mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-02 17:53:42 +02:00
1760 lines
51 KiB
PHP
1760 lines
51 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
|
|
left:=nil;
|
|
right:=nil;
|
|
setname(n);
|
|
typ:=abstractsym;
|
|
properties:=current_object_option;
|
|
{$ifdef GDB}
|
|
isstabwritten := false;
|
|
{$endif GDB}
|
|
fileinfo:=aktfilepos;
|
|
{$ifdef UseBrowser}
|
|
defref:=nil;
|
|
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;
|
|
{$endif UseBrowser}
|
|
end;
|
|
|
|
constructor tsym.load;
|
|
|
|
begin
|
|
left:=nil;
|
|
right:=nil;
|
|
setname(readstring);
|
|
typ:=abstractsym;
|
|
fillchar(fileinfo,sizeof(fileinfo),0);
|
|
if object_options then
|
|
properties:=symprop(readbyte)
|
|
else
|
|
properties:=sp_public;
|
|
{$ifdef UseBrowser}
|
|
lastref:=nil;
|
|
defref:=nil;
|
|
lastwritten:=nil;
|
|
refcount:=0;
|
|
{$endif UseBrowser}
|
|
{$ifdef GDB}
|
|
isstabwritten := false;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
{$ifdef UseBrowser}
|
|
|
|
{$ifndef OLDPPU}
|
|
|
|
procedure tsym.load_references;
|
|
var
|
|
pos : tfileposinfo;
|
|
begin
|
|
while (not current_ppu^.endofentry) do
|
|
begin
|
|
readposinfo(pos);
|
|
inc(refcount);
|
|
lastref:=new(pref,init(lastref,@pos));
|
|
if refcount=1 then
|
|
defref:=lastref;
|
|
end;
|
|
lastwritten:=lastref;
|
|
end;
|
|
|
|
procedure tsym.write_references;
|
|
var
|
|
ref : pref;
|
|
prdef : pdef;
|
|
begin
|
|
if lastwritten=lastref then
|
|
exit;
|
|
{ write address to this symbol }
|
|
writesymref(@self);
|
|
{ write symbol refs }
|
|
if assigned(lastwritten) then
|
|
ref:=lastwritten
|
|
else
|
|
ref:=defref;
|
|
while assigned(ref) do
|
|
begin
|
|
writeposinfo(ref^.posinfo);
|
|
ref:=ref^.nextref;
|
|
end;
|
|
lastwritten:=lastref;
|
|
current_ppu^.writeentry(ibsymref);
|
|
{ when it's a procsym then write also the refs to the definition
|
|
due the overloading }
|
|
if typ=procsym then
|
|
begin
|
|
prdef:=pprocsym(@self)^.definition;
|
|
while assigned(prdef) do
|
|
begin
|
|
pprocdef(prdef)^.write_references;
|
|
prdef:=pprocdef(prdef)^.nextoverloaded;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$else OLDPPU}
|
|
|
|
procedure tsym.load_references;
|
|
|
|
var fileindex : word;
|
|
b : byte;
|
|
l,c : longint;
|
|
|
|
begin
|
|
b:=readbyte;
|
|
while b=ibref do
|
|
begin
|
|
fileindex:=readword;
|
|
l:=readlong;
|
|
c:=readword;
|
|
inc(refcount);
|
|
lastref:=new(pref,load(lastref,fileindex,l,c));
|
|
if refcount=1 then defref:=lastref;
|
|
b:=readbyte;
|
|
end;
|
|
lastwritten:=lastref;
|
|
if b <> ibend then
|
|
Message(unit_f_ppu_read_error);
|
|
end;
|
|
|
|
procedure tsym.write_references;
|
|
|
|
var ref : pref;
|
|
|
|
begin
|
|
{ references do not change the ppu caracteristics }
|
|
{ this only save the references to variables/functions }
|
|
{ defined in the unit what about the others }
|
|
ppufile.do_crc:=false;
|
|
if assigned(lastwritten) then
|
|
ref:=lastwritten
|
|
else
|
|
ref:=defref;
|
|
while assigned(ref) do
|
|
begin
|
|
writebyte(ibref);
|
|
writeword(ref^.posinfo.fileindex);
|
|
writelong(ref^.posinfo.line);
|
|
writeword(ref^.posinfo.column);
|
|
ref:=ref^.nextref;
|
|
end;
|
|
lastwritten:=lastref;
|
|
writebyte(ibend);
|
|
ppufile.do_crc:=true;
|
|
end;
|
|
|
|
|
|
procedure tsym.write_external_references;
|
|
var ref : pref;
|
|
prdef : pdef;
|
|
begin
|
|
ppufile.do_crc:=false;
|
|
if lastwritten=lastref then
|
|
exit;
|
|
writebyte(ibextsymref);
|
|
writesymref(@self);
|
|
if assigned(lastwritten) then
|
|
ref:=lastwritten
|
|
else
|
|
ref:=defref;
|
|
while assigned(ref) do
|
|
begin
|
|
writebyte(ibref);
|
|
writeword(ref^.posinfo.fileindex);
|
|
writelong(ref^.posinfo.line);
|
|
writeword(ref^.posinfo.column);
|
|
ref:=ref^.nextref;
|
|
end;
|
|
lastwritten:=lastref;
|
|
writebyte(ibend);
|
|
if typ=procsym then
|
|
begin
|
|
prdef:=pprocsym(@self)^.definition;
|
|
while assigned(prdef) do
|
|
begin
|
|
pprocdef(prdef)^.write_external_references;
|
|
prdef:=pprocdef(prdef)^.nextoverloaded;
|
|
end;
|
|
end;
|
|
ppufile.do_crc:=true;
|
|
end;
|
|
|
|
{$endif OLDPPU}
|
|
|
|
procedure tsym.add_to_browserlog;
|
|
var
|
|
prdef : pprocdef;
|
|
begin
|
|
if assigned(defref) then
|
|
begin
|
|
Browse.AddLog('***'+name+'***');
|
|
Browse.AddLogRefs(defref);
|
|
end;
|
|
{ when it's a procsym then write also the refs to the definition
|
|
due the overloading }
|
|
if typ=procsym then
|
|
begin
|
|
prdef:=pprocsym(@self)^.definition;
|
|
while assigned(prdef) do
|
|
begin
|
|
pprocdef(prdef)^.add_to_browserlog;
|
|
prdef:=pprocdef(prdef)^.nextoverloaded;
|
|
end;
|
|
end;
|
|
end;
|
|
{$endif UseBrowser}
|
|
|
|
|
|
destructor tsym.done;
|
|
begin
|
|
{$ifdef tp}
|
|
if not(use_big) then
|
|
{$endif tp}
|
|
strdispose(_name);
|
|
{$ifdef UseBrowser}
|
|
if assigned(defref) then
|
|
dispose(defref,done);
|
|
{$endif UseBrowser}
|
|
if assigned(left) then
|
|
dispose(left,done);
|
|
if assigned(right) then
|
|
dispose(right,done);
|
|
end;
|
|
|
|
|
|
destructor tsym.single_done;
|
|
begin
|
|
{$ifdef tp}
|
|
if not(use_big) then
|
|
{$endif tp}
|
|
strdispose(_name);
|
|
end;
|
|
|
|
procedure tsym.write;
|
|
|
|
begin
|
|
writestring(name);
|
|
if object_options then
|
|
writebyte(byte(properties));
|
|
{$ifdef UseBrowser}
|
|
{ if cs_browser in aktmoduleswitches then
|
|
write_references; }
|
|
{$endif UseBrowser}
|
|
end;
|
|
|
|
procedure tsym.deref;
|
|
|
|
begin
|
|
end;
|
|
|
|
function tsym.name : string;
|
|
{$ifdef tp}
|
|
var
|
|
s : string;
|
|
b : byte;
|
|
{$endif}
|
|
begin
|
|
{$ifdef tp}
|
|
if use_big then
|
|
begin
|
|
symbolstream.seek(longint(_name));
|
|
symbolstream.read(b,1);
|
|
symbolstream.read(s[1],b);
|
|
s[0]:=chr(b);
|
|
name:=s;
|
|
end
|
|
else
|
|
{$endif}
|
|
if assigned(_name) then
|
|
name:=strpas(_name)
|
|
else
|
|
name:='';
|
|
end;
|
|
|
|
function tsym.mangledname : string;
|
|
begin
|
|
mangledname:=name;
|
|
end;
|
|
|
|
procedure tsym.setname(const s : string);
|
|
begin
|
|
setstring(_name,s);
|
|
end;
|
|
|
|
{ for most symbol types ther 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;
|
|
if asmlist = debuglist then do_count_dbx := true;
|
|
{ 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 : plabel);
|
|
|
|
begin
|
|
inherited init(n);
|
|
typ:=labelsym;
|
|
number:=l;
|
|
number^.is_used:=false;
|
|
number^.is_set:=true;
|
|
number^.refcount:=0;
|
|
defined:=false;
|
|
end;
|
|
|
|
destructor tlabelsym.done;
|
|
|
|
begin
|
|
if not(defined) then
|
|
Message1(sym_e_label_not_defined,name);
|
|
inherited done;
|
|
end;
|
|
|
|
function tlabelsym.mangledname : string;
|
|
|
|
begin
|
|
{ this also sets the is_used field }
|
|
mangledname:=lab2str(number);
|
|
end;
|
|
|
|
procedure tlabelsym.write;
|
|
|
|
begin
|
|
Message(sym_e_ill_label_decl);
|
|
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;
|
|
|
|
destructor tunitsym.done;
|
|
begin
|
|
if assigned(unitsymtable) and (unitsymtable^.unitsym=@self) then
|
|
unitsymtable^.unitsym:=prevsym;
|
|
inherited done;
|
|
end;
|
|
|
|
procedure tunitsym.write;
|
|
begin
|
|
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
|
|
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.check_forward;
|
|
|
|
var
|
|
pd : pprocdef;
|
|
oldaktfilepos : tfileposinfo;
|
|
begin
|
|
pd:=definition;
|
|
while assigned(pd) do
|
|
begin
|
|
if pd^.forwarddef then
|
|
begin
|
|
oldaktfilepos:=aktfilepos;
|
|
aktfilepos:=fileinfo;
|
|
if assigned(pd^._class) then
|
|
Message1(sym_e_forward_not_resolved,pd^._class^.name^+'.'+name+demangledparas(pd^.demangled_paras))
|
|
else
|
|
Message1(sym_e_forward_not_resolved,name+pd^.demangled_paras);
|
|
aktfilepos:=oldaktfilepos;
|
|
end;
|
|
pd:=pd^.nextoverloaded;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tprocsym.deref;
|
|
var t : ttoken;
|
|
last : pprocdef;
|
|
begin
|
|
resolvedef(pdef(definition));
|
|
if (definition^.options and pooperator) <> 0 then
|
|
begin
|
|
last:=definition;
|
|
while assigned(last^.nextoverloaded) do
|
|
last:=last^.nextoverloaded;
|
|
for t:=PLUS 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.write;
|
|
begin
|
|
{$ifdef OLDPPU}
|
|
writebyte(ibprocsym);
|
|
{$endif}
|
|
tsym.write;
|
|
writedefref(pdef(definition));
|
|
{$ifndef OLDPPU}
|
|
current_ppu^.writeentry(ibprocsym);
|
|
{$endif}
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
function tprocsym.stabstring : pchar;
|
|
Var RetType : Char;
|
|
Obj,Info : String;
|
|
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;
|
|
if (owner^.symtabletype=localsymtable) and assigned(owner^.name) then
|
|
info := ','+name+','+owner^.name^;
|
|
end;
|
|
stabstring :=strpnew('"'+obj+':'+RetType
|
|
+definition^.retdef^.numberstring+info+'",'+tostr(n_function)
|
|
+',0,'+
|
|
tostr(aktfilepos.line)
|
|
+','+definition^.mangledname);
|
|
end;
|
|
|
|
procedure tprocsym.concatstabto(asmlist : paasmoutput);
|
|
begin
|
|
if (definition^.options and pointernproc) <> 0 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;
|
|
options:=0;
|
|
proptype:=nil;
|
|
readaccessdef:=nil;
|
|
writeaccessdef:=nil;
|
|
readaccesssym:=nil;
|
|
writeaccesssym:=nil;
|
|
index:=$0;
|
|
end;
|
|
|
|
destructor tpropertysym.done;
|
|
|
|
begin
|
|
inherited done;
|
|
end;
|
|
|
|
constructor tpropertysym.load;
|
|
|
|
begin
|
|
inherited load;
|
|
typ:=propertysym;
|
|
proptype:=readdefref;
|
|
options:=readlong;
|
|
index:=readlong;
|
|
{ it's hack ... }
|
|
readaccesssym:=psym(stringdup(readstring));
|
|
writeaccesssym:=psym(stringdup(readstring));
|
|
{ now the defs: }
|
|
readaccessdef:=readdefref;
|
|
writeaccessdef:=readdefref;
|
|
end;
|
|
|
|
procedure tpropertysym.deref;
|
|
|
|
begin
|
|
resolvedef(proptype);
|
|
resolvedef(readaccessdef);
|
|
resolvedef(writeaccessdef);
|
|
{ solve the hack we did in load: }
|
|
if pstring(readaccesssym)^<>'' then
|
|
begin
|
|
srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(readaccesssym)^);
|
|
if not(assigned(srsym)) then
|
|
srsym:=generrorsym;
|
|
end
|
|
else
|
|
srsym:=nil;
|
|
stringdispose(pstring(readaccesssym));
|
|
readaccesssym:=srsym;
|
|
if pstring(writeaccesssym)^<>'' then
|
|
begin
|
|
srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(writeaccesssym)^);
|
|
if not(assigned(srsym)) then
|
|
srsym:=generrorsym;
|
|
end
|
|
else
|
|
srsym:=nil;
|
|
stringdispose(pstring(writeaccesssym));
|
|
writeaccesssym:=srsym;
|
|
end;
|
|
|
|
function tpropertysym.getsize : longint;
|
|
|
|
begin
|
|
getsize:=0;
|
|
end;
|
|
|
|
procedure tpropertysym.write;
|
|
|
|
begin
|
|
{$ifdef OLDPPU}
|
|
writebyte(ibpropertysym);
|
|
{$endif}
|
|
tsym.write;
|
|
writedefref(proptype);
|
|
writelong(options);
|
|
writelong(index);
|
|
if assigned(readaccesssym) then
|
|
writestring(readaccesssym^.name)
|
|
else
|
|
writestring('');
|
|
if assigned(writeaccesssym) then
|
|
writestring(writeaccesssym^.name)
|
|
else
|
|
writestring('');
|
|
writedefref(readaccessdef);
|
|
writedefref(writeaccessdef);
|
|
{$ifndef OLDPPU}
|
|
current_ppu^.writeentry(ibpropertysym);
|
|
{$endif}
|
|
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
|
|
****************************************************************************}
|
|
|
|
{$ifdef TEST_FUNCRET}
|
|
constructor tfuncretsym.init(const n : string;approcinfo : pointer{pprocinfo});
|
|
|
|
begin
|
|
tsym.init(n);
|
|
funcretprocinfo:=approcinfo;
|
|
funcretdef:=pprocinfo(approcinfo)^.retdef;
|
|
{ address valid for ret in param only }
|
|
{ otherwise set by insert }
|
|
address:=pprocinfo(approcinfo)^.retoffset;
|
|
end;
|
|
{$endif TEST_FUNCRET}
|
|
|
|
{****************************************************************************
|
|
TABSOLUTESYM
|
|
****************************************************************************}
|
|
|
|
{ constructor tabsolutesym.init(const s : string;p : pdef;newref : psym);
|
|
begin
|
|
inherited init(s,p);
|
|
ref:=newref;
|
|
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 : address:=readlong;
|
|
end;
|
|
end;
|
|
|
|
procedure tabsolutesym.write;
|
|
|
|
begin
|
|
{$ifdef OLDPPU}
|
|
writebyte(ibabsolutesym);
|
|
{$endif}
|
|
tsym.write;
|
|
writebyte(byte(varspez));
|
|
if read_member then
|
|
writelong(address);
|
|
writedefref(definition);
|
|
writebyte(byte(abstyp));
|
|
case abstyp of
|
|
tovar : writestring(ref^.name);
|
|
toasm : writestring(asmname^);
|
|
toaddr : writelong(address);
|
|
end;
|
|
{$ifndef OLDPPU}
|
|
current_ppu^.writeentry(ibabsolutesym);
|
|
{$endif}
|
|
end;
|
|
|
|
procedure tabsolutesym.deref;
|
|
begin
|
|
resolvedef(definition);
|
|
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;
|
|
_mangledname:=nil;
|
|
varspez:=vs_value;
|
|
address:=0;
|
|
refs:=0;
|
|
is_valid := 1;
|
|
var_options:=0;
|
|
{ can we load the value into a register ? }
|
|
case p^.deftype of
|
|
pointerdef,
|
|
enumdef,
|
|
procvardef : var_options:=var_options or vo_regable;
|
|
orddef : case porddef(p)^.typ of
|
|
u8bit,u16bit,u32bit,
|
|
bool8bit,bool16bit,bool32bit,
|
|
s8bit,s16bit,s32bit :
|
|
var_options:=var_options or vo_regable;
|
|
else
|
|
var_options:=var_options and not vo_regable;
|
|
end;
|
|
else
|
|
var_options:=var_options and not vo_regable;
|
|
end;
|
|
reg:=R_NO;
|
|
end;
|
|
|
|
constructor tvarsym.load;
|
|
|
|
begin
|
|
tsym.load;
|
|
typ:=varsym;
|
|
_mangledname:=nil;
|
|
varspez:=tvarspez(readbyte);
|
|
if read_member then
|
|
address:=readlong
|
|
else
|
|
address:=0;
|
|
definition:=readdefref;
|
|
refs := 0;
|
|
is_valid := 1;
|
|
{ symbols which are load are never candidates for a register }
|
|
var_options:=0;
|
|
{ was regable:=false; }
|
|
reg:=R_NO;
|
|
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);
|
|
var_options:=var_options or vo_is_C_var;
|
|
_mangledname:=strpnew(target_os.Cprefix+mangled);
|
|
end;
|
|
|
|
constructor tvarsym.load_C;
|
|
|
|
begin
|
|
{ Adding tvarsym removes the warning }
|
|
tvarsym.load;
|
|
typ:=varsym;
|
|
var_options:=readbyte;
|
|
_mangledname:=strpnew(readstring);
|
|
end;
|
|
|
|
procedure tvarsym.deref;
|
|
|
|
begin
|
|
resolvedef(definition);
|
|
end;
|
|
|
|
procedure tvarsym.write;
|
|
|
|
begin
|
|
{$ifdef OLDPPU}
|
|
if (var_options and vo_is_C_var)<>0 then
|
|
writebyte(ibvarsym_C)
|
|
else
|
|
writebyte(ibvarsym);
|
|
{$endif}
|
|
tsym.write;
|
|
writebyte(byte(varspez));
|
|
|
|
if read_member then
|
|
writelong(address);
|
|
|
|
writedefref(definition);
|
|
if (var_options and vo_is_C_var)<>0 then
|
|
begin
|
|
writebyte(var_options);
|
|
writestring(mangledname);
|
|
end;
|
|
{$ifndef OLDPPU}
|
|
if (var_options and vo_is_C_var)<>0 then
|
|
current_ppu^.writeentry(ibvarsym_C)
|
|
else
|
|
current_ppu^.writeentry(ibvarsym);
|
|
{$endif}
|
|
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_smartlink in aktmoduleswitches) then
|
|
prefix:='_'+owner^.name^+'$$$_'
|
|
else
|
|
prefix:='_';
|
|
unitsymtable,
|
|
globalsymtable : prefix:='U_'+owner^.name^+'_';
|
|
else
|
|
Message(sym_e_invalid_call_tvarsymmangledname);
|
|
end;
|
|
mangledname:=prefix+name;
|
|
end;
|
|
|
|
function tvarsym.getsize : longint;
|
|
begin
|
|
{ only if the definition is set, we could determine the }
|
|
{ size, this is if an error occurs while reading the type }
|
|
{ also used for operator, this allows not to allocate the }
|
|
{ return size twice }
|
|
if assigned(definition) then
|
|
begin
|
|
case varspez of
|
|
vs_value : getsize:=definition^.size;
|
|
vs_var : getsize:=sizeof(pointer);
|
|
vs_const : begin
|
|
if (definition^.deftype in [stringdef,arraydef,
|
|
recorddef,objectdef,setdef]) then
|
|
getsize:=sizeof(pointer)
|
|
else
|
|
getsize:=definition^.size;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
getsize:=0;
|
|
end;
|
|
|
|
procedure tvarsym.insert_in_data;
|
|
var
|
|
l,modulo : longint;
|
|
begin
|
|
if (var_options and vo_is_external)<>0 then
|
|
exit;
|
|
{ handle static variables of objects especially }
|
|
if read_member and (owner^.symtabletype=objectsymtable) and
|
|
((properties and sp_static)<>0) then
|
|
begin
|
|
{ the data filed is generated in parser.pas
|
|
with a tobject_FIELDNAME variable }
|
|
{ this symbol can't be loaded to a register }
|
|
var_options:=var_options and not vo_regable;
|
|
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 oois_abstract)<>0) then
|
|
Message(sym_e_no_instance_of_abstract_object);
|
|
}
|
|
|
|
l:=getsize;
|
|
case owner^.symtabletype of
|
|
|
|
stt_exceptsymtable:
|
|
{ can contain only one symbol, address calculated later }
|
|
;
|
|
localsymtable : begin
|
|
is_valid := 0;
|
|
modulo:=owner^.datasize and 3;
|
|
{$ifdef m68k}
|
|
{ word alignment required for motorola }
|
|
if (l=1) then
|
|
l:=2
|
|
else
|
|
{$endif}
|
|
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));
|
|
inc(owner^.datasize,l);
|
|
address:=owner^.datasize;
|
|
end;
|
|
staticsymtable : begin
|
|
if (cs_smartlink in aktmoduleswitches) then
|
|
bsssegment^.concat(new(pai_cut,init));
|
|
{$ifdef GDB}
|
|
if cs_debuginfo in aktmoduleswitches then
|
|
concatstabto(bsssegment);
|
|
{$endif GDB}
|
|
if (cs_smartlink in aktmoduleswitches) or
|
|
((var_options and vo_is_c_var)<>0) 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 }
|
|
var_options:=var_options and not vo_regable;
|
|
end;
|
|
globalsymtable : begin
|
|
if (cs_smartlink in aktmoduleswitches) then
|
|
bsssegment^.concat(new(pai_cut,init));
|
|
{$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 }
|
|
var_options:=var_options and not vo_regable;
|
|
end;
|
|
recordsymtable,
|
|
objectsymtable : begin
|
|
{ this symbol can't be loaded to a register }
|
|
var_options:=var_options and not vo_regable;
|
|
{ align record and object fields }
|
|
if (l=1) or (aktpackrecords=1) then
|
|
begin
|
|
address:=owner^.datasize;
|
|
inc(owner^.datasize,l)
|
|
end
|
|
else
|
|
if (l=2) or (aktpackrecords=2) then
|
|
begin
|
|
owner^.datasize:=(owner^.datasize+1) and (not 1);
|
|
address:=owner^.datasize;
|
|
inc(owner^.datasize,l)
|
|
end
|
|
else
|
|
if (l<=4) or (aktpackrecords=4) then
|
|
begin
|
|
owner^.datasize:=(owner^.datasize+3) and (not 3);
|
|
address:=owner^.datasize;
|
|
inc(owner^.datasize,l);
|
|
end
|
|
else
|
|
if (l<=16) or (aktpackrecords=16) then
|
|
begin
|
|
owner^.datasize:=(owner^.datasize+15) and (not 15);
|
|
address:=owner^.datasize;
|
|
inc(owner^.datasize,l);
|
|
end;
|
|
end;
|
|
parasymtable : begin
|
|
address:=owner^.datasize;
|
|
{ needs word alignment }
|
|
if odd(l) then
|
|
inc(owner^.datasize,l+1)
|
|
else
|
|
inc(owner^.datasize,l);
|
|
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
|
|
{ nice piece of code !!
|
|
inc(owner^.datasize,2-(datasize and 1));
|
|
2 - (datasize and 1) is allways 1 in this case
|
|
Florian when will your global stream analyser
|
|
find this out ?? }
|
|
inc(owner^.datasize);
|
|
address:=owner^.datasize;
|
|
inc(owner^.datasize,l);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
function tvarsym.stabstring : pchar;
|
|
var
|
|
st : char;
|
|
begin
|
|
if (owner^.symtabletype = objectsymtable) and
|
|
((properties and sp_static)<>0) then
|
|
begin
|
|
if use_gsym then st := 'G' else st := 'S';
|
|
stabstring := strpnew('"'+owner^.name^+'__'+name+':'+
|
|
+definition^.numberstring+'",'+
|
|
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
|
|
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 use_gsym then st := 'G' else st := 'S';
|
|
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'
|
|
+definition^.numberstring+'",'+
|
|
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
|
|
end
|
|
else if (owner^.symtabletype=parasymtable) then
|
|
begin
|
|
case varspez of
|
|
vs_value : st := 'p';
|
|
vs_var : st := 'v';
|
|
vs_const : if dont_copy_const_param(definition) then
|
|
st := 'v'{ should be 'i' but 'i' doesn't work }
|
|
else
|
|
st := 'p';
|
|
end;
|
|
stabstring := strpnew('"'+name+':'+st
|
|
+definition^.numberstring+'",'+
|
|
tostr(N_PSYM)+',0,'+tostr(fileinfo.line)+','+
|
|
tostr(address+owner^.call_offset));
|
|
{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'
|
|
+definition^.numberstring+'",'+
|
|
tostr(N_RSYM)+',0,'+
|
|
tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
|
|
end
|
|
else
|
|
{$endif i386}
|
|
stabstring := strpnew('"'+name+':'
|
|
+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}
|
|
|
|
destructor tvarsym.done;
|
|
|
|
begin
|
|
strdispose(_mangledname);
|
|
inherited done;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TTYPEDCONSTSYM
|
|
*****************************************************************************}
|
|
|
|
constructor ttypedconstsym.init(const n : string;p : pdef);
|
|
|
|
begin
|
|
tsym.init(n);
|
|
typ:=typedconstsym;
|
|
definition:=p;
|
|
prefix:=stringdup(procprefix);
|
|
end;
|
|
|
|
constructor ttypedconstsym.load;
|
|
|
|
begin
|
|
tsym.load;
|
|
typ:=typedconstsym;
|
|
definition:=readdefref;
|
|
prefix:=stringdup(readstring);
|
|
end;
|
|
|
|
destructor ttypedconstsym.done;
|
|
|
|
begin
|
|
stringdispose(prefix);
|
|
tsym.done;
|
|
end;
|
|
|
|
function ttypedconstsym.mangledname : string;
|
|
|
|
begin
|
|
mangledname:='TC_'+prefix^+'_'+name;
|
|
end;
|
|
|
|
procedure ttypedconstsym.deref;
|
|
|
|
begin
|
|
resolvedef(definition);
|
|
end;
|
|
|
|
procedure ttypedconstsym.write;
|
|
|
|
begin
|
|
{$ifdef OLDPPU}
|
|
writebyte(ibtypedconstsym);
|
|
{$endif}
|
|
tsym.write;
|
|
writedefref(definition);
|
|
writestring(prefix^);
|
|
{$ifndef OLDPPU}
|
|
current_ppu^.writeentry(ibtypedconstsym);
|
|
{$endif}
|
|
end;
|
|
|
|
{ for most symbol types ther is nothing to do at all }
|
|
procedure ttypedconstsym.insert_in_data;
|
|
|
|
begin
|
|
{ here there is a problem for ansistrings !! }
|
|
{ we must write the label only after the 12 header bytes (PM)
|
|
if not is_ansistring(definition) then
|
|
}
|
|
{ solved, the ansis string is moved to consts (FK) }
|
|
really_insert_in_data;
|
|
end;
|
|
|
|
procedure ttypedconstsym.really_insert_in_data;
|
|
begin
|
|
if owner^.symtabletype=globalsymtable then
|
|
begin
|
|
if (cs_smartlink in aktmoduleswitches) then
|
|
datasegment^.concat(new(pai_cut,init));
|
|
{$ifdef GDB}
|
|
if cs_debuginfo in aktmoduleswitches then
|
|
concatstabto(datasegment);
|
|
{$endif GDB}
|
|
datasegment^.concat(new(pai_symbol,init_global(mangledname)));
|
|
end
|
|
else
|
|
if owner^.symtabletype<>unitsymtable then
|
|
begin
|
|
if (cs_smartlink in aktmoduleswitches) then
|
|
datasegment^.concat(new(pai_cut,init));
|
|
{$ifdef GDB}
|
|
if cs_debuginfo in aktmoduleswitches then
|
|
concatstabto(datasegment);
|
|
{$endif GDB}
|
|
if (cs_smartlink in aktmoduleswitches) then
|
|
datasegment^.concat(new(pai_symbol,init_global(mangledname)))
|
|
else
|
|
datasegment^.concat(new(pai_symbol,init(mangledname)));
|
|
end;
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
function ttypedconstsym.stabstring : pchar;
|
|
var
|
|
st : char;
|
|
begin
|
|
if use_gsym 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;def : pdef);
|
|
|
|
begin
|
|
tsym.init(n);
|
|
typ:=constsym;
|
|
definition:=def;
|
|
consttype:=t;
|
|
value:=v;
|
|
end;
|
|
|
|
constructor tconstsym.load;
|
|
|
|
var
|
|
pd : pdouble;
|
|
ps : pointer; {***SETCONST}
|
|
|
|
begin
|
|
tsym.load;
|
|
typ:=constsym;
|
|
consttype:=tconsttype(readbyte);
|
|
case consttype of
|
|
constint,
|
|
constbool,
|
|
constchar : value:=readlong;
|
|
constord : begin
|
|
definition:=readdefref;
|
|
value:=readlong;
|
|
end;
|
|
conststring : value:=longint(stringdup(readstring));
|
|
constreal : begin
|
|
new(pd);
|
|
pd^:=readdouble;
|
|
value:=longint(pd);
|
|
end;
|
|
{***SETCONST}
|
|
constseta : begin
|
|
getmem(ps,32);
|
|
readset(ps^);
|
|
value:=longint(ps);
|
|
end;
|
|
{***}
|
|
else Message1(unit_f_ppu_invalid_entry,tostr(ord(consttype)));
|
|
end;
|
|
end;
|
|
|
|
destructor tconstsym.done;
|
|
begin
|
|
if consttype = conststring then stringdispose(pstring(value));
|
|
inherited done;
|
|
end;
|
|
|
|
function tconstsym.mangledname : string;
|
|
|
|
begin
|
|
mangledname:=name;
|
|
end;
|
|
|
|
procedure tconstsym.deref;
|
|
|
|
begin
|
|
if consttype=constord then
|
|
resolvedef(pdef(definition));
|
|
end;
|
|
|
|
procedure tconstsym.write;
|
|
|
|
begin
|
|
{$ifdef OLDPPU}
|
|
writebyte(ibconstsym);
|
|
{$endif}
|
|
tsym.write;
|
|
writebyte(byte(consttype));
|
|
case consttype of
|
|
constint,
|
|
constbool,
|
|
constchar : writelong(value);
|
|
constord : begin
|
|
writedefref(definition);
|
|
writelong(value);
|
|
end;
|
|
conststring : writestring(pstring(value)^);
|
|
constreal : writedouble(pdouble(value)^);
|
|
{***SETCONST}
|
|
constseta: writeset(pointer(value)^);
|
|
{***}
|
|
else internalerror(13);
|
|
end;
|
|
{$ifndef OLDPPU}
|
|
current_ppu^.writeentry(ibconstsym);
|
|
{$endif}
|
|
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, constord, constchar : st := 'i'+tostr(value);
|
|
constreal : begin
|
|
system.str(pdouble(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;
|
|
{$ifdef GDB}
|
|
order;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
constructor tenumsym.load;
|
|
|
|
begin
|
|
tsym.load;
|
|
typ:=enumsym;
|
|
definition:=penumdef(readdefref);
|
|
value:=readlong;
|
|
{$ifdef GDB}
|
|
next := Nil;
|
|
{$endif GDB}
|
|
end;
|
|
|
|
procedure tenumsym.deref;
|
|
|
|
begin
|
|
resolvedef(pdef(definition));
|
|
{$ifdef GDB}
|
|
order;
|
|
{$endif}
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
procedure tenumsym.order;
|
|
var sym : penumsym;
|
|
begin
|
|
sym := definition^.first;
|
|
if sym = nil then
|
|
begin
|
|
definition^.first := @self;
|
|
next := nil;
|
|
exit;
|
|
end;
|
|
{reorder the symbols in increasing value }
|
|
if value < sym^.value then
|
|
begin
|
|
next := sym;
|
|
definition^.first := @self;
|
|
end else
|
|
begin
|
|
while (sym^.value <= value) and assigned(sym^.next) do
|
|
sym := sym^.next;
|
|
next := sym^.next;
|
|
sym^.next := @self;
|
|
end;
|
|
end;
|
|
{$endif GDB}
|
|
|
|
procedure tenumsym.write;
|
|
|
|
begin
|
|
{$ifdef OLDPPU}
|
|
writebyte(ibenumsym);
|
|
{$endif}
|
|
tsym.write;
|
|
writedefref(definition);
|
|
writelong(value);
|
|
{$ifndef OLDPPU}
|
|
current_ppu^.writeentry(ibenumsym);
|
|
{$endif}
|
|
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}
|
|
forwardpointer:=nil;
|
|
{ this allows to link definitions with the type with declares }
|
|
{ them }
|
|
if assigned(definition) then
|
|
if definition^.sym=nil then
|
|
definition^.sym:=@self;
|
|
end;
|
|
|
|
constructor ttypesym.load;
|
|
|
|
begin
|
|
tsym.load;
|
|
typ:=typesym;
|
|
forwardpointer:=nil;
|
|
{$ifdef GDB}
|
|
isusedinstab := false;
|
|
{$endif GDB}
|
|
definition:=readdefref;
|
|
end;
|
|
|
|
destructor ttypesym.done;
|
|
|
|
begin
|
|
if assigned(definition) then
|
|
if definition^.sym=@self then
|
|
definition^.sym:=nil;
|
|
inherited done;
|
|
end;
|
|
|
|
procedure ttypesym.deref;
|
|
|
|
begin
|
|
resolvedef(definition);
|
|
if assigned(definition) then
|
|
if definition^.sym=nil then
|
|
definition^.sym:=@self;
|
|
if definition^.deftype=recorddef then
|
|
precdef(definition)^.symtable^.name:=stringdup('record '+name);
|
|
{if definition^.deftype=objectdef then
|
|
pobjectdef(definition)^.publicsyms^.name:=stringdup('object '+name);
|
|
done in tobjectdef.load }
|
|
end;
|
|
|
|
procedure ttypesym.write;
|
|
|
|
begin
|
|
{$ifdef OLDPPU}
|
|
writebyte(ibtypesym);
|
|
{$endif}
|
|
tsym.write;
|
|
writedefref(definition);
|
|
{$ifndef OLDPPU}
|
|
current_ppu^.writeentry(ibtypesym);
|
|
{$endif}
|
|
end;
|
|
|
|
{$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;
|
|
|
|
procedure tsyssym.write;
|
|
begin
|
|
end;
|
|
|
|
{$ifdef GDB}
|
|
procedure tsyssym.concatstabto(asmlist : paasmoutput);
|
|
begin
|
|
end;
|
|
{$endif GDB}
|
|
|
|
{****************************************************************************
|
|
TMACROSYM
|
|
****************************************************************************}
|
|
|
|
constructor tmacrosym.init(const n : string);
|
|
begin
|
|
inherited init(n);
|
|
defined:=true;
|
|
buftext:=nil;
|
|
buflen:=0;
|
|
end;
|
|
|
|
destructor tmacrosym.done;
|
|
begin
|
|
if assigned(buftext) then
|
|
freemem(buftext,buflen);
|
|
inherited done;
|
|
end;
|
|
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.27 1998-08-10 14:50:31 peter
|
|
+ localswitches, moduleswitches, globalswitches splitting
|
|
|
|
Revision 1.26 1998/08/10 10:18:35 peter
|
|
+ Compiler,Comphook unit which are the new interface units to the
|
|
compiler
|
|
|
|
Revision 1.25 1998/07/30 11:18:19 florian
|
|
+ first implementation of try ... except on .. do end;
|
|
* limitiation of 65535 bytes parameters for cdecl removed
|
|
|
|
Revision 1.24 1998/07/20 18:40:16 florian
|
|
* handling of ansi string constants should now work
|
|
|
|
Revision 1.23 1998/07/14 21:37:24 peter
|
|
* fixed packrecords as discussed at the alias
|
|
|
|
Revision 1.22 1998/07/14 14:47:08 peter
|
|
* released NEWINPUT
|
|
|
|
Revision 1.21 1998/07/13 21:17:38 florian
|
|
* changed to compile with TP
|
|
|
|
Revision 1.20 1998/07/10 00:00:05 peter
|
|
* fixed ttypesym bug finally
|
|
* fileinfo in the symtable and better using for unused vars
|
|
|
|
Revision 1.19 1998/07/07 17:40:39 peter
|
|
* packrecords 4 works
|
|
* word aligning of parameters
|
|
|
|
Revision 1.18 1998/07/07 11:20:15 peter
|
|
+ NEWINPUT for a better inputfile and scanner object
|
|
|
|
Revision 1.17 1998/06/24 14:48:40 peter
|
|
* ifdef newppu -> ifndef oldppu
|
|
|
|
Revision 1.16 1998/06/19 15:40:42 peter
|
|
* removed cosntructor/constructor warning and 0.99.5 recompiles it again
|
|
|
|
Revision 1.15 1998/06/17 14:10:18 peter
|
|
* small os2 fixes
|
|
* fixed interdependent units with newppu (remake3 under linux works now)
|
|
|
|
Revision 1.14 1998/06/16 08:56:34 peter
|
|
+ targetcpu
|
|
* cleaner pmodules for newppu
|
|
|
|
Revision 1.13 1998/06/15 15:38:10 pierre
|
|
* small bug in systems.pas corrected
|
|
+ operators in different units better hanlded
|
|
|
|
Revision 1.12 1998/06/15 14:23:44 daniel
|
|
|
|
* Reverted my changes.
|
|
|
|
Revision 1.10 1998/06/13 00:10:18 peter
|
|
* working browser and newppu
|
|
* some small fixes against crashes which occured in bp7 (but not in
|
|
fpc?!)
|
|
|
|
Revision 1.9 1998/06/12 16:15:35 pierre
|
|
* external name 'C_var';
|
|
export name 'intern_C_var';
|
|
cdecl;
|
|
cdecl;external;
|
|
are now supported only with -Sv switch
|
|
|
|
Revision 1.8 1998/06/11 10:11:59 peter
|
|
* -gb works again
|
|
|
|
Revision 1.7 1998/06/09 16:01:51 pierre
|
|
+ added procedure directive parsing for procvars
|
|
(accepted are popstack cdecl and pascal)
|
|
+ added C vars with the following syntax
|
|
var C calias 'true_c_name';(can be followed by external)
|
|
reason is that you must add the Cprefix
|
|
|
|
which is target dependent
|
|
|
|
Revision 1.6 1998/06/08 22:59:53 peter
|
|
* smartlinking works for win32
|
|
* some defines to exclude some compiler parts
|
|
|
|
Revision 1.5 1998/06/04 23:52:02 peter
|
|
* m68k compiles
|
|
+ .def file creation moved to gendef.pas so it could also be used
|
|
for win32
|
|
|
|
Revision 1.4 1998/06/04 09:55:46 pierre
|
|
* demangled name of procsym reworked to become independant of the mangling scheme
|
|
|
|
Revision 1.3 1998/06/03 22:14:20 florian
|
|
* problem with sizes of classes fixed (if the anchestor was declared
|
|
forward, the compiler doesn't update the child classes size)
|
|
|
|
Revision 1.2 1998/05/28 14:40:29 peter
|
|
* fixes for newppu, remake3 works now with it
|
|
|
|
Revision 1.1 1998/05/27 19:45:09 peter
|
|
* symtable.pas splitted into includefiles
|
|
* symtable adapted for $ifndef OLDPPU
|
|
|
|
}
|
|
|