* GDB works again better :

correct type info in one pass
  + UseTokenInfo for better source position
  * fixed one remaining bug in scanner for line counts
  * several little fixes
This commit is contained in:
pierre 1998-04-30 15:59:39 +00:00
parent f39eb43f1f
commit a10c3e36bc
16 changed files with 592 additions and 215 deletions

View File

@ -95,11 +95,10 @@ implementation
begin begin
get_file_line:=''; get_file_line:='';
if inputfile=nil then exit; if inputfile=nil then exit;
{$ifdef USE_RHIDE} if Use_Rhide then
get_file_line:=lowercase(inputfile^.name^+inputfile^.ext^)+':'+tostr(lineno)+':' get_file_line:=lowercase(inputfile^.name^+inputfile^.ext^)+':'+tostr(lineno)+':'
{$else USE_RHIDE} else
get_file_line:=inputfile^.name^+inputfile^.ext^+'('+tostr(lineno)+')' get_file_line:=inputfile^.name^+inputfile^.ext^+'('+tostr(lineno)+')'
{$endif USE_RHIDE}
end; end;
procedure add_new_ref(var ref : pref); procedure add_new_ref(var ref : pref);
@ -134,8 +133,15 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.1 1998-03-25 11:18:12 root Revision 1.2 1998-04-30 15:59:39 pierre
Initial revision * GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.1.1.1 1998/03/25 11:18:12 root
* Restored version
Revision 1.5 1998/03/10 16:27:36 pierre Revision 1.5 1998/03/10 16:27:36 pierre
* better line info in stabs debug * better line info in stabs debug

View File

@ -4786,6 +4786,9 @@ implementation
begin begin
secondpass(p^.left); secondpass(p^.left);
if (p^.left^.resulttype<>pdef(voiddef)) then
if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
ungetiftemp(p^.left^.location.reference);
end; end;
procedure secondblockn(var p : ptree); procedure secondblockn(var p : ptree);
@ -4802,6 +4805,9 @@ implementation
begin begin
cleartempgen; cleartempgen;
secondpass(hp^.right); secondpass(hp^.right);
if (hp^.right^.resulttype<>pdef(voiddef)) then
if hp^.right^.location.loc in [LOC_MEM,LOC_REFERENCE] then
ungetiftemp(hp^.right^.location.reference);
end; end;
hp:=hp^.left; hp:=hp^.left;
end; end;
@ -5755,8 +5761,9 @@ do_jmp:
oldnr:=current_module^.current_inputfile^.line_no; oldnr:=current_module^.current_inputfile^.line_no;
codegenerror:=false; codegenerror:=false;
current_module^.current_inputfile:=p^.inputfile; current_module^.current_inputfile:=
current_module^.current_inputfile^.line_no:=p^.line; pinputfile(current_module^.sourcefiles.get_file(p^.fileinfo.fileindex));
current_module^.current_inputfile^.line_no:=p^.fileinfo.line;
aktswitches:=p^.pragmas; aktswitches:=p^.pragmas;
if not(p^.error) then if not(p^.error) then
begin begin
@ -5764,7 +5771,8 @@ do_jmp:
p^.error:=codegenerror; p^.error:=codegenerror;
codegenerror:=codegenerror or oldcodegenerror; codegenerror:=codegenerror or oldcodegenerror;
end end
else codegenerror:=true; else
codegenerror:=true;
aktswitches:=oldswitches; aktswitches:=oldswitches;
current_module^.current_inputfile:=oldis; current_module^.current_inputfile:=oldis;
current_module^.current_inputfile^.line_no:=oldnr; current_module^.current_inputfile^.line_no:=oldnr;
@ -6025,7 +6033,14 @@ do_jmp:
end. end.
{ {
$Log$ $Log$
Revision 1.18 1998-04-29 10:33:48 pierre Revision 1.19 1998-04-30 15:59:39 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.18 1998/04/29 10:33:48 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output

View File

@ -133,17 +133,18 @@
flags : tresflags; flags : tresflags;
begin begin
if (p^.left^.resulttype^.deftype<>stringdef) and if (p^.left^.resulttype^.deftype<>stringdef) and
not ((p^.left^.resulttype^.deftype=setdef) and ((p^.left^.resulttype^.deftype<>setdef) or
(psetdef(p^.left^.resulttype)^.settype<>smallset)) then (psetdef(p^.left^.resulttype)^.settype=smallset)) then
begin
{ this can be useful if for instance length(string) is called }
if (p^.left^.location.loc=LOC_REFERENCE) or if (p^.left^.location.loc=LOC_REFERENCE) or
(p^.left^.location.loc=LOC_MEM) then (p^.left^.location.loc=LOC_MEM) then
ungetiftemp(p^.left^.location.reference); ungetiftemp(p^.left^.location.reference);
if (p^.right^.resulttype^.deftype<>stringdef) and
((p^.right^.resulttype^.deftype<>setdef) or
(psetdef(p^.right^.resulttype)^.settype=smallset)) then
{ this can be useful if for instance length(string) is called }
if (p^.right^.location.loc=LOC_REFERENCE) or if (p^.right^.location.loc=LOC_REFERENCE) or
(p^.right^.location.loc=LOC_MEM) then (p^.right^.location.loc=LOC_MEM) then
ungetiftemp(p^.right^.location.reference); ungetiftemp(p^.right^.location.reference);
end;
{ in case of comparison operation the put result in the flags } { in case of comparison operation the put result in the flags }
if cmpop then if cmpop then
begin begin
@ -1270,7 +1271,14 @@
{ {
$Log$ $Log$
Revision 1.5 1998-04-29 10:33:49 pierre Revision 1.6 1998-04-30 15:59:40 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.5 1998/04/29 10:33:49 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output

View File

@ -43,12 +43,21 @@ unit cobjects;
type type
pstring = ^string; pstring = ^string;
tfileposinfo = record
line : longint; { could be changed to abspos }
fileindex,column : word;
end;
pfileposinfo = ^tfileposinfo;
{ some help data types } { some help data types }
pstringitem = ^tstringitem; pstringitem = ^tstringitem;
tstringitem = record tstringitem = record
data : pstring; data : pstring;
next : pstringitem; next : pstringitem;
{$ifdef UseTokenInfo}
fileinfo : tfileposinfo; { pointer to tinputfile }
{$endif UseTokenInfo}
end; end;
plinkedlist_item = ^tlinkedlist_item; plinkedlist_item = ^tlinkedlist_item;
@ -127,9 +136,15 @@ unit cobjects;
{ inserts a string } { inserts a string }
procedure insert(const s : string); procedure insert(const s : string);
{$ifdef UseTokenInfo}
procedure insert_with_tokeninfo(const s : string;const file_info : tfileposinfo);
{$endif UseTokenInfo}
{ gets a string } { gets a string }
function get : string; function get : string;
{$ifdef UseTokenInfo}
function get_with_tokeninfo(var file_info : tfileposinfo) : string;
{$endif UseTokenInfo}
{ deletes all strings } { deletes all strings }
procedure clear; procedure clear;
@ -456,6 +471,33 @@ end;
last:=hp; last:=hp;
end; end;
{$ifdef UseTokenInfo}
procedure tstringcontainer.insert_with_tokeninfo
(const s : string; const file_info : tfileposinfo);
var
hp : pstringitem;
begin
if not(doubles) then
begin
hp:=root;
while assigned(hp) do
begin
if hp^.data^=s then exit;
hp:=hp^.next;
end;
end;
new(hp);
hp^.next:=nil;
hp^.data:=stringdup(s);
hp^.fileinfo:=file_info;
if root=nil then root:=hp
else last^.next:=hp;
last:=hp;
end;
{$endif UseTokenInfo}
procedure tstringcontainer.clear; procedure tstringcontainer.clear;
var var
@ -492,6 +534,32 @@ end;
end; end;
end; end;
{$ifdef UseTokenInfo}
function tstringcontainer.get_with_tokeninfo(var file_info : tfileposinfo) : string;
var
hp : pstringitem;
begin
if root=nil then
begin
get_with_tokeninfo:='';
file_info.fileindex:=0;
file_info.line:=0;
file_info.column:=0;
end
else
begin
get_with_tokeninfo:=root^.data^;
hp:=root;
root:=root^.next;
stringdispose(hp^.data);
file_info:=hp^.fileinfo;
dispose(hp);
end;
end;
{$endif UseTokenInfo}
{**************************************************************************** {****************************************************************************
TLINKEDLIST_ITEM TLINKEDLIST_ITEM
****************************************************************************} ****************************************************************************}
@ -995,7 +1063,14 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.4 1998-04-29 10:33:50 pierre Revision 1.5 1998-04-30 15:59:40 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.4 1998/04/29 10:33:50 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output

View File

@ -71,14 +71,9 @@ unit files;
destructor done; destructor done;
procedure close_all; procedure close_all;
procedure register_file(f : pextfile); procedure register_file(f : pextfile);
function get_file(w : word) : pextfile;
end; end;
tfileposinfo = record
infile : pinputfile;
line : longint; { could be changed to abspos }
end;
pfileposinfo = ^tfileposinfo;
type type
tunitmap = array[0..maxunits-1] of pointer; tunitmap = array[0..maxunits-1] of pointer;
punitmap = ^tunitmap; punitmap = ^tunitmap;
@ -110,6 +105,8 @@ unit files;
linkofiles : tstringcontainer; linkofiles : tstringcontainer;
used_units : tlinkedlist; used_units : tlinkedlist;
current_inputfile : pinputfile; current_inputfile : pinputfile;
{ used in firstpass for faster settings }
current_index : word;
unitname, { name of the (unit) module in uppercase } unitname, { name of the (unit) module in uppercase }
objfilename, { fullname of the objectfile } objfilename, { fullname of the objectfile }
@ -258,11 +255,10 @@ unit files;
function tinputfile.get_file_line : string; function tinputfile.get_file_line : string;
begin begin
{$ifdef USE_RHIDE} if Use_Rhide then
get_file_line:=lowercase(name^+ext^)+':'+tostr(line_no)+':' get_file_line:=lowercase(bstoslash(path^)+name^+ext^)+':'+tostr(line_no)+':'
{$else USE_RHIDE} else
get_file_line:=name^+ext^+'('+tostr(line_no)+')' get_file_line:=name^+ext^+'('+tostr(line_no)+')'
{$endif USE_RHIDE}
end; end;
{**************************************************************************** {****************************************************************************
@ -305,6 +301,16 @@ unit files;
files:=f; files:=f;
end; end;
function tfilemanager.get_file(w : word) : pextfile;
var
ff : pextfile;
begin
ff:=files;
while assigned(ff) and (ff^.ref_index<>w) do
ff:=ff^._next;
get_file:=ff;
end;
{**************************************************************************** {****************************************************************************
TMODULE TMODULE
****************************************************************************} ****************************************************************************}
@ -624,7 +630,14 @@ unit files;
end. end.
{ {
$Log$ $Log$
Revision 1.4 1998-04-29 10:33:52 pierre Revision 1.5 1998-04-30 15:59:40 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.4 1998/04/29 10:33:52 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output

View File

@ -303,6 +303,7 @@ unit parser;
token:=tokeninfo^.token; token:=tokeninfo^.token;
{$endif UseTokenInfo} {$endif UseTokenInfo}
reset_gdb_info;
{ init asm writing } { init asm writing }
datasegment:=new(paasmoutput,init); datasegment:=new(paasmoutput,init);
codesegment:=new(paasmoutput,init); codesegment:=new(paasmoutput,init);
@ -462,6 +463,7 @@ done:
dispose(consts,Done); dispose(consts,Done);
end; end;
reset_gdb_info;
{ restore symtable state } { restore symtable state }
{$ifdef UseBrowser} {$ifdef UseBrowser}
if (compile_level>1) then if (compile_level>1) then
@ -524,7 +526,6 @@ done:
nextlabelnr:=oldnextlabelnr; nextlabelnr:=oldnextlabelnr;
reset_gdb_info;
if (compile_level=1) then if (compile_level=1) then
begin begin
if (not AsmRes.Empty) then if (not AsmRes.Empty) then
@ -539,7 +540,14 @@ done:
end. end.
{ {
$Log$ $Log$
Revision 1.8 1998-04-29 10:33:55 pierre Revision 1.9 1998-04-30 15:59:40 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.8 1998/04/29 10:33:55 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output

View File

@ -1711,6 +1711,7 @@ unit pass_1;
procedure firstnothing(var p : ptree); procedure firstnothing(var p : ptree);
begin begin
p^.resulttype:=voiddef;
end; end;
procedure firstassignment(var p : ptree); procedure firstassignment(var p : ptree);
@ -4017,20 +4018,39 @@ unit pass_1;
procinfo.flags:=procinfo.flags or pi_do_call; procinfo.flags:=procinfo.flags or pi_do_call;
end; end;
{ !!!!!!!!!!!! unused } procedure firststatement(var p : ptree);
procedure firstexpr(var p : ptree);
begin begin
{ left is the next statement in the list }
p^.resulttype:=voiddef;
{ no temps over several statements }
cleartempgen;
{ right is the statement itself calln assignn or a complex one }
firstpass(p^.right);
if (not (cs_extsyntax in aktswitches)) and
assigned(p^.right^.resulttype) and
(p^.right^.resulttype<>pdef(voiddef)) then
Message(cg_e_illegal_expression);
if codegenerror then
exit;
p^.registers32:=p^.right^.registers32;
p^.registersfpu:=p^.right^.registersfpu;
{$ifdef SUPPORT_MMX}
p^.registersmmx:=p^.right^.registersmmx;
{$endif SUPPORT_MMX}
firstpass(p^.left); firstpass(p^.left);
if codegenerror then if codegenerror then
exit; exit;
p^.registers32:=p^.left^.registers32; if p^.right^.registers32>p^.registers32 then
p^.registersfpu:=p^.left^.registersfpu; p^.registers32:=p^.right^.registers32;
if p^.right^.registersfpu>p^.registersfpu then
p^.registersfpu:=p^.right^.registersfpu;
{$ifdef SUPPORT_MMX} {$ifdef SUPPORT_MMX}
p^.registersmmx:=p^.left^.registersmmx; if p^.right^.registersmmx>p^.registersmmx then
{$endif SUPPORT_MMX} p^.registersmmx:=p^.right^.registersmmx;
if (cs_extsyntax in aktswitches) and (p^.left^.resulttype<>pdef(voiddef)) then {$endif}
Message(cg_e_illegal_expression);
end; end;
procedure firstblock(var p : ptree); procedure firstblock(var p : ptree);
@ -4073,22 +4093,23 @@ unit pass_1;
(hp^.left^.treetype<>labeln) then (hp^.left^.treetype<>labeln) then
begin begin
{ use correct line number } { use correct line number }
current_module^.current_inputfile:=hp^.left^.inputfile; set_current_file_line(hp^.left);
current_module^.current_inputfile^.line_no:=hp^.left^.line;
disposetree(hp^.left); disposetree(hp^.left);
hp^.left:=nil; hp^.left:=nil;
Message(cg_w_unreachable_code); Message(cg_w_unreachable_code);
{ old lines } { old lines }
current_module^.current_inputfile:=hp^.right^.inputfile; set_current_file_line(hp^.right);
current_module^.current_inputfile^.line_no:=hp^.right^.line;
end; end;
end; end;
if assigned(hp^.right) then if assigned(hp^.right) then
begin begin
cleartempgen; cleartempgen;
firstpass(hp^.right); firstpass(hp^.right);
if (not (cs_extsyntax in aktswitches)) and
assigned(hp^.right^.resulttype) and
(hp^.right^.resulttype<>pdef(voiddef)) then
Message(cg_e_illegal_expression);
if codegenerror then if codegenerror then
exit; exit;
@ -4700,7 +4721,7 @@ unit pass_1;
setelen, {A set element (i.e. [a,b]).} setelen, {A set element (i.e. [a,b]).}
setconstrn, {A set constant (i.e. [1,2]).} setconstrn, {A set constant (i.e. [1,2]).}
blockn, {A block of statements.} blockn, {A block of statements.}
anwein, {A linear list of nodes.} statementn, {One statement in list of nodes.}
loopn, { used in genloopnode, must be converted } loopn, { used in genloopnode, must be converted }
ifn, {An if statement.} ifn, {An if statement.}
breakn, {A break statement.} breakn, {A break statement.}
@ -4741,7 +4762,7 @@ unit pass_1;
firstnot,firstinline,firstniln,firsterror, firstnot,firstinline,firstniln,firsterror,
firsttypen,firsthnewn,firsthdisposen,firstnewn, firsttypen,firsthnewn,firsthdisposen,firstnewn,
firstsimplenewdispose,firstnothing,firstsetcons,firstblock, firstsimplenewdispose,firstnothing,firstsetcons,firstblock,
firstnothing,firstnothing,firstif,firstnothing, firststatement,firstnothing,firstif,firstnothing,
firstnothing,first_while_repeat,first_while_repeat,firstfor, firstnothing,first_while_repeat,first_while_repeat,firstfor,
firstexitn,firstwith,firstcase,firstlabel, firstexitn,firstwith,firstcase,firstlabel,
firstgoto,firstsimplenewdispose,firsttryexcept,firstraise, firstgoto,firstsimplenewdispose,firsttryexcept,firstraise,
@ -4767,8 +4788,9 @@ unit pass_1;
{$endif extdebug} {$endif extdebug}
codegenerror:=false; codegenerror:=false;
current_module^.current_inputfile:=p^.inputfile; current_module^.current_inputfile:=
current_module^.current_inputfile^.line_no:=p^.line; pinputfile(current_module^.sourcefiles.get_file(p^.fileinfo.fileindex));
current_module^.current_inputfile^.line_no:=p^.fileinfo.line;
aktswitches:=p^.pragmas; aktswitches:=p^.pragmas;
if not(p^.error) then if not(p^.error) then
@ -4805,7 +4827,14 @@ unit pass_1;
end. end.
{ {
$Log$ $Log$
Revision 1.13 1998-04-29 10:33:56 pierre Revision 1.14 1998-04-30 15:59:41 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.13 1998/04/29 10:33:56 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output

View File

@ -25,7 +25,7 @@ unit pbase;
interface interface
uses uses
cobjects,globals,scanner,symtable,systems,verbose; files,cobjects,globals,scanner,symtable,systems,verbose;
const const
{ forward types should only be possible inside } { forward types should only be possible inside }
@ -208,7 +208,12 @@ unit pbase;
begin begin
sc:=new(pstringcontainer,init); sc:=new(pstringcontainer,init);
repeat repeat
{$ifndef UseTokenInfo}
sc^.insert(pattern); sc^.insert(pattern);
{$else UseTokenInfo}
sc^.insert_with_tokeninfo(pattern,
tokeninfo^.fi);
{$endif UseTokenInfo}
consume(ID); consume(ID);
if token=COMMA then consume(COMMA) if token=COMMA then consume(COMMA)
else break else break
@ -222,12 +227,27 @@ unit pbase;
var var
s : string; s : string;
{$ifdef UseTokenInfo}
filepos : tfileposinfo;
ss : pvarsym;
{$endif UseTokenInfo}
begin begin
{$ifdef UseTokenInfo}
s:=sc^.get_with_tokeninfo(filepos);
{$else UseTokenInfo}
s:=sc^.get; s:=sc^.get;
{$endif UseTokenInfo}
while s<>'' do while s<>'' do
begin begin
{$ifndef UseTokenInfo}
st^.insert(new(pvarsym,init(s,def))); st^.insert(new(pvarsym,init(s,def)));
{$else UseTokenInfo}
ss:=new(pvarsym,init(s,def));
ss^.line_no:=filepos.line;
st^.insert(ss);
{$endif UseTokenInfo}
{ static data fields are inserted in the globalsymtable } { static data fields are inserted in the globalsymtable }
if (st^.symtabletype=objectsymtable) and if (st^.symtabletype=objectsymtable) and
((current_object_option and sp_static)<>0) then ((current_object_option and sp_static)<>0) then
@ -235,7 +255,11 @@ unit pbase;
s:=lowercase(st^.name^)+'_'+s; s:=lowercase(st^.name^)+'_'+s;
st^.defowner^.owner^.insert(new(pvarsym,init(s,def))); st^.defowner^.owner^.insert(new(pvarsym,init(s,def)));
end; end;
{$ifdef UseTokenInfo}
s:=sc^.get_with_tokeninfo(filepos);
{$else UseTokenInfo}
s:=sc^.get; s:=sc^.get;
{$endif UseTokenInfo}
end; end;
dispose(sc,done); dispose(sc,done);
end; end;
@ -244,7 +268,14 @@ end.
{ {
$Log$ $Log$
Revision 1.3 1998-04-29 10:33:57 pierre Revision 1.4 1998-04-30 15:59:41 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.3 1998/04/29 10:33:57 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output

View File

@ -56,7 +56,7 @@ unit pdecl;
uses uses
cobjects,scanner,aasm,tree,pass_1, cobjects,scanner,aasm,tree,pass_1,
types,hcodegen,verbose,systems files,types,hcodegen,verbose,systems
{$ifdef GDB} {$ifdef GDB}
,gdb ,gdb
{$endif GDB} {$endif GDB}
@ -382,6 +382,9 @@ unit pdecl;
sc : pstringcontainer; sc : pstringcontainer;
hp : pdef; hp : pdef;
s : string; s : string;
{$ifdef UseTokenInfo}
filepos : tfileposinfo;
{$endif UseTokenInfo}
pp : pprocdef; pp : pprocdef;
begin begin
@ -988,7 +991,7 @@ unit pdecl;
begin begin
do_count_dbx:=true; do_count_dbx:=true;
if assigned(aktclass^.owner) and assigned(aktclass^.owner^.name) then if assigned(aktclass^.owner) and assigned(aktclass^.owner^.name) then
debuglist^.concat(new(pai_stabs,init(strpnew('"vmt_'+aktclass^.owner^.name^+n+':S'+ datasegment^.concat(new(pai_stabs,init(strpnew('"vmt_'+aktclass^.owner^.name^+n+':S'+
typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname)))); typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname))));
end; end;
{$endif * GDB *} {$endif * GDB *}
@ -1534,6 +1537,10 @@ unit pdecl;
old_block_type : tblock_type; old_block_type : tblock_type;
{ to handle absolute } { to handle absolute }
abssym : pabsolutesym; abssym : pabsolutesym;
{$ifdef UseTokenInfo}
filepos : tfileposinfo;
{$endif UseTokenInfo}
begin begin
hs:=''; hs:='';
@ -1550,7 +1557,11 @@ unit pdecl;
p:=read_type(''); p:=read_type('');
if do_absolute and (token=ID) and (pattern='ABSOLUTE') then if do_absolute and (token=ID) and (pattern='ABSOLUTE') then
begin begin
{$ifdef UseTokenInfo}
s:=sc^.get_with_tokeninfo(filepos);
{$else UseTokenInfo}
s:=sc^.get; s:=sc^.get;
{$endif UseTokenInfo}
if sc^.get<>'' then if sc^.get<>'' then
Message(parser_e_absolute_only_one_var); Message(parser_e_absolute_only_one_var);
dispose(sc,done); dispose(sc,done);
@ -1566,6 +1577,9 @@ unit pdecl;
abssym^.typ:=absolutesym; abssym^.typ:=absolutesym;
abssym^.abstyp:=tovar; abssym^.abstyp:=tovar;
abssym^.ref:=srsym; abssym^.ref:=srsym;
{$ifdef UseTokenInfo}
abssym^.line_no:=filepos.line;
{$endif UseTokenInfo}
symtablestack^.insert(abssym); symtablestack^.insert(abssym);
end end
else else
@ -1577,6 +1591,9 @@ unit pdecl;
abssym^.typ:=absolutesym; abssym^.typ:=absolutesym;
abssym^.abstyp:=toasm; abssym^.abstyp:=toasm;
abssym^.asmname:=stringdup(s); abssym^.asmname:=stringdup(s);
{$ifdef UseTokenInfo}
abssym^.line_no:=filepos.line;
{$endif UseTokenInfo}
symtablestack^.insert(abssym); symtablestack^.insert(abssym);
end end
else else
@ -1589,6 +1606,9 @@ unit pdecl;
abssym^.typ:=absolutesym; abssym^.typ:=absolutesym;
abssym^.abstyp:=toaddr; abssym^.abstyp:=toaddr;
abssym^.absseg:=false; abssym^.absseg:=false;
{$ifdef UseTokenInfo}
abssym^.line_no:=filepos.line;
{$endif UseTokenInfo}
s:=pattern; s:=pattern;
consume(INTCONST); consume(INTCONST);
val(s,abssym^.address,code); val(s,abssym^.address,code);
@ -1758,7 +1778,14 @@ unit pdecl;
end. end.
{ {
$Log$ $Log$
Revision 1.12 1998-04-29 10:33:57 pierre Revision 1.13 1998-04-30 15:59:41 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.12 1998/04/29 10:33:57 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output

View File

@ -496,11 +496,15 @@ unit pmodules;
aktprocsym:=oldprocsym; aktprocsym:=oldprocsym;
end; end;
procedure parse_uses(symt:Psymtable); procedure parse_implementation_uses(symt:Psymtable);
var
old_module_in_implementation : boolean;
begin begin
if token=_USES then if token=_USES then
begin begin
old_module_in_implementation:=module_in_implementation;
module_in_implementation:=true;
current_module^.in_implementation:=true; current_module^.in_implementation:=true;
symt^.symtabletype:=unitsymtable; symt^.symtabletype:=unitsymtable;
loadunits; loadunits;
@ -508,6 +512,7 @@ unit pmodules;
{$ifdef DEBUG} {$ifdef DEBUG}
test_symtablestack; test_symtablestack;
{$endif DEBUG} {$endif DEBUG}
module_in_implementation:=old_module_in_implementation;
end; end;
end; end;
@ -694,7 +699,7 @@ unit pmodules;
{ to reinsert it after loading the implementation units } { to reinsert it after loading the implementation units }
symtablestack:=unitst^.next; symtablestack:=unitst^.next;
parse_uses(unitst); parse_implementation_uses(unitst);
{ but reinsert the global symtable as lasts } { but reinsert the global symtable as lasts }
unitst^.next:=symtablestack; unitst^.next:=symtablestack;
@ -950,7 +955,14 @@ unit pmodules;
end. end.
{ {
$Log$ $Log$
Revision 1.7 1998-04-29 10:33:59 pierre Revision 1.8 1998-04-30 15:59:41 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.7 1998/04/29 10:33:59 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output

View File

@ -100,12 +100,12 @@ unit pstatmnt;
begin begin
if first=nil then if first=nil then
begin begin
last:=gennode(anwein,nil,statement); last:=gennode(statementn,nil,statement);
first:=last; first:=last;
end end
else else
begin begin
last^.left:=gennode(anwein,nil,statement); last^.left:=gennode(statementn,nil,statement);
last:=last^.left; last:=last^.left;
end; end;
if token<>SEMICOLON then if token<>SEMICOLON then
@ -225,7 +225,7 @@ unit pstatmnt;
p^.labelnr:=aktcaselabel; p^.labelnr:=aktcaselabel;
{ concats instruction } { concats instruction }
instruc:=gennode(anwein,instruc,p); instruc:=gennode(statementn,instruc,p);
if not((token=_ELSE) or (token=_OTHERWISE) or (token=_END)) then if not((token=_ELSE) or (token=_OTHERWISE) or (token=_END)) then
consume(SEMICOLON); consume(SEMICOLON);
@ -262,12 +262,12 @@ unit pstatmnt;
begin begin
if first=nil then if first=nil then
begin begin
last:=gennode(anwein,nil,statement); last:=gennode(statementn,nil,statement);
first:=last; first:=last;
end end
else else
begin begin
last^.left:=gennode(anwein,nil,statement); last^.left:=gennode(statementn,nil,statement);
last:=last^.left; last:=last^.left;
end; end;
if token<>SEMICOLON then if token<>SEMICOLON then
@ -458,12 +458,12 @@ unit pstatmnt;
begin begin
if first=nil then if first=nil then
begin begin
last:=gennode(anwein,nil,statement); last:=gennode(statementn,nil,statement);
first:=last; first:=last;
end end
else else
begin begin
last^.left:=gennode(anwein,nil,statement); last^.left:=gennode(statementn,nil,statement);
last:=last^.left; last:=last^.left;
end; end;
if token<>SEMICOLON then if token<>SEMICOLON then
@ -791,12 +791,12 @@ unit pstatmnt;
begin begin
if first=nil then if first=nil then
begin begin
last:=gennode(anwein,nil,statement); last:=gennode(statementn,nil,statement);
first:=last; first:=last;
end end
else else
begin begin
last^.left:=gennode(anwein,nil,statement); last^.left:=gennode(statementn,nil,statement);
last:=last^.left; last:=last^.left;
end; end;
if token=_END then if token=_END then
@ -828,7 +828,7 @@ unit pstatmnt;
code : ptree; code : ptree;
labelnr : plabel; labelnr : plabel;
{$ifdef UseTokenInfo} {$ifdef UseTokenInfo}
filepos : tfilepos; filepos : tfileposinfo;
{$endif UseTokenInfo} {$endif UseTokenInfo}
label label
@ -836,7 +836,7 @@ unit pstatmnt;
begin begin
{$ifdef UseTokenInfo} {$ifdef UseTokenInfo}
filepos:=tokeninfo^.filepos; filepos:=tokeninfo^.fi;
{$endif UseTokenInfo} {$endif UseTokenInfo}
case token of case token of
_GOTO : begin _GOTO : begin
@ -1076,7 +1076,14 @@ unit pstatmnt;
end. end.
{ {
$Log$ $Log$
Revision 1.5 1998-04-29 10:33:59 pierre Revision 1.6 1998-04-30 15:59:42 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.5 1998/04/29 10:33:59 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output

View File

@ -604,7 +604,9 @@ const
current_module^.current_inputfile^.bufpos:=longint(inputpointer)-longint(inputbuffer); current_module^.current_inputfile^.bufpos:=longint(inputpointer)-longint(inputbuffer);
hp^.next:=current_module^.current_inputfile; hp^.next:=current_module^.current_inputfile;
current_module^.current_inputfile:=hp; current_module^.current_inputfile:=hp;
status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;
current_module^.sourcefiles.register_file(hp); current_module^.sourcefiles.register_file(hp);
current_module^.current_index:=hp^.ref_index;
inputbuffer:=current_module^.current_inputfile^.buf; inputbuffer:=current_module^.current_inputfile^.buf;
Message1(scan_u_start_include_file,current_module^.current_inputfile^.name^); Message1(scan_u_start_include_file,current_module^.current_inputfile^.name^);
reload; reload;
@ -823,7 +825,14 @@ const
{ {
$Log$ $Log$
Revision 1.4 1998-04-29 13:42:27 peter Revision 1.5 1998-04-30 15:59:42 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.4 1998/04/29 13:42:27 peter
+ $IOCHECKS and $ALIGN to test already, other will follow soon + $IOCHECKS and $ALIGN to test already, other will follow soon
* fixed the wrong linecounting with comments * fixed the wrong linecounting with comments

View File

@ -28,7 +28,7 @@ unit scanner;
interface interface
uses uses
globals,files; cobjects,globals,files;
const const
{$ifdef TP} {$ifdef TP}
@ -135,15 +135,6 @@ unit scanner;
destructor done; destructor done;
end; end;
{$ifdef UseTokenInfo}
ttokeninfo = record
token : ttoken;
fi : tfileposinfo;
end;
ptokeninfo = ^ttokeninfo;
{$endif UseTokenInfo}
var var
c : char; c : char;
orgpattern, orgpattern,
@ -162,6 +153,15 @@ unit scanner;
preprocstack : ppreprocstack; preprocstack : ppreprocstack;
{$ifdef UseTokenInfo}
type
ttokeninfo = record
token : ttoken;
fi : tfileposinfo;
end;
ptokeninfo = ^ttokeninfo;
{$endif UseTokenInfo}
{public} {public}
procedure syntaxerror(const s : string); procedure syntaxerror(const s : string);
{$ifndef UseTokenInfo} {$ifndef UseTokenInfo}
@ -170,6 +170,9 @@ unit scanner;
function yylex : ptokeninfo; function yylex : ptokeninfo;
{$endif UseTokenInfo} {$endif UseTokenInfo}
function asmgetchar : char; function asmgetchar : char;
function get_current_col : longint;
procedure get_cur_file_pos(var fileinfo : tfileposinfo);
procedure set_cur_file_pos(const fileinfo : tfileposinfo);
procedure InitScanner(const fn: string); procedure InitScanner(const fn: string);
procedure DoneScanner(testendif:boolean); procedure DoneScanner(testendif:boolean);
@ -178,13 +181,14 @@ unit scanner;
implementation implementation
uses uses
dos,cobjects,verbose,pbase, dos,verbose,pbase,
symtable,switches,link; symtable,switches,link;
var var
{ this is usefull to get the write filename { this is usefull to get the write filename
for the last instruction of an include file !} for the last instruction of an include file !}
FileHasChanged : Boolean; FileHasChanged : Boolean;
status : tcompilestatus;
{***************************************************************************** {*****************************************************************************
@ -350,6 +354,8 @@ unit scanner;
current_module^.current_inputfile^.close; current_module^.current_inputfile^.close;
{ load next module } { load next module }
current_module^.current_inputfile:=current_module^.current_inputfile^.next; current_module^.current_inputfile:=current_module^.current_inputfile^.next;
current_module^.current_index:=current_module^.current_inputfile^.ref_index;
status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;
inputbuffer:=current_module^.current_inputfile^.buf; inputbuffer:=current_module^.current_inputfile^.buf;
inputpointer:=inputbuffer+current_module^.current_inputfile^.bufpos; inputpointer:=inputbuffer+current_module^.current_inputfile^.bufpos;
end; end;
@ -361,11 +367,11 @@ unit scanner;
procedure linebreak; procedure linebreak;
var var
status : tcompilestatus;
cur : char; cur : char;
begin begin
cur:=c; cur:=c;
if byte(inputpointer^)=0 then if (byte(inputpointer^)=0) and
current_module^.current_inputfile^.filenotatend then
begin begin
reload; reload;
if byte(cur)+byte(c)<>23 then if byte(cur)+byte(c)<>23 then
@ -382,7 +388,8 @@ unit scanner;
totalcompiledlines:=abslines; totalcompiledlines:=abslines;
currentline:=current_module^.current_inputfile^.line_no currentline:=current_module^.current_inputfile^.line_no
+current_module^.current_inputfile^.line_count; +current_module^.current_inputfile^.line_count;
currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^; { you call strcopy here at each line !!! }
{currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;}
totallines:=0; totallines:=0;
end; end;
if compilestatusproc(status) then if compilestatusproc(status) then
@ -419,16 +426,9 @@ unit scanner;
readstring[i]:=c; readstring[i]:=c;
end; end;
{ get next char } { get next char }
c:=inputpointer^; readchar;
if c=#0 then
reload
else
inc(longint(inputpointer));
end; end;
readstring[0]:=chr(i); readstring[0]:=chr(i);
{ was the next char a linebreak ? }
if c in [#10,#13] then
linebreak;
end; end;
@ -472,16 +472,12 @@ unit scanner;
readnumber[i]:=c; readnumber[i]:=c;
end; end;
{ get next char } { get next char }
c:=inputpointer^; readchar;
if c=#0 then
reload
else
inc(longint(inputpointer));
end; end;
readnumber[0]:=chr(i); readnumber[0]:=chr(i);
{ was the next char a linebreak ? } { was the next char a linebreak ? }
if c in [#10,#13] then { if c in [#10,#13] then
linebreak; linebreak; }
end; end;
@ -526,13 +522,14 @@ unit scanner;
begin begin
while c in [' ',#9..#13] do while c in [' ',#9..#13] do
begin begin
c:=inputpointer^; readchar;
{c:=inputpointer^;
if c=#0 then if c=#0 then
reload reload
else else
inc(longint(inputpointer)); inc(longint(inputpointer));
if c in [#10,#13] then if c in [#10,#13] then
linebreak; linebreak; }
end; end;
end; end;
@ -561,13 +558,12 @@ unit scanner;
else else
found:=0; found:=0;
end; end;
c:=inputpointer^; readchar;
{c:=inputpointer^;
if c=#0 then if c=#0 then
reload reload
else else
inc(longint(inputpointer)); inc(longint(inputpointer));}
if c in [#10,#13] then
linebreak;
until (found=2); until (found=2);
end; end;
@ -588,14 +584,14 @@ unit scanner;
'}' : dec_comment_level; '}' : dec_comment_level;
#26 : Message(scan_f_end_of_file); #26 : Message(scan_f_end_of_file);
end; end;
c:=inputpointer^; readchar;
{c:=inputpointer^;
if c=#0 then if c=#0 then
reload reload
else else
inc(longint(inputpointer)); inc(longint(inputpointer));}
if c in [#10,#13] then
linebreak;
end; end;
{if (c=#10) or (c=#13) then linebreak;}
end; end;
@ -651,13 +647,12 @@ unit scanner;
else else
found:=0; found:=0;
end; end;
c:=inputpointer^; readchar;
{c:=inputpointer^;
if c=#0 then if c=#0 then
reload reload
else else
inc(longint(inputpointer)); inc(longint(inputpointer));}
if c in [#10,#13] then
linebreak;
until (found=2); until (found=2);
end; end;
end; end;
@ -672,6 +667,7 @@ unit scanner;
y : ttoken; y : ttoken;
{$ifdef UseTokenInfo} {$ifdef UseTokenInfo}
newyylex : ptokeninfo; newyylex : ptokeninfo;
line,column : longint;
{$endif UseTokenInfo} {$endif UseTokenInfo}
code : word; code : word;
l : longint; l : longint;
@ -683,6 +679,10 @@ unit scanner;
exit_label; exit_label;
{$endif UseTokenInfo} {$endif UseTokenInfo}
begin begin
{$ifdef UseTokenInfo}
line:=current_module^.current_inputfile^.line_no;
column:=get_current_col;
{$endif UseTokenInfo}
{ was the last character a point ? } { was the last character a point ? }
{ this code is needed because the scanner if there is a 1. found if } { this code is needed because the scanner if there is a 1. found if }
{ this is a floating point number or range like 1..3 } { this is a floating point number or range like 1..3 }
@ -717,6 +717,11 @@ unit scanner;
until false; until false;
lasttokenpos:=longint(inputpointer); lasttokenpos:=longint(inputpointer);
{$ifdef UseTokenInfo}
line:=current_module^.current_inputfile^.line_no;
column:=get_current_col;
{ will become line:=lasttokenpos ??;}
{$endif UseTokenInfo}
case c of case c of
'_','A'..'Z', '_','A'..'Z',
'a'..'z' : begin 'a'..'z' : begin
@ -741,7 +746,9 @@ unit scanner;
hp:=new(pinputfile,init('','Macro '+pattern,'')); hp:=new(pinputfile,init('','Macro '+pattern,''));
hp^.next:=current_module^.current_inputfile; hp^.next:=current_module^.current_inputfile;
current_module^.current_inputfile:=hp; current_module^.current_inputfile:=hp;
status.currentsource:=current_module^.current_inputfile^.name^;
current_module^.sourcefiles.register_file(hp); current_module^.sourcefiles.register_file(hp);
current_module^.current_index:=hp^.ref_index;
{ set an own buffer } { set an own buffer }
getmem(hp2,mac^.buflen+1); getmem(hp2,mac^.buflen+1);
current_module^.current_inputfile^.setbuf(hp2,mac^.buflen+1); current_module^.current_inputfile^.setbuf(hp2,mac^.buflen+1);
@ -1087,7 +1094,7 @@ unit scanner;
{$ifndef UseTokenInfo} {$ifndef UseTokenInfo}
yylex:=DOUBLEADDR; yylex:=DOUBLEADDR;
{$else UseTokenInfo} {$else UseTokenInfo}
yylex:=DOUBLEADDR; y:=DOUBLEADDR;
{$endif UseTokenInfo} {$endif UseTokenInfo}
end end
else else
@ -1287,8 +1294,9 @@ unit scanner;
exit_label: exit_label:
new(newyylex); new(newyylex);
newyylex^.token:=y; newyylex^.token:=y;
newyylex^.fi.infile:=current_module^.current_inputfile; newyylex^.fi.fileindex:=current_module^.current_index;
newyylex^.fi.line:=current_module^.current_inputfile^.line_no; newyylex^.fi.line:=line;
newyylex^.fi.column:=column;
yylex:=newyylex; yylex:=newyylex;
{$endif UseTokenInfo} {$endif UseTokenInfo}
end; end;
@ -1352,6 +1360,8 @@ unit scanner;
current_module^.current_inputfile:=new(pinputfile,init(d,n,e)); current_module^.current_inputfile:=new(pinputfile,init(d,n,e));
current_module^.current_inputfile^.reset; current_module^.current_inputfile^.reset;
current_module^.sourcefiles.register_file(current_module^.current_inputfile); current_module^.sourcefiles.register_file(current_module^.current_inputfile);
current_module^.current_index:=current_module^.current_inputfile^.ref_index;
status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;
if ioresult<>0 then if ioresult<>0 then
Message(scan_f_cannot_open_input); Message(scan_f_cannot_open_input);
inputbuffer:=current_module^.current_inputfile^.buf; inputbuffer:=current_module^.current_inputfile^.buf;
@ -1363,6 +1373,27 @@ unit scanner;
s_point:=false; s_point:=false;
end; end;
procedure get_cur_file_pos(var fileinfo : tfileposinfo);
begin
fileinfo.line:=current_module^.current_inputfile^.line_no;
{fileinfo.fileindex:=current_module^.current_inputfile^.ref_index;}
{ should allways be the same !! }
fileinfo.fileindex:=current_module^.current_index;
fileinfo.column:=get_current_col;
end;
procedure set_cur_file_pos(const fileinfo : tfileposinfo);
begin
current_module^.current_index:=fileinfo.fileindex;
current_module^.current_inputfile:=
pinputfile(current_module^.sourcefiles.get_file(fileinfo.fileindex));
current_module^.current_inputfile^.line_no:=fileinfo.line;
{fileinfo.fileindex:=current_module^.current_inputfile^.ref_index;}
{ should allways be the same !! }
{ fileinfo.column:=get_current_col; }
end;
procedure DoneScanner(testendif:boolean); procedure DoneScanner(testendif:boolean);
var var
@ -1385,7 +1416,14 @@ unit scanner;
end. end.
{ {
$Log$ $Log$
Revision 1.13 1998-04-29 13:42:27 peter Revision 1.14 1998-04-30 15:59:42 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.13 1998/04/29 13:42:27 peter
+ $IOCHECKS and $ALIGN to test already, other will follow soon + $IOCHECKS and $ALIGN to test already, other will follow soon
* fixed the wrong linecounting with comments * fixed the wrong linecounting with comments

View File

@ -29,7 +29,7 @@ unit tree;
interface interface
uses uses
globals,symtable,cobjects,verbose,aasm,files globals,scanner,symtable,cobjects,verbose,aasm,files
{$ifdef i386} {$ifdef i386}
,i386 ,i386
{$endif} {$endif}
@ -97,7 +97,7 @@ unit tree;
setelen, {A set element (i.e. [a,b]).} setelen, {A set element (i.e. [a,b]).}
setconstrn, {A set constant (i.e. [1,2]).} setconstrn, {A set constant (i.e. [1,2]).}
blockn, {A block of statements.} blockn, {A block of statements.}
anwein, {A linear list of nodes.} statementn, {One statement in a block of nodes.}
loopn, { used in genloopnode, must be converted } loopn, { used in genloopnode, must be converted }
ifn, {An if statement.} ifn, {An if statement.}
breakn, {A break statement.} breakn, {A break statement.}
@ -193,12 +193,9 @@ unit tree;
{$endif SUPPORT_MMX} {$endif SUPPORT_MMX}
left,right : ptree; left,right : ptree;
resulttype : pdef; resulttype : pdef;
inputfile : pinputfile; { line : longint;
{$ifdef TP} fileindex,colon : word; }
line:word; fileinfo : tfileposinfo;
{$else}
line : longint;
{$endif}
pragmas : Tcswitches; pragmas : Tcswitches;
{$ifdef extdebug} {$ifdef extdebug}
firstpasscount : longint; firstpasscount : longint;
@ -285,6 +282,7 @@ unit tree;
procedure set_location(var destloc,sourceloc : tlocation); procedure set_location(var destloc,sourceloc : tlocation);
procedure swap_location(var destloc,sourceloc : tlocation); procedure swap_location(var destloc,sourceloc : tlocation);
procedure set_file_line(from,_to : ptree); procedure set_file_line(from,_to : ptree);
procedure set_current_file_line(_to : ptree);
procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo); procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo);
{$ifdef extdebug} {$ifdef extdebug}
@ -296,8 +294,9 @@ unit tree;
implementation implementation
const {$ifdef UseTokenInfo}
oldswitches : tcswitches = []; uses pbase;
{$endif UseTokenInfo}
{**************************************************************************** {****************************************************************************
this is a pool for the tree nodes to get more performance this is a pool for the tree nodes to get more performance
@ -349,8 +348,14 @@ unit tree;
hp^.error:=false; hp^.error:=false;
{ we know also the position } { we know also the position }
hp^.line:=current_module^.current_inputfile^.line_no; {$ifdef UseTokenInfo}
hp^.inputfile:=current_module^.current_inputfile; if assigned(tokeninfo) then
begin
hp^.fileinfo:=tokeninfo^.fi;
end
else
{$endif UseTokenInfo}
get_cur_file_pos(hp^.fileinfo);
hp^.pragmas:=aktswitches; hp^.pragmas:=aktswitches;
getnode:=hp; getnode:=hp;
end; end;
@ -540,17 +545,22 @@ unit tree;
procedure set_file_line(from,_to : ptree); procedure set_file_line(from,_to : ptree);
begin begin
if from<>nil then if assigned(from) then
begin _to^.fileinfo:=from^.fileinfo;
_to^.line:=from^.line;
_to^.inputfile:=from^.inputfile;
end; end;
procedure set_current_file_line(_to : ptree);
begin
current_module^.current_inputfile:=
pinputfile(current_module^.sourcefiles.get_file(_to^.fileinfo.fileindex));
current_module^.current_inputfile^.line_no:=_to^.fileinfo.line;
current_module^.current_index:=_to^.fileinfo.fileindex;
end; end;
procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo); procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo);
begin begin
p^.line:=filepos.line; p^.fileinfo:=filepos;
p^.inputfile:=filepos.infile;
end; end;
function genwithnode(symtable : psymtable;l,r : ptree;count : longint) : ptree; function genwithnode(symtable : psymtable;l,r : ptree;count : longint) : ptree;
@ -1253,7 +1263,14 @@ unit tree;
end. end.
{ {
$Log$ $Log$
Revision 1.4 1998-04-29 10:34:08 pierre Revision 1.5 1998-04-30 15:59:43 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.4 1998/04/29 10:34:08 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output

View File

@ -26,8 +26,6 @@ uses verbose;
{$define allow_oldstyle} {$define allow_oldstyle}
var
UseStdErr : boolean;
procedure SetRedirectFile(const fn:string); procedure SetRedirectFile(const fn:string);
procedure _stop; procedure _stop;
@ -45,20 +43,14 @@ uses
strings,dos,cobjects,systems,globals,files; strings,dos,cobjects,systems,globals,files;
const const
{$ifdef USE_RHIDE}
{ RHIDE expect gcc like error output } { RHIDE expect gcc like error output }
fatalstr='fatal: '; rh_errorstr='error: ';
errorstr='error: '; rh_warningstr='warning: ';
warningstr='warning: ';
notestr='warning: ';
hintstr='warning: ';
{$else}
fatalstr='Fatal Error: '; fatalstr='Fatal Error: ';
errorstr='Error: '; errorstr='Error: ';
warningstr='Warning: '; warningstr='Warning: ';
notestr='Note: '; notestr='Note: ';
hintstr='Hint: '; hintstr='Hint: ';
{$endif USE_RHIDE}
var var
redirexitsave : pointer; redirexitsave : pointer;
@ -107,14 +99,14 @@ end;
Procedure _comment(Level:Longint;const s:string); Procedure _comment(Level:Longint;const s:string);
var var
hs : string; hs : string;
{$ifdef USE_RHIDE}
i : longint; i : longint;
{$endif}
begin begin
if (verbosity and Level)=Level then if (verbosity and Level)=Level then
begin begin
{Create hs} {Create hs}
hs:=''; hs:='';
if not(use_rhide) then
begin
if (verbosity and Level)=V_Hint then if (verbosity and Level)=V_Hint then
hs:=hintstr; hs:=hintstr;
if (verbosity and Level)=V_Note then if (verbosity and Level)=V_Note then
@ -125,17 +117,32 @@ begin
hs:=errorstr; hs:=errorstr;
if (verbosity and Level)=V_Fatal then if (verbosity and Level)=V_Fatal then
hs:=fatalstr; hs:=fatalstr;
end
else
begin
if (verbosity and Level)=V_Hint then
hs:=rh_warningstr;
if (verbosity and Level)=V_Note then
hs:=rh_warningstr;
if (verbosity and Level)=V_Warning then
hs:=rh_warningstr;
if (verbosity and Level)=V_Error then
hs:=rh_errorstr;
if (verbosity and Level)=V_Fatal then
hs:=rh_errorstr;
end;
if (Level<$100) and Assigned(current_module) and if (Level<$100) and Assigned(current_module) and
Assigned(current_module^.current_inputfile) then Assigned(current_module^.current_inputfile) then
hs:=current_module^.current_inputfile^.get_file_line+' '+hs; hs:=current_module^.current_inputfile^.get_file_line+' '+hs;
{$ifdef USE_RHIDE} (* {$ifdef USE_RHIDE}
What was this ??? I did not code that (PM)
if (Level<$100) then if (Level<$100) then
begin begin
i:=length(hs)+1; i:=length(hs)+1;
hs:=hs+lowercase(Copy(s,1,5))+Copy(s,6,255); hs:=hs+lowercase(Copy(s,1,5))+Copy(s,6,255);
end end
else else
{$endif USE_RHIDE} {$endif USE_RHIDE} *)
hs:=hs+s; hs:=hs+s;
{$ifdef FPC} {$ifdef FPC}
if UseStdErr and (Level<$100) then if UseStdErr and (Level<$100) then
@ -215,9 +222,9 @@ end;
{$endif} {$endif}
begin begin
{$ifdef USE_RHIDE} (* {$ifdef USE_RHIDE}
UseStdErr:=true; UseStdErr:=true;
{$endif USE_RHIDE} {$endif USE_RHIDE} *)
{$ifdef FPC} {$ifdef FPC}
do_stop:=@_stop; do_stop:=@_stop;
do_comment:=@_comment; do_comment:=@_comment;
@ -242,7 +249,14 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.4 1998-04-29 10:34:09 pierre Revision 1.5 1998-04-30 15:59:43 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.4 1998/04/29 10:34:09 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output

View File

@ -51,13 +51,16 @@ Const
V_Debug = $8000; V_Debug = $8000;
V_All = $ffffffff; V_All = $ffffffff;
V_Default = V_Error; V_Default = V_Fatal + V_Error;
Verbosity : longint=V_Default; Verbosity : longint=V_Default;
var var
errorcount : longint; { number of generated errors } errorcount : longint; { number of generated errors }
msg : pmessage; msg : pmessage;
UseStdErr : boolean;
Use_Rhide : boolean;
procedure LoadMsgFile(const fn:string); procedure LoadMsgFile(const fn:string);
function SetVerbosity(const s:string):boolean; function SetVerbosity(const s:string):boolean;
@ -116,32 +119,92 @@ end;
function SetVerbosity(const s:string):boolean; function SetVerbosity(const s:string):boolean;
var var
m : Longint; m : Longint;
c : Word; i : Word;
inverse : boolean;
c : char;
begin begin
setverbosity:=false; setverbosity:=false;
val(s,m,c); val(s,m,i);
if (c=0) and (s<>'') then if (i=0) and (s<>'') then
verbosity:=m verbosity:=m
else else
begin begin
for c:=1 to length(s) do for i:=1 to length(s) do
case upcase(s[c]) of begin
c:=s[i];
if (i<length(s)) and (s[i+1]='-') then
begin
inc(i);
inverse:=true;
end
else
inverse:=false;
case upcase(s[i]) of
{ Special cases } { Special cases }
'A' : Verbosity:=V_All; 'A' : Verbosity:=V_All;
'0' : Verbosity:=V_Default; '0' : Verbosity:=V_Default;
'R' : begin
if inverse then
begin
Use_rhide:=false;
UseStdErr:=false;
end
else
begin
Use_rhide:=true;
UseStdErr:=true;
end;
end;
{ Normal cases - do an or } { Normal cases - do an or }
'E' : Verbosity:=Verbosity or V_Error; 'E' : if inverse then
'I' : Verbosity:=Verbosity or V_Info; Verbosity:=Verbosity and (not V_Error)
'W' : Verbosity:=Verbosity or V_Warning; else
'N' : Verbosity:=Verbosity or V_Note; Verbosity:=Verbosity or V_Error;
'H' : Verbosity:=Verbosity or V_Hint; 'I' : if inverse then
'L' : Verbosity:=Verbosity or V_Linenrs; Verbosity:=Verbosity and (not V_Info)
'U' : Verbosity:=Verbosity or V_Used; else
'T' : Verbosity:=Verbosity or V_Tried; Verbosity:=Verbosity or V_Info;
'M' : Verbosity:=Verbosity or V_Macro; 'W' : if inverse then
'P' : Verbosity:=Verbosity or V_Procedure; Verbosity:=Verbosity and (not V_Warning)
'C' : Verbosity:=Verbosity or V_Conditional; else
'D' : Verbosity:=Verbosity or V_Debug; Verbosity:=Verbosity or V_Warning;
'N' : if inverse then
Verbosity:=Verbosity and (not V_Note)
else
Verbosity:=Verbosity or V_Note;
'H' : if inverse then
Verbosity:=Verbosity and (not V_Hint)
else
Verbosity:=Verbosity or V_Hint;
'L' : if inverse then
Verbosity:=Verbosity and (not V_Linenrs)
else
Verbosity:=Verbosity or V_Linenrs;
'U' : if inverse then
Verbosity:=Verbosity and (not V_Used)
else
Verbosity:=Verbosity or V_Used;
'T' : if inverse then
Verbosity:=Verbosity and (not V_Tried)
else
Verbosity:=Verbosity or V_Tried;
'M' : if inverse then
Verbosity:=Verbosity and (not V_Macro)
else
Verbosity:=Verbosity or V_Macro;
'P' : if inverse then
Verbosity:=Verbosity and (not V_Procedure)
else
Verbosity:=Verbosity or V_Procedure;
'C' : if inverse then
Verbosity:=Verbosity and (not V_Conditional)
else
Verbosity:=Verbosity or V_Conditional;
'D' : if inverse then
Verbosity:=Verbosity and (not V_Debug)
else
Verbosity:=Verbosity or V_Debug;
end;
end; end;
end; end;
if Verbosity=0 then if Verbosity=0 then
@ -149,8 +212,6 @@ begin
setverbosity:=true; setverbosity:=true;
end; end;
procedure stop; procedure stop;
begin begin
{$ifndef TP} {$ifndef TP}
@ -292,7 +353,14 @@ end.
{ {
$Log$ $Log$
Revision 1.4 1998-04-23 12:11:22 peter Revision 1.5 1998-04-30 15:59:43 pierre
* GDB works again better :
correct type info in one pass
+ UseTokenInfo for better source position
* fixed one remaining bug in scanner for line counts
* several little fixes
Revision 1.4 1998/04/23 12:11:22 peter
* fixed -v0 to displayV_Default (=errors+fatals) * fixed -v0 to displayV_Default (=errors+fatals)
Revision 1.3 1998/04/13 21:15:42 florian Revision 1.3 1998/04/13 21:15:42 florian