fpc/compiler/symsym.inc
1999-11-21 01:42:37 +00:00

2298 lines
66 KiB
PHP

{
$Id$
Copyright (c) 1993-98 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.
****************************************************************************
}
{****************************************************************************
TSYM (base for all symtypes)
****************************************************************************}
constructor tsym.init(const n : string);
begin
inherited initname(n);
typ:=abstractsym;
symoptions:=current_object_option;
{$ifdef GDB}
isstabwritten := false;
{$endif GDB}
fileinfo:=tokenpos;
defref:=nil;
refs:=0;
lastwritten:=nil;
refcount:=0;
if (cs_browser in aktmoduleswitches) and make_ref then
begin
defref:=new(pref,init(defref,@tokenpos));
inc(refcount);
end;
lastref:=defref;
end;
constructor tsym.load;
begin
inherited init;
indexnr:=readword;
setname(readstring);
typ:=abstractsym;
readsmallset(symoptions);
readposinfo(fileinfo);
lastref:=nil;
defref:=nil;
refs:=0;
lastwritten:=nil;
refcount:=0;
{$ifdef GDB}
isstabwritten := false;
{$endif GDB}
end;
procedure tsym.load_references;
var
pos : tfileposinfo;
move_last : boolean;
begin
move_last:=lastwritten=lastref;
while (not current_ppu^.endofentry) do
begin
readposinfo(pos);
inc(refcount);
lastref:=new(pref,init(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 tsym.write_references : boolean;
var
ref : pref;
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
writesymref(@self);
symref_written:=true;
end;
writeposinfo(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
current_ppu^.writeentry(ibsymref);
write_references:=symref_written;
end;
{$ifdef BrowserLog}
procedure tsym.add_to_browserlog;
begin
if assigned(defref) then
begin
browserlog.AddLog('***'+name+'***');
browserlog.AddLogRefs(defref);
end;
end;
{$endif BrowserLog}
destructor tsym.done;
begin
if assigned(defref) then
dispose(defref,done);
inherited done;
end;
procedure tsym.write;
begin
writeword(indexnr);
writestring(name);
writesmallset(symoptions);
writeposinfo(fileinfo);
end;
procedure tsym.deref;
begin
end;
function tsym.mangledname : string;
begin
mangledname:=name;
end;
{ for most symbol types there is nothing to do at all }
procedure tsym.insert_in_data;
begin
end;
{$ifdef GDB}
function tsym.stabstring : pchar;
begin
stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+
tostr(fileinfo.line)+',0');
end;
procedure tsym.concatstabto(asmlist : paasmoutput);
var stab_str : pchar;
begin
if not isstabwritten then
begin
stab_str := stabstring;
{ count_dbx(stab_str); moved to GDB.PAS }
asmlist^.concat(new(pai_stabs,init(stab_str)));
isstabwritten:=true;
end;
end;
{$endif GDB}
{****************************************************************************
TLABELSYM
****************************************************************************}
constructor tlabelsym.init(const n : string; l : pasmlabel);
begin
inherited init(n);
typ:=labelsym;
lab:=l;
used:=false;
defined:=false;
end;
constructor tlabelsym.load;
begin
tsym.load;
typ:=labelsym;
{ this is all dummy
it is only used for local browsing }
lab:=nil;
used:=false;
defined:=true;
end;
destructor tlabelsym.done;
begin
inherited done;
end;
function tlabelsym.mangledname : string;
begin
mangledname:=lab^.name;
end;
procedure tlabelsym.write;
begin
if owner^.symtabletype in [unitsymtable,globalsymtable] then
Message(sym_e_ill_label_decl)
else
begin
tsym.write;
current_ppu^.writeentry(iblabelsym);
end;
end;
{****************************************************************************
TUNITSYM
****************************************************************************}
constructor tunitsym.init(const n : string;ref : punitsymtable);
var
old_make_ref : boolean;
begin
old_make_ref:=make_ref;
make_ref:=false;
inherited init(n);
make_ref:=old_make_ref;
typ:=unitsym;
unitsymtable:=ref;
prevsym:=ref^.unitsym;
ref^.unitsym:=@self;
refs:=0;
end;
constructor tunitsym.load;
begin
tsym.load;
typ:=unitsym;
unitsymtable:=punitsymtable(current_module^.globalsymtable);
prevsym:=nil;
end;
{ we need to remove it from the prevsym chain ! }
destructor tunitsym.done;
var pus,ppus : punitsym;
begin
if assigned(unitsymtable) then
begin
ppus:=nil;
pus:=unitsymtable^.unitsym;
if pus=@self then
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;
prevsym:=nil;
unitsymtable:=nil;
inherited done;
end;
procedure tunitsym.write;
begin
tsym.write;
current_ppu^.writeentry(ibunitsym);
end;
{$ifdef GDB}
procedure tunitsym.concatstabto(asmlist : paasmoutput);
begin
{Nothing to write to stabs !}
end;
{$endif GDB}
{****************************************************************************
TPROCSYM
****************************************************************************}
constructor tprocsym.init(const n : string);
begin
tsym.init(n);
typ:=procsym;
definition:=nil;
owner:=nil;
{$ifdef GDB}
is_global := false;
{$endif GDB}
end;
constructor tprocsym.load;
begin
tsym.load;
typ:=procsym;
definition:=pprocdef(readdefref);
{$ifdef GDB}
is_global := false;
{$endif GDB}
end;
destructor tprocsym.done;
begin
{ don't check if errors !! }
if Errorcount=0 then
check_forward;
tsym.done;
end;
function tprocsym.mangledname : string;
begin
mangledname:=definition^.mangledname;
end;
function tprocsym.demangledname:string;
begin
demangledname:=name+definition^.demangled_paras;
end;
procedure tprocsym.write_parameter_lists;
var
p : pprocdef;
begin
p:=definition;
while assigned(p) do
begin
{ force the error to be printed }
Verbose.Message1(sym_b_param_list,name+p^.demangled_paras);
p:=p^.nextoverloaded;
end;
end;
procedure tprocsym.check_forward;
var
pd : pprocdef;
begin
pd:=definition;
while assigned(pd) do
begin
if pd^.forwarddef then
begin
if assigned(pd^._class) then
MessagePos1(fileinfo,sym_e_forward_not_resolved,pd^._class^.objname^+'.'+demangledname)
else
MessagePos1(fileinfo,sym_e_forward_not_resolved,demangledname);
{ Turn futher error messages off }
pd^.forwarddef:=false;
end;
pd:=pd^.nextoverloaded;
end;
end;
procedure tprocsym.deref;
var
t : ttoken;
last : pprocdef;
begin
resolvedef(pdef(definition));
if (definition^.proctypeoption=potype_operator) then
begin
last:=definition;
while assigned(last^.nextoverloaded) do
last:=last^.nextoverloaded;
for t:=first_overloaded to last_overloaded do
if (name=overloaded_names[t]) then
begin
if assigned(overloaded_operators[t]) then
last^.nextoverloaded:=overloaded_operators[t]^.definition;
overloaded_operators[t]:=@self;
end;
end;
end;
procedure tprocsym.order_overloaded;
var firstdef,currdef,lastdef : pprocdef;
begin
firstdef:=definition;
currdef:=definition;
while assigned(currdef) do
begin
currdef^.count:=false;
currdef:=currdef^.nextoverloaded;
end;
definition:=definition^.nextoverloaded;
firstdef^.nextoverloaded:=nil;
while assigned(definition) do
begin
currdef:=firstdef;
lastdef:=definition;
definition:=definition^.nextoverloaded;
if lastdef^.mangledname<firstdef^.mangledname then
begin
lastdef^.nextoverloaded:=firstdef;
firstdef:=lastdef;
end
else
begin
while assigned(currdef^.nextoverloaded) and
(lastdef^.mangledname>currdef^.nextoverloaded^.mangledname) do
currdef:=currdef^.nextoverloaded;
lastdef^.nextoverloaded:=currdef^.nextoverloaded;
currdef^.nextoverloaded:=lastdef;
end;
end;
definition:=firstdef;
currdef:=definition;
while assigned(currdef) do
begin
currdef^.count:=true;
currdef:=currdef^.nextoverloaded;
end;
end;
procedure tprocsym.write;
begin
tsym.write;
writedefref(pdef(definition));
current_ppu^.writeentry(ibprocsym);
end;
procedure tprocsym.load_references;
(*var
prdef,prdef2 : pprocdef;
b : byte; *)
begin
inherited load_references;
(*prdef:=definition;
done in tsymtable.load_browser (PM)
{ take care about operators !! }
if (current_module^.flags and uf_has_browser) <>0 then
while assigned(prdef) and (prdef^.owner=definition^.owner) do
begin
b:=current_ppu^.readentry;
if b<>ibdefref then
Message(unit_f_ppu_read_error);
prdef2:=pprocdef(readdefref);
resolvedef(prdef2);
if prdef<>prdef2 then
Message(unit_f_ppu_read_error);
prdef^.load_references;
prdef:=prdef^.nextoverloaded;
end; *)
end;
function tprocsym.write_references : boolean;
var
prdef : pprocdef;
begin
write_references:=false;
if not inherited write_references then
exit;
write_references:=true;
prdef:=definition;
while assigned(prdef) and (prdef^.owner=definition^.owner) do
begin
prdef^.write_references;
prdef:=prdef^.nextoverloaded;
end;
end;
{$ifdef BrowserLog}
procedure tprocsym.add_to_browserlog;
var
prdef : pprocdef;
begin
inherited add_to_browserlog;
prdef:=definition;
while assigned(prdef) do
begin
pprocdef(prdef)^.add_to_browserlog;
prdef:=pprocdef(prdef)^.nextoverloaded;
end;
end;
{$endif BrowserLog}
{$ifdef GDB}
function tprocsym.stabstring : pchar;
Var RetType : Char;
Obj,Info : String;
stabsstr : string;
p : pchar;
begin
obj := name;
info := '';
if is_global then
RetType := 'F'
else
RetType := 'f';
if assigned(owner) then
begin
if (owner^.symtabletype = objectsymtable) then
obj := owner^.name^+'__'+name;
{ this code was correct only as long as the local symboltable
of the parent had the same name as the function
but this is no true anymore !! PM
if (owner^.symtabletype=localsymtable) and assigned(owner^.name) then
info := ','+name+','+owner^.name^; }
if (owner^.symtabletype=localsymtable) and assigned(owner^.defowner) and
assigned(pprocdef(owner^.defowner)^.procsym) then
info := ','+name+','+pprocdef(owner^.defowner)^.procsym^.name;
end;
stabsstr:=definition^.mangledname;
getmem(p,length(stabsstr)+255);
strpcopy(p,'"'+obj+':'+RetType
+definition^.retdef^.numberstring+info+'",'+tostr(n_function)
+',0,'+
tostr(aktfilepos.line)
+',');
strpcopy(strend(p),stabsstr);
stabstring:=strnew(p);
freemem(p,length(stabsstr)+255);
end;
procedure tprocsym.concatstabto(asmlist : paasmoutput);
begin
if (pocall_internproc in definition^.proccalloptions) then exit;
if not isstabwritten then
asmlist^.concat(new(pai_stabs,init(stabstring)));
isstabwritten := true;
if assigned(definition^.parast) then
definition^.parast^.concatstabto(asmlist);
if assigned(definition^.localst) then
definition^.localst^.concatstabto(asmlist);
definition^.is_def_stab_written := true;
end;
{$endif GDB}
{****************************************************************************
TPROGRAMSYM
****************************************************************************}
constructor tprogramsym.init(const n : string);
begin
inherited init(n);
typ:=programsym;
end;
{****************************************************************************
TERRORSYM
****************************************************************************}
constructor terrorsym.init;
begin
inherited init('');
typ:=errorsym;
end;
{****************************************************************************
TPROPERTYSYM
****************************************************************************}
constructor tpropertysym.init(const n : string);
begin
inherited init(n);
typ:=propertysym;
propoptions:=[];
proptype:=nil;
readaccessdef:=nil;
writeaccessdef:=nil;
readaccesssym:=nil;
writeaccesssym:=nil;
storedsym:=nil;
storeddef:=nil;
indexdef:=nil;
index:=0;
default:=0;
end;
destructor tpropertysym.done;
procedure disposepropsymlist(p:ppropsymlist);
var
hp : ppropsymlist;
begin
while assigned(p) do
begin
hp:=p;
p:=p^.next;
dispose(hp);
end;
end;
begin
disposepropsymlist(readaccesssym);
disposepropsymlist(writeaccesssym);
disposepropsymlist(storedsym);
inherited done;
end;
constructor tpropertysym.load;
function readpropsymlist:ppropsymlist;
var
root,last,p : ppropsymlist;
sym : psym;
begin
root:=nil;
last:=nil;
repeat
sym:=readsymref;
if sym=nil then
break;
new(p);
p^.sym:=sym;
p^.next:=nil;
if assigned(last) then
last^.next:=p
else
root:=p;
last:=p;
until false;
readpropsymlist:=root;
end;
begin
inherited load;
typ:=propertysym;
proptype:=readdefref;
readsmallset(propoptions);
index:=readlong;
default:=readlong;
{ the syms }
readaccesssym:=readpropsymlist;
writeaccesssym:=readpropsymlist;
storedsym:=readpropsymlist;
{ now the defs }
readaccessdef:=readdefref;
writeaccessdef:=readdefref;
storeddef:=readdefref;
indexdef:=readdefref;
end;
procedure tpropertysym.deref;
procedure resolvepropsymlist(p:ppropsymlist);
begin
while assigned(p) do
begin
resolvesym(p^.sym);
p:=p^.next;
end;
end;
begin
resolvedef(proptype);
resolvedef(readaccessdef);
resolvedef(writeaccessdef);
resolvedef(storeddef);
resolvedef(indexdef);
resolvepropsymlist(readaccesssym);
resolvepropsymlist(writeaccesssym);
resolvepropsymlist(storedsym);
end;
function tpropertysym.getsize : longint;
begin
getsize:=0;
end;
procedure tpropertysym.write;
procedure writepropsymlist(p:ppropsymlist);
begin
while assigned(p) do
begin
writesymref(p^.sym);
p:=p^.next;
end;
writesymref(nil);
end;
begin
tsym.write;
writedefref(proptype);
writesmallset(propoptions);
writelong(index);
writelong(default);
writepropsymlist(readaccesssym);
writepropsymlist(writeaccesssym);
writepropsymlist(storedsym);
writedefref(readaccessdef);
writedefref(writeaccessdef);
writedefref(storeddef);
writedefref(indexdef);
current_ppu^.writeentry(ibpropertysym);
end;
{$ifdef GDB}
function tpropertysym.stabstring : pchar;
begin
{ !!!! don't know how to handle }
stabstring:=strpnew('');
end;
procedure tpropertysym.concatstabto(asmlist : paasmoutput);
begin
{ !!!! don't know how to handle }
end;
{$endif GDB}
{****************************************************************************
TFUNCRETSYM
****************************************************************************}
constructor tfuncretsym.init(const n : string;approcinfo : pointer{pprocinfo});
begin
tsym.init(n);
typ:=funcretsym;
funcretprocinfo:=approcinfo;
funcretdef:=pprocinfo(approcinfo)^.retdef;
{ address valid for ret in param only }
{ otherwise set by insert }
address:=pprocinfo(approcinfo)^.retoffset;
end;
constructor tfuncretsym.load;
begin
tsym.load;
funcretdef:=readdefref;
address:=readlong;
funcretprocinfo:=nil;
typ:=funcretsym;
end;
procedure tfuncretsym.write;
begin
tsym.write;
writedefref(funcretdef);
writelong(address);
current_ppu^.writeentry(ibfuncretsym);
end;
procedure tfuncretsym.deref;
begin
resolvedef(funcretdef);
end;
{$ifdef GDB}
procedure tfuncretsym.concatstabto(asmlist : paasmoutput);
begin
{ Nothing to do here, it is done in genexitcode }
end;
{$endif GDB}
procedure tfuncretsym.insert_in_data;
var
l : longint;
begin
{ if retoffset is already set then reuse it, this is needed
when inserting the result variable }
if procinfo^.retoffset<>0 then
address:=procinfo^.retoffset
else
begin
{ allocate space in local if ret in acc or in fpu }
if ret_in_acc(procinfo^.retdef) or (procinfo^.retdef^.deftype=floatdef) then
begin
l:=funcretdef^.size;
inc(owner^.datasize,l);
{$ifdef m68k}
{ word alignment required for motorola }
if (l=1) then
inc(owner^.datasize,1)
else
{$endif}
if (l>=4) and ((owner^.datasize and 3)<>0) then
inc(owner^.datasize,4-(owner^.datasize and 3))
else if (l>=2) and ((owner^.datasize and 1)<>0) then
inc(owner^.datasize,2-(owner^.datasize and 1));
address:=owner^.datasize;
procinfo^.retoffset:=-owner^.datasize;
end;
end;
end;
{****************************************************************************
TABSOLUTESYM
****************************************************************************}
constructor tabsolutesym.init(const n : string;p : pdef);
begin
inherited init(n,p);
typ:=absolutesym;
end;
constructor tabsolutesym.load;
begin
tvarsym.load;
typ:=absolutesym;
ref:=nil;
address:=0;
asmname:=nil;
abstyp:=absolutetyp(readbyte);
absseg:=false;
case abstyp of
tovar :
begin
asmname:=stringdup(readstring);
ref:=srsym;
end;
toasm :
asmname:=stringdup(readstring);
toaddr :
begin
address:=readlong;
absseg:=boolean(readbyte);
end;
end;
end;
procedure tabsolutesym.write;
var
hvo : tvaroptions;
begin
{ Note: This needs to write everything of tvarsym.write }
tsym.write;
writebyte(byte(varspez));
if read_member then
writelong(address);
{ write only definition or definitionsym }
if assigned(definitionsym) then
begin
writedefref(nil);
writesymref(definitionsym);
end
else
begin
writedefref(definition);
writesymref(nil);
end;
hvo:=varoptions-[vo_regable];
writesmallset(hvo);
writebyte(byte(abstyp));
case abstyp of
tovar :
writestring(ref^.name);
toasm :
writestring(asmname^);
toaddr :
begin
writelong(address);
writebyte(byte(absseg));
end;
end;
current_ppu^.writeentry(ibabsolutesym);
end;
procedure tabsolutesym.deref;
begin
tvarsym.deref;
if (abstyp=tovar) and (asmname<>nil) then
begin
{ search previous loaded symtables }
getsym(asmname^,false);
if not(assigned(srsym)) then
getsymonlyin(owner,asmname^);
if not(assigned(srsym)) then
srsym:=generrorsym;
ref:=srsym;
stringdispose(asmname);
end;
end;
function tabsolutesym.mangledname : string;
begin
case abstyp of
tovar :
mangledname:=ref^.mangledname;
toasm :
mangledname:=asmname^;
toaddr :
mangledname:='$'+tostr(address);
else
internalerror(10002);
end;
end;
procedure tabsolutesym.insert_in_data;
begin
end;
{$ifdef GDB}
procedure tabsolutesym.concatstabto(asmlist : paasmoutput);
begin
{ I don't know how to handle this !! }
end;
{$endif GDB}
{****************************************************************************
TVARSYM
****************************************************************************}
constructor tvarsym.init(const n : string;p : pdef);
begin
tsym.init(n);
typ:=varsym;
definition:=p;
definitionsym:=nil;
_mangledname:=nil;
varspez:=vs_value;
address:=0;
islocalcopy:=false;
localvarsym:=nil;
refs:=0;
varstate:=vs_used;
varoptions:=[];
{ can we load the value into a register ? }
if p^.is_intregable then
{$ifdef INCLUDEOK}
include(varoptions,vo_regable)
{$else}
varoptions:=varoptions+[vo_regable]
{$endif}
else
{$ifdef INCLUDEOK}
exclude(varoptions,vo_regable);
{$else}
varoptions:=varoptions-[vo_regable];
{$endif}
if p^.is_fpuregable then
{$ifdef INCLUDEOK}
include(varoptions,vo_fpuregable)
{$else}
varoptions:=varoptions+[vo_fpuregable]
{$endif}
else
{$ifdef INCLUDEOK}
exclude(varoptions,vo_regable);
{$else}
varoptions:=varoptions-[vo_fpuregable];
{$endif}
reg:=R_NO;
end;
constructor tvarsym.init_dll(const n : string;p : pdef);
begin
{ The tvarsym is necessary for 0.99.5 (PFV) }
tvarsym.init(n,p);
{$ifdef INCLUDEOK}
include(varoptions,vo_is_dll_var);
{$else}
varoptions:=varoptions+[vo_is_dll_var];
{$endif}
end;
constructor tvarsym.init_C(const n,mangled : string;p : pdef);
begin
{ The tvarsym is necessary for 0.99.5 (PFV) }
tvarsym.init(n,p);
{$ifdef INCLUDEOK}
include(varoptions,vo_is_C_var);
{$else}
varoptions:=varoptions+[vo_is_C_var];
{$endif}
setmangledname(mangled);
end;
constructor tvarsym.initsym(const n : string;p : ptypesym);
begin
tvarsym.init(n,p^.definition);
definitionsym:=p;
end;
constructor tvarsym.initsym_dll(const n : string;p : ptypesym);
begin
tvarsym.init_dll(n,p^.definition);
definitionsym:=p;
end;
constructor tvarsym.initsym_C(const n,mangled : string;p : ptypesym);
begin
tvarsym.init_C(n,mangled,p^.definition);
definitionsym:=p;
end;
constructor tvarsym.load;
begin
tsym.load;
typ:=varsym;
_mangledname:=nil;
reg:=R_NO;
refs := 0;
varstate:=vs_used;
varspez:=tvarspez(readbyte);
if read_member then
address:=readlong
else
address:=0;
islocalcopy:=false;
localvarsym:=nil;
definition:=readdefref;
definitionsym:=ptypesym(readsymref);
readsmallset(varoptions);
if (vo_is_C_var in varoptions) then
setmangledname(readstring);
end;
destructor tvarsym.done;
begin
strdispose(_mangledname);
inherited done;
end;
procedure tvarsym.deref;
begin
if assigned(definitionsym) then
begin
resolvesym(psym(definitionsym));
definition:=definitionsym^.definition;
end
else
resolvedef(definition);
end;
procedure tvarsym.write;
var
hvo : tvaroptions;
begin
tsym.write;
writebyte(byte(varspez));
if read_member then
writelong(address);
{ write only definition or definitionsym }
if assigned(definitionsym) then
begin
writedefref(nil);
writesymref(definitionsym);
end
else
begin
writedefref(definition);
writesymref(nil);
end;
{ symbols which are load are never candidates for a register,
turn off the regable }
hvo:=varoptions-[vo_regable];
writesmallset(hvo);
if (vo_is_C_var in varoptions) then
writestring(mangledname);
current_ppu^.writeentry(ibvarsym);
end;
procedure tvarsym.setmangledname(const s : string);
begin
_mangledname:=strpnew(s);
end;
function tvarsym.mangledname : string;
var
prefix : string;
begin
if assigned(_mangledname) then
begin
mangledname:=strpas(_mangledname);
exit;
end;
case owner^.symtabletype of
staticsymtable :
if (cs_create_smart in aktmoduleswitches) then
prefix:='_'+owner^.name^+'$$$_'
else
prefix:='_';
unitsymtable,
globalsymtable :
prefix:=
{$ifdef FPC_USE_CPREFIX}
target_os.Cprefix+
{$endif FPC_USE_CPREFIX}
'U_'+owner^.name^+'_';
else
Message(sym_e_invalid_call_tvarsymmangledname);
end;
mangledname:=prefix+name;
end;
function tvarsym.getsize : longint;
begin
if assigned(definition) and (varspez=vs_value) and
((definition^.deftype<>arraydef) or (Parraydef(definition)^.highrange>=
Parraydef(definition)^.lowrange)) then
getsize:=definition^.size
else
getsize:=0;
end;
function tvarsym.getpushsize : longint;
begin
if assigned(definition) then
begin
case varspez of
vs_var :
getpushsize:=target_os.size_of_pointer;
vs_value,
vs_const :
begin
if push_addr_param(definition) then
getpushsize:=target_os.size_of_pointer
else
getpushsize:=definition^.size;
end;
end;
end
else
getpushsize:=0;
end;
function data_align(length : longint) : longint;
begin
(* this is useless under go32v2 at least
because the section are only align to dword
if length>8 then
data_align:=16
else if length>4 then
data_align:=8
else *)
if length>2 then
data_align:=4
else
if length>1 then
data_align:=2
else
data_align:=1;
end;
procedure tvarsym.insert_in_data;
var
varalign,
l,ali,modulo : longint;
storefilepos : tfileposinfo;
begin
if (vo_is_external in varoptions) then
exit;
{ handle static variables of objects especially }
if read_member and (owner^.symtabletype=objectsymtable) and
(sp_static in symoptions) then
begin
{ the data filed is generated in parser.pas
with a tobject_FIELDNAME variable }
{ this symbol can't be loaded to a register }
{$ifdef INCLUDEOK}
exclude(varoptions,vo_regable);
exclude(varoptions,vo_fpuregable);
{$else}
varoptions:=varoptions-[vo_regable,vo_fpuregable];
{$endif}
end
else
if not(read_member) then
begin
{ made problems with parameters etc. ! (FK) }
{ check for instance of an abstract object or class }
{
if (pvarsym(sym)^.definition^.deftype=objectdef) and
((pobjectdef(pvarsym(sym)^.definition)^.options and oo_is_abstract)<>0) then
Message(sym_e_no_instance_of_abstract_object);
}
storefilepos:=aktfilepos;
aktfilepos:=tokenpos;
if (vo_is_thread_var in varoptions) then
l:=4
else
l:=getsize;
case owner^.symtabletype of
stt_exceptsymtable:
{ can contain only one symbol, address calculated later }
;
localsymtable :
begin
varstate:=vs_declared;
modulo:=owner^.datasize and 3;
{$ifdef m68k}
{ word alignment required for motorola }
if (l=1) then
l:=2
else
{$endif}
{
if (cs_optimize in aktglobalswitches) and
(aktoptprocessor in [classp5,classp6]) and
(l>=8) and ((owner^.datasize and 7)<>0) then
inc(owner^.datasize,8-(owner^.datasize and 7))
else
}
begin
if (l>=4) and (modulo<>0) then
inc(l,4-modulo)
else
if (l>=2) and ((modulo and 1)<>0) then
inc(l,2-(modulo and 1));
end;
inc(owner^.datasize,l);
address:=owner^.datasize;
end;
staticsymtable :
begin
{ enable unitialized warning for local symbols }
varstate:=vs_declared;
if (cs_create_smart in aktmoduleswitches) then
bsssegment^.concat(new(pai_cut,init));
ali:=data_align(l);
if ali>1 then
begin
modulo:=owner^.datasize mod ali;
if modulo>0 then
inc(owner^.datasize,ali-modulo);
end;
{$ifdef GDB}
if cs_debuginfo in aktmoduleswitches then
concatstabto(bsssegment);
{$endif GDB}
if (cs_create_smart in aktmoduleswitches) or
DLLSource or
(vo_is_C_var in varoptions) then
bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)))
else
bsssegment^.concat(new(pai_datablock,init(mangledname,l)));
{ increase datasize }
inc(owner^.datasize,l);
{ this symbol can't be loaded to a register }
{$ifdef INCLUDEOK}
exclude(varoptions,vo_regable);
exclude(varoptions,vo_fpuregable);
{$else}
varoptions:=varoptions-[vo_regable,vo_fpuregable];
{$endif}
end;
globalsymtable :
begin
if (cs_create_smart in aktmoduleswitches) then
bsssegment^.concat(new(pai_cut,init));
ali:=data_align(l);
if ali>1 then
begin
modulo:=owner^.datasize mod ali;
if modulo>0 then
inc(owner^.datasize,ali-modulo);
end;
{$ifdef GDB}
if cs_debuginfo in aktmoduleswitches then
concatstabto(bsssegment);
{$endif GDB}
bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)));
inc(owner^.datasize,l);
{ this symbol can't be loaded to a register }
{$ifdef INCLUDEOK}
exclude(varoptions,vo_regable);
exclude(varoptions,vo_fpuregable);
{$else}
varoptions:=varoptions-[vo_regable,vo_fpuregable];
{$endif}
end;
recordsymtable,
objectsymtable :
begin
{ this symbol can't be loaded to a register }
{$ifdef INCLUDEOK}
exclude(varoptions,vo_regable);
exclude(varoptions,vo_fpuregable);
{$else}
varoptions:=varoptions-[vo_regable,vo_fpuregable];
{$endif}
{ get the alignment size }
if (aktpackrecords=packrecord_C) then
begin
varalign:=definition^.alignment;
if varalign=0 then
begin
if (owner^.dataalignment<4) then
begin
if (l>=4) then
owner^.dataalignment:=4
else
if (owner^.dataalignment<2) and (l>=2) then
owner^.dataalignment:=2;
end;
end;
end
else
varalign:=0;
{ align record and object fields }
if (l=1) or (varalign=1) or (owner^.dataalignment=1) then
begin
address:=owner^.datasize;
inc(owner^.datasize,l)
end
else
if (l=2) or (varalign=2) or (owner^.dataalignment=2) then
begin
owner^.datasize:=(owner^.datasize+1) and (not 1);
address:=owner^.datasize;
inc(owner^.datasize,l)
end
else
if (l<=4) or (varalign=4) or (owner^.dataalignment=4) then
begin
owner^.datasize:=(owner^.datasize+3) and (not 3);
address:=owner^.datasize;
inc(owner^.datasize,l);
end
else
if (l<=8) or (owner^.dataalignment=8) then
begin
owner^.datasize:=(owner^.datasize+7) and (not 7);
address:=owner^.datasize;
inc(owner^.datasize,l);
end
else
if (l<=16) or (owner^.dataalignment=16) then
begin
owner^.datasize:=(owner^.datasize+15) and (not 15);
address:=owner^.datasize;
inc(owner^.datasize,l);
end
else
if (l<=32) or (owner^.dataalignment=32) then
begin
owner^.datasize:=(owner^.datasize+31) and (not 31);
address:=owner^.datasize;
inc(owner^.datasize,l);
end;
end;
parasymtable :
begin
{ here we need the size of a push instead of the
size of the data }
l:=getpushsize;
varstate:=vs_assigned;
address:=owner^.datasize;
owner^.datasize:=align(owner^.datasize+l,target_os.stackalignment);
end
else
begin
modulo:=owner^.datasize and 3;
if (l>=4) and (modulo<>0) then
inc(owner^.datasize,4-modulo)
else
if (l>=2) and ((modulo and 1)<>0) then
inc(owner^.datasize);
address:=owner^.datasize;
inc(owner^.datasize,l);
end;
end;
aktfilepos:=storefilepos;
end;
end;
{$ifdef GDB}
function tvarsym.stabstring : pchar;
var
st : string[2];
begin
if (definition^.deftype=objectdef) and
pobjectdef(definition)^.is_class then
st:='*'
else
st:='';
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;
{$ifndef Delphi}
stabstring := strpnew('"'+owner^.name^+'__'+name+':'+st+
+definition^.numberstring+'",'+
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
{$endif}
end
else if (owner^.symtabletype = globalsymtable) or
(owner^.symtabletype = unitsymtable) 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
+definition^.numberstring+'",'+
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
end
else if owner^.symtabletype = staticsymtable then
begin
stabstring := strpnew('"'+name+':S'+st
+definition^.numberstring+'",'+
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
end
else if (owner^.symtabletype=parasymtable) then
begin
case varspez of
vs_var : st := 'v'+st;
vs_value,
vs_const : if push_addr_param(definition) then
st := 'v'+st { should be 'i' but 'i' doesn't work }
else
st := 'p'+st;
end;
stabstring := strpnew('"'+name+':'+st
+definition^.numberstring+'",'+
tostr(N_PSYM)+',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=localsymtable) then
{$ifdef i386}
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
+definition^.numberstring+'",'+
tostr(N_RSYM)+',0,'+
tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
end
else
{$endif i386}
{ I don't know if this will work (PM) }
if (vo_is_C_var in varoptions) then
stabstring := strpnew('"'+name+':S'+st
+definition^.numberstring+'",'+
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
else
stabstring := strpnew('"'+name+':'+st
+definition^.numberstring+'",'+
tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address))
else
stabstring := inherited stabstring;
end;
procedure tvarsym.concatstabto(asmlist : paasmoutput);
{$ifdef i386}
var stab_str : pchar;
{$endif i386}
begin
inherited concatstabto(asmlist);
{$ifdef i386}
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'
+definition^.numberstring+'",'+
tostr(N_RSYM)+',0,'+
tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
asmlist^.concat(new(pai_stabs,init(stab_str)));
end;
{$endif i386}
end;
{$endif GDB}
{****************************************************************************
TTYPEDCONSTSYM
*****************************************************************************}
constructor ttypedconstsym.init(const n : string;p : pdef;really_const : boolean);
begin
tsym.init(n);
typ:=typedconstsym;
definition:=p;
definitionsym:=nil;
is_really_const:=really_const;
prefix:=stringdup(procprefix);
end;
constructor ttypedconstsym.initsym(const n : string;p : ptypesym;really_const : boolean);
begin
ttypedconstsym.init(n,p^.definition,really_const);
definitionsym:=p;
end;
constructor ttypedconstsym.load;
begin
tsym.load;
typ:=typedconstsym;
definition:=readdefref;
definitionsym:=ptypesym(readsymref);
prefix:=stringdup(readstring);
is_really_const:=boolean(readbyte);
end;
destructor ttypedconstsym.done;
begin
stringdispose(prefix);
tsym.done;
end;
function ttypedconstsym.mangledname : string;
begin
mangledname:='TC_'+prefix^+'_'+name;
end;
function ttypedconstsym.getsize : longint;
begin
if assigned(definition) then
getsize:=definition^.size
else
getsize:=0;
end;
procedure ttypedconstsym.deref;
begin
if assigned(definitionsym) then
begin
resolvesym(psym(definitionsym));
definition:=definitionsym^.definition;
end
else
resolvedef(definition);
end;
procedure ttypedconstsym.write;
begin
tsym.write;
{ write only definition or definitionsym }
if assigned(definitionsym) then
begin
writedefref(nil);
writesymref(definitionsym);
end
else
begin
writedefref(definition);
writesymref(nil);
end;
writestring(prefix^);
writebyte(byte(is_really_const));
current_ppu^.writeentry(ibtypedconstsym);
end;
procedure ttypedconstsym.insert_in_data;
var
curconstsegment : paasmoutput;
l,ali,modulo : longint;
storefilepos : tfileposinfo;
begin
storefilepos:=aktfilepos;
aktfilepos:=tokenpos;
if is_really_const then
curconstsegment:=consts
else
curconstsegment:=datasegment;
if (cs_create_smart in aktmoduleswitches) then
curconstsegment^.concat(new(pai_cut,init));
l:=getsize;
ali:=data_align(l);
if ali>1 then
begin
curconstsegment^.concat(new(pai_align,init(ali)));
modulo:=owner^.datasize mod ali;
if modulo>0 then
inc(owner^.datasize,ali-modulo);
end;
{ Why was there no owner size update here ??? }
inc(owner^.datasize,l);
{$ifdef GDB}
if cs_debuginfo in aktmoduleswitches then
concatstabto(curconstsegment);
{$endif GDB}
if owner^.symtabletype=globalsymtable then
begin
curconstsegment^.concat(new(pai_symbol,initname_global(mangledname,getsize)));
end
else
if owner^.symtabletype<>unitsymtable then
begin
if (cs_create_smart in aktmoduleswitches) or
DLLSource then
curconstsegment^.concat(new(pai_symbol,initname_global(mangledname,getsize)))
else
curconstsegment^.concat(new(pai_symbol,initname(mangledname,getsize)));
end;
aktfilepos:=storefilepos;
end;
{$ifdef GDB}
function ttypedconstsym.stabstring : pchar;
var
st : char;
begin
if (cs_gdb_gsym in aktglobalswitches) and (owner^.symtabletype in [unitsymtable,globalsymtable]) then
st := 'G'
else
st := 'S';
stabstring := strpnew('"'+name+':'+st+
definition^.numberstring+'",'+tostr(n_STSYM)+',0,'+
tostr(fileinfo.line)+','+mangledname);
end;
{$endif GDB}
{****************************************************************************
TCONSTSYM
****************************************************************************}
constructor tconstsym.init(const n : string;t : tconsttype;v : longint);
begin
inherited init(n);
typ:=constsym;
consttype:=t;
value:=v;
ResStrIndex:=0;
definition:=nil;
len:=0;
end;
constructor tconstsym.init_def(const n : string;t : tconsttype;v : longint;def : pdef);
begin
inherited init(n);
typ:=constsym;
consttype:=t;
value:=v;
definition:=def;
len:=0;
end;
constructor tconstsym.init_string(const n : string;t : tconsttype;str:pchar;l:longint);
begin
inherited init(n);
typ:=constsym;
consttype:=t;
value:=longint(str);
definition:=nil;
len:=l;
if t=constresourcestring then
ResStrIndex:=registerresourcestring(name,pchar(value),len);
end;
constructor tconstsym.load;
var
pd : pbestreal;
ps : pnormalset;
begin
tsym.load;
typ:=constsym;
consttype:=tconsttype(readbyte);
case consttype of
constint,
constbool,
constchar :
value:=readlong;
constpointer,
constord :
begin
definition:=readdefref;
value:=readlong;
end;
conststring,constresourcestring :
begin
len:=readlong;
getmem(pchar(value),len+1);
current_ppu^.getdata(pchar(value)^,len);
if consttype=constresourcestring then
ResStrIndex:=readlong;
end;
constreal :
begin
new(pd);
pd^:=readreal;
value:=longint(pd);
end;
constset :
begin
definition:=readdefref;
new(ps);
readnormalset(ps^);
value:=longint(ps);
end;
constnil : ;
else
Message1(unit_f_ppu_invalid_entry,tostr(ord(consttype)));
end;
end;
destructor tconstsym.done;
begin
case consttype of
conststring :
freemem(pchar(value),len+1);
constreal :
dispose(pbestreal(value));
constset :
dispose(pnormalset(value));
end;
inherited done;
end;
function tconstsym.mangledname : string;
begin
mangledname:=name;
end;
procedure tconstsym.deref;
begin
if consttype in [constord,constpointer,constset] then
resolvedef(pdef(definition));
end;
procedure tconstsym.write;
begin
tsym.write;
writebyte(byte(consttype));
case consttype of
constnil : ;
constint,
constbool,
constchar :
writelong(value);
constpointer,
constord :
begin
writedefref(definition);
writelong(value);
end;
conststring,constresourcestring :
begin
writelong(len);
current_ppu^.putdata(pchar(value)^,len);
if consttype=constresourcestring then
writelong(ResStrIndex);
end;
constreal :
writereal(pbestreal(value)^);
constset :
begin
writedefref(definition);
writenormalset(pointer(value)^);
end;
else
internalerror(13);
end;
current_ppu^.writeentry(ibconstsym);
end;
{$ifdef GDB}
function tconstsym.stabstring : pchar;
var st : string;
begin
{even GDB v4.16 only now 'i' 'r' and 'e' !!!}
case consttype of
conststring : begin
{ I had to remove ibm2ascii !! }
st := pstring(value)^;
{st := ibm2ascii(pstring(value)^);}
st := 's'''+st+'''';
end;
constbool,
constint,
constpointer,
constord,
constchar : st := 'i'+tostr(value);
constreal : begin
system.str(pbestreal(value)^,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 : paasmoutput);
begin
if consttype <> conststring then
inherited concatstabto(asmlist);
end;
{$endif GDB}
{****************************************************************************
TENUMSYM
****************************************************************************}
constructor tenumsym.init(const n : string;def : penumdef;v : longint);
begin
tsym.init(n);
typ:=enumsym;
definition:=def;
value:=v;
if def^.min>v then
def^.setmin(v);
if def^.max<v then
def^.setmax(v);
order;
end;
constructor tenumsym.load;
begin
tsym.load;
typ:=enumsym;
definition:=penumdef(readdefref);
value:=readlong;
nextenum := Nil;
end;
procedure tenumsym.deref;
begin
resolvedef(pdef(definition));
order;
end;
procedure tenumsym.order;
var
sym : penumsym;
begin
sym := 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.write;
begin
tsym.write;
writedefref(definition);
writelong(value);
current_ppu^.writeentry(ibenumsym);
end;
{$ifdef GDB}
procedure tenumsym.concatstabto(asmlist : paasmoutput);
begin
{enum elements have no stab !}
end;
{$EndIf GDB}
{****************************************************************************
TTYPESYM
****************************************************************************}
constructor ttypesym.init(const n : string;d : pdef);
begin
tsym.init(n);
typ:=typesym;
definition:=d;
{$ifdef GDB}
isusedinstab := false;
{$endif GDB}
if assigned(definition) then
begin
if not(assigned(definition^.sym)) then
begin
definition^.sym:=@self;
synonym:=nil;
{$ifdef INCLUDEOK}
include(symoptions,sp_primary_typesym);
{$else}
symoptions:=symoptions+[sp_primary_typesym];
{$endif}
end
else
begin
synonym:=definition^.sym^.synonym;
definition^.sym^.synonym:=@self;
end;
end;
end;
constructor ttypesym.load;
begin
tsym.load;
typ:=typesym;
synonym:=nil;
{$ifdef GDB}
isusedinstab := false;
{$endif GDB}
definition:=readdefref;
end;
destructor ttypesym.done;
var prevsym : ptypesym;
begin
if assigned(definition) then
begin
prevsym:=definition^.sym;
if prevsym=@self then
definition^.sym:=synonym;
while assigned(prevsym) do
begin
if (prevsym^.synonym=@self) then
begin
prevsym^.synonym:=synonym;
break;
end;
prevsym:=prevsym^.synonym;
end;
end;
synonym:=nil;
definition:=nil;
inherited done;
end;
procedure ttypesym.deref;
begin
resolvedef(definition);
if assigned(definition) then
begin
if (sp_primary_typesym in symoptions) then
begin
if definition^.sym<>@self then
synonym:=definition^.sym;
definition^.sym:=@self;
end
else
begin
if assigned(definition^.sym) then
begin
synonym:=definition^.sym^.synonym;
if definition^.sym<>@self then
definition^.sym^.synonym:=@self;
end
else
definition^.sym:=@self;
end;
if (definition^.deftype=recorddef) and assigned(precorddef(definition)^.symtable) and
(definition^.sym=@self) then
precorddef(definition)^.symtable^.name:=stringdup('record '+name);
end;
end;
procedure ttypesym.write;
begin
tsym.write;
writedefref(definition);
current_ppu^.writeentry(ibtypesym);
end;
procedure ttypesym.load_references;
begin
inherited load_references;
if (definition^.deftype=recorddef) then
precorddef(definition)^.symtable^.load_browser;
if (definition^.deftype=objectdef) then
pobjectdef(definition)^.symtable^.load_browser;
end;
function ttypesym.write_references : boolean;
begin
if not inherited write_references then
{ write address of this symbol if record or object
even if no real refs are there
because we need it for the symtable }
if (definition^.deftype=recorddef) or
(definition^.deftype=objectdef) then
begin
writesymref(@self);
current_ppu^.writeentry(ibsymref);
end;
write_references:=true;
if (definition^.deftype=recorddef) then
precorddef(definition)^.symtable^.write_browser;
if (definition^.deftype=objectdef) then
pobjectdef(definition)^.symtable^.write_browser;
end;
{$ifdef BrowserLog}
procedure ttypesym.add_to_browserlog;
begin
inherited add_to_browserlog;
if (definition^.deftype=recorddef) then
precorddef(definition)^.symtable^.writebrowserlog;
if (definition^.deftype=objectdef) then
pobjectdef(definition)^.symtable^.writebrowserlog;
end;
{$endif BrowserLog}
{$ifdef GDB}
function ttypesym.stabstring : pchar;
var stabchar : string[2];
short : string;
begin
if definition^.deftype in tagtypes then
stabchar := 'Tt'
else
stabchar := 't';
short := '"'+name+':'+stabchar+definition^.numberstring
+'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
stabstring := strpnew(short);
end;
procedure ttypesym.concatstabto(asmlist : paasmoutput);
begin
{not stabs for forward defs }
if assigned(definition) then
if (definition^.sym = @self) then
definition^.concatstabto(asmlist)
else
inherited concatstabto(asmlist);
end;
{$endif GDB}
{****************************************************************************
TSYSSYM
****************************************************************************}
constructor tsyssym.init(const n : string;l : longint);
begin
inherited init(n);
typ:=syssym;
number:=l;
end;
constructor tsyssym.load;
begin
tsym.load;
typ:=syssym;
number:=readlong;
end;
destructor tsyssym.done;
begin
inherited done;
end;
procedure tsyssym.write;
begin
tsym.write;
writelong(number);
current_ppu^.writeentry(ibsyssym);
end;
{$ifdef GDB}
procedure tsyssym.concatstabto(asmlist : paasmoutput);
begin
end;
{$endif GDB}
{****************************************************************************
TMACROSYM
****************************************************************************}
constructor tmacrosym.init(const n : string);
begin
inherited init(n);
typ:=macrosym;
defined:=true;
defined_at_startup:=false;
is_used:=false;
buftext:=nil;
buflen:=0;
end;
destructor tmacrosym.done;
begin
if assigned(buftext) then
freemem(buftext,buflen);
inherited done;
end;
{
$Log$
Revision 1.129 1999-11-21 01:42:37 pierre
* Nextoverloading ordering fix
Revision 1.128 1999/11/20 01:22:20 pierre
+ cond FPC_USE_CPREFIX (needs also some RTL changes)
this allows to use unit global vars as DLL exports
(the underline prefix seems needed by dlltool)
Revision 1.127 1999/11/17 17:05:04 pierre
* Notes/hints changes
Revision 1.126 1999/11/15 22:00:48 peter
* labels used but not defined give error instead of warning, the warning
is now only with declared but not defined and not used.
Revision 1.125 1999/11/08 14:02:17 florian
* problem with "index X"-properties solved
* typed constants of class references are now allowed
Revision 1.124 1999/11/06 14:34:27 peter
* truncated log to 20 revs
Revision 1.123 1999/11/05 17:18:03 pierre
* local browsing works at first level
ie for function defined in interface or implementation
not yet for functions inside other functions
Revision 1.122 1999/10/21 16:41:41 florian
* problems with readln fixed: esi wasn't restored correctly when
reading ordinal fields of objects futher the register allocation
didn't take care of the extra register when reading ordinal values
* enumerations can now be used in constant indexes of properties
Revision 1.121 1999/10/01 08:02:48 peter
* forward type declaration rewritten
Revision 1.120 1999/09/27 23:44:58 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.119 1999/09/26 21:30:22 peter
+ constant pointer support which can happend with typecasting like
const p=pointer(1)
* better procvar parsing in typed consts
Revision 1.118 1999/09/20 16:39:03 peter
* cs_create_smart instead of cs_smartlink
* -CX is create smartlink
* -CD is create dynamic, but does nothing atm.
Revision 1.117 1999/08/31 15:42:24 pierre
+ tmacrosym is_used and defined_at_startup boolean fields added
Revision 1.116 1999/08/24 22:38:55 michael
* more resourcestring changes
Revision 1.115 1999/08/23 11:45:42 michael
* Hopefully final attempt at resourcestrings
Revision 1.114 1999/08/15 21:57:58 michael
Changes for resource strings
Revision 1.113 1999/08/14 00:39:00 peter
* hack to support property with record fields
Revision 1.112 1999/08/13 14:24:20 pierre
+ stabs for classes and classref working,
a class still needs an ^ to get that content of it,
but the class fields inside a class don't result into an
infinite loop anymore!
Revision 1.111 1999/08/10 12:36:31 pierre
* use of procsym field for correct gdb info in local procedures
* exported DLL vars made global to be able to use DLLTOOL with themz
Revision 1.110 1999/08/07 14:21:03 florian
* some small problems fixed
Revision 1.109 1999/08/07 13:24:34 daniel
* Fixed open arrays
Revision 1.108 1999/08/05 16:53:17 peter
* V_Fatal=1, all other V_ are also increased
* Check for local procedure when assigning procvar
* fixed comment parsing because directives
* oldtp mode directives better supported
* added some messages to errore.msg
Revision 1.107 1999/08/04 13:45:30 florian
+ floating point register variables !!
* pairegalloc is now generated for register variables
Revision 1.106 1999/08/03 22:03:19 peter
* moved bitmask constants to sets
* some other type/const renamings
Revision 1.105 1999/07/29 20:54:10 peter
* write .size also
Revision 1.104 1999/07/27 23:42:21 peter
* indirect type referencing is now allowed
}