mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-07-06 17:06:13 +02:00
* 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:
parent
f39eb43f1f
commit
a10c3e36bc
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user