paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-05 12:49:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixed resolving of ttypesym which are reference from object/record

Browse Source 
fields.
This commit is contained in:
peter 2000-01-03 19:26:03 +00:00
parent ace77883c8
commit a7161a8dfc
5 changed files with 157 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
compiler/symdef.inc
View File

@ -163,12 +163,13 @@
nextglobal^.previousglobal:=previousglobal; nextglobal^.previousglobal:=previousglobal;
previousglobal:=nil; previousglobal:=nil;
nextglobal:=nil; nextglobal:=nil;
{$ifdef SYNONYM}
while assigned(typesym) do while assigned(typesym) do
begin begin
typesym^.restype.setdef(nil); typesym^.restype.setdef(nil);
typesym:=typesym^.synonym; typesym:=typesym^.synonym;
end; end;
{$endif}
end; end;
{ used for enumdef because the symbols are { used for enumdef because the symbols are
@ -387,11 +388,6 @@
procedure tdef.deref; procedure tdef.deref;
begin
end;
procedure tdef.symderef;
begin begin
resolvesym(psym(typesym)); resolvesym(psym(typesym));
end; end;
@ -822,6 +818,7 @@
procedure tenumdef.deref; procedure tenumdef.deref;
begin begin
inherited deref;
resolvedef(pdef(basedef)); resolvedef(pdef(basedef));
end; end;
@ -1320,6 +1317,7 @@
procedure tfiledef.deref; procedure tfiledef.deref;
begin begin
inherited deref;
if filetyp=ft_typed then if filetyp=ft_typed then
typedfiletype.resolve; typedfiletype.resolve;
end; end;
@ -1479,6 +1477,7 @@
procedure tpointerdef.deref; procedure tpointerdef.deref;
begin begin
inherited deref;
pointertype.resolve; pointertype.resolve;
end; end;
@ -1709,6 +1708,7 @@
procedure tsetdef.deref; procedure tsetdef.deref;
begin begin
inherited deref;
elementtype.resolve; elementtype.resolve;
end; end;
@ -1859,6 +1859,7 @@
procedure tarraydef.deref; procedure tarraydef.deref;
begin begin
inherited deref;
elementtype.resolve; elementtype.resolve;
rangetype.resolve; rangetype.resolve;
end; end;
@ -2050,6 +2051,7 @@
var var
oldrecsyms : psymtable; oldrecsyms : psymtable;
begin begin
inherited deref;
oldrecsyms:=aktrecordsymtable; oldrecsyms:=aktrecordsymtable;
aktrecordsymtable:=symtable; aktrecordsymtable:=symtable;
{ now dereference the definitions } { now dereference the definitions }
@ -2105,6 +2107,8 @@
else else
spec:=''; spec:='';
{ class fields are pointers PM } { class fields are pointers PM }
if not assigned(pvarsym(p)^.vartype.def) then
writeln(pvarsym(p)^.name);
if (pvarsym(p)^.vartype.def^.deftype=objectdef) and if (pvarsym(p)^.vartype.def^.deftype=objectdef) and
pobjectdef(pvarsym(p)^.vartype.def)^.is_class then pobjectdef(pvarsym(p)^.vartype.def)^.is_class then
spec:=spec+'*'; spec:=spec+'*';
@ -3227,6 +3231,7 @@ Const local_symtable_index : longint = $8001;
var var
oldrecsyms : psymtable; oldrecsyms : psymtable;
begin begin
inherited deref;
resolvedef(pdef(childof)); resolvedef(pdef(childof));
oldrecsyms:=aktrecordsymtable; oldrecsyms:=aktrecordsymtable;
aktrecordsymtable:=symtable; aktrecordsymtable:=symtable;
@ -3849,7 +3854,11 @@ Const local_symtable_index : longint = $8001;
{ {
$Log$ $Log$
Revision 1.184 1999-12-31 14:24:34 peter Revision 1.185 2000-01-03 19:26:03 peter
* fixed resolving of ttypesym which are reference from object/record
fields.
Revision 1.184 1999/12/31 14:24:34 peter
* fixed rtti generation for classes with no published section * fixed rtti generation for classes with no published section
Revision 1.183 1999/12/23 12:19:42 peter Revision 1.183 1999/12/23 12:19:42 peter

7
compiler/symdefh.inc
View File

@ -46,7 +46,6 @@
constructor load; constructor load;
destructor done;virtual; destructor done;virtual;
procedure deref;virtual; procedure deref;virtual;
procedure symderef;virtual;
function typename:string; function typename:string;
procedure write;virtual; procedure write;virtual;
function size:longint;virtual; function size:longint;virtual;
@ -529,7 +528,11 @@
{ {
$Log$ $Log$
Revision 1.48 1999-11-30 10:40:55 peter Revision 1.49 2000-01-03 19:26:04 peter
* fixed resolving of ttypesym which are reference from object/record
fields.
Revision 1.48 1999/11/30 10:40:55 peter
+ ttype, tsymlist + ttype, tsymlist
Revision 1.47 1999/11/17 17:05:04 pierre Revision 1.47 1999/11/17 17:05:04 pierre

28
compiler/symsym.inc
View File

@ -161,6 +161,11 @@
end; end;
procedure tsym.prederef;
begin
end;
procedure tsym.deref; procedure tsym.deref;
begin begin
end; end;
@ -1889,6 +1894,7 @@
{$ifdef GDB} {$ifdef GDB}
isusedinstab := false; isusedinstab := false;
{$endif GDB} {$endif GDB}
{$ifdef SYNONYM}
if assigned(restype.def) then if assigned(restype.def) then
begin begin
if not(assigned(restype.def^.typesym)) then if not(assigned(restype.def^.typesym)) then
@ -1907,6 +1913,12 @@
restype.def^.typesym^.synonym:=@self; restype.def^.typesym^.synonym:=@self;
end; end;
end; end;
{$else}
{ register the typesym for the definition }
if assigned(restype.def) and
not(assigned(restype.def^.typesym)) then
restype.def^.typesym:=@self;
{$endif}
end; end;
constructor ttypesym.initdef(const n : string;d : pdef); constructor ttypesym.initdef(const n : string;d : pdef);
@ -1921,13 +1933,16 @@
begin begin
tsym.load; tsym.load;
typ:=typesym; typ:=typesym;
{$ifdef SYNONYM}
synonym:=nil; synonym:=nil;
{$endif}
{$ifdef GDB} {$ifdef GDB}
isusedinstab := false; isusedinstab := false;
{$endif GDB} {$endif GDB}
restype.load; restype.load;
end; end;
{$ifdef SYNONYM}
destructor ttypesym.done; destructor ttypesym.done;
var var
prevsym : ptypesym; prevsym : ptypesym;
@ -1950,12 +1965,13 @@
synonym:=nil; synonym:=nil;
inherited done; inherited done;
end; end;
{$endif}
procedure ttypesym.deref; procedure ttypesym.prederef;
begin begin
restype.resolve; restype.resolve;
{$ifdef SYNONYM}
if assigned(restype.def) then if assigned(restype.def) then
begin begin
if (sp_primary_typesym in symoptions) then if (sp_primary_typesym in symoptions) then
@ -1979,11 +1995,11 @@
(restype.def^.typesym=@self) then (restype.def^.typesym=@self) then
precorddef(restype.def)^.symtable^.name:=stringdup('record '+name); precorddef(restype.def)^.symtable^.name:=stringdup('record '+name);
end; end;
{$endif}
end; end;
procedure ttypesym.write; procedure ttypesym.write;
begin begin
tsym.write; tsym.write;
restype.write; restype.write;
@ -2122,7 +2138,11 @@
{ {
$Log$ $Log$
Revision 1.134 1999-12-20 21:42:37 pierre Revision 1.135 2000-01-03 19:26:04 peter
* fixed resolving of ttypesym which are reference from object/record
fields.
Revision 1.134 1999/12/20 21:42:37 pierre
+ dllversion global variable + dllversion global variable
* FPC_USE_CPREFIX code removed, not necessary anymore * FPC_USE_CPREFIX code removed, not necessary anymore
as we use .edata direct writing by default now. as we use .edata direct writing by default now.

17
compiler/symsymh.inc
View File

@ -41,11 +41,12 @@
constructor load; constructor load;
destructor done;virtual; destructor done;virtual;
procedure write;virtual; procedure write;virtual;
procedure prederef;virtual; { needed for ttypesym to be deref'd first }
procedure deref;virtual; procedure deref;virtual;
function mangledname : string;virtual; function mangledname : string;virtual;
procedure insert_in_data;virtual; procedure insert_in_data;virtual;
{$ifdef GDB} {$ifdef GDB}
function stabstring : pchar;virtual; function stabstring : pchar;virtual;
procedure concatstabto(asmlist : paasmoutput);virtual; procedure concatstabto(asmlist : paasmoutput);virtual;
{$endif GDB} {$endif GDB}
procedure load_references;virtual; procedure load_references;virtual;
@ -130,16 +131,20 @@
ttypesym = object(tsym) ttypesym = object(tsym)
restype : ttype; restype : ttype;
{$ifdef SYNONYM}
synonym : ptypesym; synonym : ptypesym;
{$endif}
{$ifdef GDB} {$ifdef GDB}
isusedinstab : boolean; isusedinstab : boolean;
{$endif GDB} {$endif GDB}
constructor init(const n : string;const tt : ttype); constructor init(const n : string;const tt : ttype);
constructor initdef(const n : string;d : pdef); constructor initdef(const n : string;d : pdef);
constructor load; constructor load;
{$ifdef SYNONYM}
destructor done;virtual; destructor done;virtual;
{$endif}
procedure write;virtual; procedure write;virtual;
procedure deref;virtual; procedure prederef;virtual;
procedure load_references;virtual; procedure load_references;virtual;
function write_references : boolean;virtual; function write_references : boolean;virtual;
{$ifdef BrowserLog} {$ifdef BrowserLog}
@ -312,7 +317,11 @@
{ {
$Log$ $Log$
Revision 1.43 1999-12-14 09:58:42 florian Revision 1.44 2000-01-03 19:26:04 peter
* fixed resolving of ttypesym which are reference from object/record
fields.
Revision 1.43 1999/12/14 09:58:42 florian
+ compiler checks now if a goto leaves an exception block + compiler checks now if a goto leaves an exception block
Revision 1.42 1999/11/30 10:40:56 peter Revision 1.42 1999/11/30 10:40:56 peter

220
compiler/symtable.pas
View File

@ -192,8 +192,6 @@ unit symtable;
function getdefnr(l : longint) : pdef; function getdefnr(l : longint) : pdef;
function getsymnr(l : longint) : psym; function getsymnr(l : longint) : psym;
{ load/write } { load/write }
constructor load;
procedure write;
constructor loadas(typ : tsymtabletype); constructor loadas(typ : tsymtabletype);
procedure writeas; procedure writeas;
procedure loaddefs; procedure loaddefs;
@ -1056,12 +1054,6 @@ implementation
psym(p)^.deref; psym(p)^.deref;
end; end;
procedure derefsymsdelayed(p : pnamedindexobject);
begin
if psym(p)^.typ in [absolutesym,propertysym] then
psym(p)^.deref;
end;
procedure check_forward(sym : pnamedindexobject); procedure check_forward(sym : pnamedindexobject);
begin begin
if psym(sym)^.typ=procsym then if psym(sym)^.typ=procsym then
@ -1536,14 +1528,21 @@ implementation
hp : pdef; hp : pdef;
hs : psym; hs : psym;
begin begin
{ first deref the ttypesyms }
hs:=psym(symindex^.first);
while assigned(hs) do
begin
hs^.prederef;
hs:=psym(hs^.next);
end;
{ deref the definitions }
hp:=pdef(defindex^.first); hp:=pdef(defindex^.first);
while assigned(hp) do while assigned(hp) do
begin begin
hp^.deref; hp^.deref;
hp^.symderef;
hp:=pdef(hp^.next); hp:=pdef(hp^.next);
end; end;
{ deref the symbols }
hs:=psym(symindex^.first); hs:=psym(symindex^.first);
while assigned(hs) do while assigned(hs) do
begin begin
@ -1553,64 +1552,6 @@ implementation
end; end;
constructor tsymtable.load;
var
st_loading : boolean;
begin
st_loading:=in_loading;
in_loading:=true;
{$ifndef NEWMAP}
current_module^.map^[0]:=@self;
{$else NEWMAP}
current_module^.globalsymtable:=@self;
{$endif NEWMAP}
symtabletype:=unitsymtable;
symtablelevel:=0;
{ unused for units }
address_fixup:=0;
datasize:=0;
defowner:=nil;
name:=nil;
unitid:=0;
defowner:=nil;
new(symindex,init(indexgrowsize));
new(defindex,init(indexgrowsize));
new(symsearch,init);
symsearch^.usehash;
symsearch^.noclear:=true;
alignment:=def_alignment;
{ load definitions }
loaddefs;
{ load symbols }
loadsyms;
{ Now we can deref the symbols and definitions }
if not(symtabletype in [objectsymtable,recordsymtable]) then
deref;
{$ifdef NEWMAP}
{ necessary for dependencies }
current_module^.globalsymtable:=nil;
{$endif NEWMAP}
in_loading:=st_loading;
end;
procedure tsymtable.write;
begin
{ write definitions }
foreach({$ifndef TP}@{$endif}Order_overloads);
writedefs;
{ write symbols }
writesyms;
end;
constructor tsymtable.loadas(typ : tsymtabletype); constructor tsymtable.loadas(typ : tsymtabletype);
var var
storesymtable : psymtable; storesymtable : psymtable;
@ -1623,32 +1564,44 @@ implementation
new(defindex,init(indexgrowsize)); new(defindex,init(indexgrowsize));
new(symsearch,init); new(symsearch,init);
symsearch^.noclear:=true; symsearch^.noclear:=true;
{ reset }
defowner:=nil; defowner:=nil;
if typ in [recordsymtable,objectsymtable] then
begin
storesymtable:=aktrecordsymtable;
aktrecordsymtable:=@self;
end;
if typ in [parasymtable,localsymtable] then
begin
storesymtable:=aktlocalsymtable;
aktlocalsymtable:=@self;
end;
{ used for local browser }
if typ=staticppusymtable then
begin
aktstaticsymtable:=@self;
symsearch^.usehash;
end;
name:=nil; name:=nil;
alignment:=def_alignment; alignment:=def_alignment;
{ isn't used there }
datasize:=0; datasize:=0;
address_fixup:= 0; address_fixup:= 0;
{ also unused }
unitid:=0; unitid:=0;
{ setup symtabletype specific things }
case typ of
unitsymtable :
begin
symtablelevel:=0;
{$ifndef NEWMAP}
current_module^.map^[0]:=@self;
{$else NEWMAP}
current_module^.globalsymtable:=@self;
{$endif NEWMAP}
end;
recordsymtable,
objectsymtable :
begin
storesymtable:=aktrecordsymtable;
aktrecordsymtable:=@self;
end;
parasymtable,
localsymtable :
begin
storesymtable:=aktlocalsymtable;
aktlocalsymtable:=@self;
end;
{ used for local browser }
staticppusymtable :
begin
aktstaticsymtable:=@self;
symsearch^.usehash;
end;
end;
{ load definitions }
{ we need the correct symtable for registering } { we need the correct symtable for registering }
if not (typ in [localsymtable,parasymtable,recordsymtable,objectsymtable]) then if not (typ in [localsymtable,parasymtable,recordsymtable,objectsymtable]) then
begin begin
@ -1662,19 +1615,30 @@ implementation
{ load symbols } { load symbols }
loadsyms; loadsyms;
{ now we can deref the syms and defs }
if not (typ in [localsymtable,parasymtable,
recordsymtable,objectsymtable]) then
deref;
if typ in [recordsymtable,objectsymtable] then
aktrecordsymtable:=storesymtable;
if typ in [localsymtable,parasymtable] then
aktlocalsymtable:=storesymtable;
if not (typ in [localsymtable,parasymtable,recordsymtable,objectsymtable]) then if not (typ in [localsymtable,parasymtable,recordsymtable,objectsymtable]) then
begin begin
symtablestack:=next; { now we can deref the syms and defs }
end; deref;
{ restore symtablestack }
symtablestack:=next;
end;
case typ of
unitsymtable :
begin
{$ifdef NEWMAP}
{ necessary for dependencies }
current_module^.globalsymtable:=nil;
{$endif NEWMAP}
end;
recordsymtable,
objectsymtable :
aktrecordsymtable:=storesymtable;
localsymtable,
parasymtable :
aktlocalsymtable:=storesymtable;
end;
in_loading:=st_loading; in_loading:=st_loading;
end; end;
@ -1684,31 +1648,40 @@ implementation
oldtyp : byte; oldtyp : byte;
storesymtable : psymtable; storesymtable : psymtable;
begin begin
oldtyp:=current_ppu^.entrytyp;
storesymtable:=aktrecordsymtable; storesymtable:=aktrecordsymtable;
if symtabletype in [recordsymtable,objectsymtable] then case symtabletype of
begin recordsymtable,
storesymtable:=aktrecordsymtable; objectsymtable :
aktrecordsymtable:=@self; begin
end; storesymtable:=aktrecordsymtable;
if symtabletype in [parasymtable,localsymtable] then aktrecordsymtable:=@self;
begin oldtyp:=current_ppu^.entrytyp;
storesymtable:=aktlocalsymtable; current_ppu^.entrytyp:=subentryid;
aktlocalsymtable:=@self; end;
end; parasymtable,
if (symtabletype in [recordsymtable,objectsymtable]) then localsymtable :
current_ppu^.entrytyp:=subentryid; begin
storesymtable:=aktlocalsymtable;
aktlocalsymtable:=@self;
end;
end;
{ order procsym overloads } { order procsym overloads }
foreach({$ifndef TP}@{$endif}Order_overloads); foreach({$ifndef TP}@{$endif}Order_overloads);
{ write definitions } { write definitions }
writedefs; writedefs;
{ write symbols } { write symbols }
writesyms; writesyms;
current_ppu^.entrytyp:=oldtyp; case symtabletype of
if symtabletype in [recordsymtable,objectsymtable] then recordsymtable,
aktrecordsymtable:=storesymtable; objectsymtable :
if symtabletype in [localsymtable,parasymtable] then begin
aktlocalsymtable:=storesymtable; current_ppu^.entrytyp:=oldtyp;
aktrecordsymtable:=storesymtable;
end;
localsymtable,
parasymtable :
aktlocalsymtable:=storesymtable;
end;
end; end;
@ -2192,7 +2165,8 @@ implementation
{$endif GDB} {$endif GDB}
{ load symtables } { load symtables }
inherited load; inherited loadas(unitsymtable);
{ set the name after because it is set to nil in tsymtable.load !! } { set the name after because it is set to nil in tsymtable.load !! }
name:=stringdup(current_module^.modulename^); name:=stringdup(current_module^.modulename^);
@ -2303,7 +2277,7 @@ implementation
current_ppu^.writeentry(ibendinterface); current_ppu^.writeentry(ibendinterface);
{ write the symtable entries } { write the symtable entries }
inherited write; inherited writeas;
{ all after doesn't affect crc } { all after doesn't affect crc }
current_ppu^.do_crc:=false; current_ppu^.do_crc:=false;
@ -2326,7 +2300,7 @@ implementation
needed for local debugging of unit functions } needed for local debugging of unit functions }
if ((current_module^.flags and uf_local_browser)<>0) and if ((current_module^.flags and uf_local_browser)<>0) and
assigned(current_module^.localsymtable) then assigned(current_module^.localsymtable) then
psymtable(current_module^.localsymtable)^.write; psymtable(current_module^.localsymtable)^.writeas;
{ write all browser section } { write all browser section }
if (current_module^.flags and uf_has_browser)<>0 then if (current_module^.flags and uf_has_browser)<>0 then
begin begin
@ -2792,7 +2766,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.71 1999-12-18 14:55:21 florian Revision 1.72 2000-01-03 19:26:04 peter
* fixed resolving of ttypesym which are reference from object/record
fields.
Revision 1.71 1999/12/18 14:55:21 florian
* very basic widestring support * very basic widestring support
Revision 1.70 1999/12/02 11:28:27 peter Revision 1.70 1999/12/02 11:28:27 peter