* indirect type referencing is now allowed

compiler/pbase.pas

@@ -78,10 +78,6 @@ unit pbase;
     { reads a list of identifiers into a string container }
     function idlist : pstringcontainer;
 
-    { inserts the symbols of sc in st with def as definition }
-    { sc is disposed                                         }
-    procedure insert_syms(st : psymtable;sc : pstringcontainer;def : pdef;is_threadvar : boolean);
-
     { just for an accurate position of the end of a procedure (PM) }
     var
        last_endtoken_filepos: tfileposinfo;
@@ -165,41 +161,14 @@ unit pbase;
          idlist:=sc;
       end;
 
-
-    { inserts the symbols of sc in st with def as definition }
-    { sc is disposed                                         }
-    procedure insert_syms(st : psymtable;sc : pstringcontainer;def : pdef;is_threadvar : boolean);
-      var
-         s : string;
-         filepos : tfileposinfo;
-         ss : pvarsym;
-      begin
-         filepos:=tokenpos;
-         while not sc^.empty do
-           begin
-              s:=sc^.get_with_tokeninfo(tokenpos);
-              ss:=new(pvarsym,init(s,def));
-              if is_threadvar then
-                ss^.var_options:=ss^.var_options or vo_is_thread_var;
-              st^.insert(ss);
-              { static data fields are inserted in the globalsymtable }
-              if (st^.symtabletype=objectsymtable) and
-                 ((current_object_option and sp_static)<>0) then
-                begin
-                   s:=lower(st^.name^)+'_'+s;
-                   st^.defowner^.owner^.insert(new(pvarsym,init(s,def)));
-                end;
-
-           end;
-         dispose(sc,done);
-         tokenpos:=filepos;
-      end;
-
 end.
 
 {
   $Log$
-  Revision 1.22  1999-07-26 09:42:10  florian
+  Revision 1.23  1999-07-27 23:42:10  peter
+    * indirect type referencing is now allowed
+
+  Revision 1.22  1999/07/26 09:42:10  florian
     * bugs 494-496 fixed
 
   Revision 1.21  1999/04/28 06:02:05  florian

compiler/pdecl.pas

@@ -31,6 +31,7 @@ unit pdecl;
        { pointer to the last read type symbol, (for "forward" }
        { types)                                        }
        lasttypesym : ptypesym;
+       readtypesym : ptypesym; { ttypesym read by read_type }
 
        { hack, which allows to use the current parsed }
        { object type as function argument type  }
@@ -190,10 +191,20 @@ unit pdecl;
                    tokenpos:=filepos;
 {$ifdef DELPHI_CONST_IN_RODATA}
                    if m_delphi in aktmodeswitches then
-                     sym:=new(ptypedconstsym,init(name,def,true))
+                     begin
+                       if assigned(readtypesym) then
+                        sym:=new(ptypedconstsym,initsym(name,readtypesym,true))
+                       else
+                        sym:=new(ptypedconstsym,init(name,def,true))
+                     end
                    else
 {$endif DELPHI_CONST_IN_RODATA}
-                     sym:=new(ptypedconstsym,init(name,def,false));
+                     begin
+                       if assigned(readtypesym) then
+                        sym:=new(ptypedconstsym,initsym(name,readtypesym,false))
+                       else
+                        sym:=new(ptypedconstsym,init(name,def,false))
+                     end;
                    tokenpos:=storetokenpos;
                    symtablestack^.insert(sym);
                    consume(EQUAL);
@@ -247,6 +258,40 @@ unit pdecl;
     { types are allowed                  }
     { => the procedure is also used to read     }
     { a sequence of variable declaration        }
+
+      procedure insert_syms(st : psymtable;sc : pstringcontainer;def : pdef;sym:ptypesym;is_threadvar : boolean);
+      { inserts the symbols of sc in st with def as definition or sym as ptypesym, sc is disposed }
+        var
+           s : string;
+           filepos : tfileposinfo;
+           ss : pvarsym;
+        begin
+           { can't have a definition and ttypesym }
+           if assigned(def) and assigned(sym) then
+            internalerror(5438257);
+           filepos:=tokenpos;
+           while not sc^.empty do
+             begin
+                s:=sc^.get_with_tokeninfo(tokenpos);
+                if assigned(sym) then
+                 ss:=new(pvarsym,initsym(s,sym))
+                else
+                 ss:=new(pvarsym,init(s,def));
+                if is_threadvar then
+                  ss^.var_options:=ss^.var_options or vo_is_thread_var;
+                st^.insert(ss);
+                { static data fields are inserted in the globalsymtable }
+                if (st^.symtabletype=objectsymtable) and
+                   ((current_object_option and sp_static)<>0) then
+                  begin
+                     s:=lower(st^.name^)+'_'+s;
+                     st^.defowner^.owner^.insert(new(pvarsym,init(s,def)));
+                  end;
+             end;
+           dispose(sc,done);
+           tokenpos:=filepos;
+        end;
+
       var
          sc : pstringcontainer;
          s : stringid;
@@ -403,7 +448,10 @@ unit pdecl;
                   s:=sc^.get_with_tokeninfo(tokenpos);
                   if not sc^.empty then
                     Message(parser_e_initialized_only_one_var);
-                  pconstsym:=new(ptypedconstsym,init(s,p,false));
+                  if assigned(readtypesym) then
+                   pconstsym:=new(ptypedconstsym,initsym(s,readtypesym,false))
+                  else
+                   pconstsym:=new(ptypedconstsym,init(s,p,false));
                   symtablestack^.insert(pconstsym);
                   tokenpos:=storetokenpos;
                   consume(EQUAL);
@@ -482,14 +530,24 @@ unit pdecl;
                    storetokenpos:=tokenpos;
                    tokenpos:=declarepos;
                    if is_dll then
-                    aktvarsym:=new(pvarsym,init_dll(s,p))
+                    begin
+                      if assigned(readtypesym) then
+                       aktvarsym:=new(pvarsym,initsym_dll(s,readtypesym))
+                      else
+                       aktvarsym:=new(pvarsym,init_dll(s,p))
+                    end
                    else
-                    aktvarsym:=new(pvarsym,init_C(s,C_name,p));
+                    begin
+                      if assigned(readtypesym) then
+                       aktvarsym:=new(pvarsym,initsym_C(s,C_name,readtypesym))
+                      else
+                       aktvarsym:=new(pvarsym,init_C(s,C_name,p));
+                    end;
                    { set some vars options }
                    if export_aktvarsym then
                     inc(aktvarsym^.refs);
                    if extern_aktvarsym then
-                      aktvarsym^.var_options:=aktvarsym^.var_options or vo_is_external;
+                    aktvarsym^.var_options:=aktvarsym^.var_options or vo_is_external;
                    { insert in the stack/datasegment }
                    symtablestack^.insert(aktvarsym);
                    tokenpos:=storetokenpos;
@@ -513,7 +571,10 @@ unit pdecl;
                  if (is_object) and (cs_static_keyword in aktmoduleswitches) and (idtoken=_STATIC) then
                   begin
                     current_object_option:=current_object_option or sp_static;
-                    insert_syms(symtablestack,sc,p,false);
+                    if assigned(readtypesym) then
+                     insert_syms(symtablestack,sc,nil,readtypesym,false)
+                    else
+                     insert_syms(symtablestack,sc,p,nil,false);
                     current_object_option:=current_object_option - sp_static;
                     consume(_STATIC);
                     consume(SEMICOLON);
@@ -526,7 +587,10 @@ unit pdecl;
                   if (current_object_option=sp_published) and
                     (not((p^.deftype=objectdef) and (pobjectdef(p)^.isclass))) then
                     Message(parser_e_cant_publish_that);
-                  insert_syms(symtablestack,sc,p,is_threadvar);
+                  if assigned(readtypesym) then
+                   insert_syms(symtablestack,sc,nil,readtypesym,is_threadvar)
+                  else
+                   insert_syms(symtablestack,sc,p,nil,is_threadvar);
                end;
            end;
          { Check for Case }
@@ -669,6 +733,11 @@ unit pdecl;
                 testforward_type(srsym);
            end;
          lasttypesym:=ptypesym(srsym);
+         if (ptypesym(srsym)^.owner^.unitid=0) or
+            (ptypesym(srsym)^.owner^.unitid=1) then
+          readtypesym:=nil
+         else
+          readtypesym:=ptypesym(srsym);
          id_type:=ptypesym(srsym)^.definition;
       end;
 
@@ -679,12 +748,14 @@ unit pdecl;
        var
           hs : string;
        begin
+          readtypesym:=nil;
           case token of
             _STRING:
                 begin
                    single_type:=stringtype;
                    s:='STRING';
                    lasttypesym:=nil;
+                   readtypesym:=nil;
                 end;
             _FILE:
                 begin
@@ -702,8 +773,12 @@ unit pdecl;
                         s:='FILE';
                      end;
                    lasttypesym:=nil;
+                   readtypesym:=nil;
                 end;
-            else single_type:=id_type(s);
+            else
+              begin
+                single_type:=id_type(s);
+              end;
          end;
       end;
 
@@ -1557,102 +1632,99 @@ unit pdecl;
     { reads a type definition and returns a pointer to it }
     function read_type(const name : stringid) : pdef;
 
-    function handle_procvar:Pprocvardef;
-
-    var
-       sc : pstringcontainer;
-       hs1,s : string;
-       p : pdef;
-       varspez : tvarspez;
-       procvardef : pprocvardef;
-
-    begin
-       procvardef:=new(pprocvardef,init);
-       if token=LKLAMMER then
-         begin
-            consume(LKLAMMER);
-            inc(testcurobject);
-            repeat
-              if try_to_consume(_VAR) then
-               varspez:=vs_var
-              else
-               if try_to_consume(_CONST) then
-                 varspez:=vs_const
-               else
-                 varspez:=vs_value;
-              { self method ? }
-              if idtoken=_SELF then
-               begin
-                 procvardef^.options:=procvardef^.options or pocontainsself;
-                 consume(idtoken);
-                 consume(COLON);
-                 p:=single_type(hs1);
-                 procvardef^.concatdef(p,vs_value);
-               end
-              else
-               begin
-                 sc:=idlist;
-                 if (token=COLON) or (varspez=vs_value) then
+        function handle_procvar:Pprocvardef;
+        var
+           sc : pstringcontainer;
+           hs1,s : string;
+           p : pdef;
+           varspez : tvarspez;
+           procvardef : pprocvardef;
+        begin
+           procvardef:=new(pprocvardef,init);
+           if token=LKLAMMER then
+             begin
+                consume(LKLAMMER);
+                inc(testcurobject);
+                repeat
+                  if try_to_consume(_VAR) then
+                   varspez:=vs_var
+                  else
+                   if try_to_consume(_CONST) then
+                     varspez:=vs_const
+                   else
+                     varspez:=vs_value;
+                  { self method ? }
+                  if idtoken=_SELF then
                    begin
-                      consume(COLON);
-                      if token=_ARRAY then
-                        begin
-                          consume(_ARRAY);
-                          consume(_OF);
-                        { define range and type of range }
-                          p:=new(Parraydef,init(0,-1,s32bitdef));
-                        { array of const ? }
-                          if (token=_CONST) and (m_objpas in aktmodeswitches) then
-                           begin
-                             consume(_CONST);
-                             srsym:=nil;
-                             if assigned(objpasunit) then
-                              getsymonlyin(objpasunit,'TVARREC');
-                             if not assigned(srsym) then
-                              InternalError(1234124);
-                             Parraydef(p)^.definition:=ptypesym(srsym)^.definition;
-                             Parraydef(p)^.IsArrayOfConst:=true;
-                           end
-                          else
-                           begin
-                           { define field type }
-                             Parraydef(p)^.definition:=single_type(s);
-                           end;
-                        end
-                      else
-                        p:=single_type(s);
+                     procvardef^.options:=procvardef^.options or pocontainsself;
+                     consume(idtoken);
+                     consume(COLON);
+                     p:=single_type(hs1);
+                     procvardef^.concatdef(p,vs_value);
                    end
-                 else
-                   p:=cformaldef;
-                 while not sc^.empty do
+                  else
                    begin
-                      s:=sc^.get;
-                      procvardef^.concatdef(p,varspez);
+                     sc:=idlist;
+                     if (token=COLON) or (varspez=vs_value) then
+                       begin
+                          consume(COLON);
+                          if token=_ARRAY then
+                            begin
+                              consume(_ARRAY);
+                              consume(_OF);
+                            { define range and type of range }
+                              p:=new(Parraydef,init(0,-1,s32bitdef));
+                            { array of const ? }
+                              if (token=_CONST) and (m_objpas in aktmodeswitches) then
+                               begin
+                                 consume(_CONST);
+                                 srsym:=nil;
+                                 if assigned(objpasunit) then
+                                  getsymonlyin(objpasunit,'TVARREC');
+                                 if not assigned(srsym) then
+                                  InternalError(1234124);
+                                 Parraydef(p)^.definition:=ptypesym(srsym)^.definition;
+                                 Parraydef(p)^.IsArrayOfConst:=true;
+                               end
+                              else
+                               begin
+                               { define field type }
+                                 Parraydef(p)^.definition:=single_type(s);
+                               end;
+                            end
+                          else
+                            p:=single_type(s);
+                       end
+                     else
+                       p:=cformaldef;
+                     while not sc^.empty do
+                       begin
+                          s:=sc^.get;
+                          procvardef^.concatdef(p,varspez);
+                       end;
+                     dispose(sc,done);
                    end;
-                 dispose(sc,done);
-               end;
-            until not try_to_consume(SEMICOLON);
-            dec(testcurobject);
-            consume(RKLAMMER);
-         end;
-       handle_procvar:=procvardef;
-    end;
+                until not try_to_consume(SEMICOLON);
+                dec(testcurobject);
+                consume(RKLAMMER);
+             end;
+           handle_procvar:=procvardef;
+        end;
 
       var
-         hp1,p : pdef;
-         aufdef : penumdef;
-         aufsym : penumsym;
-         ap : parraydef;
-         s : stringid;
-         l,v : longint;
-         oldaktpackrecords : tpackrecords;
-         hs : string;
-
-      procedure expr_type;
-
+        pt : ptree;
+        hp1,p : pdef;
+        aufdef : penumdef;
+        aufsym : penumsym;
+        ap : parraydef;
+        s : stringid;
+        l,v : longint;
+        oldaktpackrecords : tpackrecords;
+        hs : string;
+
+        procedure expr_type;
         var
            pt1,pt2 : ptree;
-
         begin
            { use of current parsed object ? }
            if (token=ID) and (testcurobject=2) and (curobjectname=pattern) then
@@ -1705,17 +1777,17 @@ unit pdecl;
              begin
                { a simple type renaming }
                if (pt1^.treetype=typen) then
-                 p:=pt1^.resulttype
+                 begin
+                   p:=pt1^.resulttype;
+                   readtypesym:=pt1^.typenodesym;
+                 end
                else
                  Message(sym_e_error_in_type_def);
              end;
            disposetree(pt1);
         end;
 
-      var
-         pt : ptree;
-
-      procedure array_dec;
+        procedure array_dec;
         var
           lowval,
           highval   : longint;
@@ -1801,10 +1873,14 @@ unit pdecl;
         end;
 
       begin
+         readtypesym:=nil;
          p:=nil;
          case token of
             _STRING,_FILE:
-              p:=single_type(hs);
+              begin
+                p:=single_type(hs);
+                readtypesym:=nil;
+              end;
             LKLAMMER:
               begin
                  consume(LKLAMMER);
@@ -1839,96 +1915,118 @@ unit pdecl;
                  min and max are now set in tenumsym.init PM }
                  p:=aufdef;
                  consume(RKLAMMER);
+                readtypesym:=nil;
               end;
             _ARRAY:
-              array_dec;
+              begin
+                array_dec;
+                readtypesym:=nil;
+              end;
             _SET:
               begin
-                 consume(_SET);
-                 consume(_OF);
-                 hp1:=read_type('');
-                 if assigned(hp1) then
-                  begin
-                    case hp1^.deftype of
+                consume(_SET);
+                consume(_OF);
+                hp1:=read_type('');
+                if assigned(hp1) then
+                 begin
+                   case hp1^.deftype of
                      { don't forget that min can be negativ  PM }
-                     enumdef : if penumdef(hp1)^.min>=0 then
-                                p:=new(psetdef,init(hp1,penumdef(hp1)^.max))
+                     enumdef :
+                       if penumdef(hp1)^.min>=0 then
+                        p:=new(psetdef,init(hp1,penumdef(hp1)^.max))
+                       else
+                        Message(sym_e_ill_type_decl_set);
+                     orddef :
+                       begin
+                         case porddef(hp1)^.typ of
+                           uchar :
+                             p:=new(psetdef,init(hp1,255));
+                           u8bit,u16bit,u32bit,
+                           s8bit,s16bit,s32bit :
+                             begin
+                               if (porddef(hp1)^.low>=0) then
+                                p:=new(psetdef,init(hp1,porddef(hp1)^.high))
                                else
                                 Message(sym_e_ill_type_decl_set);
-                      orddef : begin
-                                 case porddef(hp1)^.typ of
-                                     uchar : p:=new(psetdef,init(hp1,255));
-                                     u8bit,s8bit,u16bit,s16bit,s32bit :
-                                       begin
-                                          if (porddef(hp1)^.low>=0) then
-                                            p:=new(psetdef,init(hp1,porddef(hp1)^.high))
-                                          else Message(sym_e_ill_type_decl_set);
-                                       end;
-                                  else Message(sym_e_ill_type_decl_set);
-                                  end;
-                               end;
-                    else Message(sym_e_ill_type_decl_set);
-                    end;
-                  end
-                 else
-                  p:=generrordef;
+                             end;
+                           else
+                             Message(sym_e_ill_type_decl_set);
+                         end;
+                       end;
+                     else
+                       Message(sym_e_ill_type_decl_set);
+                   end;
+                 end
+                else
+                 p:=generrordef;
+                readtypesym:=nil;
               end;
             CARET:
               begin
-                 consume(CARET);
-                 { forwards allowed only inside TYPE statements }
-                 if typecanbeforward then
-                    forwardsallowed:=true;
-                 hp1:=single_type(hs);
-                 p:=new(ppointerdef,init(hp1));
-                 if (lasttypesym<>nil) and ((lasttypesym^.properties and sp_forwarddef)<>0) then
-                   lasttypesym^.addforwardpointer(ppointerdef(p));
-                 forwardsallowed:=false;
+                consume(CARET);
+                { forwards allowed only inside TYPE statements }
+                if typecanbeforward then
+                  forwardsallowed:=true;
+                hp1:=single_type(hs);
+                p:=new(ppointerdef,init(hp1));
+                if (lasttypesym<>nil) and ((lasttypesym^.properties and sp_forwarddef)<>0) then
+                  lasttypesym^.addforwardpointer(ppointerdef(p));
+                forwardsallowed:=false;
+                readtypesym:=nil;
               end;
             _RECORD:
-              p:=record_dec;
+              begin
+                p:=record_dec;
+                readtypesym:=nil;
+              end;
             _PACKED:
               begin
-                 consume(_PACKED);
-                 if token=_ARRAY then
-                   array_dec
-                 else
-                   begin
-                      oldaktpackrecords:=aktpackrecords;
-                      aktpackrecords:=packrecord_1;
-                      if token in [_CLASS,_OBJECT] then
-                        p:=object_dec(name,nil)
-                      else
-                        p:=record_dec;
-                      aktpackrecords:=oldaktpackrecords;
-                   end;
+                consume(_PACKED);
+                if token=_ARRAY then
+                  array_dec
+                else
+                  begin
+                    oldaktpackrecords:=aktpackrecords;
+                    aktpackrecords:=packrecord_1;
+                    if token in [_CLASS,_OBJECT] then
+                      p:=object_dec(name,nil)
+                    else
+                      p:=record_dec;
+                    aktpackrecords:=oldaktpackrecords;
+                  end;
+                readtypesym:=nil;
               end;
             _CLASS,
             _OBJECT:
-              p:=object_dec(name,nil);
+              begin
+                p:=object_dec(name,nil);
+                readtypesym:=nil;
+              end;
             _PROCEDURE:
               begin
-                 consume(_PROCEDURE);
-                 p:=handle_procvar;
-                 if token=_OF then
-                   begin
-                      consume(_OF);
-                      consume(_OBJECT);
-                      pprocvardef(p)^.options:=pprocvardef(p)^.options or pomethodpointer;
-                   end;
+                consume(_PROCEDURE);
+                p:=handle_procvar;
+                if token=_OF then
+                  begin
+                    consume(_OF);
+                    consume(_OBJECT);
+                    pprocvardef(p)^.options:=pprocvardef(p)^.options or pomethodpointer;
+                  end;
+                readtypesym:=nil;
               end;
             _FUNCTION:
               begin
-                 consume(_FUNCTION);
-                 p:=handle_procvar;
-                 consume(COLON);
-                 pprocvardef(p)^.retdef:=single_type(hs);
-                 if token=_OF then
-                   begin
-                      consume(_OF);
-                      consume(_OBJECT);
-                      pprocvardef(p)^.options:=pprocvardef(p)^.options or pomethodpointer;
-                   end;
+                consume(_FUNCTION);
+                p:=handle_procvar;
+                consume(COLON);
+                pprocvardef(p)^.retdef:=single_type(hs);
+                if token=_OF then
+                  begin
+                     consume(_OF);
+                     consume(_OBJECT);
+                     pprocvardef(p)^.options:=pprocvardef(p)^.options or pomethodpointer;
+                  end;
+                readtypesym:=nil;
               end;
             else
               expr_type;
@@ -2188,7 +2286,10 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.135  1999-07-23 16:05:23  peter
+  Revision 1.136  1999-07-27 23:42:11  peter
+    * indirect type referencing is now allowed
+
+  Revision 1.135  1999/07/23 16:05:23  peter
     * alignment is now saved in the symtable
     * C alignment added for records
     * PPU version increased to solve .12 <-> .13 probs

compiler/pexpr.pas

@@ -978,15 +978,19 @@ unit pexpr;
                                end
                               else
                                begin
-                                 { illegal reference ? }
-                                 if pd^.owner^.unitid=-1 then
-                                  Comment(V_Error,'illegal type reference, unit '+pd^.owner^.name^+' is not in uses');
                                  { if we read a type declaration  }
                                  { we have to return the type and }
                                  { nothing else               }
                                   if block_type=bt_type then
                                    begin
-                                     p1:=gentypenode(pd);
+                                     { we don't need sym reference when it's in the
+                                       current unit or system unit, because those
+                                       units are always loaded (PFV) }
+                                     if (pd^.owner^.unitid=0) or
+                                        (pd^.owner^.unitid=1) then
+                                      p1:=gentypenode(pd,nil)
+                                     else
+                                      p1:=gentypenode(pd,ptypesym(srsym));
                                      { here we can also set resulttype !! }
                                      p1^.resulttype:=pd;
                                      pd:=voiddef;
@@ -1011,7 +1015,7 @@ unit pexpr;
                                           begin
                                             if procinfo._class^.isrelated(pobjectdef(pd)) then
                                              begin
-                                               p1:=gentypenode(pd);
+                                               p1:=gentypenode(pd,ptypesym(srsym));
                                                p1^.resulttype:=pd;
                                                srsymtable:=pobjectdef(pd)^.publicsyms;
                                                sym:=pvarsym(srsymtable^.search(pattern));
@@ -1061,7 +1065,7 @@ unit pexpr;
                                           if (pd^.deftype=objectdef)
                                             and pobjectdef(pd)^.isclass then
                                             begin
-                                               p1:=gentypenode(pd);
+                                               p1:=gentypenode(pd,nil);
                                                p1^.resulttype:=pd;
                                                pd:=new(pclassrefdef,init(pd));
                                                p1:=gensinglenode(loadvmtn,p1);
@@ -1073,7 +1077,7 @@ unit pexpr;
                                                { (for typeof etc)     }
                                                if allow_type then
                                                  begin
-                                                    p1:=gentypenode(pd);
+                                                    p1:=gentypenode(pd,nil);
                                                     { here we must use typenodetype explicitly !! PM
                                                     p1^.resulttype:=pd; }
                                                     pd:=voiddef;
@@ -1723,7 +1727,7 @@ unit pexpr;
                     postfixoperators;
                   end
                  else
-                  p1:=gentypenode(pd);
+                  p1:=gentypenode(pd,nil);
                end;
        _FILE : begin
                  pd:=cfiledef;
@@ -1741,7 +1745,7 @@ unit pexpr;
                     postfixoperators;
                   end
                  else
-                  p1:=gentypenode(pd);
+                  p1:=gentypenode(pd,nil);
                end;
      CSTRING : begin
                  p1:=genstringconstnode(pattern);
@@ -2056,7 +2060,10 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.124  1999-07-23 21:31:42  peter
+  Revision 1.125  1999-07-27 23:42:14  peter
+    * indirect type referencing is now allowed
+
+  Revision 1.124  1999/07/23 21:31:42  peter
     * fixed crash with resourcestring
 
   Revision 1.123  1999/07/23 11:37:46  peter

compiler/psub.pas

@@ -105,6 +105,7 @@ begin
       else
         varspez:=vs_value;
     inserthigh:=false;
+    readtypesym:=nil;
     if idtoken=_SELF then
       begin
          { we parse the defintion in the class definition }
@@ -125,7 +126,10 @@ begin
             consume(idtoken);
             consume(COLON);
             p:=single_type(hs1);
-            aktprocsym^.definition^.concatdef(p,vs_value);
+            if assigned(readtypesym) then
+             aktprocsym^.definition^.concattypesym(readtypesym,vs_value)
+            else
+             aktprocsym^.definition^.concatdef(p,vs_value);
             CheckTypes(p,procinfo._class);
            end
          else
@@ -135,7 +139,6 @@ begin
       begin
        { read identifiers }
          sc:=idlist;
-
        { read type declaration, force reading for value and const paras }
          if (token=COLON) or (varspez=vs_value) then
           begin
@@ -165,6 +168,8 @@ begin
                 { define field type }
                   Parraydef(p)^.definition:=single_type(hs1);
                   hs1:='array_of_'+hs1;
+                  { we don't need the typesym anymore }
+                  readtypesym:=nil;
                 end;
                inserthigh:=true;
              end
@@ -201,14 +206,22 @@ begin
          storetokenpos:=tokenpos;
          while not sc^.empty do
           begin
-            s:=sc^.get_with_tokeninfo(tokenpos);
-            aktprocsym^.definition^.concatdef(p,varspez);
-     {$ifndef UseNiceNames}
+{$ifndef UseNiceNames}
             hs2:=hs2+'$'+hs1;
-     {$else UseNiceNames}
+{$else UseNiceNames}
             hs2:=hs2+tostr(length(hs1))+hs1;
-     {$endif UseNiceNames}
-            vs:=new(Pvarsym,init(s,p));
+{$endif UseNiceNames}
+            s:=sc^.get_with_tokeninfo(tokenpos);
+            if assigned(readtypesym) then
+             begin
+               aktprocsym^.definition^.concattypesym(readtypesym,varspez);
+               vs:=new(Pvarsym,initsym(s,readtypesym))
+             end
+            else
+             begin
+               aktprocsym^.definition^.concatdef(p,varspez);
+               vs:=new(Pvarsym,init(s,p));
+             end;
             vs^.varspez:=varspez;
           { we have to add this to avoid var param to be in registers !!!}
             if (varspez in [vs_var,vs_const]) and push_addr_param(p) then
@@ -1841,7 +1854,10 @@ end.
 
 {
   $Log$
-  Revision 1.5  1999-07-26 09:42:15  florian
+  Revision 1.6  1999-07-27 23:42:16  peter
+    * indirect type referencing is now allowed
+
+  Revision 1.5  1999/07/26 09:42:15  florian
     * bugs 494-496 fixed
 
   Revision 1.4  1999/07/11 20:10:24  peter

compiler/symdef.inc

@@ -2108,7 +2108,6 @@
 ***************************************************************************}
 
     constructor tabstractprocdef.init;
-
       begin
          inherited init;
          para1:=nil;
@@ -2119,7 +2118,6 @@
       end;
 
 
-
     procedure disposepdefcoll(var para1 : pdefcoll);
       var
          hp : pdefcoll;
@@ -2146,12 +2144,26 @@
       begin
          new(hp);
          hp^.paratyp:=vsp;
+         hp^.datasym:=nil;
          hp^.data:=p;
          hp^.next:=para1;
          hp^.register:=R_NO;
          para1:=hp;
       end;
 
+    procedure tabstractprocdef.concattypesym(p : ptypesym;vsp : tvarspez);
+      var
+         hp : pdefcoll;
+      begin
+         new(hp);
+         hp^.paratyp:=vsp;
+         hp^.datasym:=p;
+         hp^.data:=p^.definition;
+         hp^.next:=para1;
+         hp^.register:=R_NO;
+         para1:=hp;
+      end;
+
     { all functions returning in FPU are
       assume to use 2 FPU registers
       until the function implementation
@@ -2162,6 +2174,7 @@
            fpu_used:=2;
       end;
 
+
     procedure tabstractprocdef.deref;
       var
          hp : pdefcoll;
@@ -2171,7 +2184,13 @@
          hp:=para1;
          while assigned(hp) do
            begin
-              resolvedef(hp^.data);
+              if assigned(hp^.datasym) then
+               begin
+                 resolvesym(psym(hp^.datasym));
+                 hp^.data:=hp^.datasym^.definition;
+               end
+              else
+               resolvedef(hp^.data);
               hp:=hp^.next;
            end;
       end;
@@ -2196,6 +2215,7 @@
               { hp^.register:=tregister(readbyte); }
               hp^.register:=R_NO;
               hp^.data:=readdefref;
+              hp^.datasym:=ptypesym(readsymref);
               hp^.next:=nil;
               if para1=nil then
                 para1:=hp
@@ -2252,7 +2272,16 @@
            begin
               writebyte(byte(hp^.paratyp));
               { writebyte(byte(hp^.register)); }
-              writedefref(hp^.data);
+              if assigned(hp^.datasym) then
+               begin
+                 writedefref(nil);
+                 writesymref(psym(hp^.datasym));
+               end
+              else
+               begin
+                 writedefref(hp^.data);
+                 writesymref(nil);
+               end;
               hp:=hp^.next;
            end;
       end;
@@ -3493,7 +3522,10 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.134  1999-07-23 23:07:03  peter
+  Revision 1.135  1999-07-27 23:42:18  peter
+    * indirect type referencing is now allowed
+
+  Revision 1.134  1999/07/23 23:07:03  peter
     * fixed stabs for record which still used savesize
 
   Revision 1.133  1999/07/23 16:05:28  peter

compiler/symdefh.inc

@@ -102,6 +102,7 @@
        pdefcoll = ^tdefcoll;
        tdefcoll = record
           data    : pdef;
+          datasym : ptypesym;
           next    : pdefcoll;
           paratyp : tvarspez;
           argconvtyp : targconvtyp;
@@ -351,6 +352,7 @@
           constructor load;
           destructor done;virtual;
           procedure concatdef(p : pdef;vsp : tvarspez);
+          procedure concattypesym(p : ptypesym;vsp : tvarspez);
           procedure deref;virtual;
           function para_size : longint;
           function demangled_paras : string;
@@ -525,7 +527,10 @@
 
 {
   $Log$
-  Revision 1.34  1999-07-23 16:05:30  peter
+  Revision 1.35  1999-07-27 23:42:20  peter
+    * indirect type referencing is now allowed
+
+  Revision 1.34  1999/07/23 16:05:30  peter
     * alignment is now saved in the symtable
     * C alignment added for records
     * PPU version increased to solve .12 <-> .13 probs

compiler/symsym.inc

@@ -773,11 +773,22 @@
 
     procedure tabsolutesym.write;
       begin
+         { Note: This needs to write everything of tvarsym.write }
          tsym.write;
          writebyte(byte(varspez));
          if read_member then
            writelong(address);
-         writedefref(definition);
+         { write only definition or definitionsym }
+         if assigned(definitionsym) then
+          begin
+            writedefref(nil);
+            writesymref(definitionsym);
+          end
+         else
+          begin
+            writedefref(definition);
+            writesymref(nil);
+          end;
          writebyte(var_options and (not vo_regable));
          writebyte(byte(abstyp));
          case abstyp of
@@ -797,7 +808,7 @@
 
     procedure tabsolutesym.deref;
       begin
-         resolvedef(definition);
+         tvarsym.deref;
          if (abstyp=tovar) and (asmname<>nil) then
            begin
               { search previous loaded symtables }
@@ -849,6 +860,7 @@
          tsym.init(n);
          typ:=varsym;
          definition:=p;
+         definitionsym:=nil;
          _mangledname:=nil;
          varspez:=vs_value;
          address:=0;
@@ -899,6 +911,27 @@
       end;
 
 
+    constructor tvarsym.initsym(const n : string;p : ptypesym);
+      begin
+        tvarsym.init(n,p^.definition);
+        definitionsym:=p;
+      end;
+
+
+    constructor tvarsym.initsym_dll(const n : string;p : ptypesym);
+      begin
+        tvarsym.init_dll(n,p^.definition);
+        definitionsym:=p;
+      end;
+
+
+    constructor tvarsym.initsym_C(const n,mangled : string;p : ptypesym);
+      begin
+        tvarsym.init_C(n,mangled,p^.definition);
+        definitionsym:=p;
+      end;
+
+
     constructor tvarsym.load;
       begin
          tsym.load;
@@ -915,15 +948,29 @@
          islocalcopy:=false;
          localvarsym:=nil;
          definition:=readdefref;
+         definitionsym:=ptypesym(readsymref);
          var_options:=readbyte;
          if (var_options and vo_is_C_var)<>0 then
            setmangledname(readstring);
       end;
 
 
+    destructor tvarsym.done;
+      begin
+         strdispose(_mangledname);
+         inherited done;
+      end;
+
+
     procedure tvarsym.deref;
       begin
-         resolvedef(definition);
+         if assigned(definitionsym) then
+          begin
+            resolvesym(psym(definitionsym));
+            definition:=definitionsym^.definition;
+          end
+         else
+          resolvedef(definition);
       end;
 
 
@@ -933,7 +980,17 @@
          writebyte(byte(varspez));
          if read_member then
           writelong(address);
-         writedefref(definition);
+         { write only definition or definitionsym }
+         if assigned(definitionsym) then
+          begin
+            writedefref(nil);
+            writesymref(definitionsym);
+          end
+         else
+          begin
+            writedefref(definition);
+            writesymref(nil);
+          end;
          { symbols which are load are never candidates for a register,
            turn off the regable }
          writebyte(var_options and (not vo_regable));
@@ -993,16 +1050,6 @@
                 vs_value,
                 vs_const :
                   begin
-                    (*case definition^.deftype of
-                      arraydef,
-                      setdef,
-                      stringdef,
-                      recorddef,
-                      objectdef :
-                        getpushsize:=target_os.size_of_pointer;
-                      else
-                        getpushsize:=definition^.size;
-                        this is obsolete use push_param instead (PM) *)
                       if push_addr_param(definition) then
                         getpushsize:=target_os.size_of_pointer
                       else
@@ -1026,7 +1073,8 @@
          else *)
          if length>2 then
            data_align:=4
-         else if length>1 then
+         else
+          if length>1 then
            data_align:=2
          else
            data_align:=1;
@@ -1127,9 +1175,6 @@
                    ali:=data_align(l);
                    if ali>1 then
                      begin
-                        (* this is done
-                           either by the assembler or in ag386bin
-                        bsssegment^.concat(new(pai_align,init(ali))); *)
                         modulo:=owner^.datasize mod ali;
                         if modulo>0 then
                           inc(owner^.datasize,ali-modulo);
@@ -1234,9 +1279,9 @@
 
 {$ifdef GDB}
     function tvarsym.stabstring : pchar;
-    var
-      st : char;
-    begin
+     var
+       st : char;
+     begin
        if (owner^.symtabletype = objectsymtable) and
           ((properties and sp_static)<>0) then
          begin
@@ -1330,44 +1375,41 @@
       end;
 {$endif GDB}
 
-    destructor tvarsym.done;
-
-      begin
-         strdispose(_mangledname);
-         inherited done;
-      end;
-
 
 {****************************************************************************
                              TTYPEDCONSTSYM
 *****************************************************************************}
 
     constructor ttypedconstsym.init(const n : string;p : pdef;really_const : boolean);
-
       begin
          tsym.init(n);
          typ:=typedconstsym;
          definition:=p;
+         definitionsym:=nil;
          is_really_const:=really_const;
          prefix:=stringdup(procprefix);
       end;
 
-    constructor ttypedconstsym.load;
 
+    constructor ttypedconstsym.initsym(const n : string;p : ptypesym;really_const : boolean);
+      begin
+         ttypedconstsym.init(n,p^.definition,really_const);
+         definitionsym:=p;
+      end;
+
+
+    constructor ttypedconstsym.load;
       begin
          tsym.load;
          typ:=typedconstsym;
          definition:=readdefref;
-{$ifdef DELPHI_CONST_IN_RODATA}
-         is_really_const:=boolean(readbyte);
-{$else DELPHI_CONST_IN_RODATA}
-         is_really_const:=false;
-{$endif DELPHI_CONST_IN_RODATA}
+         definitionsym:=ptypesym(readsymref);
          prefix:=stringdup(readstring);
+         is_really_const:=boolean(readbyte);
       end;
 
-    destructor ttypedconstsym.done;
 
+    destructor ttypedconstsym.done;
       begin
          stringdispose(prefix);
          tsym.done;
@@ -1390,77 +1432,80 @@
 
 
     procedure ttypedconstsym.deref;
-
       begin
-         resolvedef(definition);
+         if assigned(definitionsym) then
+          begin
+            resolvesym(psym(definitionsym));
+            definition:=definitionsym^.definition;
+          end
+         else
+          resolvedef(definition);
       end;
 
-    procedure ttypedconstsym.write;
 
+    procedure ttypedconstsym.write;
       begin
          tsym.write;
-         writedefref(definition);
+         { write only definition or definitionsym }
+         if assigned(definitionsym) then
+          begin
+            writedefref(nil);
+            writesymref(definitionsym);
+          end
+         else
+          begin
+            writedefref(definition);
+            writesymref(nil);
+          end;
          writestring(prefix^);
-{$ifdef DELPHI_CONST_IN_RODATA}
          writebyte(byte(is_really_const));
-{$endif DELPHI_CONST_IN_RODATA}
          current_ppu^.writeentry(ibtypedconstsym);
       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
-           }
-           { solved, the ansis string is moved to consts (FK) }
-             really_insert_in_data;
-        end;
 
-      procedure ttypedconstsym.really_insert_in_data;
-        var curconstsegment : paasmoutput;
-            l,ali,modulo : longint;
-            storefilepos : tfileposinfo;
-        begin
-           storefilepos:=aktfilepos;
-           aktfilepos:=tokenpos;
-           if is_really_const then
-             curconstsegment:=consts
-           else
-             curconstsegment:=datasegment;
-           if (cs_smartlink in aktmoduleswitches) then
-             curconstsegment^.concat(new(pai_cut,init));
-           l:=getsize;
-           ali:=data_align(l);
-           if ali>1 then
-             begin
-                curconstsegment^.concat(new(pai_align,init(ali)));
-                modulo:=owner^.datasize mod ali;
-                if modulo>0 then
-                  inc(owner^.datasize,ali-modulo);
-             end;
-           {  Why was there no owner size update here ??? }
-           inc(owner^.datasize,l);
+    procedure ttypedconstsym.insert_in_data;
+      var
+        curconstsegment : paasmoutput;
+        l,ali,modulo : longint;
+        storefilepos : tfileposinfo;
+      begin
+        storefilepos:=aktfilepos;
+        aktfilepos:=tokenpos;
+        if is_really_const then
+          curconstsegment:=consts
+        else
+          curconstsegment:=datasegment;
+        if (cs_smartlink in aktmoduleswitches) then
+          curconstsegment^.concat(new(pai_cut,init));
+        l:=getsize;
+        ali:=data_align(l);
+        if ali>1 then
+          begin
+             curconstsegment^.concat(new(pai_align,init(ali)));
+             modulo:=owner^.datasize mod ali;
+             if modulo>0 then
+               inc(owner^.datasize,ali-modulo);
+          end;
+        {  Why was there no owner size update here ??? }
+        inc(owner^.datasize,l);
 {$ifdef GDB}
-                 if cs_debuginfo in aktmoduleswitches then
-                   concatstabto(curconstsegment);
+              if cs_debuginfo in aktmoduleswitches then
+                concatstabto(curconstsegment);
 {$endif GDB}
-           if owner^.symtabletype=globalsymtable then
-             begin
-                curconstsegment^.concat(new(pai_symbol,initname_global(mangledname)));
-             end
-           else
-             if owner^.symtabletype<>unitsymtable then
-               begin
-                 if (cs_smartlink in aktmoduleswitches) then
-                   curconstsegment^.concat(new(pai_symbol,initname_global(mangledname)))
-                 else
-                   curconstsegment^.concat(new(pai_symbol,initname(mangledname)));
-               end;
-             aktfilepos:=storefilepos;
-           end;
+        if owner^.symtabletype=globalsymtable then
+          begin
+             curconstsegment^.concat(new(pai_symbol,initname_global(mangledname)));
+          end
+        else
+          if owner^.symtabletype<>unitsymtable then
+            begin
+              if (cs_smartlink in aktmoduleswitches) then
+                curconstsegment^.concat(new(pai_symbol,initname_global(mangledname)))
+              else
+                curconstsegment^.concat(new(pai_symbol,initname(mangledname)));
+            end;
+        aktfilepos:=storefilepos;
+      end;
 
 {$ifdef GDB}
     function ttypedconstsym.stabstring : pchar;
@@ -2011,7 +2056,10 @@
 
 {
   $Log$
-  Revision 1.103  1999-07-24 15:12:59  michael
+  Revision 1.104  1999-07-27 23:42:21  peter
+    * indirect type referencing is now allowed
+
+  Revision 1.103  1999/07/24 15:12:59  michael
   changes for resourcestrings
 
   Revision 1.102  1999/07/24 13:36:23  michael

compiler/symsymh.inc

@@ -173,6 +173,7 @@
           localvarsym  : pvarsym;
           islocalcopy  : boolean;
           definition   : pdef;
+          definitionsym : ptypesym;
           refs         : longint;
           var_options  : byte;
           _mangledname : pchar;
@@ -182,6 +183,9 @@
           constructor init(const n : string;p : pdef);
           constructor init_dll(const n : string;p : pdef);
           constructor init_C(const n,mangled : string;p : pdef);
+          constructor initsym(const n : string;p : ptypesym);
+          constructor initsym_dll(const n : string;p : ptypesym);
+          constructor initsym_C(const n,mangled : string;p : ptypesym);
           constructor load;
           destructor done;virtual;
           procedure write;virtual;
@@ -260,8 +264,10 @@
        ttypedconstsym = object(tsym)
           prefix : pstring;
           definition : pdef;
+          definitionsym : ptypesym;
           is_really_const : boolean;
           constructor init(const n : string;p : pdef;really_const : boolean);
+          constructor initsym(const n : string;p : ptypesym;really_const : boolean);
           constructor load;
           destructor done;virtual;
           function  mangledname : string;virtual;
@@ -269,7 +275,6 @@
           procedure deref;virtual;
           function  getsize:longint;
           procedure insert_in_data;virtual;
-          procedure really_insert_in_data;
 {$ifdef GDB}
           function stabstring : pchar;virtual;
 {$endif GDB}
@@ -333,7 +338,10 @@
 
 {
   $Log$
-  Revision 1.28  1999-07-24 15:13:01  michael
+  Revision 1.29  1999-07-27 23:42:23  peter
+    * indirect type referencing is now allowed
+
+  Revision 1.28  1999/07/24 15:13:01  michael
   changes for resourcestrings
 
   Revision 1.27  1999/07/22 09:37:57  florian

compiler/tree.pas

@@ -230,7 +230,7 @@ unit tree;
              vecn : (memindex,memseg:boolean;callunique : boolean);
              stringconstn : (value_str : pchar;length : longint; lab_str : pasmlabel;stringtype : tstringtype);
              typeconvn : (convtyp : tconverttype;explizit : boolean);
-             typen : (typenodetype : pdef);
+             typen : (typenodetype : pdef;typenodesym:ptypesym);
              inlinen : (inlinenumber : byte;inlineconst:boolean);
              procinlinen : (inlinetree:ptree;inlineprocsym:pprocsym;retoffset,para_offset,para_size : longint);
              setconstn : (value_set : pconstset;lab_set:pasmlabel);
@@ -253,7 +253,7 @@ unit tree;
     function genordinalconstnode(v : longint;def : pdef) : ptree;
     function genfixconstnode(v : longint;def : pdef) : ptree;
     function gentypeconvnode(node : ptree;t : pdef) : ptree;
-    function gentypenode(t : pdef) : ptree;
+    function gentypenode(t : pdef;sym:ptypesym) : ptree;
     function gencallparanode(expr,next : ptree) : ptree;
     function genrealconstnode(v : bestreal;def : pdef) : ptree;
     function gencallnode(v : pprocsym;st : psymtable) : ptree;
@@ -1036,11 +1036,9 @@ unit tree;
          gentypeconvnode:=p;
       end;
 
-    function gentypenode(t : pdef) : ptree;
-
+    function gentypenode(t : pdef;sym:ptypesym) : ptree;
       var
          p : ptree;
-
       begin
          p:=getnode;
          p^.disposetyp:=dt_nothing;
@@ -1054,6 +1052,7 @@ unit tree;
 {$endif SUPPORT_MMX}
          p^.resulttype:=generrordef;
          p^.typenodetype:=t;
+         p^.typenodesym:=sym;
          gentypenode:=p;
       end;
 
@@ -1731,7 +1730,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.83  1999-05-27 19:45:29  peter
+  Revision 1.84  1999-07-27 23:42:24  peter
+    * indirect type referencing is now allowed
+
+  Revision 1.83  1999/05/27 19:45:29  peter
     * removed oldasm
     * plabel -> pasmlabel
     * -a switches to source writing automaticly