mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-23 23:31:29 +02:00
+ UseTokenInfo now default
* unit in interface uses and implementation uses gives error now * only one error for unknown symbol (uses lastsymknown boolean) the problem came from the label code ! + first inlined procedures and function work (warning there might be allowed cases were the result is still wrong !!) * UseBrower updated gives a global list of all position of all used symbols with switch -gb
This commit is contained in:
parent
a21b12c9e4
commit
c80de3be27
@ -23,24 +23,24 @@ unit browser;
|
||||
|
||||
interface
|
||||
|
||||
uses globals, files;
|
||||
uses globals,cobjects,files;
|
||||
|
||||
type
|
||||
pref = ^tref;
|
||||
tref = object
|
||||
nextref : pref;
|
||||
inputfile : pinputfile;
|
||||
lineno : longint;
|
||||
constructor init(ref : pref);
|
||||
constructor load(var ref : pref;fileindex : word;line : longint);
|
||||
posinfo : tfileposinfo;
|
||||
moduleindex : word;
|
||||
constructor init(ref : pref;pos : pfileposinfo);
|
||||
constructor load(var ref : pref;fileindex : word;line,column : longint);
|
||||
destructor done; virtual;
|
||||
function get_file_line : string;
|
||||
end;
|
||||
|
||||
{ simple method to chain all refs }
|
||||
procedure add_new_ref(var ref : pref);
|
||||
procedure add_new_ref(var ref : pref;pos : pfileposinfo);
|
||||
|
||||
function get_source_file(index : word) : pinputfile;
|
||||
function get_source_file(moduleindex,fileindex : word) : pinputfile;
|
||||
|
||||
{ one big problem remains for overloaded procedure }
|
||||
{ we should be able to separate them }
|
||||
@ -48,80 +48,95 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
constructor tref.init(ref :pref);
|
||||
uses scanner,verbose;
|
||||
|
||||
constructor tref.init(ref :pref;pos : pfileposinfo);
|
||||
|
||||
begin
|
||||
nextref:=nil;
|
||||
if ref<>nil then
|
||||
ref^.nextref:=@self;
|
||||
if assigned(pos) then
|
||||
posinfo:=pos^;
|
||||
if current_module<>nil then
|
||||
begin
|
||||
inputfile:=current_module^.current_inputfile;
|
||||
if inputfile<>nil then
|
||||
begin
|
||||
inc(inputfile^.ref_index);
|
||||
lineno:=inputfile^.line_no;
|
||||
end
|
||||
else
|
||||
lineno:=0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
inputfile:=nil;
|
||||
lineno:=0;
|
||||
moduleindex:=current_module^.unit_index;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor tref.load(var ref : pref;fileindex : word;line : longint);
|
||||
constructor tref.load(var ref : pref;fileindex : word;line,column : longint);
|
||||
|
||||
begin
|
||||
moduleindex:=current_module^.unit_index;
|
||||
if assigned(ref) then
|
||||
ref^.nextref:=@self;
|
||||
nextref:=nil;
|
||||
inputfile:=get_source_file(fileindex);
|
||||
lineno:=line;
|
||||
posinfo.fileindex:=fileindex;
|
||||
posinfo.line:=line;
|
||||
posinfo.column:=column;
|
||||
ref:=@self;
|
||||
end;
|
||||
|
||||
destructor tref.done;
|
||||
|
||||
var
|
||||
inputfile : pinputfile;
|
||||
begin
|
||||
inputfile:=get_source_file(moduleindex,posinfo.fileindex);
|
||||
if inputfile<>nil then
|
||||
dec(inputfile^.ref_count);
|
||||
end;
|
||||
|
||||
function tref.get_file_line : string;
|
||||
|
||||
var
|
||||
inputfile : pinputfile;
|
||||
begin
|
||||
get_file_line:='';
|
||||
if inputfile=nil then exit;
|
||||
if Use_Rhide then
|
||||
get_file_line:=lowercase(inputfile^.name^+inputfile^.ext^)+':'+tostr(lineno)+':'
|
||||
inputfile:=get_source_file(moduleindex,posinfo.fileindex);
|
||||
if assigned(inputfile) then
|
||||
if Use_Rhide then
|
||||
get_file_line:=globals.lowercase(inputfile^.name^+inputfile^.ext^)
|
||||
+':'+tostr(posinfo.line)+':'+tostr(posinfo.column)+':'
|
||||
else
|
||||
get_file_line:=inputfile^.name^+inputfile^.ext^
|
||||
+'('+tostr(posinfo.line)+','+tostr(posinfo.column)+')'
|
||||
else
|
||||
get_file_line:=inputfile^.name^+inputfile^.ext^+'('+tostr(lineno)+')'
|
||||
if Use_Rhide then
|
||||
get_file_line:='file_unknown:'
|
||||
+tostr(posinfo.line)+':'+tostr(posinfo.column)+':'
|
||||
else
|
||||
get_file_line:='file_unknown('
|
||||
+tostr(posinfo.line)+','+tostr(posinfo.column)+')'
|
||||
end;
|
||||
|
||||
procedure add_new_ref(var ref : pref);
|
||||
procedure add_new_ref(var ref : pref;pos : pfileposinfo);
|
||||
|
||||
var
|
||||
newref : pref;
|
||||
|
||||
begin
|
||||
new(newref,init(ref));
|
||||
new(newref,init(ref,pos));
|
||||
ref:=newref;
|
||||
end;
|
||||
|
||||
function get_source_file(index : word) : pinputfile;
|
||||
function get_source_file(moduleindex,fileindex : word) : pinputfile;
|
||||
|
||||
var
|
||||
hp : pmodule;
|
||||
f : pinputfile;
|
||||
|
||||
begin
|
||||
hp:=pmodule(loaded_units.first);
|
||||
while assigned(hp) and (hp^.unit_index<>moduleindex) do
|
||||
hp:=pmodule(hp^.next);
|
||||
get_source_file:=nil;
|
||||
f:=pinputfile(current_module^.sourcefiles.files);
|
||||
if not assigned(hp) then
|
||||
exit;
|
||||
f:=pinputfile(hp^.sourcefiles.files);
|
||||
while assigned(f) do
|
||||
begin
|
||||
if f^.ref_index=index then
|
||||
if f^.ref_index=fileindex then
|
||||
begin
|
||||
get_source_file:=f;
|
||||
exit;
|
||||
@ -133,7 +148,17 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1998-04-30 15:59:39 pierre
|
||||
Revision 1.3 1998-05-20 09:42:32 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
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
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -55,9 +55,7 @@ unit cobjects;
|
||||
tstringitem = record
|
||||
data : pstring;
|
||||
next : pstringitem;
|
||||
{$ifdef UseTokenInfo}
|
||||
fileinfo : tfileposinfo; { pointer to tinputfile }
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
|
||||
plinkedlist_item = ^tlinkedlist_item;
|
||||
@ -144,15 +142,11 @@ 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;
|
||||
@ -176,7 +170,11 @@ unit cobjects;
|
||||
{ but it's assumed, that there no seek while do_crc is true }
|
||||
do_crc : boolean;
|
||||
crc : longint;
|
||||
|
||||
{ temporary closing feature }
|
||||
tempclosed : boolean;
|
||||
tempmode : byte;
|
||||
temppos : longint;
|
||||
|
||||
{ inits a buffer with the size bufsize which is assigned to }
|
||||
{ the file filename }
|
||||
constructor init(const filename : string;_bufsize : longint);
|
||||
@ -216,6 +214,12 @@ unit cobjects;
|
||||
{ closes the file and releases the buffer }
|
||||
procedure close;
|
||||
|
||||
{$ifdef TEST_TEMPCLOSE}
|
||||
{ temporary closing }
|
||||
procedure tempclose;
|
||||
procedure tempreopen;
|
||||
{$endif TEST_TEMPCLOSE}
|
||||
|
||||
{ goto the given position }
|
||||
procedure seek(l : longint);
|
||||
|
||||
@ -479,7 +483,6 @@ end;
|
||||
last:=hp;
|
||||
end;
|
||||
|
||||
{$ifdef UseTokenInfo}
|
||||
procedure tstringcontainer.insert_with_tokeninfo
|
||||
(const s : string; const file_info : tfileposinfo);
|
||||
|
||||
@ -505,7 +508,6 @@ end;
|
||||
last:=hp;
|
||||
end;
|
||||
|
||||
{$endif UseTokenInfo}
|
||||
procedure tstringcontainer.clear;
|
||||
|
||||
var
|
||||
@ -542,7 +544,6 @@ end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ifdef UseTokenInfo}
|
||||
function tstringcontainer.get_with_tokeninfo(var file_info : tfileposinfo) : string;
|
||||
|
||||
var
|
||||
@ -566,7 +567,6 @@ end;
|
||||
dispose(hp);
|
||||
end;
|
||||
end;
|
||||
{$endif UseTokenInfo}
|
||||
|
||||
{****************************************************************************
|
||||
TLINKEDLIST_ITEM
|
||||
@ -807,6 +807,7 @@ end;
|
||||
buflast:=0;
|
||||
do_crc:=false;
|
||||
iomode:=0;
|
||||
tempclosed:=false;
|
||||
change_endian:=false;
|
||||
clear_crc;
|
||||
end;
|
||||
@ -994,8 +995,11 @@ end;
|
||||
begin
|
||||
if bufpos+length(s)>bufsize then
|
||||
flush;
|
||||
{ why is there not CRC here ??? }
|
||||
move(s[1],(buf+bufpos)^,length(s));
|
||||
inc(bufpos,length(s));
|
||||
{ should be
|
||||
write_data(s[1],length(s)); }
|
||||
end;
|
||||
|
||||
procedure tbufferedfile.write_pchar(p : pchar);
|
||||
@ -1007,10 +1011,13 @@ end;
|
||||
l:=strlen(p);
|
||||
if l>=bufsize then
|
||||
runerror(222);
|
||||
{ why is there not CRC here ???}
|
||||
if bufpos+l>bufsize then
|
||||
flush;
|
||||
move(p^,(buf+bufpos)^,l);
|
||||
inc(bufpos,l);
|
||||
{ should be
|
||||
write_data(p^,l); }
|
||||
end;
|
||||
|
||||
procedure tbufferedfile.write_byte(b : byte);
|
||||
@ -1071,14 +1078,67 @@ end;
|
||||
flush;
|
||||
system.close(f);
|
||||
freemem(buf,bufsize);
|
||||
buf:=nil;
|
||||
iomode:=0;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ifdef TEST_TEMPCLOSE}
|
||||
procedure tbufferedfile.tempclose;
|
||||
|
||||
begin
|
||||
if iomode<>0 then
|
||||
begin
|
||||
temppos:=system.filepos(f);
|
||||
tempmode:=iomode;
|
||||
tempclosed:=true;
|
||||
system.close(f);
|
||||
iomode:=0;
|
||||
end
|
||||
else
|
||||
tempclosed:=false;
|
||||
end;
|
||||
|
||||
procedure tbufferedfile.tempreopen;
|
||||
|
||||
var
|
||||
ofm : byte;
|
||||
|
||||
begin
|
||||
if tempclosed then
|
||||
begin
|
||||
if tempmode=1 then
|
||||
begin
|
||||
ofm:=filemode;
|
||||
iomode:=1;
|
||||
filemode:=0;
|
||||
system.reset(f,1);
|
||||
filemode:=ofm;
|
||||
end
|
||||
else if tempmode=2 then
|
||||
begin
|
||||
iomode:=2;
|
||||
system.rewrite(f,1);
|
||||
end;
|
||||
system.seek(f,temppos);
|
||||
end;
|
||||
end;
|
||||
{$endif TEST_TEMPCLOSE}
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.7 1998-05-06 18:36:53 peter
|
||||
Revision 1.8 1998-05-20 09:42:33 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.7 1998/05/06 18:36:53 peter
|
||||
* tai_section extended with code,data,bss sections and enumerated type
|
||||
* ident 'compiled by FPC' moved to pmodules
|
||||
* small fix for smartlink
|
||||
|
@ -102,6 +102,7 @@ unit files;
|
||||
|
||||
map : punitmap; { mapping of all used units }
|
||||
unitcount : word; { local unit counter }
|
||||
unit_index : word; { global counter for browser }
|
||||
symtable : pointer; { pointer to the psymtable of this unit }
|
||||
output_format : tof; { how to write this file }
|
||||
|
||||
@ -219,6 +220,7 @@ unit files;
|
||||
var
|
||||
main_module : pmodule;
|
||||
current_module : pmodule;
|
||||
global_unit_count : word;
|
||||
loaded_units : tlinkedlist;
|
||||
|
||||
|
||||
@ -300,11 +302,21 @@ unit files;
|
||||
dispose(hp,done);
|
||||
hp:=files;
|
||||
end;
|
||||
last_ref_index:=0;
|
||||
end;
|
||||
|
||||
procedure tfilemanager.close_all;
|
||||
|
||||
var
|
||||
hp : pextfile;
|
||||
|
||||
begin
|
||||
hp:=files;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
hp^.close;
|
||||
hp:=hp^._next;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure tfilemanager.register_file(f : pextfile);
|
||||
@ -420,6 +432,12 @@ unit files;
|
||||
sources_avail:=false;
|
||||
temp:=' library';
|
||||
end
|
||||
else if pos('Macro ',hs)=1 then
|
||||
begin
|
||||
{ we don't want to find this file }
|
||||
{ but there is a problem with file indexing !! }
|
||||
temp:='';
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ check the date of the source files }
|
||||
@ -849,6 +867,8 @@ unit files;
|
||||
flags:=0;
|
||||
crc:=0;
|
||||
unitcount:=1;
|
||||
inc(global_unit_count);
|
||||
unit_index:=global_unit_count;
|
||||
do_assemble:=false;
|
||||
do_compile:=false;
|
||||
sources_avail:=true;
|
||||
@ -909,7 +929,17 @@ unit files;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 1998-05-12 10:46:59 peter
|
||||
Revision 1.12 1998-05-20 09:42:33 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.11 1998/05/12 10:46:59 peter
|
||||
* moved printstatus to verb_def
|
||||
+ V_Normal which is between V_Error and V_Warning and doesn't have a
|
||||
prefix like error: warning: and is included in V_Default
|
||||
|
@ -50,6 +50,8 @@ unit hcodegen;
|
||||
_class : pobjectdef;
|
||||
{ return type }
|
||||
retdef : pdef;
|
||||
{ the definition of the proc itself }
|
||||
def : pdef;
|
||||
{ frame pointer offset }
|
||||
framepointer_offset : longint;
|
||||
{ self pointer offset }
|
||||
@ -140,14 +142,15 @@ unit hcodegen;
|
||||
|
||||
|
||||
{ convert/concats a label for constants in the consts section }
|
||||
function constlabel2str(p:plabel;ctype:tconsttype):string;
|
||||
function constlabel2str(l : plabel;ctype:tconsttype):string;
|
||||
function constlabelnb2str(pnb : longint;ctype:tconsttype):string;
|
||||
procedure concat_constlabel(p:plabel;ctype:tconsttype);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
cobjects,globals,files,strings;
|
||||
systems,cobjects,globals,files,strings;
|
||||
|
||||
{*****************************************************************************
|
||||
initialize/terminate the codegen for procedure and modules
|
||||
@ -353,12 +356,22 @@ implementation
|
||||
consttypestr : array[tconsttype] of string[6]=
|
||||
('ord','string','real','bool','int','char','set');
|
||||
|
||||
function constlabel2str(p:plabel;ctype:tconsttype):string;
|
||||
{ Peter this gives problems for my inlines !! }
|
||||
{ we must use the number directly !!! (PM) }
|
||||
function constlabel2str(l : plabel;ctype:tconsttype):string;
|
||||
begin
|
||||
if smartlink or (current_module^.output_format in [of_nasm,of_obj]) then
|
||||
constlabel2str:='_$'+current_module^.unitname^+'$'+consttypestr[ctype]+'_const_'+tostr(p^.nb)
|
||||
constlabel2str:='_$'+current_module^.unitname^+'$'+consttypestr[ctype]+'_const_'+tostr(l^.nb)
|
||||
else
|
||||
constlabel2str:=lab2str(p);
|
||||
constlabel2str:=lab2str(l);
|
||||
end;
|
||||
|
||||
function constlabelnb2str(pnb : longint;ctype:tconsttype):string;
|
||||
begin
|
||||
if smartlink or (current_module^.output_format in [of_nasm,of_obj]) then
|
||||
constlabelnb2str:='_$'+current_module^.unitname^+'$'+consttypestr[ctype]+'_const_'+tostr(pnb)
|
||||
else
|
||||
constlabelnb2str:=target_asm.labelprefix+tostr(pnb);
|
||||
end;
|
||||
|
||||
|
||||
@ -385,7 +398,17 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 1998-05-07 00:17:01 peter
|
||||
Revision 1.5 1998-05-20 09:42:34 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.4 1998/05/07 00:17:01 peter
|
||||
* smartlinking for sets
|
||||
+ consts labels are now concated/generated in hcodegen
|
||||
* moved some cpu code to cga and some none cpu depended code from cga
|
||||
|
@ -315,7 +315,8 @@ unit i386;
|
||||
|
||||
{ resets all values of ref to defaults }
|
||||
procedure reset_reference(var ref : treference);
|
||||
|
||||
{ mostly set value of a reference }
|
||||
function new_reference(base : tregister;offset : longint) : preference;
|
||||
{ same as reset_reference, but symbol is disposed }
|
||||
{ use this only for already used references }
|
||||
procedure clear_reference(var ref : treference);
|
||||
@ -1179,7 +1180,19 @@ unit i386;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure clear_reference(var ref : treference);
|
||||
function new_reference(base : tregister;offset : longint) : preference;
|
||||
|
||||
var
|
||||
r : preference;
|
||||
begin
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.base:=base;
|
||||
r^.offset:=offset;
|
||||
new_reference:=r;
|
||||
end;
|
||||
|
||||
procedure clear_reference(var ref : treference);
|
||||
|
||||
begin
|
||||
stringdispose(ref.symbol);
|
||||
@ -1780,7 +1793,17 @@ unit i386;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 1998-05-04 17:54:25 peter
|
||||
Revision 1.7 1998-05-20 09:42:34 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.6 1998/05/04 17:54:25 peter
|
||||
+ smartlinking works (only case jumptable left todo)
|
||||
* redesign of systems.pas to support assemblers and linkers
|
||||
+ Unitname is now also in the PPU-file, increased version to 14
|
||||
|
@ -123,9 +123,7 @@ unit parser;
|
||||
|
||||
{ some variables to save the compiler state }
|
||||
oldtoken : ttoken;
|
||||
{$ifdef UseTokenInfo}
|
||||
oldtokenpos : tfileposinfo;
|
||||
{$endif UseTokenInfo}
|
||||
oldpattern : stringid;
|
||||
|
||||
oldpreprocstack : ppreprocstack;
|
||||
@ -237,9 +235,7 @@ unit parser;
|
||||
oldmacros:=macros;
|
||||
oldpattern:=pattern;
|
||||
oldtoken:=token;
|
||||
{$ifdef UseTokenInfo}
|
||||
oldtokenpos:=tokenpos;
|
||||
{$endif UseTokenInfo}
|
||||
oldorgpattern:=orgpattern;
|
||||
old_block_type:=block_type;
|
||||
oldpreprocstack:=preprocstack;
|
||||
@ -284,7 +280,7 @@ unit parser;
|
||||
{ init code generator for a new module }
|
||||
codegen_newmodule;
|
||||
macros:=new(psymtable,init(macrosymtable));
|
||||
|
||||
macros^.name:=stringdup('Conditionals for '+filename);
|
||||
define_macros;
|
||||
|
||||
{ startup scanner }
|
||||
@ -306,7 +302,6 @@ unit parser;
|
||||
|
||||
{ global switches are read, so further changes aren't allowed }
|
||||
current_module^.in_main:=true;
|
||||
|
||||
{ open assembler response }
|
||||
if (compile_level=1) then
|
||||
AsmRes.Init('ppas');
|
||||
@ -320,6 +315,7 @@ unit parser;
|
||||
}
|
||||
hp:=loadunit(upper(target_info.system_unit),true,true);
|
||||
systemunit:=hp^.symtable;
|
||||
make_ref:=false;
|
||||
readconstdefs;
|
||||
{ we could try to overload caret by default }
|
||||
symtablestack:=systemunit;
|
||||
@ -328,6 +324,7 @@ unit parser;
|
||||
if assigned(srsym) and (srsym^.typ=procsym) and
|
||||
(overloaded_operators[STARSTAR]=nil) then
|
||||
overloaded_operators[STARSTAR]:=pprocsym(srsym);
|
||||
make_ref:=true;
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -364,6 +361,7 @@ unit parser;
|
||||
systemunit:=nil;
|
||||
end;
|
||||
registerdef:=true;
|
||||
make_ref:=true;
|
||||
|
||||
{ current return type is void }
|
||||
procinfo.retdef:=voiddef;
|
||||
@ -447,16 +445,16 @@ done:
|
||||
procprefix:=oldprocprefix;
|
||||
|
||||
{ close the inputfiles }
|
||||
{$ifndef UseBrowser}
|
||||
{ but not if we want the names for the browser ! }
|
||||
{$ifdef UseBrowser}
|
||||
{ we need the names for the browser ! }
|
||||
current_module^.sourcefiles.close_all;
|
||||
{$else UseBrowser}
|
||||
current_module^.sourcefiles.done;
|
||||
{$endif not UseBrowser}
|
||||
{ restore scanner state }
|
||||
pattern:=oldpattern;
|
||||
token:=oldtoken;
|
||||
{$ifdef UseTokenInfo}
|
||||
tokenpos:=oldtokenpos;
|
||||
{$endif UseTokenInfo}
|
||||
orgpattern:=oldorgpattern;
|
||||
block_type:=old_block_type;
|
||||
|
||||
@ -508,7 +506,17 @@ done:
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.16 1998-05-12 10:47:00 peter
|
||||
Revision 1.17 1998-05-20 09:42:34 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.16 1998/05/12 10:47:00 peter
|
||||
* moved printstatus to verb_def
|
||||
+ V_Normal which is between V_Error and V_Warning and doesn't have a
|
||||
prefix like error: warning: and is included in V_Default
|
||||
|
@ -35,7 +35,7 @@ unit pass_1;
|
||||
implementation
|
||||
|
||||
uses
|
||||
cobjects,verbose,systems,globals,aasm,symtable,
|
||||
scanner,cobjects,verbose,systems,globals,aasm,symtable,
|
||||
types,strings,hcodegen,files
|
||||
{$ifdef i386}
|
||||
,i386
|
||||
@ -125,16 +125,20 @@ unit pass_1;
|
||||
end;
|
||||
|
||||
|
||||
{ calculates the needed registers for a binary operator }
|
||||
procedure calcregisters(p : ptree;r32,fpu,mmx : word);
|
||||
|
||||
procedure left_right_max(p : ptree);
|
||||
begin
|
||||
p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
|
||||
p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
|
||||
{$endif SUPPORT_MMX}
|
||||
end;
|
||||
|
||||
{ calculates the needed registers for a binary operator }
|
||||
procedure calcregisters(p : ptree;r32,fpu,mmx : word);
|
||||
|
||||
begin
|
||||
left_right_max(p);
|
||||
{ Nur wenn links und rechts ein Unterschied < ben”tige Anzahl ist, }
|
||||
{ wird ein zus„tzliches Register ben”tigt, da es dann keinen }
|
||||
{ schwierigeren Ast gibt, welcher erst ausgewertet werden kann }
|
||||
@ -164,7 +168,8 @@ unit pass_1;
|
||||
end;
|
||||
|
||||
function isconvertable(def_from,def_to : pdef;
|
||||
var doconv : tconverttype;fromtreetype : ttreetyp) : boolean;
|
||||
var doconv : tconverttype;fromtreetype : ttreetyp;
|
||||
explicit : boolean) : boolean;
|
||||
|
||||
{ from_is_cstring muá true sein, wenn def_from die Definition einer }
|
||||
{ Stringkonstanten ist, n”tig wegen der Konvertierung von String- }
|
||||
@ -260,7 +265,9 @@ unit pass_1;
|
||||
doconv:=tc_real_2_real;
|
||||
{ comp isn't a floating type }
|
||||
{$ifdef i386}
|
||||
if (pfloatdef(def_to)^.typ=s64bit) then
|
||||
if (pfloatdef(def_to)^.typ=s64bit) and
|
||||
(pfloatdef(def_from)^.typ<>s64bit) and
|
||||
not (explicit) then
|
||||
Message(parser_w_convert_real_2_comp);
|
||||
{$endif}
|
||||
end;
|
||||
@ -1356,13 +1363,7 @@ unit pass_1;
|
||||
if codegenerror then
|
||||
exit;
|
||||
|
||||
p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
|
||||
p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
|
||||
{$endif SUPPORT_MMX}
|
||||
if p^.registers32<2 then p^.registers32:=2;
|
||||
|
||||
left_right_max(p);
|
||||
p^.resulttype:=s32bitdef;
|
||||
p^.location.loc:=LOC_REGISTER;
|
||||
end;
|
||||
@ -1887,7 +1888,7 @@ unit pass_1;
|
||||
Message(cg_e_upper_lower_than_lower);
|
||||
{ both types must be compatible }
|
||||
if not(isconvertable(p^.left^.resulttype,p^.right^.resulttype,
|
||||
ct,ordconstn)) and
|
||||
ct,ordconstn,false)) and
|
||||
not(is_equal(p^.left^.resulttype,p^.right^.resulttype)) then
|
||||
Message(sym_e_type_mismatch);
|
||||
end;
|
||||
@ -1910,7 +1911,7 @@ unit pass_1;
|
||||
begin
|
||||
if not(isconvertable(p^.right^.resulttype,
|
||||
parraydef(p^.left^.resulttype)^.rangedef,
|
||||
ct,ordconstn)) and
|
||||
ct,ordconstn,false)) and
|
||||
not(is_equal(p^.right^.resulttype,
|
||||
parraydef(p^.left^.resulttype)^.rangedef)) then
|
||||
Message(sym_e_type_mismatch);
|
||||
@ -2306,7 +2307,8 @@ unit pass_1;
|
||||
p^.registersmmx:=p^.left^.registersmmx;
|
||||
{$endif}
|
||||
set_location(p^.location,p^.left^.location);
|
||||
if (not(isconvertable(p^.left^.resulttype,p^.resulttype,p^.convtyp,p^.left^.treetype))) then
|
||||
if (not(isconvertable(p^.left^.resulttype,p^.resulttype,
|
||||
p^.convtyp,p^.left^.treetype,p^.explizit))) then
|
||||
begin
|
||||
if is_assignment_overloaded(p^.left^.resulttype,p^.resulttype) then
|
||||
begin
|
||||
@ -2431,7 +2433,8 @@ unit pass_1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if not isconvertable(s32bitdef,p^.resulttype,p^.convtyp,ordconstn { nur Dummy} ) then
|
||||
if not isconvertable(s32bitdef,p^.resulttype,p^.convtyp,
|
||||
ordconstn { nur Dummy},false ) then
|
||||
Message(cg_e_illegal_type_conversion);
|
||||
end;
|
||||
|
||||
@ -2451,7 +2454,8 @@ unit pass_1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if not isconvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,ordconstn { nur Dummy} ) then
|
||||
if not isconvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,
|
||||
ordconstn { nur Dummy},false ) then
|
||||
Message(cg_e_illegal_type_conversion);
|
||||
end;
|
||||
end
|
||||
@ -2472,7 +2476,8 @@ unit pass_1;
|
||||
begin
|
||||
{ this is wrong because it converts to a 4 byte long var !!
|
||||
if not isconvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,ordconstn nur Dummy ) then }
|
||||
if not isconvertable(p^.left^.resulttype,u8bitdef,p^.convtyp,ordconstn { nur Dummy} ) then
|
||||
if not isconvertable(p^.left^.resulttype,u8bitdef,
|
||||
p^.convtyp,ordconstn { nur Dummy},false ) then
|
||||
Message(cg_e_illegal_type_conversion);
|
||||
end;
|
||||
end
|
||||
@ -2567,7 +2572,8 @@ unit pass_1;
|
||||
must_be_valid:=false;
|
||||
{ here we must add something for the implicit type }
|
||||
{ conversion from array of char to pchar }
|
||||
if isconvertable(p^.left^.resulttype,defcoll^.data,convtyp,p^.left^.treetype) then
|
||||
if isconvertable(p^.left^.resulttype,defcoll^.data,convtyp,
|
||||
p^.left^.treetype,false) then
|
||||
if convtyp=tc_array_to_pointer then
|
||||
must_be_valid:=false;
|
||||
firstpass(p^.left);
|
||||
@ -2657,10 +2663,11 @@ unit pass_1;
|
||||
pd : pprocdef;
|
||||
actprocsym : pprocsym;
|
||||
def_from,def_to,conv_to : pdef;
|
||||
pt : ptree;
|
||||
exactmatch : boolean;
|
||||
pt,inlinecode : ptree;
|
||||
exactmatch,inlined : boolean;
|
||||
paralength,l : longint;
|
||||
pdc : pdefcoll;
|
||||
curtokenpos : tfileposinfo;
|
||||
|
||||
{ only Dummy }
|
||||
hcvt : tconverttype;
|
||||
@ -2696,10 +2703,19 @@ unit pass_1;
|
||||
store_valid:=must_be_valid;
|
||||
must_be_valid:=false;
|
||||
|
||||
inlined:=false;
|
||||
if assigned(p^.procdefinition) and
|
||||
((p^.procdefinition^.options and poinline)<>0) then
|
||||
begin
|
||||
inlinecode:=p^.right;
|
||||
if assigned(inlinecode) then
|
||||
begin
|
||||
inlined:=true;
|
||||
p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
|
||||
end;
|
||||
p^.right:=nil;
|
||||
end;
|
||||
{ procedure variable ? }
|
||||
{ right contains inline code for inlined procedures }
|
||||
if (not assigned(p^.procdefinition)) or
|
||||
((p^.procdefinition^.options and poinline)=0) then
|
||||
if assigned(p^.right) then
|
||||
begin
|
||||
{ procedure does a call }
|
||||
@ -2887,7 +2903,8 @@ unit pass_1;
|
||||
begin
|
||||
{ erst am Anfang }
|
||||
while (assigned(procs)) and
|
||||
not(isconvertable(pt^.resulttype,procs^.nextpara^.data,hcvt,pt^.left^.treetype)) do
|
||||
not(isconvertable(pt^.resulttype,procs^.nextpara^.data,
|
||||
hcvt,pt^.left^.treetype,false)) do
|
||||
begin
|
||||
hp:=procs^.next;
|
||||
dispose(procs);
|
||||
@ -2898,7 +2915,7 @@ unit pass_1;
|
||||
while (assigned(hp)) and assigned(hp^.next) do
|
||||
begin
|
||||
if not(isconvertable(pt^.resulttype,hp^.next^.nextpara^.data,
|
||||
hcvt,pt^.left^.treetype)) then
|
||||
hcvt,pt^.left^.treetype,false)) then
|
||||
begin
|
||||
hp2:=hp^.next^.next;
|
||||
dispose(hp^.next);
|
||||
@ -3077,7 +3094,11 @@ unit pass_1;
|
||||
end;
|
||||
{$endif CHAINPROCSYMS}
|
||||
{$ifdef UseBrowser}
|
||||
add_new_ref(procs^.data^.lastref);
|
||||
if make_ref then
|
||||
begin
|
||||
get_cur_file_pos(curtokenpos);
|
||||
add_new_ref(procs^.data^.lastref,@curtokenpos);
|
||||
end;
|
||||
{$endif UseBrowser}
|
||||
|
||||
p^.procdefinition:=procs^.data;
|
||||
@ -3100,14 +3121,6 @@ unit pass_1;
|
||||
{$endif CHAINPROCSYMS}
|
||||
end;{ end of procedure to call determination }
|
||||
|
||||
{ work trough all parameters to insert the type conversions }
|
||||
if assigned(p^.left) then
|
||||
begin
|
||||
old_count_ref:=count_ref;
|
||||
count_ref:=true;
|
||||
firstcallparan(p^.left,p^.procdefinition^.para1);
|
||||
count_ref:=old_count_ref;
|
||||
end;
|
||||
{ handle predefined procedures }
|
||||
if (p^.procdefinition^.options and pointernproc)<>0 then
|
||||
begin
|
||||
@ -3135,6 +3148,7 @@ unit pass_1;
|
||||
end
|
||||
else
|
||||
{ no intern procedure => we do a call }
|
||||
{ calc the correture value for the register }
|
||||
{ handle predefined procedures }
|
||||
if (p^.procdefinition^.options and poinline)<>0 then
|
||||
begin
|
||||
@ -3146,16 +3160,32 @@ unit pass_1;
|
||||
if not assigned(p^.right) then
|
||||
begin
|
||||
if assigned(p^.procdefinition^.code) then
|
||||
p^.right:=genprocinlinenode(p,ptree(p^.procdefinition^.code))
|
||||
inlinecode:=genprocinlinenode(p,ptree(p^.procdefinition^.code))
|
||||
else
|
||||
comment(v_fatal,'no code for inline procedure stored');
|
||||
firstpass(p^.right);
|
||||
if assigned(inlinecode) then
|
||||
begin
|
||||
firstpass(inlinecode);
|
||||
{ consider it has not inlined if called
|
||||
again inside the args }
|
||||
p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
|
||||
inlined:=true;
|
||||
end;
|
||||
|
||||
end;
|
||||
end
|
||||
else
|
||||
procinfo.flags:=procinfo.flags or pi_do_call;
|
||||
|
||||
{ calc the correture value for the register }
|
||||
{ work trough all parameters to insert the type conversions }
|
||||
{ !!! done now after internproc !! (PM) }
|
||||
if assigned(p^.left) then
|
||||
begin
|
||||
old_count_ref:=count_ref;
|
||||
count_ref:=true;
|
||||
firstcallparan(p^.left,p^.procdefinition^.para1);
|
||||
count_ref:=old_count_ref;
|
||||
end;
|
||||
{$ifdef i386}
|
||||
for regi:=R_EAX to R_EDI do
|
||||
begin
|
||||
@ -3246,6 +3276,11 @@ unit pass_1;
|
||||
end;
|
||||
end;
|
||||
|
||||
if inlined then
|
||||
begin
|
||||
p^.right:=inlinecode;
|
||||
p^.procdefinition^.options:=p^.procdefinition^.options or poinline;
|
||||
end;
|
||||
{ determine the registers of the procedure variable }
|
||||
{ is this OK for inlined procs also ?? (PM) }
|
||||
if assigned(p^.right) then
|
||||
@ -3301,7 +3336,7 @@ unit pass_1;
|
||||
|
||||
var
|
||||
hp,hpp : ptree;
|
||||
isreal,store_valid,file_is_typed : boolean;
|
||||
store_count_ref,isreal,store_valid,file_is_typed : boolean;
|
||||
|
||||
procedure do_lowhigh(adef : pdef);
|
||||
|
||||
@ -3336,9 +3371,16 @@ unit pass_1;
|
||||
end;
|
||||
|
||||
begin
|
||||
store_valid:=must_be_valid;
|
||||
store_count_ref:=count_ref;
|
||||
count_ref:=false;
|
||||
{ if we handle writeln; p^.left contains no valid address }
|
||||
if assigned(p^.left) then
|
||||
begin
|
||||
if p^.left^.treetype=callparan then
|
||||
firstcallparan(p^.left,nil)
|
||||
else
|
||||
firstpass(p^.left);
|
||||
p^.registers32:=p^.left^.registers32;
|
||||
p^.registersfpu:=p^.left^.registersfpu;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
@ -3346,7 +3388,6 @@ unit pass_1;
|
||||
{$endif SUPPORT_MMX}
|
||||
set_location(p^.location,p^.left^.location);
|
||||
end;
|
||||
store_valid:=must_be_valid;
|
||||
if not (p^.inlinenumber in [in_read_x,in_readln_x,in_sizeof_x,
|
||||
in_typeof_x,in_ord_x,
|
||||
in_reset_typedfile,in_rewrite_typedfile]) then
|
||||
@ -3492,9 +3533,8 @@ unit pass_1;
|
||||
(penumdef(p^.resulttype)^.has_jumps) then
|
||||
begin
|
||||
Message(parser_e_succ_and_pred_enums_with_assign_not_possible);
|
||||
exit;
|
||||
end;
|
||||
if p^.left^.treetype=ordconstn then
|
||||
end
|
||||
else if p^.left^.treetype=ordconstn then
|
||||
begin
|
||||
if p^.inlinenumber=in_pred_x then
|
||||
hp:=genordinalconstnode(p^.left^.value+1,
|
||||
@ -3840,6 +3880,7 @@ unit pass_1;
|
||||
else internalerror(8);
|
||||
end;
|
||||
must_be_valid:=store_valid;
|
||||
count_ref:=store_count_ref;
|
||||
end;
|
||||
|
||||
procedure firstsubscriptn(var p : ptree);
|
||||
@ -4021,11 +4062,7 @@ unit pass_1;
|
||||
if codegenerror then
|
||||
exit;
|
||||
|
||||
p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
|
||||
p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
|
||||
{$endif SUPPORT_MMX}
|
||||
left_right_max(p);
|
||||
{ this is not allways true due to optimization }
|
||||
{ but if we don't set this we get problems with optimizing self code }
|
||||
if psetdef(p^.right^.resulttype)^.settype<>smallset then
|
||||
@ -4053,6 +4090,7 @@ unit pass_1;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=p^.right^.registersmmx;
|
||||
{$endif SUPPORT_MMX}
|
||||
{ left is the next in the list }
|
||||
firstpass(p^.left);
|
||||
if codegenerror then
|
||||
exit;
|
||||
@ -4534,11 +4572,7 @@ unit pass_1;
|
||||
if codegenerror then
|
||||
exit;
|
||||
|
||||
p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
|
||||
p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
|
||||
{$endif SUPPORT_MMX}
|
||||
left_right_max(p);
|
||||
|
||||
{ left must be a class }
|
||||
if (p^.left^.resulttype^.deftype<>objectdef) or
|
||||
@ -4567,11 +4601,13 @@ unit pass_1;
|
||||
if codegenerror then
|
||||
exit;
|
||||
|
||||
left_right_max(p);
|
||||
(* this was wrong,no ??
|
||||
p^.registersfpu:=max(p^.left^.registersfpu,p^.left^.registersfpu);
|
||||
p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
|
||||
{$endif SUPPORT_MMX}
|
||||
{$endif SUPPORT_MMX} *)
|
||||
|
||||
{ left must be a class }
|
||||
if (p^.left^.resulttype^.deftype<>objectdef) or
|
||||
@ -4626,14 +4662,7 @@ unit pass_1;
|
||||
firstpass(p^.right);
|
||||
p^.right:=gentypeconvnode(p^.right,s32bitdef);
|
||||
firstpass(p^.right);
|
||||
p^.registersfpu:=max(p^.left^.registersfpu,
|
||||
p^.right^.registersfpu);
|
||||
p^.registers32:=max(p^.left^.registers32,
|
||||
p^.right^.registers32);
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=max(p^.left^.registersmmx,
|
||||
p^.right^.registersmmx);
|
||||
{$endif SUPPORT_MMX}
|
||||
left_right_max(p);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -4652,14 +4681,7 @@ unit pass_1;
|
||||
if codegenerror then
|
||||
exit;
|
||||
|
||||
p^.registers32:=max(p^.left^.registers32,
|
||||
p^.right^.registers32);
|
||||
p^.registersfpu:=max(p^.left^.registersfpu,
|
||||
p^.right^.registersfpu);
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=max(p^.left^.registersmmx,
|
||||
p^.right^.registersmmx);
|
||||
{$endif SUPPORT_MMX}
|
||||
left_right_max(p);
|
||||
p^.resulttype:=voiddef;
|
||||
end
|
||||
else
|
||||
@ -4838,7 +4860,7 @@ unit pass_1;
|
||||
begin
|
||||
comment(v_debug,'tree changed after first counting pass '
|
||||
+tostr(longint(p^.treetype)));
|
||||
compare_trees(p,oldp);
|
||||
compare_trees(oldp,p);
|
||||
end;
|
||||
dispose(oldp);
|
||||
end;
|
||||
@ -4872,7 +4894,17 @@ unit pass_1;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 1998-05-11 13:07:55 peter
|
||||
Revision 1.19 1998-05-20 09:42:34 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.18 1998/05/11 13:07:55 peter
|
||||
+ $ifdef NEWPPU for the new ppuformat
|
||||
+ $define GDB not longer required
|
||||
* removed all warnings and stripped some log comments
|
||||
|
@ -94,7 +94,7 @@ unit pbase;
|
||||
|
||||
uses
|
||||
|
||||
files,scanner,symtable,systems,verbose;
|
||||
files,scanner,systems,verbose;
|
||||
|
||||
{ consumes token i, if the current token is unequal i }
|
||||
{ a syntax error is written }
|
||||
@ -148,11 +148,7 @@ unit pbase;
|
||||
else
|
||||
begin
|
||||
if token=_END then
|
||||
{$ifdef UseTokenInfo}
|
||||
last_endtoken_filepos:=tokenpos;
|
||||
{$else UseTokenInfo}
|
||||
get_cur_file_pos(last_endtoken_filepos);
|
||||
{$endif UseTokenInfo}
|
||||
token:=yylex;
|
||||
end;
|
||||
end;
|
||||
@ -160,19 +156,11 @@ unit pbase;
|
||||
procedure consume_all_until(atoken : ttoken);
|
||||
|
||||
begin
|
||||
{$ifndef UseTokenInfo}
|
||||
while (token<>atoken) and (token<>_EOF) do
|
||||
consume(token);
|
||||
{ this will create an error if the token is _EOF }
|
||||
if token<>atoken then
|
||||
consume(atoken);
|
||||
{$else UseTokenInfo}
|
||||
while (token<>atoken) and (token<>_EOF) do
|
||||
consume(token);
|
||||
{ this will create an error if the token is _EOF }
|
||||
if token<>atoken then
|
||||
consume(atoken);
|
||||
{$endif UseTokenInfo}
|
||||
{ this error is fatal as we have read the whole file }
|
||||
Message(scan_f_end_of_file);
|
||||
end;
|
||||
@ -193,12 +181,8 @@ unit pbase;
|
||||
begin
|
||||
sc:=new(pstringcontainer,init);
|
||||
repeat
|
||||
{$ifndef UseTokenInfo}
|
||||
sc^.insert(pattern);
|
||||
{$else UseTokenInfo}
|
||||
sc^.insert_with_tokeninfo(pattern,
|
||||
tokenpos);
|
||||
{$endif UseTokenInfo}
|
||||
consume(ID);
|
||||
if token=COMMA then consume(COMMA)
|
||||
else break
|
||||
@ -212,27 +196,17 @@ unit pbase;
|
||||
|
||||
var
|
||||
s : string;
|
||||
{$ifdef UseTokenInfo}
|
||||
filepos : tfileposinfo;
|
||||
ss : pvarsym;
|
||||
{$endif UseTokenInfo}
|
||||
|
||||
|
||||
begin
|
||||
{$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
|
||||
@ -240,11 +214,7 @@ 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;
|
||||
@ -253,7 +223,17 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 1998-05-12 10:47:00 peter
|
||||
Revision 1.7 1998-05-20 09:42:35 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.6 1998/05/12 10:47:00 peter
|
||||
* moved printstatus to verb_def
|
||||
+ V_Normal which is between V_Error and V_Warning and doesn't have a
|
||||
prefix like error: warning: and is included in V_Default
|
||||
|
@ -201,7 +201,7 @@ unit pdecl;
|
||||
{$ifndef GDB}
|
||||
else d:=new(pstringdef,init(255));
|
||||
{$else GDB}
|
||||
else d:=globaldef('SYSTEM.STRING');
|
||||
else d:=globaldef('STRING');
|
||||
{$endif GDB}
|
||||
{$else UseAnsiString}
|
||||
if p^.value>255 then
|
||||
@ -211,18 +211,18 @@ unit pdecl;
|
||||
{$ifndef GDB}
|
||||
else d:=new(pstringdef,init(255));
|
||||
{$else GDB}
|
||||
else d:=globaldef('SYSTEM.STRING');
|
||||
else d:=globaldef('STRING');
|
||||
{$endif GDB}
|
||||
consume(RECKKLAMMER);
|
||||
{$endif UseAnsiString}
|
||||
disposetree(p);
|
||||
end
|
||||
{ should string bwithout suffix be an ansistring also
|
||||
{ should string without suffix be an ansistring also
|
||||
in ansistring mode ?? (PM) }
|
||||
{$ifndef GDB}
|
||||
else d:=new(pstringdef,init(255));
|
||||
{$else GDB}
|
||||
else d:=globaldef('SYSTEM.STRING');
|
||||
else d:=globaldef('STRING');
|
||||
{$endif GDB}
|
||||
stringtype:=d;
|
||||
end;
|
||||
@ -382,9 +382,7 @@ unit pdecl;
|
||||
sc : pstringcontainer;
|
||||
hp : pdef;
|
||||
s : string;
|
||||
{$ifdef UseTokenInfo}
|
||||
filepos : tfileposinfo;
|
||||
{$endif UseTokenInfo}
|
||||
pp : pprocdef;
|
||||
|
||||
begin
|
||||
@ -442,7 +440,7 @@ unit pdecl;
|
||||
end
|
||||
else
|
||||
hp:=new(pformaldef,init);
|
||||
s:=sc^.get;
|
||||
s:=sc^.get_with_tokeninfo(filepos);
|
||||
while s<>'' do
|
||||
begin
|
||||
new(hp2);
|
||||
@ -450,7 +448,7 @@ unit pdecl;
|
||||
hp2^.data:=hp;
|
||||
hp2^.next:=propertyparas;
|
||||
propertyparas:=hp2;
|
||||
s:=sc^.get;
|
||||
s:=sc^.get_with_tokeninfo(filepos);
|
||||
end;
|
||||
dispose(sc,done);
|
||||
if token=SEMICOLON then consume(SEMICOLON)
|
||||
@ -1546,9 +1544,7 @@ unit pdecl;
|
||||
old_block_type : tblock_type;
|
||||
{ to handle absolute }
|
||||
abssym : pabsolutesym;
|
||||
{$ifdef UseTokenInfo}
|
||||
filepos : tfileposinfo;
|
||||
{$endif UseTokenInfo}
|
||||
|
||||
|
||||
begin
|
||||
@ -1566,11 +1562,7 @@ unit pdecl;
|
||||
p:=read_type('');
|
||||
if do_absolute and (token=ID) and (pattern='ABSOLUTE') then
|
||||
begin
|
||||
{$ifdef UseTokenInfo}
|
||||
s:=sc^.get_with_tokeninfo(filepos);
|
||||
{$else UseTokenInfo}
|
||||
s:=sc^.get;
|
||||
{$endif UseTokenInfo}
|
||||
s:=sc^.get_with_tokeninfo(filepos);
|
||||
if sc^.get<>'' then
|
||||
Message(parser_e_absolute_only_one_var);
|
||||
dispose(sc,done);
|
||||
@ -1586,9 +1578,7 @@ 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
|
||||
@ -1600,9 +1590,7 @@ 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
|
||||
@ -1615,9 +1603,7 @@ 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);
|
||||
@ -1787,7 +1773,17 @@ unit pdecl;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.17 1998-05-11 13:07:55 peter
|
||||
Revision 1.18 1998-05-20 09:42:35 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.17 1998/05/11 13:07:55 peter
|
||||
+ $ifdef NEWPPU for the new ppuformat
|
||||
+ $define GDB not longer required
|
||||
* removed all warnings and stripped some log comments
|
||||
|
@ -654,13 +654,10 @@ unit pexpr;
|
||||
d : bestreal;
|
||||
constset : pconstset;
|
||||
propsym : ppropertysym;
|
||||
{$ifdef UseTokenInfo}
|
||||
oldp1 : ptree;
|
||||
filepos : tfileposinfo;
|
||||
{$endif UseTokenInfo}
|
||||
|
||||
|
||||
{$ifdef UseTokenInfo}
|
||||
procedure check_tokenpos;
|
||||
begin
|
||||
if (p1<>oldp1) then
|
||||
@ -671,15 +668,12 @@ unit pexpr;
|
||||
filepos:=tokenpos;
|
||||
end;
|
||||
end;
|
||||
{$endif UseTokenInfo}
|
||||
|
||||
{ p1 and p2 must contain valid values }
|
||||
procedure postfixoperators;
|
||||
|
||||
begin
|
||||
{$ifdef UseTokenInfo}
|
||||
check_tokenpos;
|
||||
{$endif UseTokenInfo}
|
||||
while again do
|
||||
begin
|
||||
case token of
|
||||
@ -904,9 +898,7 @@ unit pexpr;
|
||||
else again:=false;
|
||||
end;
|
||||
end;
|
||||
{$ifdef UseTokenInfo}
|
||||
check_tokenpos;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -930,10 +922,8 @@ unit pexpr;
|
||||
possible_error : boolean;
|
||||
|
||||
begin
|
||||
{$ifdef UseTokenInfo}
|
||||
oldp1:=nil;
|
||||
filepos:=tokenpos;
|
||||
{$endif UseTokenInfo}
|
||||
case token of
|
||||
ID:
|
||||
begin
|
||||
@ -954,7 +944,14 @@ unit pexpr;
|
||||
end
|
||||
else
|
||||
begin
|
||||
getsym(pattern,true);
|
||||
if lastsymknown then
|
||||
begin
|
||||
srsym:=lastsrsym;
|
||||
srsymtable:=lastsrsymtable;
|
||||
lastsymknown:=false;
|
||||
end
|
||||
else
|
||||
getsym(pattern,true);
|
||||
consume(ID);
|
||||
{ is this an access to a function result ? }
|
||||
if assigned(aktprocsym) and
|
||||
@ -1516,9 +1513,7 @@ unit pexpr;
|
||||
end;
|
||||
end;
|
||||
factor:=p1;
|
||||
{$ifdef UseTokenInfo}
|
||||
check_tokenpos;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
|
||||
type Toperator_precedence=(opcompare,opaddition,opmultiply);
|
||||
@ -1556,9 +1551,7 @@ unit pexpr;
|
||||
|
||||
var p1,p2:Ptree;
|
||||
oldt:Ttoken;
|
||||
{$ifdef UseTokenInfo}
|
||||
filepos : tfileposinfo;
|
||||
{$endif UseTokenInfo}
|
||||
|
||||
|
||||
begin
|
||||
@ -1574,9 +1567,7 @@ unit pexpr;
|
||||
((token<>EQUAL) or accept_equal) then
|
||||
begin
|
||||
oldt:=token;
|
||||
{$ifdef UseTokenInfo}
|
||||
filepos:=tokenpos;
|
||||
{$endif UseTokenInfo}
|
||||
|
||||
consume(token);
|
||||
{ if pred_level=high(Toperator_precedence) then }
|
||||
@ -1585,9 +1576,7 @@ unit pexpr;
|
||||
else
|
||||
p2:=sub_expr(succ(pred_level),true);
|
||||
p1:=gennode(tok2node[oldt],p1,p2);
|
||||
{$ifdef UseTokenInfo}
|
||||
set_tree_filepos(p1,filepos);
|
||||
{$endif UseTokenInfo}
|
||||
|
||||
end
|
||||
else
|
||||
@ -1613,20 +1602,16 @@ unit pexpr;
|
||||
var
|
||||
p1,p2 : ptree;
|
||||
oldafterassignment : boolean;
|
||||
{$ifdef UseTokenInfo}
|
||||
oldp1 : ptree;
|
||||
filepos : tfileposinfo;
|
||||
{$endif UseTokenInfo}
|
||||
|
||||
begin
|
||||
oldafterassignment:=afterassignment;
|
||||
p1:=sub_expr(opcompare,true);
|
||||
if token in [ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
|
||||
afterassignment:=true;
|
||||
{$ifdef UseTokenInfo}
|
||||
filepos:=tokenpos;
|
||||
oldp1:=p1;
|
||||
{$endif UseTokenInfo}
|
||||
case token of
|
||||
POINTPOINT : begin
|
||||
consume(POINTPOINT);
|
||||
@ -1679,10 +1664,8 @@ unit pexpr;
|
||||
end;
|
||||
end;
|
||||
afterassignment:=oldafterassignment;
|
||||
{$ifdef UseTokenInfo}
|
||||
if p1<>oldp1 then
|
||||
set_tree_filepos(p1,filepos);
|
||||
{$endif UseTokenInfo}
|
||||
expr:=p1;
|
||||
end;
|
||||
|
||||
@ -1732,7 +1715,17 @@ unit pexpr;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 1998-05-11 13:07:56 peter
|
||||
Revision 1.15 1998-05-20 09:42:35 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.14 1998/05/11 13:07:56 peter
|
||||
+ $ifdef NEWPPU for the new ppuformat
|
||||
+ $define GDB not longer required
|
||||
* removed all warnings and stripped some log comments
|
||||
|
@ -274,7 +274,7 @@ unit pmodules;
|
||||
insertinternsyms(p);
|
||||
end;
|
||||
|
||||
procedure load_ppu(hp : pmodule;compile_system : boolean);
|
||||
procedure load_ppu(oldhp,hp : pmodule;compile_system : boolean);
|
||||
|
||||
var
|
||||
loaded_unit : pmodule;
|
||||
@ -322,7 +322,17 @@ unit pmodules;
|
||||
if not(hp^.sources_avail) then
|
||||
Message1(unit_f_cant_compile_unit,hp^.unitname^)
|
||||
else
|
||||
compile(hp^.mainsource^,compile_system);
|
||||
begin
|
||||
{$ifdef TEST_TEMPCLOSE}
|
||||
if assigned(oldhp^.current_inputfile) then
|
||||
oldhp^.current_inputfile^.tempclose;
|
||||
{$endif TEST_TEMPCLOSE}
|
||||
compile(hp^.mainsource^,compile_system);
|
||||
{$ifdef TEST_TEMPCLOSE}
|
||||
if not oldhp^.compiled then
|
||||
oldhp^.current_inputfile^.tempreopen;
|
||||
{$endif TEST_TEMPCLOSE}
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -336,8 +346,10 @@ unit pmodules;
|
||||
hp^.symtable:=new(punitsymtable,load(hp^.unitname^));
|
||||
|
||||
{ if this is the system unit insert the intern symbols }
|
||||
make_ref:=false;
|
||||
if compile_system then
|
||||
insertinternsyms(psymtable(hp^.symtable));
|
||||
make_ref:=true;
|
||||
end;
|
||||
|
||||
{ now only read the implementation part }
|
||||
@ -389,7 +401,17 @@ unit pmodules;
|
||||
if not(hp^.sources_avail) then
|
||||
Message1(unit_f_cant_compile_unit,hp^.unitname^)
|
||||
else
|
||||
compile(hp^.mainsource^,compile_system);
|
||||
begin
|
||||
{$ifdef TEST_TEMPCLOSE}
|
||||
if assigned(oldhp^.current_inputfile) then
|
||||
oldhp^.current_inputfile^.tempclose;
|
||||
{$endif TEST_TEMPCLOSE}
|
||||
compile(hp^.mainsource^,compile_system);
|
||||
{$ifdef TEST_TEMPCLOSE}
|
||||
if not oldhp^.compiled then
|
||||
oldhp^.current_inputfile^.tempreopen;
|
||||
{$endif TEST_TEMPCLOSE}
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
{ setup the map entry for deref }
|
||||
@ -407,8 +429,10 @@ unit pmodules;
|
||||
|
||||
{ if this is the system unit insert the intern }
|
||||
{ symbols }
|
||||
make_ref:=false;
|
||||
if compile_system then
|
||||
insertinternsyms(psymtable(hp^.symtable));
|
||||
make_ref:=true;
|
||||
|
||||
{ now only read the implementation part }
|
||||
hp^.in_implementation:=true;
|
||||
@ -443,7 +467,15 @@ unit pmodules;
|
||||
if not(hp^.sources_avail) then
|
||||
Message1(unit_f_cant_compile_unit,hp^.unitname^)
|
||||
else
|
||||
compile(hp^.mainsource^,compile_system);
|
||||
begin
|
||||
{ifdef TEST_TEMPCLOSE}
|
||||
oldhp^.current_inputfile^.tempclose;
|
||||
{endif TEST_TEMPCLOSE}
|
||||
compile(hp^.mainsource^,compile_system);
|
||||
{ifdef TEST_TEMPCLOSE}
|
||||
oldhp^.current_inputfile^.tempclose;
|
||||
{endif TEST_TEMPCLOSE}
|
||||
end;
|
||||
exit;
|
||||
end; *)
|
||||
{ read until ibend }
|
||||
@ -514,7 +546,17 @@ unit pmodules;
|
||||
if not(hp^.sources_avail) then
|
||||
Message1(unit_f_cant_compile_unit,hp^.unitname^)
|
||||
else
|
||||
compile(hp^.mainsource^,compile_system);
|
||||
begin
|
||||
{$ifdef TEST_TEMPCLOSE}
|
||||
if assigned(old_current_module^.current_inputfile) then
|
||||
old_current_module^.current_inputfile^.tempclose;
|
||||
{$endif TEST_TEMPCLOSE}
|
||||
compile(hp^.mainsource^,compile_system);
|
||||
{$ifdef TEST_TEMPCLOSE}
|
||||
if not old_current_module^.compiled then
|
||||
old_current_module^.current_inputfile^.tempreopen;
|
||||
{$endif TEST_TEMPCLOSE}
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -528,7 +570,7 @@ unit pmodules;
|
||||
{$else}
|
||||
if hp^.ppufile^.name^<>'' then
|
||||
{$endif}
|
||||
load_ppu(hp,compile_system);
|
||||
load_ppu(old_current_module,hp,compile_system);
|
||||
{ add the files for the linker }
|
||||
addlinkerfiles(hp);
|
||||
end;
|
||||
@ -567,11 +609,24 @@ unit pmodules;
|
||||
{ we must preserve the unit chain }
|
||||
hp^.next:=nextmodule;
|
||||
if assigned(hp^.ppufile) then
|
||||
load_ppu(hp,compile_system)
|
||||
load_ppu(old_current_module,hp,compile_system)
|
||||
else
|
||||
begin
|
||||
{$ifdef UseBrowser}
|
||||
{ here we need to remove the names ! }
|
||||
hp^.sourcefiles.done;
|
||||
hp^.sourcefiles.init;
|
||||
{$endif not UseBrowser}
|
||||
{$ifdef TEST_TEMPCLOSE}
|
||||
if assigned(old_current_module^.current_inputfile) then
|
||||
old_current_module^.current_inputfile^.tempclose;
|
||||
{$endif TEST_TEMPCLOSE}
|
||||
Message1(parser_d_compiling_second_time,hp^.mainsource^);
|
||||
compile(hp^.mainsource^,compile_system);
|
||||
{$ifdef TEST_TEMPCLOSE}
|
||||
if not old_current_module^.compiled then
|
||||
old_current_module^.current_inputfile^.tempreopen;
|
||||
{$endif TEST_TEMPCLOSE}
|
||||
end;
|
||||
current_module^.compiled:=true;
|
||||
end;
|
||||
@ -841,7 +896,8 @@ unit pmodules;
|
||||
}
|
||||
{ generates static symbol table }
|
||||
p:=new(punitsymtable,init(staticsymtable,current_module^.unitname^));
|
||||
refsymtable:=p;
|
||||
{ must be done only after _USES !! (PM)
|
||||
refsymtable:=p;}
|
||||
|
||||
{Generate a procsym.}
|
||||
aktprocsym:=new(Pprocsym,init(current_module^.unitname^+'_init'));
|
||||
@ -864,6 +920,8 @@ unit pmodules;
|
||||
symtablestack:=unitst^.next;
|
||||
|
||||
parse_implementation_uses(unitst);
|
||||
{ now we can change refsymtable }
|
||||
refsymtable:=p;
|
||||
|
||||
{ but reinsert the global symtable as lasts }
|
||||
unitst^.next:=symtablestack;
|
||||
@ -946,12 +1004,7 @@ unit pmodules;
|
||||
pu:=pused_unit(pu^.next);
|
||||
end;
|
||||
inc(datasize,symtablestack^.datasize);
|
||||
|
||||
|
||||
|
||||
{ finish asmlist by adding segment starts }
|
||||
|
||||
|
||||
{ finish asmlist by adding segment starts }
|
||||
insertsegment;
|
||||
end;
|
||||
|
||||
@ -1020,6 +1073,9 @@ unit pmodules;
|
||||
|
||||
refsymtable:=st;
|
||||
|
||||
{ necessary for browser }
|
||||
loaded_units.insert(current_module);
|
||||
|
||||
{Insert the symbols of the system unit into the stack of symbol
|
||||
tables.}
|
||||
symtablestack:=systemunit;
|
||||
@ -1081,24 +1137,27 @@ unit pmodules;
|
||||
|
||||
|
||||
datasize:=symtablestack^.datasize;
|
||||
symtablestack^.check_forwards;
|
||||
{ symtablestack^.check_forwards;
|
||||
symtablestack^.allsymbolsused;
|
||||
|
||||
|
||||
|
||||
{ finish asmlist by adding segment starts }
|
||||
|
||||
|
||||
done in compile_proc_body }
|
||||
{ finish asmlist by adding segment starts }
|
||||
insertsegment;
|
||||
|
||||
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 1998-05-12 10:47:00 peter
|
||||
Revision 1.14 1998-05-20 09:42:35 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.13 1998/05/12 10:47:00 peter
|
||||
* moved printstatus to verb_def
|
||||
+ V_Normal which is between V_Error and V_Warning and doesn't have a
|
||||
prefix like error: warning: and is included in V_Default
|
||||
|
@ -57,17 +57,17 @@
|
||||
{ and only one of the two }
|
||||
{$ifndef I386}
|
||||
{$ifndef M68K}
|
||||
{$fatalerror One of the switches I386 or M68K must be defined}
|
||||
{$fatal One of the switches I386 or M68K must be defined}
|
||||
{$endif M68K}
|
||||
{$endif I386}
|
||||
{$ifdef I386}
|
||||
{$ifdef M68K}
|
||||
{$fatalerror ONLY one of the switches I386 or M68K must be defined}
|
||||
{$fatal ONLY one of the switches I386 or M68K must be defined}
|
||||
{$endif M68K}
|
||||
{$endif I386}
|
||||
{$ifdef support_mmx}
|
||||
{$ifndef i386}
|
||||
{$fatalerror I386 switch must be on for MMX support}
|
||||
{$fatal I386 switch must be on for MMX support}
|
||||
{$endif i386}
|
||||
{$endif support_mmx}
|
||||
{$endif}
|
||||
@ -195,6 +195,13 @@ var
|
||||
procedure myexit;{$ifndef FPC}far;{$endif}
|
||||
begin
|
||||
exitproc:=oldexit;
|
||||
{$ifdef UseBrowser}
|
||||
if browser_file_open then
|
||||
begin
|
||||
close(browserfile);
|
||||
browser_file_open:=false;
|
||||
end;
|
||||
{$endif UseBrowser}
|
||||
{$ifdef tp}
|
||||
if use_big then
|
||||
symbolstream.done;
|
||||
@ -353,7 +360,17 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1998-05-12 10:47:00 peter
|
||||
Revision 1.11 1998-05-20 09:42:35 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.10 1998/05/12 10:47:00 peter
|
||||
* moved printstatus to verb_def
|
||||
+ V_Normal which is between V_Error and V_Warning and doesn't have a
|
||||
prefix like error: warning: and is included in V_Default
|
||||
|
@ -569,6 +569,12 @@ unit pstatmnt;
|
||||
function _asm_statement : ptree;
|
||||
|
||||
begin
|
||||
if (aktprocsym^.definition^.options and poinline)<>0 then
|
||||
Begin
|
||||
Comment(V_Warning,'asm statement inside inline procedure/function not yet supported');
|
||||
Comment(V_Warning,'inlining disabled');
|
||||
aktprocsym^.definition^.options:= aktprocsym^.definition^.options and not poinline;
|
||||
End;
|
||||
case aktasmmode of
|
||||
I386_ATT : _asm_statement:=ratti386.assemble;
|
||||
I386_INTEL : _asm_statement:=rai386.assemble;
|
||||
@ -801,15 +807,11 @@ unit pstatmnt;
|
||||
|
||||
var
|
||||
first,last : ptree;
|
||||
{$ifdef UseTokenInfo}
|
||||
filepos : tfileposinfo;
|
||||
{$endif UseTokenInfo}
|
||||
|
||||
begin
|
||||
first:=nil;
|
||||
{$ifdef UseTokenInfo}
|
||||
filepos:=tokenpos;
|
||||
{$endif UseTokenInfo}
|
||||
consume(_BEGIN);
|
||||
inc(statement_level);
|
||||
|
||||
@ -845,11 +847,7 @@ unit pstatmnt;
|
||||
dec(statement_level);
|
||||
|
||||
last:=gensinglenode(blockn,first);
|
||||
{$ifdef UseTokenInfo}
|
||||
set_tree_filepos(last,filepos);
|
||||
{$else UseTokenInfo}
|
||||
set_file_line(first,last);
|
||||
{$endif UseTokenInfo}
|
||||
statement_block:=last;
|
||||
end;
|
||||
|
||||
@ -859,17 +857,13 @@ unit pstatmnt;
|
||||
p : ptree;
|
||||
code : ptree;
|
||||
labelnr : plabel;
|
||||
{$ifdef UseTokenInfo}
|
||||
filepos : tfileposinfo;
|
||||
{$endif UseTokenInfo}
|
||||
|
||||
label
|
||||
ready;
|
||||
|
||||
begin
|
||||
{$ifdef UseTokenInfo}
|
||||
filepos:=tokenpos;
|
||||
{$endif UseTokenInfo}
|
||||
case token of
|
||||
_GOTO : begin
|
||||
if not(cs_support_goto in aktswitches)then
|
||||
@ -929,7 +923,9 @@ unit pstatmnt;
|
||||
end;
|
||||
}
|
||||
_EXIT : code:=exit_statement;
|
||||
_ASM : code:=_asm_statement;
|
||||
_ASM : begin
|
||||
code:=_asm_statement;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
if (token=INTCONST) or
|
||||
@ -938,6 +934,11 @@ unit pstatmnt;
|
||||
(pattern='RESULT'))) then
|
||||
begin
|
||||
getsym(pattern,false);
|
||||
lastsymknown:=true;
|
||||
lastsrsym:=srsym;
|
||||
{ it is NOT necessarily the owner
|
||||
it can be a withsymtable !!! }
|
||||
lastsrsymtable:=srsymtable;
|
||||
if assigned(srsym) and (srsym^.typ=labelsym) then
|
||||
begin
|
||||
consume(token);
|
||||
@ -948,7 +949,7 @@ unit pstatmnt;
|
||||
|
||||
{ statement modifies srsym }
|
||||
labelnr:=plabelsym(srsym)^.number;
|
||||
|
||||
lastsymknown:=false;
|
||||
{ the pointer to the following instruction }
|
||||
{ isn't a very clean way }
|
||||
{$ifdef tp}
|
||||
@ -965,13 +966,19 @@ unit pstatmnt;
|
||||
if not(p^.treetype in [calln,assignn,breakn,inlinen,
|
||||
continuen]) then
|
||||
Message(cg_e_illegal_expression);
|
||||
{ specify that we don't use the value returned by the call }
|
||||
{ Question : can this be also improtant
|
||||
for inlinen ??
|
||||
it is used for :
|
||||
- dispose of temp stack space
|
||||
- dispose on FPU stack }
|
||||
if p^.treetype=calln then
|
||||
p^.return_value_used:=false;
|
||||
code:=p;
|
||||
end;
|
||||
end;
|
||||
ready:
|
||||
{$ifdef UseTokenInfo}
|
||||
set_tree_filepos(code,filepos);
|
||||
{$endif UseTokenInfo}
|
||||
statement:=code;
|
||||
end;
|
||||
|
||||
@ -1091,8 +1098,10 @@ unit pstatmnt;
|
||||
end;
|
||||
{ set the framepointer to esp for assembler functions }
|
||||
{ but only if the are no local variables }
|
||||
{ added no parameter also (PM) }
|
||||
if ((aktprocsym^.definition^.options and poassembler)<>0) and
|
||||
(aktprocsym^.definition^.localst^.datasize=0) then
|
||||
(aktprocsym^.definition^.localst^.datasize=0) and
|
||||
(aktprocsym^.definition^.parast^.datasize=0) then
|
||||
begin
|
||||
{$ifdef i386}
|
||||
procinfo.framepointer:=R_ESP;
|
||||
@ -1110,7 +1119,17 @@ unit pstatmnt;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1998-05-11 13:07:56 peter
|
||||
Revision 1.11 1998-05-20 09:42:35 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.10 1998/05/11 13:07:56 peter
|
||||
+ $ifdef NEWPPU for the new ppuformat
|
||||
+ $define GDB not longer required
|
||||
* removed all warnings and stripped some log comments
|
||||
|
@ -73,7 +73,7 @@ var
|
||||
Implementation
|
||||
|
||||
uses
|
||||
globals,AsmUtils,strings,hcodegen,scanner,aasm,
|
||||
files,globals,AsmUtils,strings,hcodegen,scanner,aasm,
|
||||
cobjects,verbose,symtable;
|
||||
|
||||
|
||||
@ -249,6 +249,9 @@ var
|
||||
end;
|
||||
{ Possiblities for first token in a statement: }
|
||||
{ Local Label, Label, Directive, Prefix or Opcode.... }
|
||||
tokenpos.line:=current_module^.current_inputfile^.line_no;
|
||||
tokenpos.column:=get_current_col;
|
||||
tokenpos.fileindex:=current_module^.current_index;
|
||||
if firsttoken and not (c in [newline,#13,'{',';']) then
|
||||
begin
|
||||
|
||||
@ -2169,7 +2172,17 @@ Begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1998-04-29 10:34:01 pierre
|
||||
Revision 1.3 1998-05-20 09:42:36 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.2 1998/04/29 10:34:01 pierre
|
||||
+ added some code for ansistring (not complete nor working yet)
|
||||
* corrected operator overloading
|
||||
* corrected nasm output
|
||||
|
@ -32,7 +32,7 @@ unit radi386;
|
||||
implementation
|
||||
|
||||
uses
|
||||
i386,hcodegen,globals,scanner,aasm,
|
||||
files,i386,hcodegen,globals,scanner,aasm,
|
||||
cobjects,symtable,types,verbose,asmutils;
|
||||
|
||||
function assemble : ptree;
|
||||
@ -73,10 +73,13 @@ unit radi386;
|
||||
retstr:=upper(tostr(procinfo.retoffset)+'('+att_reg2str[procinfo.framepointer]+')')
|
||||
else
|
||||
retstr:='';
|
||||
c:=asmgetchar;
|
||||
c:=asmgetchar;
|
||||
code:=new(paasmoutput,init);
|
||||
while not(ende) do
|
||||
begin
|
||||
tokenpos.line:=current_module^.current_inputfile^.line_no;
|
||||
tokenpos.column:=get_current_col;
|
||||
tokenpos.fileindex:=current_module^.current_index;
|
||||
case c of
|
||||
'A'..'Z','a'..'z','_' : begin
|
||||
hs:='';
|
||||
@ -236,7 +239,17 @@ unit radi386;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1998-04-08 16:58:06 pierre
|
||||
Revision 1.3 1998-05-20 09:42:36 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.2 1998/04/08 16:58:06 pierre
|
||||
* several bugfixes
|
||||
ADD ADC and AND are also sign extended
|
||||
nasm output OK (program still crashes at end
|
||||
|
@ -82,7 +82,7 @@ var
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
aasm,globals,AsmUtils,strings,hcodegen,scanner,
|
||||
files,aasm,globals,AsmUtils,strings,hcodegen,scanner,
|
||||
cobjects,verbose,types;
|
||||
|
||||
|
||||
@ -350,6 +350,9 @@ var
|
||||
c := asmgetchar;
|
||||
{ Possiblities for first token in a statement: }
|
||||
{ Local Label, Label, Directive, Prefix or Opcode.... }
|
||||
tokenpos.line:=current_module^.current_inputfile^.line_no;
|
||||
tokenpos.column:=get_current_col;
|
||||
tokenpos.fileindex:=current_module^.current_index;
|
||||
if firsttoken and not (c in [newline,#13,'{',';']) then
|
||||
begin
|
||||
firsttoken := FALSE;
|
||||
@ -3366,7 +3369,17 @@ Begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 1998-04-29 10:34:03 pierre
|
||||
Revision 1.5 1998-05-20 09:42:36 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.4 1998/04/29 10:34:03 pierre
|
||||
+ added some code for ansistring (not complete nor working yet)
|
||||
* corrected operator overloading
|
||||
* corrected nasm output
|
||||
|
@ -75,7 +75,7 @@ var
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
aasm,globals,AsmUtils,strings,hcodegen,scanner,
|
||||
files,aasm,globals,AsmUtils,strings,hcodegen,scanner,
|
||||
cobjects,verbose,symtable,types;
|
||||
|
||||
type
|
||||
@ -327,6 +327,9 @@ const
|
||||
c:=asmgetchar;
|
||||
{ Possiblities for first token in a statement: }
|
||||
{ Local Label, Label, Directive, Prefix or Opcode.... }
|
||||
tokenpos.line:=current_module^.current_inputfile^.line_no;
|
||||
tokenpos.column:=get_current_col;
|
||||
tokenpos.fileindex:=current_module^.current_index;
|
||||
if firsttoken and not (c in [newline,#13,'{',';']) then
|
||||
begin
|
||||
firsttoken := FALSE;
|
||||
@ -3678,7 +3681,17 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 1998-04-29 13:52:23 peter
|
||||
Revision 1.6 1998-05-20 09:42:37 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.5 1998/04/29 13:52:23 peter
|
||||
* small optimize fix
|
||||
|
||||
Revision 1.4 1998/04/29 10:34:04 pierre
|
||||
|
@ -160,15 +160,7 @@ unit scanner;
|
||||
preprocstack : ppreprocstack;
|
||||
|
||||
|
||||
{$ifdef UseTokenInfo}
|
||||
{ type
|
||||
ttokeninfo = record
|
||||
token : ttoken;
|
||||
fi : tfileposinfo;
|
||||
end;
|
||||
ptokeninfo = ^ttokeninfo; }
|
||||
var tokenpos : tfileposinfo;
|
||||
{$endif UseTokenInfo}
|
||||
|
||||
{public}
|
||||
procedure syntaxerror(const s : string);
|
||||
@ -659,24 +651,17 @@ unit scanner;
|
||||
function yylex : ttoken;
|
||||
var
|
||||
y : ttoken;
|
||||
{$ifdef UseTokenInfo}
|
||||
fileindex,line,column : longint;
|
||||
{$endif UseTokenInfo}
|
||||
code : word;
|
||||
l : longint;
|
||||
mac : pmacrosym;
|
||||
hp : pinputfile;
|
||||
hp2 : pchar;
|
||||
{$ifdef UseTokenInfo}
|
||||
label
|
||||
exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
begin
|
||||
{$ifdef UseTokenInfo}
|
||||
line:=current_module^.current_inputfile^.line_no;
|
||||
column:=get_current_col;
|
||||
fileindex:=current_module^.current_index;
|
||||
{$endif UseTokenInfo}
|
||||
tokenpos.line:=current_module^.current_inputfile^.line_no;
|
||||
tokenpos.column:=get_current_col;
|
||||
tokenpos.fileindex:=current_module^.current_index;
|
||||
{ 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 }
|
||||
@ -686,39 +671,29 @@ unit scanner;
|
||||
if c='.' then
|
||||
begin
|
||||
readchar;
|
||||
{$ifndef UseTokenInfo}
|
||||
yylex:=POINTPOINT;
|
||||
exit;
|
||||
end;
|
||||
yylex:=POINT;
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
yylex:=POINTPOINT;
|
||||
goto exit_label;
|
||||
end;
|
||||
yylex:=POINT;
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
|
||||
repeat
|
||||
case c of
|
||||
'{' : skipcomment;
|
||||
' ',#9..#13 : skipspace;
|
||||
' ',#9..#13 : skipspace;
|
||||
else
|
||||
break;
|
||||
end;
|
||||
until false;
|
||||
|
||||
lasttokenpos:=longint(inputpointer);
|
||||
{$ifdef UseTokenInfo}
|
||||
line:=current_module^.current_inputfile^.line_no;
|
||||
column:=get_current_col;
|
||||
fileindex:=current_module^.current_index;
|
||||
tokenpos.line:=current_module^.current_inputfile^.line_no;
|
||||
tokenpos.column:=get_current_col;
|
||||
tokenpos.fileindex:=current_module^.current_index;
|
||||
{ will become line:=lasttokenpos ??;}
|
||||
{$endif UseTokenInfo}
|
||||
case c of
|
||||
'_','A'..'Z',
|
||||
'_','A'..'Z',
|
||||
'a'..'z' : begin
|
||||
orgpattern:=readstring;
|
||||
pattern:=upper(orgpattern);
|
||||
@ -740,6 +715,9 @@ unit scanner;
|
||||
hp^.next:=current_module^.current_inputfile;
|
||||
current_module^.current_inputfile:=hp;
|
||||
status.currentsource:=current_module^.current_inputfile^.name^;
|
||||
{ I don't think that we should do that
|
||||
because otherwise the file will be searched !! (PM)
|
||||
but there is the problem of index !! }
|
||||
current_module^.sourcefiles.register_file(hp);
|
||||
current_module^.current_index:=hp^.ref_index;
|
||||
{ set an own buffer }
|
||||
@ -772,29 +750,17 @@ unit scanner;
|
||||
end;
|
||||
yylex:=ID;
|
||||
end;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'$' : begin
|
||||
pattern:=readnumber;
|
||||
yylex:=INTCONST;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'%' : begin
|
||||
pattern:=readnumber;
|
||||
yylex:=INTCONST;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'0'..'9' : begin
|
||||
pattern:=readnumber;
|
||||
@ -805,11 +771,7 @@ unit scanner;
|
||||
begin
|
||||
s_point:=true;
|
||||
yylex:=INTCONST;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
pattern:=pattern+'.';
|
||||
while c in ['0'..'9'] do
|
||||
@ -818,11 +780,7 @@ unit scanner;
|
||||
readchar;
|
||||
end;
|
||||
yylex:=REALNUMBER;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'e','E' : begin
|
||||
pattern:=pattern+'E';
|
||||
@ -840,46 +798,26 @@ unit scanner;
|
||||
readchar;
|
||||
end;
|
||||
yylex:=REALNUMBER;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
end;
|
||||
yylex:=INTCONST;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
';' : begin
|
||||
readchar;
|
||||
yylex:=SEMICOLON;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'[' : begin
|
||||
readchar;
|
||||
yylex:=LECKKLAMMER;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
']' : begin
|
||||
readchar;
|
||||
yylex:=RECKKLAMMER;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'(' : begin
|
||||
readchar;
|
||||
@ -894,20 +832,12 @@ unit scanner;
|
||||
exit;
|
||||
end;
|
||||
yylex:=LKLAMMER;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
')' : begin
|
||||
readchar;
|
||||
yylex:=RKLAMMER;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'+' : begin
|
||||
readchar;
|
||||
@ -915,18 +845,10 @@ unit scanner;
|
||||
begin
|
||||
readchar;
|
||||
yylex:=_PLUSASN;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
yylex:=PLUS;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'-' : begin
|
||||
readchar;
|
||||
@ -934,18 +856,10 @@ unit scanner;
|
||||
begin
|
||||
readchar;
|
||||
yylex:=_MINUSASN;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
yylex:=MINUS;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
':' : begin
|
||||
readchar;
|
||||
@ -953,18 +867,10 @@ unit scanner;
|
||||
begin
|
||||
readchar;
|
||||
yylex:=ASSIGNMENT;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
yylex:=COLON;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'*' : begin
|
||||
readchar;
|
||||
@ -979,11 +885,7 @@ unit scanner;
|
||||
end
|
||||
else
|
||||
yylex:=STAR;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'/' : begin
|
||||
readchar;
|
||||
@ -993,11 +895,7 @@ unit scanner;
|
||||
begin
|
||||
readchar;
|
||||
yylex:=_SLASHASN;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
end;
|
||||
'/' : begin
|
||||
@ -1011,20 +909,12 @@ unit scanner;
|
||||
end;
|
||||
end;
|
||||
yylex:=SLASH;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'=' : begin
|
||||
readchar;
|
||||
yylex:=EQUAL;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'.' : begin
|
||||
readchar;
|
||||
@ -1032,19 +922,11 @@ unit scanner;
|
||||
begin
|
||||
readchar;
|
||||
yylex:=POINTPOINT;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end
|
||||
else
|
||||
yylex:=POINT;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'@' : begin
|
||||
readchar;
|
||||
@ -1055,20 +937,12 @@ unit scanner;
|
||||
end
|
||||
else
|
||||
yylex:=KLAMMERAFFE;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
',' : begin
|
||||
readchar;
|
||||
yylex:=COMMA;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'''','#','^' : begin
|
||||
if c='^' then
|
||||
@ -1084,11 +958,7 @@ unit scanner;
|
||||
else
|
||||
begin
|
||||
yylex:=CARET;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
end
|
||||
else
|
||||
@ -1135,11 +1005,7 @@ unit scanner;
|
||||
yylex:=CCHAR
|
||||
else
|
||||
yylex:=CSTRING;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'>' : begin
|
||||
readchar;
|
||||
@ -1147,37 +1013,21 @@ unit scanner;
|
||||
'=' : begin
|
||||
readchar;
|
||||
yylex:=GTE;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'>' : begin
|
||||
readchar;
|
||||
yylex:=_SHR;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'<' : begin { >< is for a symetric diff for sets }
|
||||
readchar;
|
||||
yylex:=SYMDIF;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
end;
|
||||
yylex:=GT;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'<' : begin
|
||||
readchar;
|
||||
@ -1185,57 +1035,32 @@ unit scanner;
|
||||
'>' : begin
|
||||
readchar;
|
||||
yylex:=UNEQUAL;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'=' : begin
|
||||
readchar;
|
||||
yylex:=LTE;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
'<' : begin
|
||||
readchar;
|
||||
yylex:=_SHL;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
end;
|
||||
yylex:=LT;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
#26 : begin
|
||||
yylex:=_EOF;
|
||||
{$ifndef UseTokenInfo}
|
||||
exit;
|
||||
{$else UseTokenInfo}
|
||||
goto exit_label;
|
||||
{$endif UseTokenInfo}
|
||||
end;
|
||||
else
|
||||
begin
|
||||
Message(scan_f_illegal_char);
|
||||
end;
|
||||
end;
|
||||
{$ifdef UseTokenInfo}
|
||||
exit_label:
|
||||
tokenpos.fileindex:=fileindex;
|
||||
tokenpos.line:=line;
|
||||
tokenpos.column:=column;
|
||||
{$endif UseTokenInfo}
|
||||
exit_label:
|
||||
end;
|
||||
|
||||
|
||||
@ -1248,6 +1073,9 @@ unit scanner;
|
||||
end
|
||||
else
|
||||
readchar;
|
||||
tokenpos.line:=current_module^.current_inputfile^.line_no;
|
||||
tokenpos.column:=get_current_col;
|
||||
tokenpos.fileindex:=current_module^.current_index;
|
||||
case c of
|
||||
'{' : begin
|
||||
skipcomment;
|
||||
@ -1326,7 +1154,8 @@ unit scanner;
|
||||
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;
|
||||
if assigned(current_module^.current_inputfile) then
|
||||
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; }
|
||||
@ -1389,7 +1218,17 @@ unit scanner;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 1998-05-12 10:47:00 peter
|
||||
Revision 1.19 1998-05-20 09:42:37 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.18 1998/05/12 10:47:00 peter
|
||||
* moved printstatus to verb_def
|
||||
+ V_Normal which is between V_Error and V_Warning and doesn't have a
|
||||
prefix like error: warning: and is included in V_Default
|
||||
|
@ -58,7 +58,12 @@ unit tgeni386;
|
||||
procedure setfirsttemp(l : longint);
|
||||
function gettempsize : longint;
|
||||
function gettempofsize(size : longint) : longint;
|
||||
{ special call for inlined procedures }
|
||||
function gettempofsizepersistant(size : longint) : longint;
|
||||
{ for parameter func returns }
|
||||
procedure persistanttemptonormal(pos : longint);
|
||||
procedure ungettemp(pos : longint;size : longint);
|
||||
procedure ungetpersistanttemp(pos : longint;size : longint);
|
||||
procedure gettempofsizereference(l : longint;var ref : treference);
|
||||
function istemp(const ref : treference) : boolean;
|
||||
procedure ungetiftemp(const ref : treference);
|
||||
@ -321,6 +326,7 @@ unit tgeni386;
|
||||
next : pfreerecord;
|
||||
pos : longint;
|
||||
size : longint;
|
||||
persistant : boolean; { used for inlined procedures }
|
||||
{$ifdef EXTDEBUG}
|
||||
line : longint;
|
||||
{$endif}
|
||||
@ -348,7 +354,7 @@ unit tgeni386;
|
||||
begin
|
||||
{$ifdef EXTDEBUG}
|
||||
Comment(V_Warning,'temporary assignment of size '
|
||||
+tostr(templist^.size)+' from '+tostr(templist^.line)+
|
||||
+tostr(templist^.size)+' from line '+tostr(templist^.line)+
|
||||
+' at pos '+tostr(templist^.pos)+
|
||||
' not freed at the end of the procedure');
|
||||
{$endif}
|
||||
@ -378,12 +384,14 @@ unit tgeni386;
|
||||
function gettempofsize(size : longint) : longint;
|
||||
|
||||
var
|
||||
last,hp : pfreerecord;
|
||||
tl,last,hp : pfreerecord;
|
||||
ofs : longint;
|
||||
|
||||
begin
|
||||
{ this code comes from the heap management of FPC ... }
|
||||
if (size mod 4)<>0 then
|
||||
size:=size+(4-(size mod 4));
|
||||
ofs:=0;
|
||||
if assigned(tmpfreelist) then
|
||||
begin
|
||||
last:=nil;
|
||||
@ -393,7 +401,7 @@ unit tgeni386;
|
||||
{ first fit }
|
||||
if hp^.size>=size then
|
||||
begin
|
||||
gettempofsize:=hp^.pos;
|
||||
ofs:=hp^.pos;
|
||||
if hp^.pos-size < maxtemp then
|
||||
maxtemp := hp^.size-size;
|
||||
{ the whole block is needed ? }
|
||||
@ -410,17 +418,45 @@ unit tgeni386;
|
||||
tmpfreelist:=nil;
|
||||
dispose(hp);
|
||||
end;
|
||||
exit;
|
||||
break;
|
||||
end;
|
||||
last:=hp;
|
||||
hp:=hp^.next;
|
||||
end;
|
||||
end;
|
||||
{ nothing free is big enough : expand temp }
|
||||
gettempofsize:=lastoccupied-size;
|
||||
lastoccupied:=lastoccupied-size;
|
||||
if lastoccupied < maxtemp then
|
||||
maxtemp := lastoccupied;
|
||||
if ofs=0 then
|
||||
begin
|
||||
ofs:=lastoccupied-size;
|
||||
lastoccupied:=lastoccupied-size;
|
||||
if lastoccupied < maxtemp then
|
||||
maxtemp := lastoccupied;
|
||||
end;
|
||||
new(tl);
|
||||
tl^.pos:=ofs;
|
||||
tl^.size:=size;
|
||||
tl^.next:=templist;
|
||||
tl^.persistant:=false;
|
||||
templist:=tl;
|
||||
{$ifdef EXTDEBUG}
|
||||
tl^.line:=current_module^.current_inputfile^.line_no;
|
||||
{$endif}
|
||||
gettempofsize:=ofs;
|
||||
end;
|
||||
|
||||
function gettempofsizepersistant(size : longint) : longint;
|
||||
|
||||
var
|
||||
l : longint;
|
||||
|
||||
begin
|
||||
l:=gettempofsize(size);
|
||||
templist^.persistant:=true;
|
||||
{$ifdef EXTDEBUG}
|
||||
Comment(V_Debug,'temp managment : call to gettempofsizepersistant()'+
|
||||
' with size '+tostr(size)+' returned '+tostr(l));
|
||||
{$endif}
|
||||
gettempofsizepersistant:=l;
|
||||
end;
|
||||
|
||||
function gettempsize : longint;
|
||||
@ -434,29 +470,77 @@ unit tgeni386;
|
||||
|
||||
procedure gettempofsizereference(l : longint;var ref : treference);
|
||||
|
||||
var
|
||||
tl : pfreerecord;
|
||||
|
||||
begin
|
||||
{ do a reset, because the reference isn't used }
|
||||
reset_reference(ref);
|
||||
ref.offset:=gettempofsize(l);
|
||||
ref.base:=procinfo.framepointer;
|
||||
new(tl);
|
||||
tl^.pos:=ref.offset;
|
||||
tl^.size:=l;
|
||||
tl^.next:=templist;
|
||||
templist:=tl;
|
||||
{$ifdef EXTDEBUG}
|
||||
tl^.line:=current_module^.current_inputfile^.line_no;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function istemp(const ref : treference) : boolean;
|
||||
|
||||
begin
|
||||
{ ref.index = R_NO was missing
|
||||
led to problems with local arrays
|
||||
with lower bound > 0 (PM) }
|
||||
istemp:=((ref.base=procinfo.framepointer) and
|
||||
(ref.offset<firsttemp));
|
||||
(ref.offset<firsttemp) and (ref.index=R_NO));
|
||||
end;
|
||||
|
||||
procedure persistanttemptonormal(pos : longint);
|
||||
|
||||
var hp : pfreerecord;
|
||||
|
||||
begin
|
||||
hp:=templist;
|
||||
while assigned(hp) do
|
||||
if (hp^.persistant) and (hp^.pos=pos) then
|
||||
begin
|
||||
{$ifdef EXTDEBUG}
|
||||
Comment(V_Debug,'temp managment : persistanttemptonormal()'+
|
||||
' at pos '+tostr(pos)+ ' found !');
|
||||
{$endif}
|
||||
hp^.persistant:=false;
|
||||
exit;
|
||||
end
|
||||
else
|
||||
hp:=hp^.next;
|
||||
{$ifdef EXTDEBUG}
|
||||
Comment(V_Debug,'temp managment problem : persistanttemptonormal()'+
|
||||
' at pos '+tostr(pos)+ ' not found !');
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure ungetpersistanttemp(pos : longint;size : longint);
|
||||
var
|
||||
prev,hp : pfreerecord;
|
||||
|
||||
begin
|
||||
ungettemp(pos,size);
|
||||
prev:=nil;
|
||||
hp:=templist;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
if (hp^.persistant) and (hp^.pos=pos) and (hp^.size=size) then
|
||||
begin
|
||||
if assigned(prev) then
|
||||
prev^.next:=hp^.next
|
||||
else
|
||||
templist:=hp^.next;
|
||||
{$ifdef EXTDEBUG}
|
||||
Comment(V_Debug,'temp managment : ungetpersistanttemp()'+
|
||||
' at pos '+tostr(pos)+ ' found !');
|
||||
{$endif}
|
||||
dispose(hp);
|
||||
exit;
|
||||
end;
|
||||
prev:=hp;
|
||||
hp:=hp^.next;
|
||||
end;
|
||||
{$ifdef EXTDEBUG}
|
||||
Comment(V_Warning,'temp managment problem : ungetpersistanttemp()'+
|
||||
' at pos '+tostr(pos)+ ' not found !');
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure ungettemp(pos : longint;size : longint);
|
||||
@ -469,6 +553,7 @@ unit tgeni386;
|
||||
size:=size+(4-(size mod 4));
|
||||
if size = 0 then
|
||||
exit;
|
||||
|
||||
if pos<=lastoccupied then
|
||||
if pos=lastoccupied then
|
||||
begin
|
||||
@ -493,7 +578,8 @@ unit tgeni386;
|
||||
else
|
||||
begin
|
||||
{$ifdef EXTDEBUG}
|
||||
Comment(V_Warning,'temp managment problem : ungettemp() pos < lastoccupied !');
|
||||
Comment(V_Warning,'temp managment problem : ungettemp()'+
|
||||
'pos '+tostr(pos)+ '< lastoccupied '+tostr(lastoccupied)+' !');
|
||||
{$endif}
|
||||
end
|
||||
else
|
||||
@ -564,9 +650,24 @@ unit tgeni386;
|
||||
tl:=templist;
|
||||
while assigned(tl) do
|
||||
begin
|
||||
if ref.offset=tl^.pos then
|
||||
{ no release of persistant blocks this way!! }
|
||||
if tl^.persistant then
|
||||
if (ref.offset>=tl^.pos) and
|
||||
(ref.offset<tl^.pos+tl^.size) then
|
||||
begin
|
||||
{$ifdef EXTDEBUG}
|
||||
Comment(V_Debug,'temp '+
|
||||
' at pos '+tostr(ref.offset)+ ' not released because persistant !');
|
||||
{$endif}
|
||||
exit;
|
||||
end;
|
||||
if (ref.offset=tl^.pos) then
|
||||
begin
|
||||
ungettemp(ref.offset,tl^.size);
|
||||
{$ifdef TEMPDEBUG}
|
||||
Comment(V_Debug,'temp managment : ungettemp()'+
|
||||
' at pos '+tostr(tl^.pos)+ ' found !');
|
||||
{$endif}
|
||||
if assigned(prev) then
|
||||
prev^.next:=tl^.next
|
||||
else
|
||||
@ -598,7 +699,17 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 1998-05-11 13:07:58 peter
|
||||
Revision 1.6 1998-05-20 09:42:38 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.5 1998/05/11 13:07:58 peter
|
||||
+ $ifdef NEWPPU for the new ppuformat
|
||||
+ $define GDB not longer required
|
||||
* removed all warnings and stripped some log comments
|
||||
|
@ -206,7 +206,7 @@ unit tree;
|
||||
calln : (symtableprocentry : pprocsym;
|
||||
symtableproc : psymtable;procdefinition : pprocdef;
|
||||
methodpointer : ptree;
|
||||
no_check,unit_specific : boolean);
|
||||
no_check,unit_specific,return_value_used : boolean);
|
||||
ordconstn : (value : longint);
|
||||
realconstn : (valued : bestreal;labnumber : longint;realtyp : tait);
|
||||
fixconstn : (valuef: longint);
|
||||
@ -224,7 +224,8 @@ unit tree;
|
||||
{$endif UseAnsiString}
|
||||
typeconvn : (convtyp : tconverttype;explizit : boolean);
|
||||
inlinen : (inlinenumber : longint);
|
||||
procinlinen : (inlineprocdef : pprocdef);
|
||||
procinlinen : (inlineprocdef : pprocdef;
|
||||
retoffset,para_offset,para_size : longint);
|
||||
setconstrn : (constset : pconstset);
|
||||
loopn : (t1,t2 : ptree;backward : boolean);
|
||||
asmn : (p_asm : paasmoutput);
|
||||
@ -283,7 +284,7 @@ unit tree;
|
||||
procedure set_current_file_line(_to : ptree);
|
||||
procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo);
|
||||
{$ifdef extdebug}
|
||||
procedure compare_trees(p1,p2 : ptree);
|
||||
procedure compare_trees(oldp,p : ptree);
|
||||
const
|
||||
maxfirstpasscount : longint = 0;
|
||||
{$endif extdebug}
|
||||
@ -345,11 +346,7 @@ unit tree;
|
||||
hp^.error:=false;
|
||||
|
||||
{ we know also the position }
|
||||
{$ifdef UseTokenInfo}
|
||||
hp^.fileinfo:=tokenpos;
|
||||
{$else UseTokenInfo}
|
||||
get_cur_file_pos(hp^.fileinfo);
|
||||
{$endif UseTokenInfo}
|
||||
hp^.pragmas:=aktswitches;
|
||||
getnode:=hp;
|
||||
end;
|
||||
@ -989,6 +986,7 @@ unit tree;
|
||||
p^.symtableproc:=st;
|
||||
p^.unit_specific:=false;
|
||||
p^.no_check:=false;
|
||||
p^.return_value_used:=true;
|
||||
p^.disposetyp := dt_leftright;
|
||||
p^.methodpointer:=nil;
|
||||
p^.left:=nil;
|
||||
@ -1012,7 +1010,7 @@ unit tree;
|
||||
p^.registersmmx:=0;
|
||||
{$endif SUPPORT_MMX}
|
||||
p^.treetype:=calln;
|
||||
|
||||
p^.return_value_used:=true;
|
||||
p^.symtableprocentry:=v;
|
||||
p^.symtableproc:=st;
|
||||
p^.disposetyp:=dt_mbleft_and_method;
|
||||
@ -1142,6 +1140,9 @@ unit tree;
|
||||
p^.disposetyp:=dt_left;
|
||||
p^.treetype:=procinlinen;
|
||||
p^.inlineprocdef:=callp^.procdefinition;
|
||||
p^.retoffset:=-4; { less dangerous as zero (PM) }
|
||||
p^.para_offset:=0;
|
||||
p^.para_size:=p^.inlineprocdef^.para_size;
|
||||
{ copy args }
|
||||
p^.left:=getcopy(code);
|
||||
p^.registers32:=code^.registers32;
|
||||
@ -1175,110 +1176,117 @@ unit tree;
|
||||
end;
|
||||
|
||||
{$ifdef extdebug}
|
||||
procedure compare_trees(p1,p2 : ptree);
|
||||
procedure compare_trees(oldp,p : ptree);
|
||||
|
||||
var
|
||||
error_found : boolean;
|
||||
|
||||
begin
|
||||
if p1^.error<>p2^.error then
|
||||
if oldp^.resulttype<>p^.resulttype then
|
||||
begin
|
||||
error_found:=true;
|
||||
if is_equal(oldp^.resulttype,p^.resulttype) then
|
||||
comment(v_debug,'resulttype fields are different but equal')
|
||||
else
|
||||
comment(v_warning,'resulttype fields are really different');
|
||||
end;
|
||||
if oldp^.treetype<>p^.treetype then
|
||||
begin
|
||||
comment(v_warning,'treetype field different');
|
||||
error_found:=true;
|
||||
end
|
||||
else
|
||||
comment(v_debug,' treetype '+tostr(longint(oldp^.treetype)));
|
||||
if oldp^.error<>p^.error then
|
||||
begin
|
||||
comment(v_warning,'error field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.disposetyp<>p2^.disposetyp then
|
||||
if oldp^.disposetyp<>p^.disposetyp then
|
||||
begin
|
||||
comment(v_warning,'disposetyp field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
{ is true, if the right and left operand are swaped }
|
||||
if p1^.swaped<>p2^.swaped then
|
||||
if oldp^.swaped<>p^.swaped then
|
||||
begin
|
||||
comment(v_warning,'swaped field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
|
||||
{ the location of the result of this node }
|
||||
if p1^.location.loc<>p2^.location.loc then
|
||||
if oldp^.location.loc<>p^.location.loc then
|
||||
begin
|
||||
comment(v_warning,'location.loc field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
|
||||
{ the number of registers needed to evalute the node }
|
||||
if p1^.registers32<>p2^.registers32 then
|
||||
if oldp^.registers32<>p^.registers32 then
|
||||
begin
|
||||
comment(v_warning,'registers32 field different');
|
||||
comment(v_warning,tostr(p1^.registers32)+'<>'+tostr(p2^.registers32));
|
||||
comment(v_warning,' old '+tostr(oldp^.registers32)+'<> new '+tostr(p^.registers32));
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.registersfpu<>p2^.registersfpu then
|
||||
if oldp^.registersfpu<>p^.registersfpu then
|
||||
begin
|
||||
comment(v_warning,'registersfpu field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
if p1^.registersmmx<>p2^.registersmmx then
|
||||
if oldp^.registersmmx<>p^.registersmmx then
|
||||
begin
|
||||
comment(v_warning,'registersmmx field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
{$endif SUPPORT_MMX}
|
||||
if p1^.left<>p2^.left then
|
||||
if oldp^.left<>p^.left then
|
||||
begin
|
||||
comment(v_warning,'left field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.right<>p2^.right then
|
||||
if oldp^.right<>p^.right then
|
||||
begin
|
||||
comment(v_warning,'right field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.resulttype<>p2^.resulttype then
|
||||
begin
|
||||
error_found:=true;
|
||||
if is_equal(p1^.resulttype,p2^.resulttype) then
|
||||
comment(v_debug,'resulttype fields are different but equal')
|
||||
else
|
||||
comment(v_warning,'resulttype fields are really different');
|
||||
end;
|
||||
if p1^.fileinfo.line<>p2^.fileinfo.line then
|
||||
if oldp^.fileinfo.line<>p^.fileinfo.line then
|
||||
begin
|
||||
comment(v_warning,'fileinfo.line field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.fileinfo.column<>p2^.fileinfo.column then
|
||||
if oldp^.fileinfo.column<>p^.fileinfo.column then
|
||||
begin
|
||||
comment(v_warning,'fileinfo.column field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.fileinfo.fileindex<>p2^.fileinfo.fileindex then
|
||||
if oldp^.fileinfo.fileindex<>p^.fileinfo.fileindex then
|
||||
begin
|
||||
comment(v_warning,'fileinfo.fileindex field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.pragmas<>p2^.pragmas then
|
||||
if oldp^.pragmas<>p^.pragmas then
|
||||
begin
|
||||
comment(v_warning,'pragmas field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
{$ifdef extdebug}
|
||||
if p1^.firstpasscount<>p2^.firstpasscount then
|
||||
if oldp^.firstpasscount<>p^.firstpasscount then
|
||||
begin
|
||||
comment(v_warning,'firstpasscount field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
{$endif extdebug}
|
||||
if p1^.treetype=p2^.treetype then
|
||||
case p1^.treetype of
|
||||
if oldp^.treetype=p^.treetype then
|
||||
case oldp^.treetype of
|
||||
addn :
|
||||
begin
|
||||
if p1^.use_strconcat<>p2^.use_strconcat then
|
||||
if oldp^.use_strconcat<>p^.use_strconcat then
|
||||
begin
|
||||
comment(v_warning,'use_strconcat field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.string_typ<>p2^.string_typ then
|
||||
if oldp^.string_typ<>p^.string_typ then
|
||||
begin
|
||||
comment(v_warning,'stringtyp field different');
|
||||
error_found:=true;
|
||||
@ -1287,12 +1295,12 @@ unit tree;
|
||||
callparan :
|
||||
{(is_colon_para : boolean;exact_match_found : boolean);}
|
||||
begin
|
||||
if p1^.is_colon_para<>p2^.is_colon_para then
|
||||
if oldp^.is_colon_para<>p^.is_colon_para then
|
||||
begin
|
||||
comment(v_warning,'use_strconcat field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.exact_match_found<>p2^.exact_match_found then
|
||||
if oldp^.exact_match_found<>p^.exact_match_found then
|
||||
begin
|
||||
comment(v_warning,'exact_match_found field different');
|
||||
error_found:=true;
|
||||
@ -1301,12 +1309,12 @@ unit tree;
|
||||
assignn :
|
||||
{(assigntyp : tassigntyp;concat_string : boolean);}
|
||||
begin
|
||||
if p1^.assigntyp<>p2^.assigntyp then
|
||||
if oldp^.assigntyp<>p^.assigntyp then
|
||||
begin
|
||||
comment(v_warning,'assigntyp field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.concat_string<>p2^.concat_string then
|
||||
if oldp^.concat_string<>p^.concat_string then
|
||||
begin
|
||||
comment(v_warning,'concat_string field different');
|
||||
error_found:=true;
|
||||
@ -1316,22 +1324,22 @@ unit tree;
|
||||
{(symtableentry : psym;symtable : psymtable;
|
||||
is_absolute,is_first : boolean);}
|
||||
begin
|
||||
if p1^.symtableentry<>p2^.symtableentry then
|
||||
if oldp^.symtableentry<>p^.symtableentry then
|
||||
begin
|
||||
comment(v_warning,'symtableentry field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.symtable<>p2^.symtable then
|
||||
if oldp^.symtable<>p^.symtable then
|
||||
begin
|
||||
comment(v_warning,'symtable field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.is_absolute<>p2^.is_absolute then
|
||||
if oldp^.is_absolute<>p^.is_absolute then
|
||||
begin
|
||||
comment(v_warning,'is_absolute field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.is_first<>p2^.is_first then
|
||||
if oldp^.is_first<>p^.is_first then
|
||||
begin
|
||||
comment(v_warning,'is_first field different');
|
||||
error_found:=true;
|
||||
@ -1343,32 +1351,32 @@ unit tree;
|
||||
methodpointer : ptree;
|
||||
no_check,unit_specific : boolean);}
|
||||
begin
|
||||
if p1^.symtableprocentry<>p2^.symtableprocentry then
|
||||
if oldp^.symtableprocentry<>p^.symtableprocentry then
|
||||
begin
|
||||
comment(v_warning,'symtableprocentry field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.symtableproc<>p2^.symtableproc then
|
||||
if oldp^.symtableproc<>p^.symtableproc then
|
||||
begin
|
||||
comment(v_warning,'symtableproc field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.procdefinition<>p2^.procdefinition then
|
||||
if oldp^.procdefinition<>p^.procdefinition then
|
||||
begin
|
||||
comment(v_warning,'procdefinition field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.methodpointer<>p2^.methodpointer then
|
||||
if oldp^.methodpointer<>p^.methodpointer then
|
||||
begin
|
||||
comment(v_warning,'methodpointer field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.no_check<>p2^.no_check then
|
||||
if oldp^.no_check<>p^.no_check then
|
||||
begin
|
||||
comment(v_warning,'no_check field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.unit_specific<>p2^.unit_specific then
|
||||
if oldp^.unit_specific<>p^.unit_specific then
|
||||
begin
|
||||
error_found:=true;
|
||||
comment(v_warning,'unit_specific field different');
|
||||
@ -1376,7 +1384,7 @@ unit tree;
|
||||
end;
|
||||
ordconstn :
|
||||
begin
|
||||
if p1^.value<>p2^.value then
|
||||
if oldp^.value<>p^.value then
|
||||
begin
|
||||
comment(v_warning,'value field different');
|
||||
error_found:=true;
|
||||
@ -1384,17 +1392,17 @@ unit tree;
|
||||
end;
|
||||
realconstn :
|
||||
begin
|
||||
if p1^.valued<>p2^.valued then
|
||||
if oldp^.valued<>p^.valued then
|
||||
begin
|
||||
comment(v_warning,'valued field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.labnumber<>p2^.labnumber then
|
||||
if oldp^.labnumber<>p^.labnumber then
|
||||
begin
|
||||
comment(v_warning,'labnumber field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if p1^.realtyp<>p2^.realtyp then
|
||||
if oldp^.realtyp<>p^.realtyp then
|
||||
begin
|
||||
comment(v_warning,'realtyp field different');
|
||||
error_found:=true;
|
||||
@ -1527,7 +1535,17 @@ unit tree;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 1998-05-12 10:47:00 peter
|
||||
Revision 1.10 1998-05-20 09:42:38 pierre
|
||||
+ UseTokenInfo now default
|
||||
* unit in interface uses and implementation uses gives error now
|
||||
* only one error for unknown symbol (uses lastsymknown boolean)
|
||||
the problem came from the label code !
|
||||
+ first inlined procedures and function work
|
||||
(warning there might be allowed cases were the result is still wrong !!)
|
||||
* UseBrower updated gives a global list of all position of all used symbols
|
||||
with switch -gb
|
||||
|
||||
Revision 1.9 1998/05/12 10:47:00 peter
|
||||
* moved printstatus to verb_def
|
||||
+ V_Normal which is between V_Error and V_Warning and doesn't have a
|
||||
prefix like error: warning: and is included in V_Default
|
||||
|
Loading…
Reference in New Issue
Block a user