* 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
get_file_line:='';
if inputfile=nil then exit;
{$ifdef USE_RHIDE}
get_file_line:=lowercase(inputfile^.name^+inputfile^.ext^)+':'+tostr(lineno)+':'
{$else USE_RHIDE}
get_file_line:=inputfile^.name^+inputfile^.ext^+'('+tostr(lineno)+')'
{$endif USE_RHIDE}
if Use_Rhide then
get_file_line:=lowercase(inputfile^.name^+inputfile^.ext^)+':'+tostr(lineno)+':'
else
get_file_line:=inputfile^.name^+inputfile^.ext^+'('+tostr(lineno)+')'
end;
procedure add_new_ref(var ref : pref);
@ -134,8 +133,15 @@ implementation
end.
{
$Log$
Revision 1.1 1998-03-25 11:18:12 root
Initial revision
Revision 1.2 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.1.1.1 1998/03/25 11:18:12 root
* Restored version
Revision 1.5 1998/03/10 16:27:36 pierre
* better line info in stabs debug

View File

@ -4786,6 +4786,9 @@ implementation
begin
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;
procedure secondblockn(var p : ptree);
@ -4802,6 +4805,9 @@ implementation
begin
cleartempgen;
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;
hp:=hp^.left;
end;
@ -5751,22 +5757,24 @@ do_jmp:
begin
oldcodegenerror:=codegenerror;
oldswitches:=aktswitches;
oldis:=current_module^.current_inputfile;
oldnr:=current_module^.current_inputfile^.line_no;
oldis:=current_module^.current_inputfile;
oldnr:=current_module^.current_inputfile^.line_no;
codegenerror:=false;
current_module^.current_inputfile:=p^.inputfile;
current_module^.current_inputfile^.line_no:=p^.line;
current_module^.current_inputfile:=
pinputfile(current_module^.sourcefiles.get_file(p^.fileinfo.fileindex));
current_module^.current_inputfile^.line_no:=p^.fileinfo.line;
aktswitches:=p^.pragmas;
if not(p^.error) then
begin
procedures[p^.treetype](p);
p^.error:=codegenerror;
codegenerror:=codegenerror or oldcodegenerror;
codegenerror:=codegenerror or oldcodegenerror;
end
else codegenerror:=true;
else
codegenerror:=true;
aktswitches:=oldswitches;
current_module^.current_inputfile:=oldis;
current_module^.current_inputfile:=oldis;
current_module^.current_inputfile^.line_no:=oldnr;
end;
@ -6025,7 +6033,14 @@ do_jmp:
end.
{
$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)
* corrected operator overloading
* corrected nasm output

View File

@ -133,17 +133,18 @@
flags : tresflags;
begin
if (p^.left^.resulttype^.deftype<>stringdef) and
not ((p^.left^.resulttype^.deftype=setdef) and
(psetdef(p^.left^.resulttype)^.settype<>smallset)) then
begin
{ this can be useful if for instance length(string) is called }
((p^.left^.resulttype^.deftype<>setdef) or
(psetdef(p^.left^.resulttype)^.settype=smallset)) then
if (p^.left^.location.loc=LOC_REFERENCE) or
(p^.left^.location.loc=LOC_MEM) then
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
(p^.right^.location.loc=LOC_MEM) then
ungetiftemp(p^.right^.location.reference);
end;
{ in case of comparison operation the put result in the flags }
if cmpop then
begin
@ -1270,7 +1271,14 @@
{
$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)
* corrected operator overloading
* corrected nasm output

View File

@ -43,12 +43,21 @@ unit cobjects;
type
pstring = ^string;
tfileposinfo = record
line : longint; { could be changed to abspos }
fileindex,column : word;
end;
pfileposinfo = ^tfileposinfo;
{ some help data types }
pstringitem = ^tstringitem;
tstringitem = record
data : pstring;
next : pstringitem;
{$ifdef UseTokenInfo}
fileinfo : tfileposinfo; { pointer to tinputfile }
{$endif UseTokenInfo}
end;
plinkedlist_item = ^tlinkedlist_item;
@ -127,9 +136,15 @@ unit cobjects;
{ inserts a string }
procedure insert(const s : string);
{$ifdef UseTokenInfo}
procedure insert_with_tokeninfo(const s : string;const file_info : tfileposinfo);
{$endif UseTokenInfo}
{ gets a string }
function get : string;
{$ifdef UseTokenInfo}
function get_with_tokeninfo(var file_info : tfileposinfo) : string;
{$endif UseTokenInfo}
{ deletes all strings }
procedure clear;
@ -456,6 +471,33 @@ end;
last:=hp;
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;
var
@ -492,6 +534,32 @@ 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
****************************************************************************}
@ -995,7 +1063,14 @@ end;
end.
{
$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)
* corrected operator overloading
* corrected nasm output

View File

@ -71,14 +71,9 @@ unit files;
destructor done;
procedure close_all;
procedure register_file(f : pextfile);
function get_file(w : word) : pextfile;
end;
tfileposinfo = record
infile : pinputfile;
line : longint; { could be changed to abspos }
end;
pfileposinfo = ^tfileposinfo;
type
tunitmap = array[0..maxunits-1] of pointer;
punitmap = ^tunitmap;
@ -110,6 +105,8 @@ unit files;
linkofiles : tstringcontainer;
used_units : tlinkedlist;
current_inputfile : pinputfile;
{ used in firstpass for faster settings }
current_index : word;
unitname, { name of the (unit) module in uppercase }
objfilename, { fullname of the objectfile }
@ -258,11 +255,10 @@ unit files;
function tinputfile.get_file_line : string;
begin
{$ifdef USE_RHIDE}
get_file_line:=lowercase(name^+ext^)+':'+tostr(line_no)+':'
{$else USE_RHIDE}
get_file_line:=name^+ext^+'('+tostr(line_no)+')'
{$endif USE_RHIDE}
if Use_Rhide then
get_file_line:=lowercase(bstoslash(path^)+name^+ext^)+':'+tostr(line_no)+':'
else
get_file_line:=name^+ext^+'('+tostr(line_no)+')'
end;
{****************************************************************************
@ -305,6 +301,16 @@ unit files;
files:=f;
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
****************************************************************************}
@ -624,7 +630,14 @@ unit files;
end.
{
$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)
* corrected operator overloading
* corrected nasm output

View File

@ -303,6 +303,7 @@ unit parser;
token:=tokeninfo^.token;
{$endif UseTokenInfo}
reset_gdb_info;
{ init asm writing }
datasegment:=new(paasmoutput,init);
codesegment:=new(paasmoutput,init);
@ -462,6 +463,7 @@ done:
dispose(consts,Done);
end;
reset_gdb_info;
{ restore symtable state }
{$ifdef UseBrowser}
if (compile_level>1) then
@ -524,7 +526,6 @@ done:
nextlabelnr:=oldnextlabelnr;
reset_gdb_info;
if (compile_level=1) then
begin
if (not AsmRes.Empty) then
@ -539,7 +540,14 @@ done:
end.
{
$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)
* corrected operator overloading
* corrected nasm output

View File

@ -1711,6 +1711,7 @@ unit pass_1;
procedure firstnothing(var p : ptree);
begin
p^.resulttype:=voiddef;
end;
procedure firstassignment(var p : ptree);
@ -4017,20 +4018,39 @@ unit pass_1;
procinfo.flags:=procinfo.flags or pi_do_call;
end;
{ !!!!!!!!!!!! unused }
procedure firstexpr(var p : ptree);
procedure firststatement(var p : ptree);
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);
if codegenerror then
exit;
p^.registers32:=p^.left^.registers32;
p^.registersfpu:=p^.left^.registersfpu;
if p^.right^.registers32>p^.registers32 then
p^.registers32:=p^.right^.registers32;
if p^.right^.registersfpu>p^.registersfpu then
p^.registersfpu:=p^.right^.registersfpu;
{$ifdef SUPPORT_MMX}
p^.registersmmx:=p^.left^.registersmmx;
{$endif SUPPORT_MMX}
if (cs_extsyntax in aktswitches) and (p^.left^.resulttype<>pdef(voiddef)) then
Message(cg_e_illegal_expression);
if p^.right^.registersmmx>p^.registersmmx then
p^.registersmmx:=p^.right^.registersmmx;
{$endif}
end;
procedure firstblock(var p : ptree);
@ -4067,28 +4087,29 @@ unit pass_1;
end;
end
{ warning if unreachable code occurs and elimate this }
else if (hp^.right^.treetype in
[exitn,breakn,continuen,goton]) and
assigned(hp^.left) and
(hp^.left^.treetype<>labeln) then
begin
{ use correct line number }
current_module^.current_inputfile:=hp^.left^.inputfile;
current_module^.current_inputfile^.line_no:=hp^.left^.line;
else if (hp^.right^.treetype in
[exitn,breakn,continuen,goton]) and
assigned(hp^.left) and
(hp^.left^.treetype<>labeln) then
begin
{ use correct line number }
set_current_file_line(hp^.left);
disposetree(hp^.left);
hp^.left:=nil;
Message(cg_w_unreachable_code);
disposetree(hp^.left);
hp^.left:=nil;
Message(cg_w_unreachable_code);
{ old lines }
current_module^.current_inputfile:=hp^.right^.inputfile;
current_module^.current_inputfile^.line_no:=hp^.right^.line;
end;
{ old lines }
set_current_file_line(hp^.right);
end;
end;
if assigned(hp^.right) then
begin
cleartempgen;
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
exit;
@ -4700,7 +4721,7 @@ unit pass_1;
setelen, {A set element (i.e. [a,b]).}
setconstrn, {A set constant (i.e. [1,2]).}
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 }
ifn, {An if statement.}
breakn, {A break statement.}
@ -4741,7 +4762,7 @@ unit pass_1;
firstnot,firstinline,firstniln,firsterror,
firsttypen,firsthnewn,firsthdisposen,firstnewn,
firstsimplenewdispose,firstnothing,firstsetcons,firstblock,
firstnothing,firstnothing,firstif,firstnothing,
firststatement,firstnothing,firstif,firstnothing,
firstnothing,first_while_repeat,first_while_repeat,firstfor,
firstexitn,firstwith,firstcase,firstlabel,
firstgoto,firstsimplenewdispose,firsttryexcept,firstraise,
@ -4767,8 +4788,9 @@ unit pass_1;
{$endif extdebug}
codegenerror:=false;
current_module^.current_inputfile:=p^.inputfile;
current_module^.current_inputfile^.line_no:=p^.line;
current_module^.current_inputfile:=
pinputfile(current_module^.sourcefiles.get_file(p^.fileinfo.fileindex));
current_module^.current_inputfile^.line_no:=p^.fileinfo.line;
aktswitches:=p^.pragmas;
if not(p^.error) then
@ -4805,7 +4827,14 @@ unit pass_1;
end.
{
$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)
* corrected operator overloading
* corrected nasm output

View File

@ -25,7 +25,7 @@ unit pbase;
interface
uses
cobjects,globals,scanner,symtable,systems,verbose;
files,cobjects,globals,scanner,symtable,systems,verbose;
const
{ forward types should only be possible inside }
@ -208,7 +208,12 @@ unit pbase;
begin
sc:=new(pstringcontainer,init);
repeat
{$ifndef UseTokenInfo}
sc^.insert(pattern);
{$else UseTokenInfo}
sc^.insert_with_tokeninfo(pattern,
tokeninfo^.fi);
{$endif UseTokenInfo}
consume(ID);
if token=COMMA then consume(COMMA)
else break
@ -222,12 +227,27 @@ unit pbase;
var
s : string;
{$ifdef UseTokenInfo}
filepos : tfileposinfo;
ss : pvarsym;
{$endif UseTokenInfo}
begin
s:=sc^.get;
{$ifdef UseTokenInfo}
s:=sc^.get_with_tokeninfo(filepos);
{$else UseTokenInfo}
s:=sc^.get;
{$endif UseTokenInfo}
while s<>'' do
begin
{$ifndef UseTokenInfo}
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 }
if (st^.symtabletype=objectsymtable) and
((current_object_option and sp_static)<>0) then
@ -235,7 +255,11 @@ unit pbase;
s:=lowercase(st^.name^)+'_'+s;
st^.defowner^.owner^.insert(new(pvarsym,init(s,def)));
end;
{$ifdef UseTokenInfo}
s:=sc^.get_with_tokeninfo(filepos);
{$else UseTokenInfo}
s:=sc^.get;
{$endif UseTokenInfo}
end;
dispose(sc,done);
end;
@ -244,7 +268,14 @@ end.
{
$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)
* corrected operator overloading
* corrected nasm output

View File

@ -56,7 +56,7 @@ unit pdecl;
uses
cobjects,scanner,aasm,tree,pass_1,
types,hcodegen,verbose,systems
files,types,hcodegen,verbose,systems
{$ifdef GDB}
,gdb
{$endif GDB}
@ -382,6 +382,9 @@ unit pdecl;
sc : pstringcontainer;
hp : pdef;
s : string;
{$ifdef UseTokenInfo}
filepos : tfileposinfo;
{$endif UseTokenInfo}
pp : pprocdef;
begin
@ -988,7 +991,7 @@ unit pdecl;
begin
do_count_dbx:=true;
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))));
end;
{$endif * GDB *}
@ -1534,6 +1537,10 @@ unit pdecl;
old_block_type : tblock_type;
{ to handle absolute }
abssym : pabsolutesym;
{$ifdef UseTokenInfo}
filepos : tfileposinfo;
{$endif UseTokenInfo}
begin
hs:='';
@ -1550,7 +1557,11 @@ unit pdecl;
p:=read_type('');
if do_absolute and (token=ID) and (pattern='ABSOLUTE') then
begin
s:=sc^.get;
{$ifdef UseTokenInfo}
s:=sc^.get_with_tokeninfo(filepos);
{$else UseTokenInfo}
s:=sc^.get;
{$endif UseTokenInfo}
if sc^.get<>'' then
Message(parser_e_absolute_only_one_var);
dispose(sc,done);
@ -1566,6 +1577,9 @@ unit pdecl;
abssym^.typ:=absolutesym;
abssym^.abstyp:=tovar;
abssym^.ref:=srsym;
{$ifdef UseTokenInfo}
abssym^.line_no:=filepos.line;
{$endif UseTokenInfo}
symtablestack^.insert(abssym);
end
else
@ -1577,6 +1591,9 @@ unit pdecl;
abssym^.typ:=absolutesym;
abssym^.abstyp:=toasm;
abssym^.asmname:=stringdup(s);
{$ifdef UseTokenInfo}
abssym^.line_no:=filepos.line;
{$endif UseTokenInfo}
symtablestack^.insert(abssym);
end
else
@ -1589,6 +1606,9 @@ unit pdecl;
abssym^.typ:=absolutesym;
abssym^.abstyp:=toaddr;
abssym^.absseg:=false;
{$ifdef UseTokenInfo}
abssym^.line_no:=filepos.line;
{$endif UseTokenInfo}
s:=pattern;
consume(INTCONST);
val(s,abssym^.address,code);
@ -1758,7 +1778,14 @@ unit pdecl;
end.
{
$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)
* corrected operator overloading
* corrected nasm output

View File

@ -496,11 +496,15 @@ unit pmodules;
aktprocsym:=oldprocsym;
end;
procedure parse_uses(symt:Psymtable);
procedure parse_implementation_uses(symt:Psymtable);
var
old_module_in_implementation : boolean;
begin
if token=_USES then
begin
old_module_in_implementation:=module_in_implementation;
module_in_implementation:=true;
current_module^.in_implementation:=true;
symt^.symtabletype:=unitsymtable;
loadunits;
@ -508,6 +512,7 @@ unit pmodules;
{$ifdef DEBUG}
test_symtablestack;
{$endif DEBUG}
module_in_implementation:=old_module_in_implementation;
end;
end;
@ -694,7 +699,7 @@ unit pmodules;
{ to reinsert it after loading the implementation units }
symtablestack:=unitst^.next;
parse_uses(unitst);
parse_implementation_uses(unitst);
{ but reinsert the global symtable as lasts }
unitst^.next:=symtablestack;
@ -950,7 +955,14 @@ unit pmodules;
end.
{
$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)
* corrected operator overloading
* corrected nasm output

View File

@ -100,12 +100,12 @@ unit pstatmnt;
begin
if first=nil then
begin
last:=gennode(anwein,nil,statement);
last:=gennode(statementn,nil,statement);
first:=last;
end
else
begin
last^.left:=gennode(anwein,nil,statement);
last^.left:=gennode(statementn,nil,statement);
last:=last^.left;
end;
if token<>SEMICOLON then
@ -225,7 +225,7 @@ unit pstatmnt;
p^.labelnr:=aktcaselabel;
{ concats instruction }
instruc:=gennode(anwein,instruc,p);
instruc:=gennode(statementn,instruc,p);
if not((token=_ELSE) or (token=_OTHERWISE) or (token=_END)) then
consume(SEMICOLON);
@ -262,12 +262,12 @@ unit pstatmnt;
begin
if first=nil then
begin
last:=gennode(anwein,nil,statement);
last:=gennode(statementn,nil,statement);
first:=last;
end
else
begin
last^.left:=gennode(anwein,nil,statement);
last^.left:=gennode(statementn,nil,statement);
last:=last^.left;
end;
if token<>SEMICOLON then
@ -455,22 +455,22 @@ unit pstatmnt;
consume(_TRY);
first:=nil;
while (token<>_FINALLY) and (token<>_EXCEPT) do
begin
begin
if first=nil then
begin
last:=gennode(anwein,nil,statement);
last:=gennode(statementn,nil,statement);
first:=last;
end
else
begin
last^.left:=gennode(anwein,nil,statement);
last^.left:=gennode(statementn,nil,statement);
last:=last^.left;
end;
if token<>SEMICOLON then
break;
consume(SEMICOLON);
emptystats;
end;
if token<>SEMICOLON then
break;
consume(SEMICOLON);
emptystats;
end;
p_try_block:=gensinglenode(blockn,first);
if token=_FINALLY then
@ -791,12 +791,12 @@ unit pstatmnt;
begin
if first=nil then
begin
last:=gennode(anwein,nil,statement);
last:=gennode(statementn,nil,statement);
first:=last;
end
else
begin
last^.left:=gennode(anwein,nil,statement);
last^.left:=gennode(statementn,nil,statement);
last:=last^.left;
end;
if token=_END then
@ -828,7 +828,7 @@ unit pstatmnt;
code : ptree;
labelnr : plabel;
{$ifdef UseTokenInfo}
filepos : tfilepos;
filepos : tfileposinfo;
{$endif UseTokenInfo}
label
@ -836,7 +836,7 @@ unit pstatmnt;
begin
{$ifdef UseTokenInfo}
filepos:=tokeninfo^.filepos;
filepos:=tokeninfo^.fi;
{$endif UseTokenInfo}
case token of
_GOTO : begin
@ -1076,7 +1076,14 @@ unit pstatmnt;
end.
{
$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)
* corrected operator overloading
* corrected nasm output

View File

@ -604,7 +604,9 @@ const
current_module^.current_inputfile^.bufpos:=longint(inputpointer)-longint(inputbuffer);
hp^.next:=current_module^.current_inputfile;
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^.current_index:=hp^.ref_index;
inputbuffer:=current_module^.current_inputfile^.buf;
Message1(scan_u_start_include_file,current_module^.current_inputfile^.name^);
reload;
@ -823,7 +825,14 @@ const
{
$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
* fixed the wrong linecounting with comments

View File

@ -28,7 +28,7 @@ unit scanner;
interface
uses
globals,files;
cobjects,globals,files;
const
{$ifdef TP}
@ -135,15 +135,6 @@ unit scanner;
destructor done;
end;
{$ifdef UseTokenInfo}
ttokeninfo = record
token : ttoken;
fi : tfileposinfo;
end;
ptokeninfo = ^ttokeninfo;
{$endif UseTokenInfo}
var
c : char;
orgpattern,
@ -162,6 +153,15 @@ unit scanner;
preprocstack : ppreprocstack;
{$ifdef UseTokenInfo}
type
ttokeninfo = record
token : ttoken;
fi : tfileposinfo;
end;
ptokeninfo = ^ttokeninfo;
{$endif UseTokenInfo}
{public}
procedure syntaxerror(const s : string);
{$ifndef UseTokenInfo}
@ -170,6 +170,9 @@ unit scanner;
function yylex : ptokeninfo;
{$endif UseTokenInfo}
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 DoneScanner(testendif:boolean);
@ -178,13 +181,14 @@ unit scanner;
implementation
uses
dos,cobjects,verbose,pbase,
dos,verbose,pbase,
symtable,switches,link;
var
{ this is usefull to get the write filename
for the last instruction of an include file !}
FileHasChanged : Boolean;
status : tcompilestatus;
{*****************************************************************************
@ -350,6 +354,8 @@ unit scanner;
current_module^.current_inputfile^.close;
{ load next module }
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;
inputpointer:=inputbuffer+current_module^.current_inputfile^.bufpos;
end;
@ -361,11 +367,11 @@ unit scanner;
procedure linebreak;
var
status : tcompilestatus;
cur : char;
begin
cur:=c;
if byte(inputpointer^)=0 then
if (byte(inputpointer^)=0) and
current_module^.current_inputfile^.filenotatend then
begin
reload;
if byte(cur)+byte(c)<>23 then
@ -382,7 +388,8 @@ unit scanner;
totalcompiledlines:=abslines;
currentline:=current_module^.current_inputfile^.line_no
+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;
end;
if compilestatusproc(status) then
@ -419,16 +426,9 @@ unit scanner;
readstring[i]:=c;
end;
{ get next char }
c:=inputpointer^;
if c=#0 then
reload
else
inc(longint(inputpointer));
readchar;
end;
readstring[0]:=chr(i);
{ was the next char a linebreak ? }
if c in [#10,#13] then
linebreak;
end;
@ -472,16 +472,12 @@ unit scanner;
readnumber[i]:=c;
end;
{ get next char }
c:=inputpointer^;
if c=#0 then
reload
else
inc(longint(inputpointer));
readchar;
end;
readnumber[0]:=chr(i);
{ was the next char a linebreak ? }
if c in [#10,#13] then
linebreak;
{ if c in [#10,#13] then
linebreak; }
end;
@ -526,13 +522,14 @@ unit scanner;
begin
while c in [' ',#9..#13] do
begin
c:=inputpointer^;
readchar;
{c:=inputpointer^;
if c=#0 then
reload
else
inc(longint(inputpointer));
if c in [#10,#13] then
linebreak;
linebreak; }
end;
end;
@ -561,13 +558,12 @@ unit scanner;
else
found:=0;
end;
c:=inputpointer^;
readchar;
{c:=inputpointer^;
if c=#0 then
reload
else
inc(longint(inputpointer));
if c in [#10,#13] then
linebreak;
inc(longint(inputpointer));}
until (found=2);
end;
@ -588,14 +584,14 @@ unit scanner;
'}' : dec_comment_level;
#26 : Message(scan_f_end_of_file);
end;
c:=inputpointer^;
readchar;
{c:=inputpointer^;
if c=#0 then
reload
else
inc(longint(inputpointer));
if c in [#10,#13] then
linebreak;
inc(longint(inputpointer));}
end;
{if (c=#10) or (c=#13) then linebreak;}
end;
@ -651,13 +647,12 @@ unit scanner;
else
found:=0;
end;
c:=inputpointer^;
readchar;
{c:=inputpointer^;
if c=#0 then
reload
else
inc(longint(inputpointer));
if c in [#10,#13] then
linebreak;
inc(longint(inputpointer));}
until (found=2);
end;
end;
@ -672,6 +667,7 @@ unit scanner;
y : ttoken;
{$ifdef UseTokenInfo}
newyylex : ptokeninfo;
line,column : longint;
{$endif UseTokenInfo}
code : word;
l : longint;
@ -683,6 +679,10 @@ unit scanner;
exit_label;
{$endif UseTokenInfo}
begin
{$ifdef UseTokenInfo}
line:=current_module^.current_inputfile^.line_no;
column:=get_current_col;
{$endif UseTokenInfo}
{ was the last character a point ? }
{ 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 }
@ -717,6 +717,11 @@ unit scanner;
until false;
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
'_','A'..'Z',
'a'..'z' : begin
@ -741,7 +746,9 @@ unit scanner;
hp:=new(pinputfile,init('','Macro '+pattern,''));
hp^.next:=current_module^.current_inputfile;
current_module^.current_inputfile:=hp;
status.currentsource:=current_module^.current_inputfile^.name^;
current_module^.sourcefiles.register_file(hp);
current_module^.current_index:=hp^.ref_index;
{ set an own buffer }
getmem(hp2,mac^.buflen+1);
current_module^.current_inputfile^.setbuf(hp2,mac^.buflen+1);
@ -1087,7 +1094,7 @@ unit scanner;
{$ifndef UseTokenInfo}
yylex:=DOUBLEADDR;
{$else UseTokenInfo}
yylex:=DOUBLEADDR;
y:=DOUBLEADDR;
{$endif UseTokenInfo}
end
else
@ -1287,8 +1294,9 @@ unit scanner;
exit_label:
new(newyylex);
newyylex^.token:=y;
newyylex^.fi.infile:=current_module^.current_inputfile;
newyylex^.fi.line:=current_module^.current_inputfile^.line_no;
newyylex^.fi.fileindex:=current_module^.current_index;
newyylex^.fi.line:=line;
newyylex^.fi.column:=column;
yylex:=newyylex;
{$endif UseTokenInfo}
end;
@ -1352,6 +1360,8 @@ unit scanner;
current_module^.current_inputfile:=new(pinputfile,init(d,n,e));
current_module^.current_inputfile^.reset;
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
Message(scan_f_cannot_open_input);
inputbuffer:=current_module^.current_inputfile^.buf;
@ -1363,6 +1373,27 @@ unit scanner;
s_point:=false;
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);
var
@ -1385,7 +1416,14 @@ unit scanner;
end.
{
$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
* fixed the wrong linecounting with comments

View File

@ -29,7 +29,7 @@ unit tree;
interface
uses
globals,symtable,cobjects,verbose,aasm,files
globals,scanner,symtable,cobjects,verbose,aasm,files
{$ifdef i386}
,i386
{$endif}
@ -97,7 +97,7 @@ unit tree;
setelen, {A set element (i.e. [a,b]).}
setconstrn, {A set constant (i.e. [1,2]).}
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 }
ifn, {An if statement.}
breakn, {A break statement.}
@ -193,12 +193,9 @@ unit tree;
{$endif SUPPORT_MMX}
left,right : ptree;
resulttype : pdef;
inputfile : pinputfile;
{$ifdef TP}
line:word;
{$else}
line : longint;
{$endif}
{ line : longint;
fileindex,colon : word; }
fileinfo : tfileposinfo;
pragmas : Tcswitches;
{$ifdef extdebug}
firstpasscount : longint;
@ -285,6 +282,7 @@ unit tree;
procedure set_location(var destloc,sourceloc : tlocation);
procedure swap_location(var destloc,sourceloc : tlocation);
procedure set_file_line(from,_to : ptree);
procedure set_current_file_line(_to : ptree);
procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo);
{$ifdef extdebug}
@ -296,8 +294,9 @@ unit tree;
implementation
const
oldswitches : tcswitches = [];
{$ifdef UseTokenInfo}
uses pbase;
{$endif UseTokenInfo}
{****************************************************************************
this is a pool for the tree nodes to get more performance
@ -349,8 +348,14 @@ unit tree;
hp^.error:=false;
{ we know also the position }
hp^.line:=current_module^.current_inputfile^.line_no;
hp^.inputfile:=current_module^.current_inputfile;
{$ifdef UseTokenInfo}
if assigned(tokeninfo) then
begin
hp^.fileinfo:=tokeninfo^.fi;
end
else
{$endif UseTokenInfo}
get_cur_file_pos(hp^.fileinfo);
hp^.pragmas:=aktswitches;
getnode:=hp;
end;
@ -540,17 +545,22 @@ unit tree;
procedure set_file_line(from,_to : ptree);
begin
if from<>nil then
begin
_to^.line:=from^.line;
_to^.inputfile:=from^.inputfile;
end;
if assigned(from) then
_to^.fileinfo:=from^.fileinfo;
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;
procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo);
begin
p^.line:=filepos.line;
p^.inputfile:=filepos.infile;
p^.fileinfo:=filepos;
end;
function genwithnode(symtable : psymtable;l,r : ptree;count : longint) : ptree;
@ -1253,7 +1263,14 @@ unit tree;
end.
{
$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)
* corrected operator overloading
* corrected nasm output

View File

@ -26,8 +26,6 @@ uses verbose;
{$define allow_oldstyle}
var
UseStdErr : boolean;
procedure SetRedirectFile(const fn:string);
procedure _stop;
@ -45,20 +43,14 @@ uses
strings,dos,cobjects,systems,globals,files;
const
{$ifdef USE_RHIDE}
{ RHIDE expect gcc like error output }
fatalstr='fatal: ';
errorstr='error: ';
warningstr='warning: ';
notestr='warning: ';
hintstr='warning: ';
{$else}
rh_errorstr='error: ';
rh_warningstr='warning: ';
fatalstr='Fatal Error: ';
errorstr='Error: ';
warningstr='Warning: ';
notestr='Note: ';
hintstr='Hint: ';
{$endif USE_RHIDE}
var
redirexitsave : pointer;
@ -107,35 +99,50 @@ end;
Procedure _comment(Level:Longint;const s:string);
var
hs : string;
{$ifdef USE_RHIDE}
i : longint;
{$endif}
begin
if (verbosity and Level)=Level then
begin
{Create hs}
hs:='';
if (verbosity and Level)=V_Hint then
hs:=hintstr;
if (verbosity and Level)=V_Note then
hs:=notestr;
if (verbosity and Level)=V_Warning then
hs:=warningstr;
if (verbosity and Level)=V_Error then
hs:=errorstr;
if (verbosity and Level)=V_Fatal then
hs:=fatalstr;
if not(use_rhide) then
begin
if (verbosity and Level)=V_Hint then
hs:=hintstr;
if (verbosity and Level)=V_Note then
hs:=notestr;
if (verbosity and Level)=V_Warning then
hs:=warningstr;
if (verbosity and Level)=V_Error then
hs:=errorstr;
if (verbosity and Level)=V_Fatal then
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
Assigned(current_module^.current_inputfile) then
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
begin
i:=length(hs)+1;
hs:=hs+lowercase(Copy(s,1,5))+Copy(s,6,255);
end
else
{$endif USE_RHIDE}
{$endif USE_RHIDE} *)
hs:=hs+s;
{$ifdef FPC}
if UseStdErr and (Level<$100) then
@ -215,9 +222,9 @@ end;
{$endif}
begin
{$ifdef USE_RHIDE}
(* {$ifdef USE_RHIDE}
UseStdErr:=true;
{$endif USE_RHIDE}
{$endif USE_RHIDE} *)
{$ifdef FPC}
do_stop:=@_stop;
do_comment:=@_comment;
@ -242,7 +249,14 @@ begin
end.
{
$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)
* corrected operator overloading
* corrected nasm output

View File

@ -51,13 +51,16 @@ Const
V_Debug = $8000;
V_All = $ffffffff;
V_Default = V_Error;
V_Default = V_Fatal + V_Error;
Verbosity : longint=V_Default;
var
errorcount : longint; { number of generated errors }
msg : pmessage;
UseStdErr : boolean;
Use_Rhide : boolean;
procedure LoadMsgFile(const fn:string);
function SetVerbosity(const s:string):boolean;
@ -116,41 +119,99 @@ end;
function SetVerbosity(const s:string):boolean;
var
m : Longint;
c : Word;
i : Word;
inverse : boolean;
c : char;
begin
setverbosity:=false;
val(s,m,c);
if (c=0) and (s<>'') then
val(s,m,i);
if (i=0) and (s<>'') then
verbosity:=m
else
begin
for c:=1 to length(s) do
case upcase(s[c]) of
{ Special cases }
'A' : Verbosity:=V_All;
'0' : Verbosity:=V_Default;
{ Normal cases - do an or }
'E' : Verbosity:=Verbosity or V_Error;
'I' : Verbosity:=Verbosity or V_Info;
'W' : Verbosity:=Verbosity or V_Warning;
'N' : Verbosity:=Verbosity or V_Note;
'H' : Verbosity:=Verbosity or V_Hint;
'L' : Verbosity:=Verbosity or V_Linenrs;
'U' : Verbosity:=Verbosity or V_Used;
'T' : Verbosity:=Verbosity or V_Tried;
'M' : Verbosity:=Verbosity or V_Macro;
'P' : Verbosity:=Verbosity or V_Procedure;
'C' : Verbosity:=Verbosity or V_Conditional;
'D' : Verbosity:=Verbosity or V_Debug;
end;
end;
for i:=1 to length(s) do
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 }
'A' : Verbosity:=V_All;
'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 }
'E' : if inverse then
Verbosity:=Verbosity and (not V_Error)
else
Verbosity:=Verbosity or V_Error;
'I' : if inverse then
Verbosity:=Verbosity and (not V_Info)
else
Verbosity:=Verbosity or V_Info;
'W' : if inverse then
Verbosity:=Verbosity and (not V_Warning)
else
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;
if Verbosity=0 then
Verbosity:=V_Default;
setverbosity:=true;
end;
procedure stop;
begin
{$ifndef TP}
@ -292,7 +353,14 @@ end.
{
$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)
Revision 1.3 1998/04/13 21:15:42 florian