mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-27 08:13:42 +02:00
afe0d5a50d
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
1711 lines
48 KiB
PHP
1711 lines
48 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}
|
||
if assigned(current_module) and assigned(current_module^.current_inputfile) then
|
||
line_no:=current_module^.current_inputfile^.line_no
|
||
else
|
||
line_no:=0;
|
||
{$ifdef UseBrowser}
|
||
defref:=nil;
|
||
lastwritten:=nil;
|
||
if make_ref then
|
||
add_new_ref(defref,@tokenpos);
|
||
lastref:=defref;
|
||
refcount:=1;
|
||
{$endif UseBrowser}
|
||
end;
|
||
|
||
constructor tsym.load;
|
||
|
||
begin
|
||
left:=nil;
|
||
right:=nil;
|
||
setname(readstring);
|
||
typ:=abstractsym;
|
||
if object_options then
|
||
properties:=symprop(readbyte)
|
||
else
|
||
properties:=sp_public;
|
||
{$ifdef UseBrowser}
|
||
lastref:=nil;
|
||
defref:=nil;
|
||
lastwritten:=nil;
|
||
refcount:=0;
|
||
if (current_module^.flags and uf_uses_browser)<>0 then
|
||
{ references do not change the ppu caracteristics }
|
||
{ this only save the references to variables/functions }
|
||
{ defined in the unit what about the others }
|
||
load_references;
|
||
{$endif UseBrowser}
|
||
{$ifdef GDB}
|
||
isstabwritten := false;
|
||
{$endif GDB}
|
||
line_no:=0;
|
||
end;
|
||
|
||
{$ifdef UseBrowser}
|
||
|
||
{$ifdef NEWPPU}
|
||
|
||
procedure tsym.load_references;
|
||
var
|
||
fileindex : word;
|
||
b : byte;
|
||
l,c : longint;
|
||
begin
|
||
b:=readentry;
|
||
if b=ibref then
|
||
begin
|
||
while (not ppufile^.endofentry) do
|
||
begin
|
||
fileindex:=readword;
|
||
l:=readlong;
|
||
c:=readword;
|
||
inc(refcount);
|
||
lastref:=new(pref,load(lastref,fileindex,l,c));
|
||
if refcount=1 then
|
||
defref:=lastref;
|
||
end;
|
||
end
|
||
else
|
||
Message(unit_f_ppu_read_error);
|
||
lastwritten:=lastref;
|
||
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
|
||
writeposinfo(ref^.posinfo);
|
||
ref:=ref^.nextref;
|
||
end;
|
||
lastwritten:=lastref;
|
||
ppufile^.writeentry(ibref);
|
||
ppufile^.do_crc:=true;
|
||
end;
|
||
|
||
|
||
procedure load_external_references;
|
||
var b : byte;
|
||
sym : psym;
|
||
prdef : pdef;
|
||
begin
|
||
b:=readentry;
|
||
if b=ibextsymref then
|
||
begin
|
||
sym:=readsymref;
|
||
resolvesym(sym);
|
||
sym^.load_references;
|
||
end;
|
||
ibextdefref : begin
|
||
prdef:=readdefref;
|
||
resolvedef(prdef);
|
||
if prdef^.deftype<>procdef then
|
||
Message(unit_f_ppu_read_error);
|
||
pprocdef(prdef)^.load_references;
|
||
end;
|
||
else
|
||
Message(unit_f_ppu_read_error);
|
||
end;
|
||
end;
|
||
|
||
procedure tsym.write_external_references;
|
||
var ref : pref;
|
||
prdef : pdef;
|
||
begin
|
||
ppufile^.do_crc:=false;
|
||
if lastwritten=lastref then
|
||
exit;
|
||
writesymref(@self);
|
||
writeentry(ibextsymref);
|
||
|
||
write_references;
|
||
|
||
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;
|
||
|
||
{$else NEWPPU}
|
||
|
||
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 load_external_references;
|
||
|
||
var b : byte;
|
||
sym : psym;
|
||
prdef : pdef;
|
||
begin
|
||
b:=readbyte;
|
||
while (b=ibextsymref) or (b=ibextdefref) do
|
||
begin
|
||
if b=ibextsymref then
|
||
begin
|
||
sym:=readsymref;
|
||
resolvesym(sym);
|
||
sym^.load_references;
|
||
b:=readbyte;
|
||
end
|
||
else
|
||
if b=ibextdefref then
|
||
begin
|
||
prdef:=readdefref;
|
||
resolvedef(prdef);
|
||
if prdef^.deftype<>procdef then
|
||
Message(unit_f_ppu_read_error);
|
||
pprocdef(prdef)^.load_references;
|
||
b:=readbyte;
|
||
end;
|
||
end;
|
||
if b <> ibend then
|
||
Message(unit_f_ppu_read_error);
|
||
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 NEWPPU}
|
||
|
||
procedure tsym.write_ref_to_file(var f : text);
|
||
|
||
var ref : pref;
|
||
i : longint;
|
||
|
||
begin
|
||
ref:=defref;
|
||
if assigned(ref) then
|
||
begin
|
||
for i:=1 to reffile_indent do
|
||
system.write(f,' ');
|
||
writeln(f,'***',name,'***');
|
||
end;
|
||
inc(reffile_indent,2);
|
||
while assigned(ref) do
|
||
begin
|
||
for i:=1 to reffile_indent do
|
||
system.write(f,' ');
|
||
writeln(f,ref^.get_file_line);
|
||
ref:=ref^.nextref;
|
||
end;
|
||
dec(reffile_indent,2);
|
||
end;
|
||
{$endif UseBrowser}
|
||
|
||
destructor tsym.done;
|
||
|
||
begin
|
||
{$ifdef tp}
|
||
if not(use_big) then
|
||
{$endif tp}
|
||
strdispose(_name);
|
||
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 (current_module^.flags and uf_uses_browser)<>0 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(line_no)+',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);
|
||
|
||
begin
|
||
tsym.init(n);
|
||
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;
|
||
|
||
begin
|
||
pd:=definition;
|
||
while assigned(pd) do
|
||
begin
|
||
if pd^.forwarddef then
|
||
begin
|
||
{$ifdef GDB}
|
||
if assigned(pd^._class) then
|
||
Message1(sym_e_forward_not_resolved,pd^._class^.name^+'.'+name+demangledparas(pd^.demangled_paras))
|
||
else
|
||
{$endif GDB}
|
||
Message1(sym_e_forward_not_resolved,name+pd^.demangled_paras)
|
||
end;
|
||
pd:=pd^.nextoverloaded;
|
||
end;
|
||
end;
|
||
|
||
procedure tprocsym.deref;
|
||
var t : ttoken;
|
||
|
||
begin
|
||
resolvedef(pdef(definition));
|
||
for t:=PLUS to last_overloaded do
|
||
if (overloaded_operators[t]=nil) and
|
||
(name=overloaded_names[t]) then
|
||
overloaded_operators[t]:=@self;
|
||
end;
|
||
|
||
procedure tprocsym.write;
|
||
begin
|
||
{$ifndef NEWPPU}
|
||
writebyte(ibprocsym);
|
||
{$endif}
|
||
tsym.write;
|
||
writedefref(pdef(definition));
|
||
{$ifdef NEWPPU}
|
||
ppufile^.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(current_module^.current_inputfile^.line_no)
|
||
+','+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
|
||
tsym.init(n);
|
||
typ:=programsym;
|
||
end;
|
||
|
||
{****************************************************************************
|
||
TERRORSYM
|
||
****************************************************************************}
|
||
|
||
constructor terrorsym.init;
|
||
begin
|
||
tsym.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
|
||
{$ifndef NEWPPU}
|
||
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);
|
||
{$ifdef NEWPPU}
|
||
ppufile^.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
|
||
{$ifndef NEWPPU}
|
||
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;
|
||
{$ifdef NEWPPU}
|
||
ppufile^.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;
|
||
varspez:=vs_value;
|
||
address:=0;
|
||
refs:=0;
|
||
is_valid := 1;
|
||
{ can we load the value into a register ? }
|
||
case p^.deftype of
|
||
pointerdef,
|
||
enumdef,
|
||
procvardef : regable:=true;
|
||
orddef : case porddef(p)^.typ of
|
||
u8bit,s32bit,
|
||
bool8bit,uchar,
|
||
s8bit,s16bit,
|
||
u16bit,u32bit : regable:=true;
|
||
else
|
||
regable:=false;
|
||
end;
|
||
else
|
||
regable:=false;
|
||
end;
|
||
reg:=R_NO;
|
||
end;
|
||
|
||
constructor tvarsym.load;
|
||
|
||
begin
|
||
tsym.load;
|
||
typ:=varsym;
|
||
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 }
|
||
regable:=false;
|
||
reg:=R_NO;
|
||
end;
|
||
|
||
procedure tvarsym.deref;
|
||
|
||
begin
|
||
resolvedef(definition);
|
||
end;
|
||
|
||
procedure tvarsym.write;
|
||
|
||
begin
|
||
{$ifndef NEWPPU}
|
||
writebyte(ibvarsym);
|
||
{$endif}
|
||
tsym.write;
|
||
writebyte(byte(varspez));
|
||
|
||
if read_member then
|
||
writelong(address);
|
||
|
||
writedefref(definition);
|
||
{$ifdef NEWPPU}
|
||
ppufile^.writeentry(ibvarsym);
|
||
{$endif}
|
||
end;
|
||
|
||
function tvarsym.mangledname : string;
|
||
var
|
||
prefix : string;
|
||
begin
|
||
case owner^.symtabletype of
|
||
staticsymtable : if (cs_smartlink in aktswitches) 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
|
||
{ 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 }
|
||
regable:=false;
|
||
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);
|
||
}
|
||
{ bei einer lokalen Symboltabelle erst! erh<72>hen, da der }
|
||
{ Wert in codegen.secondload dann mit minus verwendet }
|
||
{ wird }
|
||
l:=getsize;
|
||
if owner^.symtabletype=localsymtable then
|
||
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
|
||
else if owner^.symtabletype=staticsymtable then
|
||
begin
|
||
if (cs_smartlink in aktswitches) then
|
||
bsssegment^.concat(new(pai_cut,init));
|
||
{$ifdef GDB}
|
||
if cs_debuginfo in aktswitches then
|
||
concatstabto(bsssegment);
|
||
{$endif GDB}
|
||
if (cs_smartlink in aktswitches) then
|
||
bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)))
|
||
else
|
||
bsssegment^.concat(new(pai_datablock,init(mangledname,l)));
|
||
|
||
inc(owner^.datasize,l);
|
||
|
||
{ this symbol can't be loaded to a register }
|
||
regable:=false;
|
||
end
|
||
else if owner^.symtabletype=globalsymtable then
|
||
begin
|
||
if (cs_smartlink in aktswitches) then
|
||
bsssegment^.concat(new(pai_cut,init));
|
||
{$ifdef GDB}
|
||
if cs_debuginfo in aktswitches then
|
||
begin
|
||
concatstabto(bsssegment);
|
||
{ this has to be added so that the debugger knows where to find
|
||
the global variable
|
||
Doesn't work !!
|
||
bsssegment^.concat(new(pai_symbol,init('_'+name))); }
|
||
end;
|
||
{$endif GDB}
|
||
bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)));
|
||
inc(owner^.datasize,l);
|
||
|
||
{ this symbol can't be loaded to a register }
|
||
regable:=false;
|
||
end
|
||
else if owner^.symtabletype in [recordsymtable,objectsymtable] then
|
||
begin
|
||
{ align record and object fields }
|
||
if aktpackrecords=2 then
|
||
begin
|
||
{ align to word }
|
||
modulo:=owner^.datasize and 3;
|
||
if (l>=2) and ((modulo and 1)<>0) then
|
||
inc(owner^.datasize);
|
||
end
|
||
else if aktpackrecords=4 then
|
||
begin
|
||
{ align to dword }
|
||
if (l>=3) and (modulo<>0) then
|
||
inc(owner^.datasize,4-modulo)
|
||
{ or word }
|
||
else if (l=2) and ((modulo and 1)<>0) then
|
||
inc(owner^.datasize)
|
||
end;
|
||
address:=owner^.datasize;
|
||
inc(owner^.datasize,l);
|
||
|
||
{ this symbol can't be loaded to a register }
|
||
regable:=false;
|
||
end
|
||
else if owner^.symtabletype=parasymtable then
|
||
begin
|
||
address:=owner^.datasize;
|
||
|
||
{ intel processors don't know a byte push, }
|
||
{ so is always a word pushed }
|
||
{ so it must allways be even }
|
||
if (l and 1)<>0 then
|
||
inc(l);
|
||
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;
|
||
|
||
{$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(line_no)+','+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(line_no)+','+mangledname);
|
||
end
|
||
else if owner^.symtabletype = staticsymtable then
|
||
begin
|
||
stabstring := strpnew('"'+name+':S'
|
||
+definition^.numberstring+'",'+
|
||
tostr(N_LCSYM)+',0,'+tostr(line_no)+','+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(line_no)+','+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(line_no)+','+tostr(GDB_i386index[reg]));
|
||
end
|
||
else
|
||
{$endif i386}
|
||
stabstring := strpnew('"'+name+':'
|
||
+definition^.numberstring+'",'+
|
||
tostr(N_LSYM)+',0,'+tostr(line_no)+',-'+tostr(address))
|
||
else
|
||
stabstring := inherited stabstring;
|
||
end;
|
||
|
||
procedure tvarsym.concatstabto(asmlist : paasmoutput);
|
||
var stab_str : pchar;
|
||
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(line_no)+','+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);
|
||
|
||
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
|
||
{$ifndef NEWPPU}
|
||
writebyte(ibtypedconstsym);
|
||
{$endif}
|
||
tsym.write;
|
||
writedefref(definition);
|
||
writestring(prefix^);
|
||
{$ifdef NEWPPU}
|
||
ppufile^.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
|
||
really_insert_in_data;
|
||
end;
|
||
|
||
procedure ttypedconstsym.really_insert_in_data;
|
||
begin
|
||
if (cs_smartlink in aktswitches) then
|
||
datasegment^.concat(new(pai_cut,init));
|
||
if owner^.symtabletype=globalsymtable then
|
||
begin
|
||
{$ifdef GDB}
|
||
if cs_debuginfo in aktswitches then
|
||
concatstabto(datasegment);
|
||
{$endif GDB}
|
||
datasegment^.concat(new(pai_symbol,init_global(mangledname)));
|
||
end
|
||
else
|
||
if owner^.symtabletype<>unitsymtable then
|
||
begin
|
||
{$ifdef GDB}
|
||
if cs_debuginfo in aktswitches then
|
||
concatstabto(datasegment);
|
||
{$endif GDB}
|
||
if (cs_smartlink in aktswitches) 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(line_no)+','+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
|
||
{$ifndef NEWPPU}
|
||
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;
|
||
{$ifdef NEWPPU}
|
||
ppufile^.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(line_no)+',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
|
||
{$ifndef NEWPPU}
|
||
writebyte(ibenumsym);
|
||
{$endif}
|
||
tsym.write;
|
||
writedefref(definition);
|
||
writelong(value);
|
||
{$ifdef NEWPPU}
|
||
ppufile^.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
|
||
{$ifndef NEWPPU}
|
||
writebyte(ibtypesym);
|
||
{$endif}
|
||
tsym.write;
|
||
writedefref(definition);
|
||
{$ifdef NEWPPU}
|
||
ppufile^.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(line_no)+',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;
|
||
|
||
{$ifdef GDB}
|
||
function typeglobalnumber(const s : string) : string;
|
||
|
||
var st : string;
|
||
symt : psymtable;
|
||
old_make_ref : boolean;
|
||
begin
|
||
old_make_ref:=make_ref;
|
||
make_ref:=false;
|
||
typeglobalnumber := '0';
|
||
srsym := nil;
|
||
if pos('.',s) > 0 then
|
||
begin
|
||
st := copy(s,1,pos('.',s)-1);
|
||
getsym(st,false);
|
||
st := copy(s,pos('.',s)+1,255);
|
||
if assigned(srsym) then
|
||
begin
|
||
if srsym^.typ = unitsym then
|
||
begin
|
||
symt := punitsym(srsym)^.unitsymtable;
|
||
srsym := symt^.search(st);
|
||
end else srsym := nil;
|
||
end;
|
||
end else st := s;
|
||
if srsym = nil then getsym(st,true);
|
||
if srsym^.typ<>typesym then
|
||
begin
|
||
Message(sym_e_type_id_expected);
|
||
exit;
|
||
end;
|
||
typeglobalnumber := ptypesym(srsym)^.definition^.numberstring;
|
||
make_ref:=old_make_ref;
|
||
end;
|
||
{$endif GDB}
|
||
|
||
{
|
||
$Log$
|
||
Revision 1.4 1998-06-04 09:55:46 pierre
|
||
* demangled name of procsym reworked to become independant of the mangling scheme
|
||
|
||
Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
|
||
|
||
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 $ifdef NEWPPU
|
||
|
||
}
|
||
|