compiler:

  - move objname, objrealname fields from tobjectdef to tabstractrecorddef, 
  - load and save them from/to ppu file, 
  - use tabstarctrecorddef in some more places where previously code worked for tobjectdef
  - change push_nested_hierarchy, pop_nested_hierarchy to handle records too

git-svn-id: branches/paul/extended_records@16519 -

compiler/pdecsub.pas

@@ -65,10 +65,10 @@ interface
     { helper functions - they insert nested objects hierarcy to the symtablestack
       with object hierarchy
     }
-    function push_child_hierarcy(obj:tobjectdef):integer;
-    function pop_child_hierarchy(obj:tobjectdef):integer;
-    function push_nested_hierarchy(obj:tobjectdef):integer;
-    function pop_nested_hierarchy(obj:tobjectdef):integer;
+    function push_child_hierarcy(obj:tabstractrecorddef):integer;
+    function pop_child_hierarchy(obj:tabstractrecorddef):integer;
+    function push_nested_hierarchy(obj:tabstractrecorddef):integer;
+    function pop_nested_hierarchy(obj:tabstractrecorddef):integer;
 
 implementation
 
@@ -97,15 +97,21 @@ implementation
         Declaring it as string here results in an error when compiling (PFV) }
       current_procinfo = 'error';
 
-    function push_child_hierarcy(obj:tobjectdef):integer;
+    function push_child_hierarcy(obj:tabstractrecorddef):integer;
       var
         _class,hp : tobjectdef;
       begin
+        if obj.typ=recorddef then
+          begin
+            symtablestack.push(obj.symtable);
+            result:=1;
+            exit;
+          end;
         result:=0;
         { insert class hierarchy in the reverse order }
         hp:=nil;
         repeat
-          _class:=obj;
+          _class:=tobjectdef(obj);
           while _class.childof<>hp do
             _class:=_class.childof;
           hp:=_class;
@@ -114,20 +120,26 @@ implementation
         until hp=obj;
       end;
 
-    function push_nested_hierarchy(obj:tobjectdef):integer;
+    function push_nested_hierarchy(obj:tabstractrecorddef):integer;
       begin
         result:=0;
-        if obj.owner.symtabletype=ObjectSymtable then
-          inc(result,push_nested_hierarchy(tobjectdef(obj.owner.defowner)));
+        if obj.owner.symtabletype in [ObjectSymtable,recordsymtable] then
+          inc(result,push_nested_hierarchy(tabstractrecorddef(obj.owner.defowner)));
         inc(result,push_child_hierarcy(obj));
       end;
 
-    function pop_child_hierarchy(obj:tobjectdef):integer;
+    function pop_child_hierarchy(obj:tabstractrecorddef):integer;
       var
         _class : tobjectdef;
       begin
+        if obj.typ=recorddef then
+          begin
+            symtablestack.pop(obj.symtable);
+            result:=1;
+            exit;
+          end;
         result:=0;
-        _class:=obj;
+        _class:=tobjectdef(obj);
         while assigned(_class) do
           begin
             symtablestack.pop(_class.symtable);
@@ -136,11 +148,11 @@ implementation
           end;
       end;
 
-    function pop_nested_hierarchy(obj:tobjectdef):integer;
+    function pop_nested_hierarchy(obj:tabstractrecorddef):integer;
       begin
         result:=pop_child_hierarchy(obj);
-        if obj.owner.symtabletype=ObjectSymtable then
-          inc(result,pop_nested_hierarchy(tobjectdef(obj.owner.defowner)));
+        if obj.owner.symtabletype in [ObjectSymtable,recordsymtable] then
+          inc(result,pop_nested_hierarchy(tabstractrecorddef(obj.owner.defowner)));
       end;
 
     procedure insert_funcret_para(pd:tabstractprocdef);

compiler/pdecvar.pas

@@ -1608,8 +1608,8 @@ implementation
                 Message(type_e_ordinal_expr_expected);
               consume(_OF);
 
-              UnionSymtable:=trecordsymtable.create(current_settings.packrecords);
-              UnionDef:=trecorddef.create(unionsymtable);
+              UnionSymtable:=trecordsymtable.create('',current_settings.packrecords);
+              UnionDef:=trecorddef.create('',unionsymtable);
               uniondef.isunion:=true;
               startvarrecsize:=UnionSymtable.datasize;
               { align the bitpacking to the next byte }

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 121;
+  CurrentPPUVersion = 122;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/psystem.pas

@@ -347,8 +347,8 @@ implementation
           end;
         addtype('$s64currency',s64currencytype);
         { Add a type for virtual method tables }
-        hrecst:=trecordsymtable.create(current_settings.packrecords);
-        vmttype:=trecorddef.create(hrecst);
+        hrecst:=trecordsymtable.create('',current_settings.packrecords);
+        vmttype:=trecorddef.create('',hrecst);
         pvmttype:=tpointerdef.create(vmttype);
         { can't use addtype for pvmt because the rtti of the pointed
           type is not available. The rtti for pvmt will be written implicitly
@@ -371,10 +371,10 @@ implementation
         tarraydef(vmtarraytype).elementdef:=pvmttype;
         addtype('$vtblarray',vmtarraytype);
         { Add a type for methodpointers }
-        hrecst:=trecordsymtable.create(1);
+        hrecst:=trecordsymtable.create('',1);
         addfield(hrecst,tfieldvarsym.create('$proc',vs_value,voidpointertype,[]));
         addfield(hrecst,tfieldvarsym.create('$self',vs_value,voidpointertype,[]));
-        methodpointertype:=trecorddef.create(hrecst);
+        methodpointertype:=trecorddef.create('',hrecst);
         addtype('$methodpointer',methodpointertype);
         symtablestack.pop(systemunit);
       end;

compiler/ptype.pas

@@ -871,15 +871,15 @@ implementation
       end;
 
     { reads a record declaration }
-    function record_dec : tdef;
+    function record_dec(const n:tidstring):tdef;
       var
          old_current_structdef : tabstractrecorddef;
          recst : trecordsymtable;
       begin
          old_current_structdef:=current_structdef;
          { create recdef }
-         recst:=trecordsymtable.create(current_settings.packrecords);
-         current_structdef:=trecorddef.create(recst);
+         recst:=trecordsymtable.create(n,current_settings.packrecords);
+         current_structdef:=trecorddef.create(n,recst);
          result:=current_structdef;
          { insert in symtablestack }
          symtablestack.push(recst);
@@ -890,8 +890,7 @@ implementation
          recst.addalignmentpadding;
          { restore symtable stack }
          symtablestack.pop(recst);
-         if trecorddef(record_dec).is_packed and
-            is_managed_type(record_dec) then
+         if trecorddef(current_structdef).is_packed and is_managed_type(current_structdef) then
            Message(type_e_no_packed_inittable);
          current_structdef:=old_current_structdef;
       end;
@@ -1314,7 +1313,7 @@ implementation
               end;
             _RECORD:
               begin
-                def:=record_dec;
+                def:=record_dec(name);
               end;
             _PACKED,
             _BITPACKED:
@@ -1349,7 +1348,7 @@ implementation
                           def:=object_dec(odt_object,name,genericdef,genericlist,nil);
                         end;
                       else
-                        def:=record_dec;
+                        def:=record_dec(name);
                     end;
                     current_settings.packrecords:=oldpackrecords;
                   end;

compiler/symdef.pas

@@ -171,9 +171,15 @@ interface
        { tabstractrecorddef }
 
        tabstractrecorddef= class(tstoreddef)
+          objname,
+          objrealname: PShortString;
           symtable : TSymtable;
           cloneddef      : tabstractrecorddef;
           cloneddefderef : tderef;
+          constructor create(const n:string; dt:tdeftyp);
+          constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          destructor destroy; override;
           function  GetSymtable(t:tGetSymtable):TSymtable;override;
           function is_packed:boolean;
           function RttiName: string;
@@ -182,7 +188,7 @@ interface
        trecorddef = class(tabstractrecorddef)
        public
           isunion       : boolean;
-          constructor create(p : TSymtable);
+          constructor create(const n:string; p:TSymtable);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           function getcopy : tstoreddef;override;
@@ -246,8 +252,6 @@ interface
 
           { for C++ classes: name of the library this class is imported from }
           import_lib,
-          objname,
-          objrealname,
           { for Objective-C: protocols and classes can have the same name there }
           objextname     : pshortstring;
           objectoptions  : tobjectoptions;
@@ -274,7 +278,7 @@ interface
           classref_created_in_current_module : boolean;
           { store implemented interfaces defs and name mappings }
           ImplementedInterfaces : TFPObjectList;
-          constructor create(ot : tobjecttyp;const n : string;c : tobjectdef);
+          constructor create(ot:tobjecttyp;const n:string;c:tobjectdef);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
           function getcopy : tstoreddef;override;
@@ -869,11 +873,11 @@ implementation
            st:=st.defowner.owner;
          end;
         { object/classes symtable, nested type definitions in classes require the while loop }
-        while st.symtabletype=ObjectSymtable do
+        while st.symtabletype in [ObjectSymtable,recordsymtable] do
          begin
-           if st.defowner.typ<>objectdef then
+           if not (st.defowner.typ in [objectdef,recorddef]) then
             internalerror(200204174);
-           prefix:=tobjectdef(st.defowner).objname^+'_$_'+prefix;
+           prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix;
            st:=st.defowner.owner;
          end;
         { symtable must now be static or global }
@@ -2554,6 +2558,33 @@ implementation
                               tabstractrecorddef
 ***************************************************************************}
 
+    constructor tabstractrecorddef.create(const n:string; dt:tdeftyp);
+      begin
+        inherited create(dt);
+        objname:=stringdup(upper(n));
+        objrealname:=stringdup(n);
+      end;
+
+    constructor tabstractrecorddef.ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(dt,ppufile);
+        objrealname:=stringdup(ppufile.getstring);
+        objname:=stringdup(upper(objrealname^));
+      end;
+
+    procedure tabstractrecorddef.ppuwrite(ppufile: tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putstring(objrealname^);
+      end;
+
+    destructor tabstractrecorddef.destroy;
+      begin
+        stringdispose(objname);
+        stringdispose(objrealname);
+        inherited destroy;
+      end;
+
     function tabstractrecorddef.GetSymtable(t:tGetSymtable):TSymtable;
       begin
          if t=gs_record then
@@ -2572,14 +2603,14 @@ implementation
       var
         tmp: tabstractrecorddef;
       begin
-        Result:=typename;
+        Result:=objrealname^;
         tmp:=self;
         repeat
           if tmp.owner.symtabletype in [ObjectSymtable,recordsymtable] then
             tmp:=tabstractrecorddef(tmp.owner.defowner)
           else
             break;
-          Result:=tmp.typename+'.'+Result;
+          Result:=tmp.objrealname^+'.'+Result;
         until tmp=nil;
       end;
 
@@ -2588,9 +2619,9 @@ implementation
                                   trecorddef
 ***************************************************************************}
 
-    constructor trecorddef.create(p : TSymtable);
+    constructor trecorddef.create(const n:string; p:TSymtable);
       begin
-         inherited create(recorddef);
+         inherited create(n,recorddef);
          symtable:=p;
          { we can own the symtable only if nobody else owns a copy so far }
          if symtable.refcount=1 then
@@ -2606,7 +2637,7 @@ implementation
            ppufile.getderef(cloneddefderef)
          else
            begin
-             symtable:=trecordsymtable.create(0);
+             symtable:=trecordsymtable.create(objrealname^,0);
              trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
              trecordsymtable(symtable).recordalignment:=shortint(ppufile.getbyte);
              trecordsymtable(symtable).padalignment:=shortint(ppufile.getbyte);
@@ -2633,7 +2664,7 @@ implementation
 
     function trecorddef.getcopy : tstoreddef;
       begin
-        result:=trecorddef.create(symtable.getcopy);
+        result:=trecorddef.create(objrealname^,symtable.getcopy);
         trecorddef(result).isunion:=isunion;
         include(trecorddef(result).defoptions,df_copied_def);
       end;
@@ -3933,9 +3964,9 @@ implementation
                               TOBJECTDEF
 ***************************************************************************}
 
-   constructor tobjectdef.create(ot : tobjecttyp;const n : string;c : tobjectdef);
+   constructor tobjectdef.create(ot:tobjecttyp;const n:string;c:tobjectdef);
      begin
-        inherited create(objectdef);
+        inherited create(n,objectdef);
         fcurrent_dispid:=0;
         objecttype:=ot;
         objectoptions:=[];
@@ -3945,8 +3976,6 @@ implementation
         vmtentries:=TFPList.Create;
         vmt_offset:=0;
         set_parent(c);
-        objname:=stringdup(upper(n));
-        objrealname:=stringdup(n);
         if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then
           prepareguid;
         { setup implemented interfaces }
@@ -3968,8 +3997,6 @@ implementation
       begin
          inherited ppuload(objectdef,ppufile);
          objecttype:=tobjecttyp(ppufile.getbyte);
-         objrealname:=stringdup(ppufile.getstring);
-         objname:=stringdup(upper(objrealname^));
          objextname:=stringdup(ppufile.getstring);
          { only used for external Objective-C classes/protocols }
          if (objextname^='') then
@@ -4054,8 +4081,6 @@ implementation
              symtable.free;
              symtable:=nil;
            end;
-         stringdispose(objname);
-         stringdispose(objrealname);
          stringdispose(objextname);
          stringdispose(import_lib);
          stringdispose(iidstr);
@@ -4088,14 +4113,10 @@ implementation
       var
         i : longint;
       begin
-        result:=tobjectdef.create(objecttype,objname^,childof);
+        result:=tobjectdef.create(objecttype,objrealname^,childof);
         { the constructor allocates a symtable which we release to avoid memory leaks }
         tobjectdef(result).symtable.free;
         tobjectdef(result).symtable:=symtable.getcopy;
-        if assigned(objname) then
-          tobjectdef(result).objname:=stringdup(objname^);
-        if assigned(objrealname) then
-          tobjectdef(result).objrealname:=stringdup(objrealname^);
         if assigned(objextname) then
           tobjectdef(result).objextname:=stringdup(objextname^);
         if assigned(import_lib) then
@@ -4141,7 +4162,6 @@ implementation
          ppufile.do_indirect_crc:=true;
          inherited ppuwrite(ppufile);
          ppufile.putbyte(byte(objecttype));
-         ppufile.putstring(objrealname^);
          if assigned(objextname) then
            ppufile.putstring(objextname^)
          else

compiler/symtable.pas

@@ -104,7 +104,7 @@ interface
 
        trecordsymtable = class(tabstractrecordsymtable)
        public
-          constructor create(usealign:shortint);
+          constructor create(const n:string;usealign:shortint);
           procedure insertunionst(unionst : trecordsymtable;offset : longint);
        end;
 
@@ -1047,9 +1047,9 @@ implementation
                               TRecordSymtable
 ****************************************************************************}
 
-    constructor trecordsymtable.create(usealign:shortint);
+    constructor trecordsymtable.create(const n:string;usealign:shortint);
       begin
-        inherited create('',usealign);
+        inherited create(n,usealign);
         symtabletype:=recordsymtable;
       end;
 
@@ -1622,7 +1622,7 @@ implementation
     function generate_nested_name(symtable:tsymtable;delimiter:string):string;
       begin
         result:='';
-        while assigned(symtable) and (symtable.symtabletype=ObjectSymtable) do
+        while assigned(symtable) and (symtable.symtabletype in [ObjectSymtable,recordsymtable]) do
           begin
             if (result='') then
               result:=symtable.name^

compiler/utils/ppudump.pp

@@ -2091,6 +2091,7 @@ begin
          ibrecorddef :
            begin
              readcommondef('Record definition',defoptions);
+             writeln(space,'   Name of Record : ',getstring);
              writeln(space,'       FieldAlign : ',getbyte);
              writeln(space,'      RecordAlign : ',getbyte);
              writeln(space,'         PadAlign : ',getbyte);
@@ -2108,6 +2109,7 @@ begin
          ibobjectdef :
            begin
              readcommondef('Object/Class definition',defoptions);
+             writeln(space,'    Name of Class : ',getstring);
              b:=getbyte;
              write  (space,'             Type : ');
              case tobjecttyp(b) of
@@ -2121,7 +2123,6 @@ begin
                odt_objcprotocol   : writeln('objcprotocol');
                else                 writeln('!! Warning: Invalid object type ',b);
              end;
-             writeln(space,'    Name of Class : ',getstring);
              writeln(space,'    External name : ',getstring);
              writeln(space,'       Import lib : ',getstring);
              writeln(space,'         DataSize : ',getaint);