From a7161a8dfcc8266c07e4b097a4d30138860ee3b3 Mon Sep 17 00:00:00 2001
From: peter <peter@freepascal.org>
Date: Mon, 3 Jan 2000 19:26:03 +0000
Subject: [PATCH]   * fixed resolving of ttypesym which are reference from
 object/record     fields.

---
 compiler/symdef.inc   |  23 +++--
 compiler/symdefh.inc  |   7 +-
 compiler/symsym.inc   |  28 +++++-
 compiler/symsymh.inc  |  17 +++-
 compiler/symtable.pas | 220 +++++++++++++++++++-----------------------
 5 files changed, 157 insertions(+), 138 deletions(-)

diff --git a/compiler/symdef.inc b/compiler/symdef.inc
index 8faf08eb91..62734ad710 100644
--- a/compiler/symdef.inc
+++ b/compiler/symdef.inc
@@ -163,12 +163,13 @@
            nextglobal^.previousglobal:=previousglobal;
          previousglobal:=nil;
          nextglobal:=nil;
+{$ifdef SYNONYM}
          while assigned(typesym) do
            begin
               typesym^.restype.setdef(nil);
               typesym:=typesym^.synonym;
            end;
-
+{$endif}
       end;
 
     { used for enumdef because the symbols are
@@ -387,11 +388,6 @@
 
 
     procedure tdef.deref;
-      begin
-      end;
-
-
-    procedure tdef.symderef;
       begin
         resolvesym(psym(typesym));
       end;
@@ -822,6 +818,7 @@
 
     procedure tenumdef.deref;
       begin
+        inherited deref;
         resolvedef(pdef(basedef));
       end;
 
@@ -1320,6 +1317,7 @@
 
     procedure tfiledef.deref;
       begin
+        inherited deref;
         if filetyp=ft_typed then
           typedfiletype.resolve;
       end;
@@ -1479,6 +1477,7 @@
 
     procedure tpointerdef.deref;
       begin
+        inherited deref;
         pointertype.resolve;
       end;
 
@@ -1709,6 +1708,7 @@
 
     procedure tsetdef.deref;
       begin
+        inherited deref;
         elementtype.resolve;
       end;
 
@@ -1859,6 +1859,7 @@
 
     procedure tarraydef.deref;
       begin
+        inherited deref;
         elementtype.resolve;
         rangetype.resolve;
       end;
@@ -2050,6 +2051,7 @@
       var
          oldrecsyms : psymtable;
       begin
+         inherited deref;
          oldrecsyms:=aktrecordsymtable;
          aktrecordsymtable:=symtable;
          { now dereference the definitions }
@@ -2105,6 +2107,8 @@
          else
            spec:='';
          { 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
             pobjectdef(pvarsym(p)^.vartype.def)^.is_class then
             spec:=spec+'*';
@@ -3227,6 +3231,7 @@ Const local_symtable_index : longint = $8001;
       var
          oldrecsyms : psymtable;
       begin
+         inherited deref;
          resolvedef(pdef(childof));
          oldrecsyms:=aktrecordsymtable;
          aktrecordsymtable:=symtable;
@@ -3849,7 +3854,11 @@ Const local_symtable_index : longint = $8001;
 
 {
   $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
 
   Revision 1.183  1999/12/23 12:19:42  peter
diff --git a/compiler/symdefh.inc b/compiler/symdefh.inc
index cbd0bd4211..6faddb7080 100644
--- a/compiler/symdefh.inc
+++ b/compiler/symdefh.inc
@@ -46,7 +46,6 @@
           constructor load;
           destructor  done;virtual;
           procedure deref;virtual;
-          procedure symderef;virtual;
           function  typename:string;
           procedure write;virtual;
           function  size:longint;virtual;
@@ -529,7 +528,11 @@
 
 {
   $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
 
   Revision 1.47  1999/11/17 17:05:04  pierre
diff --git a/compiler/symsym.inc b/compiler/symsym.inc
index 19d7fc3746..d5233288d1 100644
--- a/compiler/symsym.inc
+++ b/compiler/symsym.inc
@@ -161,6 +161,11 @@
       end;
 
 
+    procedure tsym.prederef;
+      begin
+      end;
+
+
     procedure tsym.deref;
       begin
       end;
@@ -1889,6 +1894,7 @@
 {$ifdef GDB}
          isusedinstab := false;
 {$endif GDB}
+{$ifdef SYNONYM}
          if assigned(restype.def) then
           begin
              if not(assigned(restype.def^.typesym)) then
@@ -1907,6 +1913,12 @@
                   restype.def^.typesym^.synonym:=@self;
                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;
 
     constructor ttypesym.initdef(const n : string;d : pdef);
@@ -1921,13 +1933,16 @@
       begin
          tsym.load;
          typ:=typesym;
+{$ifdef SYNONYM}
          synonym:=nil;
+{$endif}
 {$ifdef GDB}
          isusedinstab := false;
 {$endif GDB}
          restype.load;
       end;
 
+{$ifdef SYNONYM}
     destructor ttypesym.done;
       var
         prevsym : ptypesym;
@@ -1950,12 +1965,13 @@
          synonym:=nil;
          inherited done;
       end;
+{$endif}
 
 
-    procedure ttypesym.deref;
-
+    procedure ttypesym.prederef;
       begin
          restype.resolve;
+{$ifdef SYNONYM}
          if assigned(restype.def) then
           begin
             if (sp_primary_typesym in symoptions) then
@@ -1979,11 +1995,11 @@
                (restype.def^.typesym=@self) then
               precorddef(restype.def)^.symtable^.name:=stringdup('record '+name);
           end;
+{$endif}
       end;
 
 
     procedure ttypesym.write;
-
       begin
          tsym.write;
          restype.write;
@@ -2122,7 +2138,11 @@
 
 {
   $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
     * FPC_USE_CPREFIX code removed, not necessary anymore
       as we use .edata direct writing by default now.
diff --git a/compiler/symsymh.inc b/compiler/symsymh.inc
index e0a578e004..a616232de5 100644
--- a/compiler/symsymh.inc
+++ b/compiler/symsymh.inc
@@ -41,11 +41,12 @@
           constructor load;
           destructor done;virtual;
           procedure write;virtual;
+          procedure prederef;virtual; { needed for ttypesym to be deref'd first }
           procedure deref;virtual;
-          function mangledname : string;virtual;
+          function  mangledname : string;virtual;
           procedure insert_in_data;virtual;
 {$ifdef GDB}
-          function stabstring : pchar;virtual;
+          function  stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
           procedure load_references;virtual;
@@ -130,16 +131,20 @@
 
        ttypesym = object(tsym)
           restype    : ttype;
+{$ifdef SYNONYM}
           synonym    : ptypesym;
+{$endif}
 {$ifdef GDB}
           isusedinstab : boolean;
 {$endif GDB}
           constructor init(const n : string;const tt : ttype);
           constructor initdef(const n : string;d : pdef);
           constructor load;
+{$ifdef SYNONYM}
           destructor done;virtual;
+{$endif}
           procedure write;virtual;
-          procedure deref;virtual;
+          procedure prederef;virtual;
           procedure load_references;virtual;
           function  write_references : boolean;virtual;
 {$ifdef BrowserLog}
@@ -312,7 +317,11 @@
 
 {
   $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
 
   Revision 1.42  1999/11/30 10:40:56  peter
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 16c6fb86b2..d4e17cd6d6 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -192,8 +192,6 @@ unit symtable;
           function getdefnr(l : longint) : pdef;
           function getsymnr(l : longint) : psym;
           { load/write }
-          constructor load;
-          procedure write;
           constructor loadas(typ : tsymtabletype);
           procedure writeas;
           procedure loaddefs;
@@ -1056,12 +1054,6 @@ implementation
          psym(p)^.deref;
       end;
 
-    procedure derefsymsdelayed(p : pnamedindexobject);
-      begin
-         if psym(p)^.typ in [absolutesym,propertysym] then
-           psym(p)^.deref;
-      end;
-
     procedure check_forward(sym : pnamedindexobject);
       begin
          if psym(sym)^.typ=procsym then
@@ -1536,14 +1528,21 @@ implementation
         hp : pdef;
         hs : psym;
       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);
         while assigned(hp) do
          begin
            hp^.deref;
-           hp^.symderef;
            hp:=pdef(hp^.next);
          end;
-
+        { deref the symbols }
         hs:=psym(symindex^.first);
         while assigned(hs) do
          begin
@@ -1553,64 +1552,6 @@ implementation
       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);
       var
          storesymtable : psymtable;
@@ -1623,32 +1564,44 @@ implementation
          new(defindex,init(indexgrowsize));
          new(symsearch,init);
          symsearch^.noclear:=true;
+       { reset }
          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;
          alignment:=def_alignment;
-         { isn't used there }
          datasize:=0;
          address_fixup:= 0;
-         { also unused }
          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 }
          if not (typ in [localsymtable,parasymtable,recordsymtable,objectsymtable]) then
            begin
@@ -1662,19 +1615,30 @@ implementation
       { load symbols }
          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
-           begin
-             symtablestack:=next;
-           end;
+          begin
+            { now we can deref the syms and defs }
+            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;
       end;
 
@@ -1684,31 +1648,40 @@ implementation
          oldtyp : byte;
          storesymtable : psymtable;
       begin
-         oldtyp:=current_ppu^.entrytyp;
          storesymtable:=aktrecordsymtable;
-         if symtabletype in [recordsymtable,objectsymtable] then
-           begin
-             storesymtable:=aktrecordsymtable;
-             aktrecordsymtable:=@self;
-           end;
-         if symtabletype in [parasymtable,localsymtable] then
-           begin
-             storesymtable:=aktlocalsymtable;
-             aktlocalsymtable:=@self;
-           end;
-         if (symtabletype in [recordsymtable,objectsymtable]) then
-         current_ppu^.entrytyp:=subentryid;
+         case symtabletype of
+           recordsymtable,
+           objectsymtable :
+             begin
+               storesymtable:=aktrecordsymtable;
+               aktrecordsymtable:=@self;
+               oldtyp:=current_ppu^.entrytyp;
+               current_ppu^.entrytyp:=subentryid;
+             end;
+           parasymtable,
+           localsymtable :
+             begin
+               storesymtable:=aktlocalsymtable;
+               aktlocalsymtable:=@self;
+             end;
+         end;
       { order procsym overloads }
          foreach({$ifndef TP}@{$endif}Order_overloads);
          { write definitions }
          writedefs;
          { write symbols }
          writesyms;
-         current_ppu^.entrytyp:=oldtyp;
-         if symtabletype in [recordsymtable,objectsymtable] then
-           aktrecordsymtable:=storesymtable;
-         if symtabletype in [localsymtable,parasymtable] then
-           aktlocalsymtable:=storesymtable;
+         case symtabletype of
+           recordsymtable,
+           objectsymtable :
+             begin
+               current_ppu^.entrytyp:=oldtyp;
+               aktrecordsymtable:=storesymtable;
+             end;
+           localsymtable,
+           parasymtable :
+             aktlocalsymtable:=storesymtable;
+         end;
       end;
 
 
@@ -2192,7 +2165,8 @@ implementation
 {$endif GDB}
 
        { load symtables }
-         inherited load;
+         inherited loadas(unitsymtable);
+
        { set the name after because it is set to nil in tsymtable.load !! }
          name:=stringdup(current_module^.modulename^);
 
@@ -2303,7 +2277,7 @@ implementation
         current_ppu^.writeentry(ibendinterface);
 
       { write the symtable entries }
-        inherited write;
+        inherited writeas;
 
       { all after doesn't affect crc }
         current_ppu^.do_crc:=false;
@@ -2326,7 +2300,7 @@ implementation
            needed for local debugging of unit functions }
         if ((current_module^.flags and uf_local_browser)<>0) and
            assigned(current_module^.localsymtable) then
-          psymtable(current_module^.localsymtable)^.write;
+          psymtable(current_module^.localsymtable)^.writeas;
       { write all browser section }
         if (current_module^.flags and uf_has_browser)<>0 then
          begin
@@ -2792,7 +2766,11 @@ implementation
 end.
 {
   $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
 
   Revision 1.70  1999/12/02 11:28:27  peter