Browse Source

* fixes for storenumber

peter 26 years ago
parent
commit
d9e1c47d84
4 changed files with 128 additions and 59 deletions
  1. 51 49
      compiler/pdecl.pas
  2. 6 2
      compiler/ppu.pas
  3. 61 6
      compiler/symsym.inc
  4. 10 2
      compiler/symsymh.inc

+ 51 - 49
compiler/pdecl.pas

@@ -1089,7 +1089,6 @@ unit pdecl;
          hs         : string;
          hs         : string;
          pcrd       : pclassrefdef;
          pcrd       : pclassrefdef;
          hp1        : pdef;
          hp1        : pdef;
-         hfp        : pforwardpointer;
          oldprocsym : pprocsym;
          oldprocsym : pprocsym;
          oldparse_only : boolean;
          oldparse_only : boolean;
          intmessagetable,strmessagetable,classnamelabel : plabel;
          intmessagetable,strmessagetable,classnamelabel : plabel;
@@ -1147,23 +1146,8 @@ unit pdecl;
                      begin
                      begin
                         pcrd:=new(pclassrefdef,init(hp1));
                         pcrd:=new(pclassrefdef,init(hp1));
                         object_dec:=pcrd;
                         object_dec:=pcrd;
-                        {I add big troubles here
-                        with var p : ^byte in graph.putimage
-                        because a save_forward was called and
-                        no resolve forward
-                        => so the definition was rewritten after
-                        having been disposed !!
-                        Strange problems appeared !!!!}
-                        {Anyhow forwards should only be allowed
-                        inside a type statement ??
-                        don't you think so }
-                        if (lasttypesym<>nil) and ((lasttypesym^.properties and sp_forwarddef)<>0) then
-                         begin
-                           new(hfp);
-                           hfp^.next:=lasttypesym^.forwardpointer;
-                           hfp^.def:=ppointerdef(pcrd);
-                           lasttypesym^.forwardpointer:=hfp;
-                         end;
+                        if assigned(lasttypesym) and ((lasttypesym^.properties and sp_forwarddef)<>0) then
+                         lasttypesym^.addforwardpointer(ppointerdef(pcrd));
                         forwardsallowed:=false;
                         forwardsallowed:=false;
                      end
                      end
                    else
                    else
@@ -1898,8 +1882,6 @@ unit pdecl;
              ap^.definition:=hp1;
              ap^.definition:=hp1;
         end;
         end;
 
 
-      var
-        hfp : pforwardpointer;
       begin
       begin
          p:=nil;
          p:=nil;
          case token of
          case token of
@@ -1981,23 +1963,8 @@ unit pdecl;
                     forwardsallowed:=true;
                     forwardsallowed:=true;
                  hp1:=single_type(hs);
                  hp1:=single_type(hs);
                  p:=new(ppointerdef,init(hp1));
                  p:=new(ppointerdef,init(hp1));
-                 {I add big troubles here
-                 with var p : ^byte in graph.putimage
-                 because a save_forward was called and
-                 no resolve forward
-                 => so the definition was rewritten after
-                 having been disposed !!
-                 Strange problems appeared !!!!}
-                 {Anyhow forwards should only be allowed
-                 inside a type statement ??
-                 don't you think so }
                  if (lasttypesym<>nil) and ((lasttypesym^.properties and sp_forwarddef)<>0) then
                  if (lasttypesym<>nil) and ((lasttypesym^.properties and sp_forwarddef)<>0) then
-                  begin
-                    new(hfp);
-                    hfp^.next:=lasttypesym^.forwardpointer;
-                    hfp^.def:=ppointerdef(p);
-                    lasttypesym^.forwardpointer:=hfp;
-                  end;
+                   lasttypesym^.addforwardpointer(ppointerdef(p));
                  forwardsallowed:=false;
                  forwardsallowed:=false;
               end;
               end;
             _RECORD:
             _RECORD:
@@ -2059,12 +2026,8 @@ unit pdecl;
 
 
       var
       var
          typename : stringid;
          typename : stringid;
-         newtype : ptypesym;
-{$ifdef dummy}
-         olddef,newdef : pdef;
-         s : string;
-{$endif dummy}
-
+         newtype  : ptypesym;
+         sym      : psym;
       begin
       begin
          block_type:=bt_type;
          block_type:=bt_type;
          consume(_TYPE);
          consume(_TYPE);
@@ -2095,13 +2058,48 @@ unit pdecl;
 {$endif testequaltype}
 {$endif testequaltype}
              begin
              begin
                 getsym(typename,false);
                 getsym(typename,false);
+                sym:=srsym;
+                newtype:=nil;
+{$ifdef STORENUMBER}
+                { found a symbol with this name? }
+                if assigned(sym) then
+                 begin
+                   if (sym^.typ=typesym) then
+                    begin
+                      if (token=_CLASS) and
+                         (assigned(ptypesym(sym)^.definition)) and
+                         (ptypesym(sym)^.definition^.deftype=objectdef) and
+                         ((pobjectdef(ptypesym(sym)^.definition)^.options and oo_isforward)<>0) and
+                         ((pobjectdef(ptypesym(sym)^.definition)^.options and oo_is_class)<>0) then
+                       begin
+                         { we can ignore the result   }
+                         { the definition is modified }
+                         object_dec(typename,pobjectdef(ptypesym(sym)^.definition));
+                         newtype:=ptypesym(sym);
+                       end
+                      else
+                       if sym^.properties=sp_forwarddef then
+                        begin
+                          ptypesym(sym)^.updateforwarddef(read_type(typename));
+                          newtype:=ptypesym(sym);
+                        end;
+                    end;
+                 end;
+                { no old type reused ? Then insert this new type }
+                if not assigned(newtype) then
+                 begin
+                   newtype:=new(ptypesym,init(typename,read_type(typename)));
+                   newtype:=ptypesym(symtablestack^.insert(newtype));
+                 end;
+{$else}
                 { check if it is the definition of a forward defined class }
                 { check if it is the definition of a forward defined class }
-                if assigned(srsym) and (token=_CLASS) and
-                  (srsym^.typ=typesym) and
-                  (assigned(ptypesym(srsym)^.definition)) and
-                  (ptypesym(srsym)^.definition^.deftype=objectdef) and
-                  ((pobjectdef(ptypesym(srsym)^.definition)^.options and oo_isforward)<>0) and
-                  ((pobjectdef(ptypesym(srsym)^.definition)^.options and oo_is_class)<>0) then
+                if assigned(srsym) and
+                   (token=_CLASS) and
+                   (srsym^.typ=typesym) and
+                   (assigned(ptypesym(srsym)^.definition)) and
+                   (ptypesym(srsym)^.definition^.deftype=objectdef) and
+                   ((pobjectdef(ptypesym(srsym)^.definition)^.options and oo_isforward)<>0) and
+                   ((pobjectdef(ptypesym(srsym)^.definition)^.options and oo_is_class)<>0) then
                   begin
                   begin
                      { we can ignore the result   }
                      { we can ignore the result   }
                      { the definition is modified }
                      { the definition is modified }
@@ -2115,6 +2113,7 @@ unit pdecl;
                        because it can be an already defined forwarded type !! }
                        because it can be an already defined forwarded type !! }
                      newtype:=ptypesym(symtablestack^.insert(newtype));
                      newtype:=ptypesym(symtablestack^.insert(newtype));
                   end;
                   end;
+{$endif}
              end;
              end;
            consume(SEMICOLON);
            consume(SEMICOLON);
            if assigned(newtype^.definition) and (newtype^.definition^.deftype=procvardef) then
            if assigned(newtype^.definition) and (newtype^.definition^.deftype=procvardef) then
@@ -2223,7 +2222,10 @@ unit pdecl;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.107  1999-04-14 09:14:50  peter
+  Revision 1.108  1999-04-17 13:16:19  peter
+    * fixes for storenumber
+
+  Revision 1.107  1999/04/14 09:14:50  peter
     * first things to store the symbol/def number in the ppu
     * first things to store the symbol/def number in the ppu
 
 
   Revision 1.106  1999/04/07 15:31:15  pierre
   Revision 1.106  1999/04/07 15:31:15  pierre

+ 6 - 2
compiler/ppu.pas

@@ -91,6 +91,7 @@ const
   ibunitsym       = 29;  { needed for browser }
   ibunitsym       = 29;  { needed for browser }
   iblabelsym      = 30;
   iblabelsym      = 30;
   ibfuncretsym    = 31;
   ibfuncretsym    = 31;
+  ibsyssym        = 32;
   {definitions}
   {definitions}
   iborddef        = 40;
   iborddef        = 40;
   ibpointerdef    = 41;
   ibpointerdef    = 41;
@@ -230,7 +231,7 @@ implementation
 {$ifdef Test_Double_checksum}
 {$ifdef Test_Double_checksum}
   uses
   uses
     comphook;
     comphook;
-    
+
 {$endif def Test_Double_checksum}
 {$endif def Test_Double_checksum}
 {*****************************************************************************
 {*****************************************************************************
                                    Crc 32
                                    Crc 32
@@ -874,7 +875,10 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.26  1999-04-07 15:39:31  pierre
+  Revision 1.27  1999-04-17 13:16:20  peter
+    * fixes for storenumber
+
+  Revision 1.26  1999/04/07 15:39:31  pierre
     + double_checksum code added
     + double_checksum code added
 
 
   Revision 1.25  1999/03/02 13:49:18  peter
   Revision 1.25  1999/03/02 13:49:18  peter

+ 61 - 6
compiler/symsym.inc

@@ -1719,12 +1719,11 @@
 {$ifdef GDB}
 {$ifdef GDB}
          isusedinstab := false;
          isusedinstab := false;
 {$endif GDB}
 {$endif GDB}
+{$ifndef STORENUMBER}
          forwardpointer:=nil;
          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;
+{$endif}
+        if assigned(definition) and not(assigned(definition^.sym)) then
+          definition^.sym:=@self;
       end;
       end;
 
 
     constructor ttypesym.load;
     constructor ttypesym.load;
@@ -1732,7 +1731,9 @@
       begin
       begin
          tsym.load;
          tsym.load;
          typ:=typesym;
          typ:=typesym;
+{$ifndef STORENUMBER}
          forwardpointer:=nil;
          forwardpointer:=nil;
+{$endif}
 {$ifdef GDB}
 {$ifdef GDB}
          isusedinstab := false;
          isusedinstab := false;
 {$endif GDB}
 {$endif GDB}
@@ -1803,6 +1804,38 @@
       end;
       end;
 
 
 
 
+    procedure ttypesym.addforwardpointer(p:ppointerdef);
+      var
+        hfp : pforwardpointer;
+      begin
+        new(hfp);
+        hfp^.next:=forwardpointer;
+        hfp^.def:=p;
+        forwardpointer:=hfp;
+      end;
+
+
+    procedure ttypesym.updateforwarddef(p:pdef);
+      var
+        lasthfp,hfp : pforwardpointer;
+      begin
+        definition:=p;
+        properties:=current_object_option;
+        fileinfo:=tokenpos;
+        if assigned(definition) and not(assigned(definition^.sym)) then
+          definition^.sym:=@self;
+        { update all forwardpointers to this definition }
+        hfp:=forwardpointer;
+        while assigned(hfp) do
+         begin
+           lasthfp:=hfp;
+           hfp^.def^.definition:=definition;
+           hfp:=hfp^.next;
+           dispose(lasthfp);
+         end;
+      end;
+
+
 {$ifdef BrowserLog}
 {$ifdef BrowserLog}
     procedure ttypesym.add_to_browserlog;
     procedure ttypesym.add_to_browserlog;
       begin
       begin
@@ -1840,6 +1873,7 @@
       end;
       end;
 {$endif GDB}
 {$endif GDB}
 
 
+
 {****************************************************************************
 {****************************************************************************
                                   TSYSSYM
                                   TSYSSYM
 ****************************************************************************}
 ****************************************************************************}
@@ -1851,8 +1885,25 @@
          number:=l;
          number:=l;
       end;
       end;
 
 
+    constructor tsyssym.load;
+      begin
+         tsym.load;
+         typ:=syssym;
+         number:=readlong;
+      end;
+
+    destructor tsyssym.done;
+      begin
+        inherited done;
+      end;
+
     procedure tsyssym.write;
     procedure tsyssym.write;
       begin
       begin
+{$ifdef STORENUMBER}
+         tsym.write;
+         writelong(number);
+         current_ppu^.writeentry(ibsyssym);
+{$endif}
       end;
       end;
 
 
 {$ifdef GDB}
 {$ifdef GDB}
@@ -1861,6 +1912,7 @@
       end;
       end;
 {$endif GDB}
 {$endif GDB}
 
 
+
 {****************************************************************************
 {****************************************************************************
                                   TMACROSYM
                                   TMACROSYM
 ****************************************************************************}
 ****************************************************************************}
@@ -1884,7 +1936,10 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.78  1999-04-14 09:15:02  peter
+  Revision 1.79  1999-04-17 13:16:21  peter
+    * fixes for storenumber
+
+  Revision 1.78  1999/04/14 09:15:02  peter
     * first things to store the symbol/def number in the ppu
     * first things to store the symbol/def number in the ppu
 
 
   Revision 1.77  1999/04/08 10:11:32  pierre
   Revision 1.77  1999/04/08 10:11:32  pierre

+ 10 - 2
compiler/symsymh.inc

@@ -157,7 +157,6 @@
 
 
        ttypesym = object(tsym)
        ttypesym = object(tsym)
           definition : pdef;
           definition : pdef;
-          forwardpointer : pforwardpointer;
 {$ifdef GDB}
 {$ifdef GDB}
           isusedinstab : boolean;
           isusedinstab : boolean;
 {$endif GDB}
 {$endif GDB}
@@ -166,6 +165,8 @@
           destructor done;virtual;
           destructor done;virtual;
           procedure write;virtual;
           procedure write;virtual;
           procedure deref;virtual;
           procedure deref;virtual;
+          procedure addforwardpointer(p:ppointerdef);
+          procedure updateforwarddef(p:pdef);
           procedure load_references;virtual;
           procedure load_references;virtual;
           function  write_references : boolean;virtual;
           function  write_references : boolean;virtual;
 {$ifdef BrowserLog}
 {$ifdef BrowserLog}
@@ -175,6 +176,8 @@
           function stabstring : pchar;virtual;
           function stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
 {$endif GDB}
+       private
+          forwardpointer : pforwardpointer;
        end;
        end;
 
 
        pvarsym = ^tvarsym;
        pvarsym = ^tvarsym;
@@ -330,6 +333,8 @@
        tsyssym = object(tsym)
        tsyssym = object(tsym)
           number : longint;
           number : longint;
           constructor init(const n : string;l : longint);
           constructor init(const n : string;l : longint);
+          constructor load;
+          destructor done;virtual;
           procedure write;virtual;
           procedure write;virtual;
 {$ifdef GDB}
 {$ifdef GDB}
           procedure concatstabto(asmlist : paasmoutput);virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
@@ -338,7 +343,10 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.18  1999-04-14 09:15:03  peter
+  Revision 1.19  1999-04-17 13:16:23  peter
+    * fixes for storenumber
+
+  Revision 1.18  1999/04/14 09:15:03  peter
     * first things to store the symbol/def number in the ppu
     * first things to store the symbol/def number in the ppu
 
 
   Revision 1.17  1999/03/31 13:55:23  peter
   Revision 1.17  1999/03/31 13:55:23  peter