mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-25 12:37:27 +01:00
4b82d30953
+ Added read/write notifications of variables. These will be usefull for providing information for several optimizations. For example the value of the loop variable of a for loop does matter is the variable is read after the for loop, but if it's no longer used or written, it doesn't matter and this can be used to optimize the loop code generation.
2587 lines
77 KiB
ObjectPascal
2587 lines
77 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
|
|
|
|
Implementation for the symbols types of the symtable
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
****************************************************************************
|
|
}
|
|
unit symsym;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{ common }
|
|
cutils,
|
|
{ target }
|
|
cpuinfo,
|
|
{ symtable }
|
|
symconst,symbase,symtype,symdef,
|
|
{ ppu }
|
|
ppu,symppu,
|
|
{$ifdef var_notification}
|
|
cclasses,symnot,
|
|
{$endif}
|
|
{ aasm }
|
|
aasmbase,aasmtai,cpubase,
|
|
globals
|
|
;
|
|
|
|
type
|
|
{************************************************
|
|
TSym
|
|
************************************************}
|
|
|
|
{ this object is the base for all symbol objects }
|
|
tstoredsym = class(tsym)
|
|
protected
|
|
_mangledname : pstring;
|
|
public
|
|
{$ifdef GDB}
|
|
isstabwritten : boolean;
|
|
{$endif GDB}
|
|
refs : longint;
|
|
lastref,
|
|
defref,
|
|
lastwritten : tref;
|
|
refcount : longint;
|
|
constructor create(const n : string);
|
|
constructor loadsym(ppufile:tcompilerppufile);
|
|
destructor destroy;override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);virtual;abstract;
|
|
procedure writesym(ppufile:tcompilerppufile);
|
|
procedure deref;override;
|
|
{$ifdef GDB}
|
|
function stabstring : pchar;virtual;
|
|
procedure concatstabto(asmlist : taasmoutput);virtual;
|
|
{$endif GDB}
|
|
procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
|
|
function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
|
|
function is_visible_for_proc(currprocdef:tprocdef):boolean;
|
|
function is_visible_for_object(currobjdef:tobjectdef):boolean;
|
|
function mangledname : string;
|
|
procedure generate_mangledname;virtual;abstract;
|
|
end;
|
|
|
|
tlabelsym = class(tstoredsym)
|
|
lab : tasmlabel;
|
|
used,
|
|
defined : boolean;
|
|
code : pointer; { should be tnode }
|
|
constructor create(const n : string; l : tasmlabel);
|
|
destructor destroy;override;
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
procedure generate_mangledname;override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
end;
|
|
|
|
tunitsym = class(tstoredsym)
|
|
unitsymtable : tsymtable;
|
|
prevsym : tunitsym;
|
|
constructor create(const n : string;ref : tsymtable);
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
destructor destroy;override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure restoreunitsym;
|
|
{$ifdef GDB}
|
|
procedure concatstabto(asmlist : taasmoutput);override;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
terrorsym = class(tstoredsym)
|
|
constructor create;
|
|
end;
|
|
|
|
Tprocdefcallback = procedure(p:Tprocdef;arg:pointer);
|
|
|
|
tprocsym = class(tstoredsym)
|
|
{ protected}
|
|
defs : pprocdeflist; { linked list of overloaded procdefs }
|
|
public
|
|
is_global : boolean;
|
|
overloadchecked : boolean;
|
|
overloadcount : longint; { amount of overloaded functions in this module }
|
|
constructor create(const n : string);
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
destructor destroy;override;
|
|
{ writes all declarations except the specified one }
|
|
procedure write_parameter_lists(skipdef:tprocdef);
|
|
{ tests, if all procedures definitions are defined and not }
|
|
{ only forward }
|
|
procedure check_forward;
|
|
procedure unchain_overload;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure deref;override;
|
|
procedure addprocdef(p:tprocdef);
|
|
function procdef_count:byte;
|
|
function procdef(nr:byte):Tprocdef;
|
|
procedure add_para_match_to(Aprocsym:Tprocsym);
|
|
procedure concat_procdefs_to(s:Tprocsym);
|
|
procedure foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
|
|
function first_procdef:Tprocdef;
|
|
function last_procdef:Tprocdef;
|
|
function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
|
|
function search_procdef_bypara(params:Tparalinkedlist):Tprocdef;
|
|
function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
|
|
function search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef;
|
|
matchtype:Tdefmatch):Tprocdef;
|
|
function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
|
|
{$ifdef GDB}
|
|
function stabstring : pchar;override;
|
|
procedure concatstabto(asmlist : taasmoutput);override;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
ttypesym = class(tstoredsym)
|
|
restype : ttype;
|
|
{$ifdef GDB}
|
|
isusedinstab : boolean;
|
|
{$endif GDB}
|
|
constructor create(const n : string;const tt : ttype);
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure deref;override;
|
|
function gettypedef:tdef;override;
|
|
procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
|
|
function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
|
|
{$ifdef GDB}
|
|
function stabstring : pchar;override;
|
|
procedure concatstabto(asmlist : taasmoutput);override;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
tvarsym = class(tstoredsym)
|
|
address : longint;
|
|
localvarsym : tvarsym;
|
|
vartype : ttype;
|
|
varoptions : tvaroptions;
|
|
reg : tregister; { if reg<>R_NO, then the variable is an register variable }
|
|
varspez : tvarspez; { sets the type of access }
|
|
varstate : tvarstate;
|
|
{$ifdef var_notification}
|
|
notifications : Tlinkedlist;
|
|
{$endif}
|
|
constructor create(const n : string;const tt : ttype);
|
|
constructor create_dll(const n : string;const tt : ttype);
|
|
constructor create_C(const n,mangled : string;const tt : ttype);
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
destructor destroy;override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure deref;override;
|
|
procedure generate_mangledname;override;
|
|
procedure set_mangledname(const s:string);
|
|
function getsize : longint;
|
|
function getvaluesize : longint;
|
|
function getpushsize(is_cdecl:boolean): longint;
|
|
{$ifdef var_notification}
|
|
function register_notification(flags:Tnotification_flags;
|
|
callback:Tnotification_callback):cardinal;
|
|
{$endif}
|
|
{$ifdef GDB}
|
|
function stabstring : pchar;override;
|
|
procedure concatstabto(asmlist : taasmoutput);override;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
tpropertysym = class(tstoredsym)
|
|
propoptions : tpropertyoptions;
|
|
propoverriden : tpropertysym;
|
|
proptype,
|
|
indextype : ttype;
|
|
index,
|
|
default : longint;
|
|
readaccess,
|
|
writeaccess,
|
|
storedaccess : tsymlist;
|
|
constructor create(const n : string);
|
|
destructor destroy;override;
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
function getsize : longint;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
function gettypedef:tdef;override;
|
|
procedure deref;override;
|
|
procedure dooverride(overriden:tpropertysym);
|
|
{$ifdef GDB}
|
|
function stabstring : pchar;override;
|
|
procedure concatstabto(asmlist : taasmoutput);override;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
tfuncretsym = class(tstoredsym)
|
|
returntype : ttype;
|
|
address : longint;
|
|
funcretstate : tvarstate;
|
|
constructor create(const n : string;const tt : ttype);
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
destructor destroy;override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure deref;override;
|
|
{$ifdef GDB}
|
|
procedure concatstabto(asmlist : taasmoutput);override;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
tabsolutesym = class(tvarsym)
|
|
abstyp : absolutetyp;
|
|
absseg : boolean;
|
|
ref : tstoredsym;
|
|
asmname : pstring;
|
|
constructor create(const n : string;const tt : ttype);
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
procedure deref;override;
|
|
function mangledname : string;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
{$ifdef GDB}
|
|
procedure concatstabto(asmlist : taasmoutput);override;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
ttypedconstsym = class(tstoredsym)
|
|
typedconsttype : ttype;
|
|
is_writable : boolean;
|
|
constructor create(const n : string;p : tdef;writable : boolean);
|
|
constructor createtype(const n : string;const tt : ttype;writable : boolean);
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
destructor destroy;override;
|
|
procedure generate_mangledname;override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure deref;override;
|
|
function getsize:longint;
|
|
{$ifdef GDB}
|
|
function stabstring : pchar;override;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
tconstsym = class(tstoredsym)
|
|
consttype : ttype;
|
|
consttyp : tconsttyp;
|
|
resstrindex, { needed for resource strings }
|
|
valueord : tconstexprint; { used for ordinal values }
|
|
valueordptr : TConstPtrUInt; { used for pointer values }
|
|
valueptr : pointer; { used for string, set, real values }
|
|
len : longint; { len is needed for string length }
|
|
constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint);
|
|
constructor create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
|
|
constructor create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
|
|
constructor create_ptr(const n : string;t : tconsttyp;v : pointer);
|
|
constructor create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
|
|
constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
destructor destroy;override;
|
|
function mangledname : string;
|
|
procedure deref;override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
{$ifdef GDB}
|
|
function stabstring : pchar;override;
|
|
procedure concatstabto(asmlist : taasmoutput);override;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
tenumsym = class(tstoredsym)
|
|
value : longint;
|
|
definition : tenumdef;
|
|
nextenum : tenumsym;
|
|
constructor create(const n : string;def : tenumdef;v : longint);
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
procedure deref;override;
|
|
procedure order;
|
|
{$ifdef GDB}
|
|
procedure concatstabto(asmlist : taasmoutput);override;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
tsyssym = class(tstoredsym)
|
|
number : longint;
|
|
constructor create(const n : string;l : longint);
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
destructor destroy;override;
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
{$ifdef GDB}
|
|
procedure concatstabto(asmlist : taasmoutput);override;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
{ compiler generated symbol to point to rtti and init/finalize tables }
|
|
trttisym = class(tstoredsym)
|
|
lab : tasmsymbol;
|
|
rttityp : trttitype;
|
|
constructor create(const n:string;rt:trttitype);
|
|
constructor ppuload(ppufile:tcompilerppufile);
|
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
|
function mangledname:string;
|
|
function get_label:tasmsymbol;
|
|
end;
|
|
|
|
{ register variables }
|
|
pregvarinfo = ^tregvarinfo;
|
|
tregvarinfo = record
|
|
regvars : array[1..maxvarregs] of tvarsym;
|
|
regvars_para : array[1..maxvarregs] of boolean;
|
|
regvars_refs : array[1..maxvarregs] of longint;
|
|
|
|
fpuregvars : array[1..maxfpuvarregs] of tvarsym;
|
|
fpuregvars_para : array[1..maxfpuvarregs] of boolean;
|
|
fpuregvars_refs : array[1..maxfpuvarregs] of longint;
|
|
end;
|
|
|
|
|
|
var
|
|
aktprocsym : tprocsym; { pointer to the symbol for the
|
|
currently be parsed procedure }
|
|
aktprocdef : tprocdef;
|
|
|
|
aktcallprocdef : tabstractprocdef; { pointer to the definition of the
|
|
currently called procedure,
|
|
only set/unset in ncal }
|
|
|
|
aktvarsym : tvarsym; { pointer to the symbol for the
|
|
currently read var, only used
|
|
for variable directives }
|
|
|
|
generrorsym : tsym;
|
|
|
|
otsym : tvarsym;
|
|
|
|
const
|
|
current_object_option : tsymoptions = [sp_public];
|
|
|
|
{ rtti and init/final }
|
|
procedure generate_rtti(p:tsym);
|
|
procedure generate_inittable(p:tsym);
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$ifdef Delphi}
|
|
sysutils,
|
|
{$else Delphi}
|
|
strings,
|
|
{$endif Delphi}
|
|
{ global }
|
|
globtype,verbose,
|
|
{ target }
|
|
systems,
|
|
{ symtable }
|
|
symtable,defbase,
|
|
{$ifdef GDB}
|
|
gdb,
|
|
{$endif GDB}
|
|
{ tree }
|
|
node,
|
|
{ aasm }
|
|
aasmcpu,
|
|
{ module }
|
|
fmodule,
|
|
{ codegen }
|
|
paramgr,cgbase,cresstr
|
|
;
|
|
|
|
{****************************************************************************
|
|
Helpers
|
|
****************************************************************************}
|
|
|
|
{****************************************************************************
|
|
TSYM (base for all symtypes)
|
|
****************************************************************************}
|
|
|
|
constructor tstoredsym.create(const n : string);
|
|
begin
|
|
inherited create(n);
|
|
symoptions:=current_object_option;
|
|
{$ifdef GDB}
|
|
isstabwritten := false;
|
|
{$endif GDB}
|
|
fileinfo:=akttokenpos;
|
|
defref:=nil;
|
|
refs:=0;
|
|
lastwritten:=nil;
|
|
refcount:=0;
|
|
if (cs_browser in aktmoduleswitches) and make_ref then
|
|
begin
|
|
defref:=tref.create(defref,@akttokenpos);
|
|
inc(refcount);
|
|
end;
|
|
lastref:=defref;
|
|
_mangledname:=nil;
|
|
end;
|
|
|
|
|
|
constructor tstoredsym.loadsym(ppufile:tcompilerppufile);
|
|
var
|
|
s : string;
|
|
nr : word;
|
|
begin
|
|
nr:=ppufile.getword;
|
|
s:=ppufile.getstring;
|
|
inherited create(s);
|
|
{ force the correct indexnr. must be after create! }
|
|
indexnr:=nr;
|
|
ppufile.getsmallset(symoptions);
|
|
ppufile.getposinfo(fileinfo);
|
|
lastref:=nil;
|
|
defref:=nil;
|
|
refs:=0;
|
|
lastwritten:=nil;
|
|
refcount:=0;
|
|
_mangledname:=nil;
|
|
{$ifdef GDB}
|
|
isstabwritten := false;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
|
|
procedure tstoredsym.deref;
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure tstoredsym.load_references(ppufile:tcompilerppufile;locals:boolean);
|
|
var
|
|
pos : tfileposinfo;
|
|
move_last : boolean;
|
|
begin
|
|
move_last:=lastwritten=lastref;
|
|
while (not ppufile.endofentry) do
|
|
begin
|
|
ppufile.getposinfo(pos);
|
|
inc(refcount);
|
|
lastref:=tref.create(lastref,@pos);
|
|
lastref.is_written:=true;
|
|
if refcount=1 then
|
|
defref:=lastref;
|
|
end;
|
|
if move_last then
|
|
lastwritten:=lastref;
|
|
end;
|
|
|
|
{ big problem here :
|
|
wrong refs were written because of
|
|
interface parsing of other units PM
|
|
moduleindex must be checked !! }
|
|
|
|
function tstoredsym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
|
|
var
|
|
ref : tref;
|
|
symref_written,move_last : boolean;
|
|
begin
|
|
write_references:=false;
|
|
if lastwritten=lastref then
|
|
exit;
|
|
{ should we update lastref }
|
|
move_last:=true;
|
|
symref_written:=false;
|
|
{ write symbol refs }
|
|
if assigned(lastwritten) then
|
|
ref:=lastwritten
|
|
else
|
|
ref:=defref;
|
|
while assigned(ref) do
|
|
begin
|
|
if ref.moduleindex=current_module.unit_index then
|
|
begin
|
|
{ write address to this symbol }
|
|
if not symref_written then
|
|
begin
|
|
ppufile.putderef(self);
|
|
symref_written:=true;
|
|
end;
|
|
ppufile.putposinfo(ref.posinfo);
|
|
ref.is_written:=true;
|
|
if move_last then
|
|
lastwritten:=ref;
|
|
end
|
|
else if not ref.is_written then
|
|
move_last:=false
|
|
else if move_last then
|
|
lastwritten:=ref;
|
|
ref:=ref.nextref;
|
|
end;
|
|
if symref_written then
|
|
ppufile.writeentry(ibsymref);
|
|
write_references:=symref_written;
|
|
end;
|
|
|
|
|
|
destructor tstoredsym.destroy;
|
|
begin
|
|
if assigned(_mangledname) then
|
|
stringdispose(_mangledname);
|
|
if assigned(defref) then
|
|
begin
|
|
defref.freechain;
|
|
defref.free;
|
|
end;
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
procedure tstoredsym.writesym(ppufile:tcompilerppufile);
|
|
begin
|
|
ppufile.putword(indexnr);
|
|
ppufile.putstring(_realname^);
|
|
ppufile.putsmallset(symoptions);
|
|
ppufile.putposinfo(fileinfo);
|
|
end;
|
|
|
|
|
|
{$ifdef GDB}
|
|
function tstoredsym.stabstring : pchar;
|
|
|
|
begin
|
|
stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+
|
|
tostr(fileinfo.line)+',0');
|
|
end;
|
|
|
|
procedure tstoredsym.concatstabto(asmlist : taasmoutput);
|
|
var
|
|
stab_str : pchar;
|
|
begin
|
|
if not isstabwritten then
|
|
begin
|
|
stab_str := stabstring;
|
|
{ count_dbx(stab_str); moved to GDB.PAS }
|
|
asmList.concat(Tai_stabs.Create(stab_str));
|
|
isstabwritten:=true;
|
|
end;
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
function tstoredsym.is_visible_for_proc(currprocdef:tprocdef):boolean;
|
|
begin
|
|
is_visible_for_proc:=false;
|
|
|
|
{ private symbols are allowed when we are in the same
|
|
module as they are defined }
|
|
if (sp_private in symoptions) and
|
|
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
|
|
(owner.defowner.owner.unitid<>0) then
|
|
exit;
|
|
|
|
{ protected symbols are vissible in the module that defines them and
|
|
also visible to related objects }
|
|
if (sp_protected in symoptions) and
|
|
(
|
|
(
|
|
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
|
|
(owner.defowner.owner.unitid<>0)
|
|
) and
|
|
not(
|
|
assigned(currprocdef) and
|
|
assigned(currprocdef._class) and
|
|
currprocdef._class.is_related(tobjectdef(owner.defowner))
|
|
)
|
|
) then
|
|
exit;
|
|
|
|
is_visible_for_proc:=true;
|
|
end;
|
|
|
|
|
|
function tstoredsym.is_visible_for_object(currobjdef:tobjectdef):boolean;
|
|
begin
|
|
is_visible_for_object:=false;
|
|
|
|
{ private symbols are allowed when we are in the same
|
|
module as they are defined }
|
|
if (sp_private in symoptions) and
|
|
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
|
|
(owner.defowner.owner.unitid<>0) then
|
|
exit;
|
|
|
|
{ protected symbols are vissible in the module that defines them and
|
|
also visible to related objects }
|
|
if (sp_protected in symoptions) and
|
|
(
|
|
(
|
|
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
|
|
(owner.defowner.owner.unitid<>0)
|
|
) and
|
|
not(
|
|
assigned(currobjdef) and
|
|
currobjdef.is_related(tobjectdef(owner.defowner))
|
|
)
|
|
) then
|
|
exit;
|
|
|
|
is_visible_for_object:=true;
|
|
end;
|
|
|
|
|
|
function tstoredsym.mangledname : string;
|
|
begin
|
|
if not assigned(_mangledname) then
|
|
begin
|
|
generate_mangledname;
|
|
if not assigned(_mangledname) then
|
|
internalerror(200204171);
|
|
end;
|
|
mangledname:=_mangledname^
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TLABELSYM
|
|
****************************************************************************}
|
|
|
|
constructor tlabelsym.create(const n : string; l : tasmlabel);
|
|
|
|
begin
|
|
inherited create(n);
|
|
typ:=labelsym;
|
|
lab:=l;
|
|
used:=false;
|
|
defined:=false;
|
|
code:=nil;
|
|
end;
|
|
|
|
constructor tlabelsym.ppuload(ppufile:tcompilerppufile);
|
|
|
|
begin
|
|
inherited loadsym(ppufile);
|
|
typ:=labelsym;
|
|
{ this is all dummy
|
|
it is only used for local browsing }
|
|
lab:=nil;
|
|
code:=nil;
|
|
used:=false;
|
|
defined:=true;
|
|
end;
|
|
|
|
destructor tlabelsym.destroy;
|
|
|
|
begin
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
procedure tlabelsym.generate_mangledname;
|
|
begin
|
|
_mangledname:=stringdup(lab.name);
|
|
end;
|
|
|
|
|
|
procedure tlabelsym.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
if owner.symtabletype=globalsymtable then
|
|
Message(sym_e_ill_label_decl)
|
|
else
|
|
begin
|
|
inherited writesym(ppufile);
|
|
ppufile.writeentry(iblabelsym);
|
|
end;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TUNITSYM
|
|
****************************************************************************}
|
|
|
|
constructor tunitsym.create(const n : string;ref : tsymtable);
|
|
var
|
|
old_make_ref : boolean;
|
|
begin
|
|
old_make_ref:=make_ref;
|
|
make_ref:=false;
|
|
inherited create(n);
|
|
make_ref:=old_make_ref;
|
|
typ:=unitsym;
|
|
unitsymtable:=ref;
|
|
if assigned(ref) and
|
|
(ref.symtabletype=globalsymtable) then
|
|
begin
|
|
prevsym:=tglobalsymtable(ref).unitsym;
|
|
tglobalsymtable(ref).unitsym:=self;
|
|
end;
|
|
end;
|
|
|
|
constructor tunitsym.ppuload(ppufile:tcompilerppufile);
|
|
|
|
begin
|
|
inherited loadsym(ppufile);
|
|
typ:=unitsym;
|
|
unitsymtable:=nil;
|
|
prevsym:=nil;
|
|
refs:=0;
|
|
end;
|
|
|
|
{ we need to remove it from the prevsym chain ! }
|
|
|
|
procedure tunitsym.restoreunitsym;
|
|
var pus,ppus : tunitsym;
|
|
begin
|
|
if assigned(unitsymtable) and
|
|
(unitsymtable.symtabletype=globalsymtable) then
|
|
begin
|
|
ppus:=nil;
|
|
pus:=tglobalsymtable(unitsymtable).unitsym;
|
|
if pus=self then
|
|
tglobalsymtable(unitsymtable).unitsym:=prevsym
|
|
else while assigned(pus) do
|
|
begin
|
|
if pus=self then
|
|
begin
|
|
ppus.prevsym:=prevsym;
|
|
break;
|
|
end
|
|
else
|
|
begin
|
|
ppus:=pus;
|
|
pus:=ppus.prevsym;
|
|
end;
|
|
end;
|
|
end;
|
|
unitsymtable:=nil;
|
|
prevsym:=nil;
|
|
end;
|
|
|
|
destructor tunitsym.destroy;
|
|
begin
|
|
restoreunitsym;
|
|
inherited destroy;
|
|
end;
|
|
|
|
procedure tunitsym.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited writesym(ppufile);
|
|
ppufile.writeentry(ibunitsym);
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
procedure tunitsym.concatstabto(asmlist : taasmoutput);
|
|
begin
|
|
{Nothing to write to stabs !}
|
|
end;
|
|
{$endif GDB}
|
|
|
|
{****************************************************************************
|
|
TPROCSYM
|
|
****************************************************************************}
|
|
|
|
constructor tprocsym.create(const n : string);
|
|
|
|
begin
|
|
inherited create(n);
|
|
typ:=procsym;
|
|
defs:=nil;
|
|
owner:=nil;
|
|
is_global:=false;
|
|
overloadchecked:=false;
|
|
overloadcount:=0;
|
|
end;
|
|
|
|
|
|
constructor tprocsym.ppuload(ppufile:tcompilerppufile);
|
|
var
|
|
pd : tprocdef;
|
|
begin
|
|
inherited loadsym(ppufile);
|
|
typ:=procsym;
|
|
defs:=nil;
|
|
repeat
|
|
pd:=tprocdef(ppufile.getderef);
|
|
if pd=nil then
|
|
break;
|
|
addprocdef(pd);
|
|
until false;
|
|
is_global:=false;
|
|
overloadchecked:=false;
|
|
overloadcount:=-1; { invalid, not used anymore }
|
|
end;
|
|
|
|
|
|
destructor tprocsym.destroy;
|
|
var
|
|
hp,p : pprocdeflist;
|
|
begin
|
|
p:=defs;
|
|
while assigned(p) do
|
|
begin
|
|
hp:=p^.next;
|
|
dispose(p);
|
|
p:=hp;
|
|
end;
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
procedure tprocsym.write_parameter_lists(skipdef:tprocdef);
|
|
var
|
|
p : pprocdeflist;
|
|
begin
|
|
p:=defs;
|
|
while assigned(p) do
|
|
begin
|
|
if p^.def<>skipdef then
|
|
MessagePos1(p^.def.fileinfo,sym_b_param_list,p^.def.fullprocname);
|
|
p:=p^.next;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tprocsym.check_forward;
|
|
var
|
|
p : pprocdeflist;
|
|
begin
|
|
p:=defs;
|
|
while assigned(p) do
|
|
begin
|
|
if (p^.def.procsym=self) and
|
|
(p^.def.forwarddef) then
|
|
begin
|
|
MessagePos1(fileinfo,sym_e_forward_not_resolved,p^.def.fullprocname);
|
|
{ Turn futher error messages off }
|
|
p^.def.forwarddef:=false;
|
|
end;
|
|
p:=p^.next;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tprocsym.deref;
|
|
var
|
|
p : pprocdeflist;
|
|
begin
|
|
p:=defs;
|
|
while assigned(p) do
|
|
begin
|
|
resolvedef(pointer(p^.def));
|
|
p:=p^.next;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tprocsym.addprocdef(p:tprocdef);
|
|
var
|
|
pd : pprocdeflist;
|
|
begin
|
|
new(pd);
|
|
pd^.def:=p;
|
|
pd^.next:=defs;
|
|
defs:=pd;
|
|
end;
|
|
|
|
function Tprocsym.procdef_count:byte;
|
|
|
|
var pd:Pprocdeflist;
|
|
|
|
begin
|
|
procdef_count:=0;
|
|
pd:=defs;
|
|
while assigned(pd) do
|
|
begin
|
|
inc(procdef_count);
|
|
pd:=pd^.next;
|
|
end;
|
|
end;
|
|
|
|
function Tprocsym.procdef(nr:byte):Tprocdef;
|
|
|
|
var i:byte;
|
|
pd:Pprocdeflist;
|
|
|
|
begin
|
|
pd:=defs;
|
|
for i:=2 to nr do
|
|
pd:=pd^.next;
|
|
procdef:=pd^.def;
|
|
end;
|
|
|
|
procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym);
|
|
|
|
var pd:Pprocdeflist;
|
|
|
|
begin
|
|
pd:=defs;
|
|
while assigned(pd) do
|
|
begin
|
|
if Aprocsym.search_procdef_bypara(pd^.def.para)=nil then
|
|
Aprocsym.addprocdef(pd^.def);
|
|
pd:=pd^.next;
|
|
end;
|
|
end;
|
|
|
|
procedure Tprocsym.concat_procdefs_to(s:Tprocsym);
|
|
|
|
var pd:Pprocdeflist;
|
|
|
|
begin
|
|
pd:=defs;
|
|
while assigned(pd) do
|
|
begin
|
|
s.addprocdef(pd^.def);
|
|
pd:=pd^.next;
|
|
end;
|
|
end;
|
|
|
|
function Tprocsym.first_procdef:Tprocdef;
|
|
|
|
begin
|
|
first_procdef:=defs^.def;
|
|
end;
|
|
|
|
function Tprocsym.last_procdef:Tprocdef;
|
|
|
|
var pd:Pprocdeflist;
|
|
|
|
begin
|
|
pd:=defs;
|
|
while assigned(pd) do
|
|
begin
|
|
last_procdef:=pd^.def;
|
|
pd:=pd^.next;
|
|
end;
|
|
end;
|
|
|
|
procedure Tprocsym.foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
|
|
|
|
var p:Pprocdeflist;
|
|
|
|
begin
|
|
p:=defs;
|
|
while assigned(p) do
|
|
begin
|
|
proc2call(p^.def,arg);
|
|
p:=p^.next;
|
|
end;
|
|
end;
|
|
|
|
function Tprocsym.search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
|
|
|
|
var p:Pprocdeflist;
|
|
|
|
begin
|
|
search_procdef_bytype:=nil;
|
|
p:=defs;
|
|
while p<>nil do
|
|
begin
|
|
if p^.def.proctypeoption=pt then
|
|
begin
|
|
search_procdef_bytype:=p^.def;
|
|
break;
|
|
end;
|
|
p:=p^.next;
|
|
end;
|
|
end;
|
|
|
|
function Tprocsym.search_procdef_bypara(params:Tparalinkedlist):Tprocdef;
|
|
|
|
var pd:Pprocdeflist;
|
|
|
|
begin
|
|
search_procdef_bypara:=nil;
|
|
pd:=defs;
|
|
while assigned(pd) do
|
|
begin
|
|
if equal_paras(pd^.def.para,params,cp_value_equal_const) then
|
|
begin
|
|
search_procdef_bypara:=pd^.def;
|
|
break;
|
|
end;
|
|
pd:=pd^.next;
|
|
end;
|
|
end;
|
|
|
|
function Tprocsym.search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
|
|
|
|
var pd:Pprocdeflist;
|
|
|
|
begin
|
|
{This function will return the pprocdef of pprocsym that
|
|
is the best match for procvardef. When there are multiple
|
|
matches it returns nil.}
|
|
{Try to find an exact match first.}
|
|
search_procdef_byprocvardef:=nil;
|
|
pd:=defs;
|
|
while assigned(pd) do
|
|
begin
|
|
if proc_to_procvar_equal(pd^.def,d,true) then
|
|
begin
|
|
{ already found a match ? Then stop and return nil }
|
|
if assigned(search_procdef_byprocvardef) then
|
|
begin
|
|
search_procdef_byprocvardef:=nil;
|
|
break;
|
|
end;
|
|
search_procdef_byprocvardef:=pd^.def;
|
|
end;
|
|
pd:=pd^.next;
|
|
end;
|
|
{Try a convertable match, if no exact match was found.}
|
|
if not assigned(search_procdef_byprocvardef) and not assigned(pd) then
|
|
begin
|
|
pd:=defs;
|
|
while assigned(pd) do
|
|
begin
|
|
if proc_to_procvar_equal(pd^.def,d,false) then
|
|
begin
|
|
{ already found a match ? Then stop and return nil }
|
|
if assigned(search_procdef_byprocvardef) then
|
|
begin
|
|
search_procdef_byprocvardef:=nil;
|
|
break;
|
|
end;
|
|
search_procdef_byprocvardef:=pd^.def;
|
|
end;
|
|
pd:=pd^.next;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function Tprocsym.search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef;
|
|
matchtype:Tdefmatch):Tprocdef;
|
|
|
|
var pd:Pprocdeflist;
|
|
convtyp:Tconverttype;
|
|
a,b:boolean;
|
|
|
|
begin
|
|
search_procdef_byretdef_by1paradef:=nil;
|
|
pd:=defs;
|
|
while assigned(pd) do
|
|
begin
|
|
a:=is_equal(retdef,pd^.def.rettype.def);
|
|
{Alert alert alert alert alert alert alert!!!
|
|
|
|
Make sure you never call isconvertable when a=false. You get
|
|
endless recursion then. Originally a and b were placed in a
|
|
single if statement. There was only one reason that it worked:
|
|
short circuit boolean eval.}
|
|
if a then
|
|
case matchtype of
|
|
dm_exact:
|
|
b:=TParaItem(pd^.def.para.first).paratype.def=firstpara;
|
|
dm_equal:
|
|
b:=is_equal(Tparaitem(pd^.def.para.first).paratype.def,firstpara);
|
|
dm_convertl1:
|
|
b:=isconvertable(firstpara,Tparaitem(pd^.def.para.first).paratype.def,
|
|
convtyp,ordconstn,false)=1;
|
|
end;
|
|
if a and b then
|
|
begin
|
|
search_procdef_byretdef_by1paradef:=pd^.def;
|
|
break;
|
|
end;
|
|
pd:=pd^.next;
|
|
end;
|
|
end;
|
|
|
|
procedure tprocsym.ppuwrite(ppufile:tcompilerppufile);
|
|
var
|
|
p : pprocdeflist;
|
|
begin
|
|
inherited writesym(ppufile);
|
|
p:=defs;
|
|
while assigned(p) do
|
|
begin
|
|
{ only write the proc definitions that belong
|
|
to this procsym }
|
|
if (p^.def.procsym=self) then
|
|
ppufile.putderef(p^.def);
|
|
p:=p^.next;
|
|
end;
|
|
ppufile.putderef(nil);
|
|
ppufile.writeentry(ibprocsym);
|
|
end;
|
|
|
|
|
|
function tprocsym.write_references(ppufile:tcompilerppufile;locals:boolean) : boolean;
|
|
var
|
|
p : pprocdeflist;
|
|
begin
|
|
write_references:=false;
|
|
if not inherited write_references(ppufile,locals) then
|
|
exit;
|
|
write_references:=true;
|
|
p:=defs;
|
|
while assigned(p) do
|
|
begin
|
|
if (p^.def.procsym=self) then
|
|
p^.def.write_references(ppufile,locals);
|
|
p:=p^.next;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tprocsym.unchain_overload;
|
|
var
|
|
p,hp,
|
|
first,
|
|
last : pprocdeflist;
|
|
begin
|
|
{ remove all overloaded procdefs from the
|
|
procdeflist that are not in the current symtable }
|
|
first:=nil;
|
|
last:=nil;
|
|
p:=defs;
|
|
while assigned(p) do
|
|
begin
|
|
hp:=p^.next;
|
|
if (p^.def.procsym=self) then
|
|
begin
|
|
{ keep in list }
|
|
if not assigned(first) then
|
|
begin
|
|
first:=p;
|
|
last:=p;
|
|
end
|
|
else
|
|
last^.next:=p;
|
|
last:=p;
|
|
p^.next:=nil;
|
|
end
|
|
else
|
|
begin
|
|
{ remove }
|
|
dispose(p);
|
|
end;
|
|
p:=hp;
|
|
end;
|
|
defs:=first;
|
|
end;
|
|
|
|
|
|
{$ifdef GDB}
|
|
function tprocsym.stabstring : pchar;
|
|
begin
|
|
internalerror(200111171);
|
|
stabstring:=nil;
|
|
end;
|
|
|
|
procedure tprocsym.concatstabto(asmlist : taasmoutput);
|
|
begin
|
|
internalerror(200111172);
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TERRORSYM
|
|
****************************************************************************}
|
|
|
|
constructor terrorsym.create;
|
|
begin
|
|
inherited create('');
|
|
typ:=errorsym;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TPROPERTYSYM
|
|
****************************************************************************}
|
|
|
|
constructor tpropertysym.create(const n : string);
|
|
begin
|
|
inherited create(n);
|
|
typ:=propertysym;
|
|
propoptions:=[];
|
|
index:=0;
|
|
default:=0;
|
|
proptype.reset;
|
|
indextype.reset;
|
|
readaccess:=tsymlist.create;
|
|
writeaccess:=tsymlist.create;
|
|
storedaccess:=tsymlist.create;
|
|
end;
|
|
|
|
|
|
constructor tpropertysym.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited loadsym(ppufile);
|
|
typ:=propertysym;
|
|
ppufile.getsmallset(propoptions);
|
|
if (ppo_is_override in propoptions) then
|
|
begin
|
|
propoverriden:=tpropertysym(ppufile.getderef);
|
|
{ we need to have these objects initialized }
|
|
readaccess:=tsymlist.create;
|
|
writeaccess:=tsymlist.create;
|
|
storedaccess:=tsymlist.create;
|
|
end
|
|
else
|
|
begin
|
|
ppufile.gettype(proptype);
|
|
index:=ppufile.getlongint;
|
|
default:=ppufile.getlongint;
|
|
ppufile.gettype(indextype);
|
|
readaccess:=ppufile.getsymlist;
|
|
writeaccess:=ppufile.getsymlist;
|
|
storedaccess:=ppufile.getsymlist;
|
|
end;
|
|
end;
|
|
|
|
|
|
destructor tpropertysym.destroy;
|
|
begin
|
|
readaccess.free;
|
|
writeaccess.free;
|
|
storedaccess.free;
|
|
inherited destroy;
|
|
end;
|
|
|
|
function tpropertysym.gettypedef:tdef;
|
|
begin
|
|
gettypedef:=proptype.def;
|
|
end;
|
|
|
|
procedure tpropertysym.deref;
|
|
begin
|
|
if (ppo_is_override in propoptions) then
|
|
begin
|
|
resolvesym(pointer(propoverriden));
|
|
dooverride(propoverriden);
|
|
end
|
|
else
|
|
begin
|
|
proptype.resolve;
|
|
indextype.resolve;
|
|
readaccess.resolve;
|
|
writeaccess.resolve;
|
|
storedaccess.resolve;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tpropertysym.getsize : longint;
|
|
begin
|
|
getsize:=0;
|
|
end;
|
|
|
|
|
|
procedure tpropertysym.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited writesym(ppufile);
|
|
ppufile.putsmallset(propoptions);
|
|
if (ppo_is_override in propoptions) then
|
|
ppufile.putderef(propoverriden)
|
|
else
|
|
begin
|
|
ppufile.puttype(proptype);
|
|
ppufile.putlongint(index);
|
|
ppufile.putlongint(default);
|
|
ppufile.puttype(indextype);
|
|
ppufile.putsymlist(readaccess);
|
|
ppufile.putsymlist(writeaccess);
|
|
ppufile.putsymlist(storedaccess);
|
|
end;
|
|
ppufile.writeentry(ibpropertysym);
|
|
end;
|
|
|
|
|
|
procedure tpropertysym.dooverride(overriden:tpropertysym);
|
|
begin
|
|
propoverriden:=overriden;
|
|
proptype:=overriden.proptype;
|
|
propoptions:=overriden.propoptions+[ppo_is_override];
|
|
index:=overriden.index;
|
|
default:=overriden.default;
|
|
indextype:=overriden.indextype;
|
|
readaccess.free;
|
|
readaccess:=overriden.readaccess.getcopy;
|
|
writeaccess.free;
|
|
writeaccess:=overriden.writeaccess.getcopy;
|
|
storedaccess.free;
|
|
storedaccess:=overriden.storedaccess.getcopy;
|
|
end;
|
|
|
|
|
|
{$ifdef GDB}
|
|
function tpropertysym.stabstring : pchar;
|
|
begin
|
|
{ !!!! don't know how to handle }
|
|
stabstring:=strpnew('');
|
|
end;
|
|
|
|
procedure tpropertysym.concatstabto(asmlist : taasmoutput);
|
|
begin
|
|
{ !!!! don't know how to handle }
|
|
end;
|
|
{$endif GDB}
|
|
|
|
{****************************************************************************
|
|
TFUNCRETSYM
|
|
****************************************************************************}
|
|
|
|
constructor tfuncretsym.create(const n : string;const tt:ttype);
|
|
|
|
begin
|
|
inherited create(n);
|
|
typ:=funcretsym;
|
|
returntype:=tt;
|
|
funcretstate:=vs_declared;
|
|
{ address valid for ret in param only }
|
|
{ otherwise set by insert }
|
|
address:=procinfo.return_offset;
|
|
end;
|
|
|
|
constructor tfuncretsym.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited loadsym(ppufile);
|
|
ppufile.gettype(returntype);
|
|
address:=ppufile.getlongint;
|
|
typ:=funcretsym;
|
|
end;
|
|
|
|
destructor tfuncretsym.destroy;
|
|
begin
|
|
inherited destroy;
|
|
end;
|
|
|
|
procedure tfuncretsym.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited writesym(ppufile);
|
|
ppufile.puttype(returntype);
|
|
ppufile.putlongint(address);
|
|
ppufile.writeentry(ibfuncretsym);
|
|
funcretstate:=vs_used;
|
|
end;
|
|
|
|
procedure tfuncretsym.deref;
|
|
begin
|
|
returntype.resolve;
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
procedure tfuncretsym.concatstabto(asmlist : taasmoutput);
|
|
begin
|
|
{ Nothing to do here, it is done in genexitcode }
|
|
end;
|
|
{$endif GDB}
|
|
|
|
{****************************************************************************
|
|
TABSOLUTESYM
|
|
****************************************************************************}
|
|
|
|
constructor tabsolutesym.create(const n : string;const tt : ttype);
|
|
begin
|
|
inherited create(n,tt);
|
|
typ:=absolutesym;
|
|
end;
|
|
|
|
|
|
constructor tabsolutesym.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
{ Note: This needs to load everything of tvarsym.write }
|
|
inherited ppuload(ppufile);
|
|
{ load absolute }
|
|
typ:=absolutesym;
|
|
ref:=nil;
|
|
address:=0;
|
|
asmname:=nil;
|
|
abstyp:=absolutetyp(ppufile.getbyte);
|
|
absseg:=false;
|
|
case abstyp of
|
|
tovar :
|
|
asmname:=stringdup(ppufile.getstring);
|
|
toasm :
|
|
asmname:=stringdup(ppufile.getstring);
|
|
toaddr :
|
|
begin
|
|
address:=ppufile.getlongint;
|
|
absseg:=boolean(ppufile.getbyte);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tabsolutesym.ppuwrite(ppufile:tcompilerppufile);
|
|
var
|
|
hvo : tvaroptions;
|
|
begin
|
|
{ Note: This needs to write everything of tvarsym.write }
|
|
inherited writesym(ppufile);
|
|
ppufile.putbyte(byte(varspez));
|
|
ppufile.putlongint(address);
|
|
{ write only definition or definitionsym }
|
|
ppufile.puttype(vartype);
|
|
hvo:=varoptions-[vo_regable];
|
|
ppufile.putsmallset(hvo);
|
|
ppufile.putbyte(byte(abstyp));
|
|
case abstyp of
|
|
tovar :
|
|
ppufile.putstring(ref.name);
|
|
toasm :
|
|
ppufile.putstring(asmname^);
|
|
toaddr :
|
|
begin
|
|
ppufile.putlongint(address);
|
|
ppufile.putbyte(byte(absseg));
|
|
end;
|
|
end;
|
|
ppufile.writeentry(ibabsolutesym);
|
|
end;
|
|
|
|
|
|
procedure tabsolutesym.deref;
|
|
var
|
|
srsym : tsym;
|
|
srsymtable : tsymtable;
|
|
begin
|
|
{ inheritance of varsym.deref ! }
|
|
vartype.resolve;
|
|
{ own absolute deref }
|
|
if (abstyp=tovar) and (asmname<>nil) then
|
|
begin
|
|
{ search previous loaded symtables }
|
|
searchsym(asmname^,srsym,srsymtable);
|
|
if not assigned(srsym) then
|
|
srsym:=searchsymonlyin(owner,asmname^);
|
|
if not assigned(srsym) then
|
|
srsym:=generrorsym;
|
|
ref:=tstoredsym(srsym);
|
|
stringdispose(asmname);
|
|
end;
|
|
end;
|
|
|
|
|
|
function tabsolutesym.mangledname : string;
|
|
begin
|
|
case abstyp of
|
|
tovar :
|
|
begin
|
|
case ref.typ of
|
|
varsym :
|
|
mangledname:=tvarsym(ref).mangledname;
|
|
else
|
|
internalerror(200111011);
|
|
end;
|
|
end;
|
|
toasm :
|
|
mangledname:=asmname^;
|
|
toaddr :
|
|
mangledname:='$'+tostr(address);
|
|
else
|
|
internalerror(10002);
|
|
end;
|
|
end;
|
|
|
|
|
|
{$ifdef GDB}
|
|
procedure tabsolutesym.concatstabto(asmlist : taasmoutput);
|
|
begin
|
|
{ I don't know how to handle this !! }
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TVARSYM
|
|
****************************************************************************}
|
|
|
|
constructor tvarsym.create(const n : string;const tt : ttype);
|
|
begin
|
|
inherited create(n);
|
|
typ:=varsym;
|
|
vartype:=tt;
|
|
_mangledname:=nil;
|
|
varspez:=vs_value;
|
|
address:=0;
|
|
localvarsym:=nil;
|
|
refs:=0;
|
|
varstate:=vs_used;
|
|
varoptions:=[];
|
|
{ can we load the value into a register ? }
|
|
if tstoreddef(tt.def).is_intregable then
|
|
include(varoptions,vo_regable)
|
|
else
|
|
exclude(varoptions,vo_regable);
|
|
|
|
if tstoreddef(tt.def).is_fpuregable then
|
|
include(varoptions,vo_fpuregable)
|
|
else
|
|
exclude(varoptions,vo_fpuregable);
|
|
reg:=R_NO;
|
|
end;
|
|
|
|
|
|
constructor tvarsym.create_dll(const n : string;const tt : ttype);
|
|
begin
|
|
tvarsym(self).create(n,tt);
|
|
include(varoptions,vo_is_dll_var);
|
|
end;
|
|
|
|
|
|
constructor tvarsym.create_C(const n,mangled : string;const tt : ttype);
|
|
begin
|
|
tvarsym(self).create(n,tt);
|
|
include(varoptions,vo_is_C_var);
|
|
stringdispose(_mangledname);
|
|
_mangledname:=stringdup(mangled);
|
|
end;
|
|
|
|
|
|
constructor tvarsym.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited loadsym(ppufile);
|
|
typ:=varsym;
|
|
reg:=R_NO;
|
|
refs := 0;
|
|
varstate:=vs_used;
|
|
varspez:=tvarspez(ppufile.getbyte);
|
|
address:=ppufile.getlongint;
|
|
localvarsym:=nil;
|
|
ppufile.gettype(vartype);
|
|
ppufile.getsmallset(varoptions);
|
|
if (vo_is_C_var in varoptions) then
|
|
_mangledname:=stringdup(ppufile.getstring);
|
|
end;
|
|
|
|
|
|
destructor tvarsym.destroy;
|
|
begin
|
|
{$ifdef var_notification}
|
|
if assigned(notifications) then
|
|
notifications.destroy;
|
|
{$endif}
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
procedure tvarsym.deref;
|
|
begin
|
|
vartype.resolve;
|
|
end;
|
|
|
|
|
|
procedure tvarsym.ppuwrite(ppufile:tcompilerppufile);
|
|
var
|
|
hvo : tvaroptions;
|
|
begin
|
|
inherited writesym(ppufile);
|
|
ppufile.putbyte(byte(varspez));
|
|
ppufile.putlongint(address);
|
|
ppufile.puttype(vartype);
|
|
{ symbols which are load are never candidates for a register,
|
|
turn off the regable }
|
|
hvo:=varoptions-[vo_regable,vo_fpuregable];
|
|
ppufile.putsmallset(hvo);
|
|
if (vo_is_C_var in varoptions) then
|
|
ppufile.putstring(mangledname);
|
|
ppufile.writeentry(ibvarsym);
|
|
end;
|
|
|
|
|
|
procedure tvarsym.generate_mangledname;
|
|
begin
|
|
_mangledname:=stringdup(mangledname_prefix('U',owner)+name);
|
|
end;
|
|
|
|
|
|
procedure tvarsym.set_mangledname(const s:string);
|
|
begin
|
|
stringdispose(_mangledname);
|
|
_mangledname:=stringdup(s);
|
|
end;
|
|
|
|
|
|
function tvarsym.getsize : longint;
|
|
begin
|
|
if assigned(vartype.def) then
|
|
getsize:=vartype.def.size
|
|
else
|
|
getsize:=0;
|
|
end;
|
|
|
|
|
|
function tvarsym.getvaluesize : longint;
|
|
begin
|
|
if assigned(vartype.def) and
|
|
(varspez=vs_value) and
|
|
((vartype.def.deftype<>arraydef) or
|
|
tarraydef(vartype.def).isDynamicArray or
|
|
(tarraydef(vartype.def).highrange>=tarraydef(vartype.def).lowrange)) then
|
|
getvaluesize:=vartype.def.size
|
|
else
|
|
getvaluesize:=0;
|
|
end;
|
|
|
|
|
|
function tvarsym.getpushsize(is_cdecl:boolean) : longint;
|
|
begin
|
|
getpushsize:=-1;
|
|
if assigned(vartype.def) then
|
|
begin
|
|
case varspez of
|
|
vs_out,
|
|
vs_var :
|
|
getpushsize:=pointer_size;
|
|
vs_value,
|
|
vs_const :
|
|
begin
|
|
if paramanager.push_addr_param(vartype.def,is_cdecl) then
|
|
getpushsize:=pointer_size
|
|
else
|
|
getpushsize:=vartype.def.size;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$ifdef var_notification}
|
|
function Tvarsym.register_notification(flags:Tnotification_flags;callback:
|
|
Tnotification_callback):cardinal;
|
|
|
|
var n:Tnotification;
|
|
|
|
begin
|
|
if not assigned(notifications) then
|
|
notifications:=Tlinkedlist.create;
|
|
n:=Tnotification.create(flags,callback);
|
|
register_notification:=n.id;
|
|
notifications.concat(n);
|
|
end;
|
|
{$endif}
|
|
|
|
{$ifdef GDB}
|
|
function tvarsym.stabstring : pchar;
|
|
var
|
|
st : string;
|
|
is_cdecl : boolean;
|
|
begin
|
|
st:=tstoreddef(vartype.def).numberstring;
|
|
if (owner.symtabletype = objectsymtable) and
|
|
(sp_static in symoptions) then
|
|
begin
|
|
if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
|
|
stabstring := strpnew('"'+upper(owner.name^)+'__'+name+':'+st+
|
|
'",'+
|
|
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
|
|
end
|
|
else if (owner.symtabletype = globalsymtable) then
|
|
begin
|
|
{ Here we used S instead of
|
|
because with G GDB doesn't look at the address field
|
|
but searches the same name or with a leading underscore
|
|
but these names don't exist in pascal !}
|
|
if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
|
|
stabstring := strpnew('"'+name+':'+st+'",'+
|
|
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
|
|
end
|
|
else if owner.symtabletype = staticsymtable then
|
|
begin
|
|
stabstring := strpnew('"'+name+':S'+st+'",'+
|
|
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
|
|
end
|
|
else if (owner.symtabletype in [parasymtable,inlineparasymtable]) then
|
|
begin
|
|
is_cdecl:=(tprocdef(owner.defowner).proccalloption in [pocall_cdecl,pocall_cppdecl]);
|
|
case varspez of
|
|
vs_out,
|
|
vs_var : st := 'v'+st;
|
|
vs_value,
|
|
vs_const : if paramanager.push_addr_param(vartype.def,is_cdecl) then
|
|
st := 'v'+st { should be 'i' but 'i' doesn't work }
|
|
else
|
|
st := 'p'+st;
|
|
end;
|
|
stabstring := strpnew('"'+name+':'+st+'",'+
|
|
tostr(N_tsym)+',0,'+tostr(fileinfo.line)+','+
|
|
tostr(address+owner.address_fixup));
|
|
{offset to ebp => will not work if the framepointer is esp
|
|
so some optimizing will make things harder to debug }
|
|
end
|
|
else if (owner.symtabletype in [localsymtable,inlinelocalsymtable]) then
|
|
if reg<>R_NO then
|
|
begin
|
|
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
|
|
{ this is the register order for GDB}
|
|
stabstring:=strpnew('"'+name+':r'+st+'",'+
|
|
tostr(N_RSYM)+',0,'+
|
|
tostr(fileinfo.line)+','+tostr(stab_regindex[reg]));
|
|
end
|
|
else
|
|
{ I don't know if this will work (PM) }
|
|
if (vo_is_C_var in varoptions) then
|
|
stabstring := strpnew('"'+name+':S'+st+'",'+
|
|
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
|
|
else
|
|
stabstring := strpnew('"'+name+':'+st+'",'+
|
|
tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address-owner.address_fixup))
|
|
else
|
|
stabstring := inherited stabstring;
|
|
end;
|
|
|
|
procedure tvarsym.concatstabto(asmlist : taasmoutput);
|
|
var stab_str : pchar;
|
|
begin
|
|
inherited concatstabto(asmlist);
|
|
if (owner.symtabletype=parasymtable) and
|
|
(reg<>R_NO) then
|
|
begin
|
|
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
|
|
{ this is the register order for GDB}
|
|
stab_str:=strpnew('"'+name+':r'
|
|
+tstoreddef(vartype.def).numberstring+'",'+
|
|
tostr(N_RSYM)+',0,'+
|
|
tostr(fileinfo.line)+','+tostr(stab_regindex[reg]));
|
|
asmList.concat(Tai_stabs.Create(stab_str));
|
|
end;
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TTYPEDCONSTSYM
|
|
*****************************************************************************}
|
|
|
|
constructor ttypedconstsym.create(const n : string;p : tdef;writable : boolean);
|
|
begin
|
|
inherited create(n);
|
|
typ:=typedconstsym;
|
|
typedconsttype.setdef(p);
|
|
is_writable:=writable;
|
|
end;
|
|
|
|
|
|
constructor ttypedconstsym.createtype(const n : string;const tt : ttype;writable : boolean);
|
|
begin
|
|
inherited create(n);
|
|
typ:=typedconstsym;
|
|
typedconsttype:=tt;
|
|
is_writable:=writable;
|
|
end;
|
|
|
|
|
|
constructor ttypedconstsym.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited loadsym(ppufile);
|
|
typ:=typedconstsym;
|
|
ppufile.gettype(typedconsttype);
|
|
is_writable:=boolean(ppufile.getbyte);
|
|
end;
|
|
|
|
|
|
destructor ttypedconstsym.destroy;
|
|
begin
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
procedure ttypedconstsym.generate_mangledname;
|
|
begin
|
|
_mangledname:=stringdup(mangledname_prefix('TC',owner)+name);
|
|
end;
|
|
|
|
|
|
function ttypedconstsym.getsize : longint;
|
|
begin
|
|
if assigned(typedconsttype.def) then
|
|
getsize:=typedconsttype.def.size
|
|
else
|
|
getsize:=0;
|
|
end;
|
|
|
|
|
|
procedure ttypedconstsym.deref;
|
|
begin
|
|
typedconsttype.resolve;
|
|
end;
|
|
|
|
|
|
procedure ttypedconstsym.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited writesym(ppufile);
|
|
ppufile.puttype(typedconsttype);
|
|
ppufile.putbyte(byte(is_writable));
|
|
ppufile.writeentry(ibtypedconstsym);
|
|
end;
|
|
|
|
|
|
{$ifdef GDB}
|
|
function ttypedconstsym.stabstring : pchar;
|
|
var
|
|
st : char;
|
|
begin
|
|
if (cs_gdb_gsym in aktglobalswitches) and (owner.symtabletype=globalsymtable) then
|
|
st := 'G'
|
|
else
|
|
st := 'S';
|
|
stabstring := strpnew('"'+name+':'+st+
|
|
tstoreddef(typedconsttype.def).numberstring+'",'+tostr(n_STSYM)+',0,'+
|
|
tostr(fileinfo.line)+','+mangledname);
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TCONSTSYM
|
|
****************************************************************************}
|
|
|
|
constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : TConstExprInt);
|
|
begin
|
|
inherited create(n);
|
|
typ:=constsym;
|
|
consttyp:=t;
|
|
valueord:=v;
|
|
valueordptr:=0;
|
|
valueptr:=nil;
|
|
ResStrIndex:=0;
|
|
consttype.reset;
|
|
len:=0;
|
|
end;
|
|
|
|
|
|
constructor tconstsym.create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
|
|
begin
|
|
inherited create(n);
|
|
typ:=constsym;
|
|
consttyp:=t;
|
|
valueord:=v;
|
|
valueordptr:=0;
|
|
valueptr:=nil;
|
|
ResStrIndex:=0;
|
|
consttype:=tt;
|
|
len:=0;
|
|
end;
|
|
|
|
|
|
constructor tconstsym.create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
|
|
begin
|
|
inherited create(n);
|
|
typ:=constsym;
|
|
consttyp:=t;
|
|
valueord:=0;
|
|
valueordptr:=v;
|
|
valueptr:=nil;
|
|
ResStrIndex:=0;
|
|
consttype:=tt;
|
|
len:=0;
|
|
end;
|
|
|
|
|
|
constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer);
|
|
begin
|
|
inherited create(n);
|
|
typ:=constsym;
|
|
consttyp:=t;
|
|
valueord:=0;
|
|
valueordptr:=0;
|
|
valueptr:=v;
|
|
ResStrIndex:=0;
|
|
consttype.reset;
|
|
len:=0;
|
|
end;
|
|
|
|
|
|
constructor tconstsym.create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
|
|
begin
|
|
inherited create(n);
|
|
typ:=constsym;
|
|
consttyp:=t;
|
|
valueord:=0;
|
|
valueordptr:=0;
|
|
valueptr:=v;
|
|
ResStrIndex:=0;
|
|
consttype:=tt;
|
|
len:=0;
|
|
end;
|
|
|
|
|
|
constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
|
|
begin
|
|
inherited create(n);
|
|
typ:=constsym;
|
|
consttyp:=t;
|
|
valueord:=0;
|
|
valueordptr:=0;
|
|
valueptr:=str;
|
|
consttype.reset;
|
|
len:=l;
|
|
if t=constresourcestring then
|
|
ResStrIndex:=ResourceStrings.Register(name,pchar(valueptr),len);
|
|
end;
|
|
|
|
|
|
constructor tconstsym.ppuload(ppufile:tcompilerppufile);
|
|
var
|
|
pd : pbestreal;
|
|
ps : pnormalset;
|
|
pc : pchar;
|
|
begin
|
|
inherited loadsym(ppufile);
|
|
typ:=constsym;
|
|
consttype.reset;
|
|
consttyp:=tconsttyp(ppufile.getbyte);
|
|
valueord:=0;
|
|
valueordptr:=0;
|
|
valueptr:=nil;
|
|
case consttyp of
|
|
constint:
|
|
valueord:=ppufile.getexprint;
|
|
constwchar,
|
|
constbool,
|
|
constchar :
|
|
valueord:=ppufile.getlongint;
|
|
constord :
|
|
begin
|
|
ppufile.gettype(consttype);
|
|
valueord:=ppufile.getexprint;
|
|
end;
|
|
constpointer :
|
|
begin
|
|
ppufile.gettype(consttype);
|
|
valueordptr:=ppufile.getptruint;
|
|
end;
|
|
conststring,
|
|
constresourcestring :
|
|
begin
|
|
len:=ppufile.getlongint;
|
|
getmem(pc,len+1);
|
|
ppufile.getdata(pc^,len);
|
|
if consttyp=constresourcestring then
|
|
ResStrIndex:=ppufile.getlongint;
|
|
valueptr:=pc;
|
|
end;
|
|
constreal :
|
|
begin
|
|
new(pd);
|
|
pd^:=ppufile.getreal;
|
|
valueptr:=pd;
|
|
end;
|
|
constset :
|
|
begin
|
|
ppufile.gettype(consttype);
|
|
new(ps);
|
|
ppufile.getnormalset(ps^);
|
|
valueptr:=ps;
|
|
end;
|
|
constnil : ;
|
|
else
|
|
Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));
|
|
end;
|
|
end;
|
|
|
|
|
|
destructor tconstsym.destroy;
|
|
begin
|
|
case consttyp of
|
|
conststring,
|
|
constresourcestring :
|
|
freemem(pchar(valueptr),len+1);
|
|
constreal :
|
|
dispose(pbestreal(valueptr));
|
|
constset :
|
|
dispose(pnormalset(valueptr));
|
|
end;
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
function tconstsym.mangledname : string;
|
|
begin
|
|
mangledname:=name;
|
|
end;
|
|
|
|
|
|
procedure tconstsym.deref;
|
|
begin
|
|
if consttyp in [constord,constpointer,constset] then
|
|
consttype.resolve;
|
|
end;
|
|
|
|
|
|
procedure tconstsym.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited writesym(ppufile);
|
|
ppufile.putbyte(byte(consttyp));
|
|
case consttyp of
|
|
constnil : ;
|
|
constint:
|
|
ppufile.putexprint(valueord);
|
|
constbool,
|
|
constchar :
|
|
ppufile.putlongint(valueord);
|
|
constord :
|
|
begin
|
|
ppufile.puttype(consttype);
|
|
ppufile.putexprint(valueord);
|
|
end;
|
|
constpointer :
|
|
begin
|
|
ppufile.puttype(consttype);
|
|
ppufile.putptruint(valueordptr);
|
|
end;
|
|
conststring,
|
|
constresourcestring :
|
|
begin
|
|
ppufile.putlongint(len);
|
|
ppufile.putdata(pchar(valueptr)^,len);
|
|
if consttyp=constresourcestring then
|
|
ppufile.putlongint(ResStrIndex);
|
|
end;
|
|
constreal :
|
|
ppufile.putreal(pbestreal(valueptr)^);
|
|
constset :
|
|
begin
|
|
ppufile.puttype(consttype);
|
|
ppufile.putnormalset(valueptr^);
|
|
end;
|
|
else
|
|
internalerror(13);
|
|
end;
|
|
ppufile.writeentry(ibconstsym);
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
function tconstsym.stabstring : pchar;
|
|
var st : string;
|
|
begin
|
|
{even GDB v4.16 only now 'i' 'r' and 'e' !!!}
|
|
case consttyp of
|
|
conststring : begin
|
|
st := 's'''+strpas(pchar(valueptr))+'''';
|
|
end;
|
|
constbool,
|
|
constint,
|
|
constord,
|
|
constchar : st := 'i'+int64tostr(valueord);
|
|
constpointer :
|
|
st := 'i'+int64tostr(valueordptr);
|
|
constreal : begin
|
|
system.str(pbestreal(valueptr)^,st);
|
|
st := 'r'+st;
|
|
end;
|
|
{ if we don't know just put zero !! }
|
|
else st:='i0';
|
|
{***SETCONST}
|
|
{constset:;} {*** I don't know what to do with a set.}
|
|
{ sets are not recognized by GDB}
|
|
{***}
|
|
end;
|
|
stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+
|
|
tostr(fileinfo.line)+',0');
|
|
end;
|
|
|
|
procedure tconstsym.concatstabto(asmlist : taasmoutput);
|
|
begin
|
|
if consttyp <> conststring then
|
|
inherited concatstabto(asmlist);
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TENUMSYM
|
|
****************************************************************************}
|
|
|
|
constructor tenumsym.create(const n : string;def : tenumdef;v : longint);
|
|
begin
|
|
inherited create(n);
|
|
typ:=enumsym;
|
|
definition:=def;
|
|
value:=v;
|
|
{ check for jumps }
|
|
if v>def.max+1 then
|
|
def.has_jumps:=true;
|
|
{ update low and high }
|
|
if def.min>v then
|
|
def.setmin(v);
|
|
if def.max<v then
|
|
def.setmax(v);
|
|
order;
|
|
end;
|
|
|
|
|
|
constructor tenumsym.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited loadsym(ppufile);
|
|
typ:=enumsym;
|
|
definition:=tenumdef(ppufile.getderef);
|
|
value:=ppufile.getlongint;
|
|
nextenum := Nil;
|
|
end;
|
|
|
|
|
|
procedure tenumsym.deref;
|
|
begin
|
|
resolvedef(pointer(definition));
|
|
order;
|
|
end;
|
|
|
|
|
|
procedure tenumsym.order;
|
|
var
|
|
sym : tenumsym;
|
|
begin
|
|
sym := tenumsym(definition.firstenum);
|
|
if sym = nil then
|
|
begin
|
|
definition.firstenum := self;
|
|
nextenum := nil;
|
|
exit;
|
|
end;
|
|
{ reorder the symbols in increasing value }
|
|
if value < sym.value then
|
|
begin
|
|
nextenum := sym;
|
|
definition.firstenum := self;
|
|
end
|
|
else
|
|
begin
|
|
while (sym.value <= value) and assigned(sym.nextenum) do
|
|
sym := sym.nextenum;
|
|
nextenum := sym.nextenum;
|
|
sym.nextenum := self;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tenumsym.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited writesym(ppufile);
|
|
ppufile.putderef(definition);
|
|
ppufile.putlongint(value);
|
|
ppufile.writeentry(ibenumsym);
|
|
end;
|
|
|
|
|
|
{$ifdef GDB}
|
|
procedure tenumsym.concatstabto(asmlist : taasmoutput);
|
|
begin
|
|
{enum elements have no stab !}
|
|
end;
|
|
{$EndIf GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TTYPESYM
|
|
****************************************************************************}
|
|
|
|
constructor ttypesym.create(const n : string;const tt : ttype);
|
|
|
|
begin
|
|
inherited create(n);
|
|
typ:=typesym;
|
|
restype:=tt;
|
|
{$ifdef GDB}
|
|
isusedinstab := false;
|
|
{$endif GDB}
|
|
{ register the typesym for the definition }
|
|
if assigned(restype.def) and
|
|
(restype.def.deftype<>errordef) and
|
|
not(assigned(restype.def.typesym)) then
|
|
restype.def.typesym:=self;
|
|
end;
|
|
|
|
|
|
constructor ttypesym.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited loadsym(ppufile);
|
|
typ:=typesym;
|
|
{$ifdef GDB}
|
|
isusedinstab := false;
|
|
{$endif GDB}
|
|
ppufile.gettype(restype);
|
|
end;
|
|
|
|
|
|
function ttypesym.gettypedef:tdef;
|
|
begin
|
|
gettypedef:=restype.def;
|
|
end;
|
|
|
|
|
|
procedure ttypesym.deref;
|
|
begin
|
|
restype.resolve;
|
|
end;
|
|
|
|
|
|
procedure ttypesym.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited writesym(ppufile);
|
|
ppufile.puttype(restype);
|
|
ppufile.writeentry(ibtypesym);
|
|
end;
|
|
|
|
|
|
procedure ttypesym.load_references(ppufile:tcompilerppufile;locals:boolean);
|
|
begin
|
|
inherited load_references(ppufile,locals);
|
|
if (restype.def.deftype=recorddef) then
|
|
tstoredsymtable(trecorddef(restype.def).symtable).load_references(ppufile,locals);
|
|
if (restype.def.deftype=objectdef) then
|
|
tstoredsymtable(tobjectdef(restype.def).symtable).load_references(ppufile,locals);
|
|
end;
|
|
|
|
|
|
function ttypesym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
|
|
begin
|
|
if not inherited write_references(ppufile,locals) then
|
|
begin
|
|
{ write address of this symbol if record or object
|
|
even if no real refs are there
|
|
because we need it for the symtable }
|
|
if (restype.def.deftype in [recorddef,objectdef]) then
|
|
begin
|
|
ppufile.putderef(self);
|
|
ppufile.writeentry(ibsymref);
|
|
end;
|
|
end;
|
|
write_references:=true;
|
|
if (restype.def.deftype=recorddef) then
|
|
tstoredsymtable(trecorddef(restype.def).symtable).write_references(ppufile,locals);
|
|
if (restype.def.deftype=objectdef) then
|
|
tstoredsymtable(tobjectdef(restype.def).symtable).write_references(ppufile,locals);
|
|
end;
|
|
|
|
|
|
{$ifdef GDB}
|
|
function ttypesym.stabstring : pchar;
|
|
var
|
|
stabchar : string[2];
|
|
short : string;
|
|
begin
|
|
if restype.def.deftype in tagtypes then
|
|
stabchar := 'Tt'
|
|
else
|
|
stabchar := 't';
|
|
short := '"'+name+':'+stabchar+tstoreddef(restype.def).numberstring
|
|
+'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
|
|
stabstring := strpnew(short);
|
|
end;
|
|
|
|
procedure ttypesym.concatstabto(asmlist : taasmoutput);
|
|
begin
|
|
{not stabs for forward defs }
|
|
if assigned(restype.def) then
|
|
if (restype.def.typesym = self) then
|
|
tstoreddef(restype.def).concatstabto(asmlist)
|
|
else
|
|
inherited concatstabto(asmlist);
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TSYSSYM
|
|
****************************************************************************}
|
|
|
|
constructor tsyssym.create(const n : string;l : longint);
|
|
begin
|
|
inherited create(n);
|
|
typ:=syssym;
|
|
number:=l;
|
|
end;
|
|
|
|
constructor tsyssym.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited loadsym(ppufile);
|
|
typ:=syssym;
|
|
number:=ppufile.getlongint;
|
|
end;
|
|
|
|
destructor tsyssym.destroy;
|
|
begin
|
|
inherited destroy;
|
|
end;
|
|
|
|
procedure tsyssym.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited writesym(ppufile);
|
|
ppufile.putlongint(number);
|
|
ppufile.writeentry(ibsyssym);
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
procedure tsyssym.concatstabto(asmlist : taasmoutput);
|
|
begin
|
|
end;
|
|
{$endif GDB}
|
|
|
|
|
|
{****************************************************************************
|
|
TRTTISYM
|
|
****************************************************************************}
|
|
|
|
constructor trttisym.create(const n:string;rt:trttitype);
|
|
const
|
|
prefix : array[trttitype] of string[5]=('$rtti','$init');
|
|
begin
|
|
inherited create(prefix[rt]+n);
|
|
typ:=rttisym;
|
|
lab:=nil;
|
|
rttityp:=rt;
|
|
end;
|
|
|
|
|
|
constructor trttisym.ppuload(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited loadsym(ppufile);
|
|
typ:=rttisym;
|
|
lab:=nil;
|
|
rttityp:=trttitype(ppufile.getbyte);
|
|
end;
|
|
|
|
|
|
procedure trttisym.ppuwrite(ppufile:tcompilerppufile);
|
|
begin
|
|
inherited writesym(ppufile);
|
|
ppufile.putbyte(byte(rttityp));
|
|
ppufile.writeentry(ibrttisym);
|
|
end;
|
|
|
|
|
|
function trttisym.mangledname : string;
|
|
const
|
|
prefix : array[trttitype] of string[5]=('RTTI_','INIT_');
|
|
var
|
|
s : string;
|
|
p : tsymtable;
|
|
begin
|
|
s:='';
|
|
p:=owner;
|
|
while assigned(p) and (p.symtabletype=localsymtable) do
|
|
begin
|
|
s:=s+'_'+p.defowner.name;
|
|
p:=p.defowner.owner;
|
|
end;
|
|
if not(p.symtabletype in [globalsymtable,staticsymtable]) then
|
|
internalerror(200108265);
|
|
mangledname:=prefix[rttityp]+p.name^+s+'$_'+Copy(name,5,255);
|
|
end;
|
|
|
|
|
|
function trttisym.get_label:tasmsymbol;
|
|
begin
|
|
{ the label is always a global label }
|
|
if not assigned(lab) then
|
|
lab:=objectlibrary.newasmsymboltype(mangledname,AB_GLOBAL,AT_DATA);
|
|
get_label:=lab;
|
|
end;
|
|
|
|
|
|
{ persistent rtti generation }
|
|
procedure generate_rtti(p:tsym);
|
|
var
|
|
rsym : trttisym;
|
|
def : tstoreddef;
|
|
begin
|
|
{ rtti can only be generated for classes that are always typesyms }
|
|
if not(p.typ=typesym) then
|
|
internalerror(200108261);
|
|
def:=tstoreddef(ttypesym(p).restype.def);
|
|
{ only create rtti once for each definition }
|
|
if not(df_has_rttitable in def.defoptions) then
|
|
begin
|
|
{ definition should be in the same symtable as the symbol }
|
|
if p.owner<>def.owner then
|
|
internalerror(200108262);
|
|
{ create rttisym }
|
|
rsym:=trttisym.create(p.name,fullrtti);
|
|
p.owner.insert(rsym);
|
|
{ register rttisym in definition }
|
|
include(def.defoptions,df_has_rttitable);
|
|
def.rttitablesym:=rsym;
|
|
{ write rtti data }
|
|
def.write_child_rtti_data(fullrtti);
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
rttiList.concat(Tai_cut.Create);
|
|
rttiList.concat(Tai_symbol.Create(rsym.get_label,0));
|
|
def.write_rtti_data(fullrtti);
|
|
rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
|
|
end;
|
|
end;
|
|
|
|
|
|
{ persistent init table generation }
|
|
procedure generate_inittable(p:tsym);
|
|
var
|
|
rsym : trttisym;
|
|
def : tstoreddef;
|
|
begin
|
|
{ anonymous types are also allowed for records that can be varsym }
|
|
case p.typ of
|
|
typesym :
|
|
def:=tstoreddef(ttypesym(p).restype.def);
|
|
varsym :
|
|
def:=tstoreddef(tvarsym(p).vartype.def);
|
|
else
|
|
internalerror(200108263);
|
|
end;
|
|
{ only create inittable once for each definition }
|
|
if not(df_has_inittable in def.defoptions) then
|
|
begin
|
|
{ definition should be in the same symtable as the symbol }
|
|
if p.owner<>def.owner then
|
|
internalerror(200108264);
|
|
{ create rttisym }
|
|
rsym:=trttisym.create(p.name,initrtti);
|
|
p.owner.insert(rsym);
|
|
{ register rttisym in definition }
|
|
include(def.defoptions,df_has_inittable);
|
|
def.inittablesym:=rsym;
|
|
{ write inittable data }
|
|
def.write_child_rtti_data(initrtti);
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
rttiList.concat(Tai_cut.Create);
|
|
rttiList.concat(Tai_symbol.Create(rsym.get_label,0));
|
|
def.write_rtti_data(initrtti);
|
|
rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.58 2002-09-01 08:01:16 daniel
|
|
* Removed sets from Tcallnode.det_resulttype
|
|
+ Added read/write notifications of variables. These will be usefull
|
|
for providing information for several optimizations. For example
|
|
the value of the loop variable of a for loop does matter is the
|
|
variable is read after the for loop, but if it's no longer used
|
|
or written, it doesn't matter and this can be used to optimize
|
|
the loop code generation.
|
|
|
|
Revision 1.57 2002/08/25 19:25:21 peter
|
|
* sym.insert_in_data removed
|
|
* symtable.insertvardata/insertconstdata added
|
|
* removed insert_in_data call from symtable.insert, it needs to be
|
|
called separatly. This allows to deref the address calculation
|
|
* procedures now calculate the parast addresses after the procedure
|
|
directives are parsed. This fixes the cdecl parast problem
|
|
* push_addr_param has an extra argument that specifies if cdecl is used
|
|
or not
|
|
|
|
Revision 1.56 2002/08/25 09:06:21 peter
|
|
* fixed loop in concat_procdefs
|
|
|
|
Revision 1.55 2002/08/20 16:54:40 peter
|
|
* write address of varsym always
|
|
|
|
Revision 1.54 2002/08/20 10:31:26 daniel
|
|
* Tcallnode.det_resulttype rewritten
|
|
|
|
Revision 1.53 2002/08/18 20:06:27 peter
|
|
* inlining is now also allowed in interface
|
|
* renamed write/load to ppuwrite/ppuload
|
|
* tnode storing in ppu
|
|
* nld,ncon,nbas are already updated for storing in ppu
|
|
|
|
Revision 1.52 2002/08/17 09:23:42 florian
|
|
* first part of procinfo rewrite
|
|
|
|
Revision 1.51 2002/08/16 14:24:59 carl
|
|
* issameref() to test if two references are the same (then emit no opcodes)
|
|
+ ret_in_reg to replace ret_in_acc
|
|
(fix some register allocation bugs at the same time)
|
|
+ save_std_register now has an extra parameter which is the
|
|
usedinproc registers
|
|
|
|
Revision 1.50 2002/08/13 21:40:57 florian
|
|
* more fixes for ppc calling conventions
|
|
|
|
Revision 1.49 2002/08/12 15:08:40 carl
|
|
+ stab register indexes for powerpc (moved from gdb to cpubase)
|
|
+ tprocessor enumeration moved to cpuinfo
|
|
+ linker in target_info is now a class
|
|
* many many updates for m68k (will soon start to compile)
|
|
- removed some ifdef or correct them for correct cpu
|
|
|
|
Revision 1.48 2002/08/11 14:32:28 peter
|
|
* renamed current_library to objectlibrary
|
|
|
|
Revision 1.47 2002/08/11 13:24:14 peter
|
|
* saving of asmsymbols in ppu supported
|
|
* asmsymbollist global is removed and moved into a new class
|
|
tasmlibrarydata that will hold the info of a .a file which
|
|
corresponds with a single module. Added librarydata to tmodule
|
|
to keep the library info stored for the module. In the future the
|
|
objectfiles will also be stored to the tasmlibrarydata class
|
|
* all getlabel/newasmsymbol and friends are moved to the new class
|
|
|
|
Revision 1.46 2002/07/23 10:13:23 daniel
|
|
* Added important comment
|
|
|
|
Revision 1.45 2002/07/23 09:51:26 daniel
|
|
* Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
|
|
are worth comitting.
|
|
|
|
Revision 1.44 2002/07/20 17:45:29 daniel
|
|
* Register variables are now possible for global variables too. This is
|
|
important for small programs without procedures.
|
|
|
|
Revision 1.43 2002/07/20 11:57:58 florian
|
|
* types.pas renamed to defbase.pas because D6 contains a types
|
|
unit so this would conflicts if D6 programms are compiled
|
|
+ Willamette/SSE2 instructions to assembler added
|
|
|
|
Revision 1.42 2002/07/11 14:41:31 florian
|
|
* start of the new generic parameter handling
|
|
|
|
Revision 1.41 2002/07/10 07:24:40 jonas
|
|
* memory leak fixes from Sergey Korshunoff
|
|
|
|
Revision 1.40 2002/07/01 18:46:27 peter
|
|
* internal linker
|
|
* reorganized aasm layer
|
|
|
|
Revision 1.39 2002/05/18 13:34:18 peter
|
|
* readded missing revisions
|
|
|
|
Revision 1.38 2002/05/16 19:46:45 carl
|
|
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
|
|
+ try to fix temp allocation (still in ifdef)
|
|
+ generic constructor calls
|
|
+ start of tassembler / tmodulebase class cleanup
|
|
|
|
Revision 1.36 2002/05/12 16:53:15 peter
|
|
* moved entry and exitcode to ncgutil and cgobj
|
|
* foreach gets extra argument for passing local data to the
|
|
iterator function
|
|
* -CR checks also class typecasts at runtime by changing them
|
|
into as
|
|
* fixed compiler to cycle with the -CR option
|
|
* fixed stabs with elf writer, finally the global variables can
|
|
be watched
|
|
* removed a lot of routines from cga unit and replaced them by
|
|
calls to cgobj
|
|
* u32bit-s32bit updates for and,or,xor nodes. When one element is
|
|
u32bit then the other is typecasted also to u32bit without giving
|
|
a rangecheck warning/error.
|
|
* fixed pascal calling method with reversing also the high tree in
|
|
the parast, detected by tcalcst3 test
|
|
|
|
Revision 1.35 2002/04/19 15:46:03 peter
|
|
* mangledname rewrite, tprocdef.mangledname is now created dynamicly
|
|
in most cases and not written to the ppu
|
|
* add mangeledname_prefix() routine to generate the prefix of
|
|
manglednames depending on the current procedure, object and module
|
|
* removed static procprefix since the mangledname is now build only
|
|
on demand from tprocdef.mangledname
|
|
|
|
Revision 1.34 2002/04/16 16:12:47 peter
|
|
* give error when using enums with jumps as array index
|
|
* allow char as enum value
|
|
|
|
Revision 1.33 2002/04/15 19:08:22 carl
|
|
+ target_info.size_of_pointer -> pointer_size
|
|
+ some cleanup of unused types/variables
|
|
|
|
Revision 1.32 2002/04/07 13:37:29 carl
|
|
+ change unit use
|
|
|
|
Revision 1.31 2002/02/03 09:30:04 peter
|
|
* more fixes for protected handling
|
|
|
|
}
|