* Fixes to make it compilable under BP again.

This commit is contained in:
daniel 1998-06-15 13:31:20 +00:00
parent cb936cddb2
commit d9445e22e9
2 changed files with 254 additions and 200 deletions

View File

@ -29,8 +29,7 @@
deftype:=abstractdef;
owner := nil;
next := nil;
sym := nil;
indexnb := 0;
number := 0;
if registerdef then
symtablestack^.registerdef(@self);
has_rtti:=false;
@ -49,19 +48,20 @@
end;
lastglobaldef := @self;
nextglobal := nil;
sym := nil;
{$endif GDB}
end;
constructor tdef.load;
begin
{$ifdef GDB}
deftype:=abstractdef;
indexnb := 0;
is_def_stab_written := false;
number := 0;
sym := nil;
owner := nil;
next := nil;
has_rtti:=false;
{$ifdef GDB}
is_def_stab_written := false;
globalnb := 0;
if assigned(lastglobaldef) then
begin
@ -580,7 +580,7 @@
constructor torddef.init(t : tbasetype;v,b : longint);
begin
inherited init;
tdef.init;
deftype:=orddef;
low:=v;
high:=b;
@ -590,7 +590,7 @@
constructor torddef.load;
begin
inherited load;
tdef.load;
deftype:=orddef;
typ:=tbasetype(readbyte);
low:=readlong;
@ -910,7 +910,7 @@
_private : array[1..26] of byte;
userdata : array[1..16] of byte;
name : string[79 or 255 for linux]; }
{$ifdef i386}
{$ifdef i386}
if (target_info.target=target_GO32V1) or
(target_info.target=target_GO32V2) then
@ -1356,11 +1356,13 @@
end;
function tarraydef.needs_rtti : boolean;
begin
needs_rtti:=definition^.needs_rtti;
end;
procedure tarraydef.generate_rtti;
begin
{ first, generate the rtti of the element type, else we get mixed }
{ up because the rtti would be mixed }
@ -1795,16 +1797,14 @@
localst^.next:=parast;
{$ifdef UseBrowser}
defref:=nil;
lastwritten:=nil;
refcount:=0;
if (cs_browser in aktswitches) and make_ref then
begin
defref:=new(pref,init(defref,@tokenpos));
inc(refcount);
end;
if make_ref then
add_new_ref(defref,@tokenpos);
lastref:=defref;
lastwritten:=nil;
refcount:=1;
{$endif UseBrowser}
{ first, we assume, that all registers are used }
{ first, we assume, that all registers are used }
{$ifdef i386}
usedregisters:=$ff;
{$endif i386}
@ -1821,8 +1821,10 @@
end;
constructor tprocdef.load;
var
s : string;
begin
{ deftype:=procdef; this is at the wrong place !! }
inherited load;
@ -1852,78 +1854,47 @@
localst:=nil;
forwarddef:=false;
{$ifdef UseBrowser}
lastref:=nil;
lastwritten:=nil;
defref:=nil;
refcount:=0;
if (current_module^.flags and uf_has_browser)<>0 then
load_references;
if (current_module^.flags and uf_uses_browser)<>0 then
load_references
else
begin
lastref:=nil;
lastwritten:=nil;
defref:=nil;
refcount:=0;
end;
{$endif UseBrowser}
end;
{$ifdef UseBrowser}
{$ifdef NEWPPU}
procedure tprocdef.load_references;
var
pos : tfileposinfo;
begin
while (not ppufile^.endofentry) do
begin
readposinfo(pos);
inc(refcount);
lastref:=new(pref,init(lastref,@pos));
if refcount=1 then
defref:=lastref;
end;
end;
var fileindex : word;
b : byte;
l,c : longint;
procedure tprocdef.write_references;
var
ref : pref;
begin
if lastwritten=lastref then
exit;
{ write address of this symbol }
writedefref(@self);
{ write refs }
if assigned(lastwritten) then
ref:=lastwritten
else
ref:=defref;
while assigned(ref) do
begin
writeposinfo(ref^.posinfo);
ref:=ref^.nextref;
end;
ppufile^.writeentry(ibdefref);
lastwritten:=lastref;
end;
{$else NEWPPU}
procedure tprocdef.load_references;
var
pos : tfileposinfo;
b : byte;
begin
b:=readbyte;
refcount:=0;
lastref:=nil;
lastwritten:=nil;
defref:=nil;
while b=ibref do
begin
readposinfo(pos);
fileindex:=readword;
l:=readlong;
c:=readword;
inc(refcount);
lastref:=new(pref,init(lastref,@pos));
if refcount=1 then
defref:=lastref;
lastref:=new(pref,load(lastref,fileindex,l,c));
if refcount=1 then defref:=lastref;
b:=readbyte;
end;
if b <> ibend then
Comment(V_fatal,'error in load_reference');
{ Message(unit_f_ppu_read);
message disappeared ?? }
Comment(V_fatal,'error in load_reference');
end;
procedure tprocdef.write_references;
var ref : pref;
@ -1940,7 +1911,9 @@
while assigned(ref) do
begin
writebyte(ibref);
writeposinfo(ref^.posinfo);
writeword(ref^.posinfo.fileindex);
writelong(ref^.posinfo.line);
writeword(ref^.posinfo.column);
ref:=ref^.nextref;
end;
lastwritten:=lastref;
@ -1964,34 +1937,44 @@
while assigned(ref) do
begin
writebyte(ibref);
writeposinfo(ref^.posinfo);
writeword(ref^.posinfo.fileindex);
writelong(ref^.posinfo.line);
writeword(ref^.posinfo.column);
ref:=ref^.nextref;
end;
lastwritten:=lastref;
writebyte(ibend);
ppufile.do_crc:=false;
ppufile.do_crc:=true;
end;
procedure tprocdef.write_ref_to_file(var f : text);
{$endif NEWPPU}
var ref : pref;
i : longint;
procedure tprocdef.add_to_browserlog;
begin
if assigned(defref) then
begin
Browse.AddLog('***'+mangledname);
Browse.AddLogRefs(defref);
end;
ref:=defref;
if assigned(ref) then
begin
for i:=1 to reffile_indent do
system.write(f,' ');
writeln(f,'***',mangledname);
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 tprocdef.done;
begin
{$ifdef UseBrowser}
if assigned(defref) then
dispose(defref,done);
{$endif UseBrowser}
if assigned(parast) then
dispose(parast,done);
if assigned(localst) then
@ -2000,12 +1983,13 @@
{$ifdef tp}
not(use_big) and
{$endif}
assigned(_mangledname) then
assigned(_mangledname) then
strdispose(_mangledname);
inherited done;
end;
procedure tprocdef.write;
begin
{$ifndef NEWPPU}
writebyte(ibprocdef);
@ -2035,9 +2019,14 @@
writeptree(ptree(code));
}
end;
{$ifdef NEWPPU}
ppufile^.writeentry(ibprocdef);
{$endif}
{$ifdef UseBrowser}
if (current_module^.flags and uf_uses_browser)<>0 then
write_references;
{$endif UseBrowser}
end;
{$ifdef GDB}
@ -2631,10 +2620,10 @@
{
$Log$
Revision 1.10 1998-06-13 00:10:16 peter
* working browser and newppu
* some small fixes against crashes which occured in bp7 (but not in
fpc?!)
Revision 1.11 1998-06-15 13:31:20 daniel
* Fixes to make it compilable under BP again.
Revision 1.9 1998/06/12 14:10:37 michael
* Fixed wrong code for ansistring
@ -2656,8 +2645,9 @@
for win32
Revision 1.4 1998/06/04 09:55:45 pierre
* demangled name of procsym reworked to become independant of the mangling
scheme
* 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:49:03 peter
+ wordbool,longbool
@ -2675,4 +2665,4 @@
* symtable adapted for $ifdef NEWPPU
}

View File

@ -41,13 +41,10 @@
{$ifdef UseBrowser}
defref:=nil;
lastwritten:=nil;
refcount:=0;
if (cs_browser in aktswitches) and make_ref then
begin
defref:=new(pref,init(defref,@tokenpos));
inc(refcount);
end;
if make_ref then
add_new_ref(defref,@tokenpos);
lastref:=defref;
refcount:=1;
{$endif UseBrowser}
end;
@ -58,7 +55,6 @@
right:=nil;
setname(readstring);
typ:=abstractsym;
line_no:=0;
if object_options then
properties:=symprop(readbyte)
else
@ -68,10 +64,16 @@
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}
@ -80,51 +82,98 @@
procedure tsym.load_references;
var
pos : tfileposinfo;
fileindex : word;
b : byte;
l,c : longint;
begin
while (not ppufile^.endofentry) do
begin
readposinfo(pos);
inc(refcount);
lastref:=new(pref,init(lastref,@pos));
if refcount=1 then
defref:=lastref;
end;
lastwritten:=lastref;
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;
prdef : pdef;
ref : pref;
begin
if lastwritten=lastref then
exit;
{ write address to this symbol }
writesymref(@self);
{ write symbol refs }
if assigned(lastwritten) then
ref:=lastwritten
{ 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
ref:=defref;
while assigned(ref) do
begin
writeposinfo(ref^.posinfo);
ref:=ref^.nextref;
end;
lastwritten:=lastref;
ppufile^.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;
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}
@ -179,6 +228,37 @@
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;
@ -216,48 +296,44 @@
{$endif NEWPPU}
procedure tsym.add_to_browserlog;
var
prdef : pprocdef;
procedure tsym.write_ref_to_file(var f : text);
var ref : pref;
i : longint;
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;
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);
{$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);
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
@ -272,8 +348,8 @@
if object_options then
writebyte(byte(properties));
{$ifdef UseBrowser}
{ if cs_browser in aktswitches then
write_references; }
if (current_module^.flags and uf_uses_browser)<>0 then
write_references;
{$endif UseBrowser}
end;
@ -386,13 +462,9 @@
****************************************************************************}
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;
tsym.init(n);
typ:=unitsym;
unitsymtable:=ref;
prevsym:=ref^.unitsym;
@ -555,8 +627,8 @@
constructor tprogramsym.init(const n : string);
begin
inherited init(n);
typ:=programsym;
tsym.init(n);
typ:=programsym;
end;
{****************************************************************************
@ -565,8 +637,8 @@
constructor terrorsym.init;
begin
inherited init('');
typ:=errorsym;
tsym.init('');
typ:=errorsym;
end;
{****************************************************************************
@ -803,14 +875,15 @@
_mangledname:=nil;
varspez:=vs_value;
address:=0;
refs:=0;
refs:=0;
var_options:=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;
procvardef :
var_options:=var_options or vo_regable;
orddef : case porddef(p)^.typ of
u8bit,u16bit,u32bit,
bool8bit,bool16bit,bool32bit,
@ -834,8 +907,7 @@
varspez:=tvarspez(readbyte);
if read_member then
address:=readlong
else
address:=0;
else address:=0;
definition:=readdefref;
refs := 0;
is_valid := 1;
@ -852,7 +924,7 @@
var_options:=var_options or vo_is_C_var;
_mangledname:=strpnew(target_os.Cprefix+mangled);
end;
constructor tvarsym.load_C;
begin
@ -956,7 +1028,7 @@
{ 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;
var_options:=var_options or vo_regable;
end
else if not(read_member) then
begin
@ -999,8 +1071,7 @@
if cs_debuginfo in aktswitches then
concatstabto(bsssegment);
{$endif GDB}
if (cs_smartlink in aktswitches) or
((var_options and vo_is_c_var)<>0) then
if (cs_smartlink in aktswitches) then
bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)))
else
bsssegment^.concat(new(pai_datablock,init(mangledname,l)));
@ -1177,7 +1248,7 @@
strdispose(_mangledname);
inherited done;
end;
{****************************************************************************
TTYPEDCONSTSYM
@ -1671,17 +1742,10 @@
{
$Log$
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.11 1998-06-15 13:31:21 daniel
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
* Fixes to make it compilable under BP again.
Revision 1.8 1998/06/11 10:11:59 peter
* -gb works again