Merged revisions 11262,11273,11498 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r11262 | florian | 2008-06-22 23:12:22 +0200 (So, 22 Jun 2008) | 3 lines
  
  * do not write a "copied" symtable to a ppu when holding only a reference to it, 
    write the owner instead and get a reference to the symtable again when loading
    a ppu, might resolve #8180
........
  r11273 | florian | 2008-06-24 22:23:45 +0200 (Di, 24 Jun 2008) | 4 lines
  
  * moved oo_copied into defoptions
  * record symtables are now handled properly as well if a record is copied, resolves #9144
  * fixed a memory leak when copying classes
  * increased PPU version to 91
........
  r11498 | florian | 2008-08-01 20:03:41 +0200 (Fr, 01 Aug 2008) | 1 line
  
  * passing by value of variants with stdcall conventions, resolves #10042
........

git-svn-id: branches/fixes_2_2@12098 -

compiler/ncgutil.pas

@@ -884,64 +884,64 @@ implementation
         list:=TAsmList(arg);
         if (tsym(p).typ=paravarsym) and
            (tparavarsym(p).varspez=vs_value) and
-           (paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
-         begin
-           location_get_data_ref(list,tparavarsym(p).initialloc,href,true);
-           if is_open_array(tparavarsym(p).vardef) or
-              is_array_of_const(tparavarsym(p).vardef) then
-            begin
-              { cdecl functions don't have a high pointer so it is not possible to generate
-                a local copy }
-              if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
-                begin
-                  hsym:=tparavarsym(tsym(p).owner.Find('high'+tsym(p).name));
-                  if not assigned(hsym) then
-                    internalerror(200306061);
-                  hreg:=cg.getaddressregister(list);
-                  if not is_packed_array(tparavarsym(p).vardef) then
-                    cg.g_copyvaluepara_openarray(list,href,hsym.initialloc,tarraydef(tparavarsym(p).vardef).elesize,hreg)
-                  else
-                    internalerror(2006080401);
-//                    cg.g_copyvaluepara_packedopenarray(list,href,hsym.intialloc,tarraydef(tparavarsym(p).vardef).elepackedbitsize,hreg);
-                  cg.a_load_reg_loc(list,OS_ADDR,hreg,tparavarsym(p).initialloc);
-                end;
-            end
-           else
-            begin
-              { Allocate space for the local copy }
-              l:=tparavarsym(p).getsize;
-              localcopyloc.loc:=LOC_REFERENCE;
-              localcopyloc.size:=int_cgsize(l);
-              tg.GetLocal(list,l,tparavarsym(p).vardef,localcopyloc.reference);
-              { Copy data }
-              if is_shortstring(tparavarsym(p).vardef) then
-                begin
-                  { this code is only executed before the code for the body and the entry/exit code is generated
-                    so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
-                  }
-                  include(current_procinfo.flags,pi_do_call);
-                  cg.g_copyshortstring(list,href,localcopyloc.reference,tstringdef(tparavarsym(p).vardef).len)
-                end
-              else if tparavarsym(p).vardef.typ = variantdef then
-                begin
-                  { this code is only executed before the code for the body and the entry/exit code is generated
-                    so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
-                  }
-                  include(current_procinfo.flags,pi_do_call);
-                  cg.g_copyvariant(list,href,localcopyloc.reference)
-                end
-              else
-                begin
-                  { pass proper alignment info }
-                  localcopyloc.reference.alignment:=tparavarsym(p).vardef.alignment;
-                  cg.g_concatcopy(list,href,localcopyloc.reference,tparavarsym(p).vardef.size);
-                end;
-              { update localloc of varsym }
-              tg.Ungetlocal(list,tparavarsym(p).localloc.reference);
-              tparavarsym(p).localloc:=localcopyloc;
-              tparavarsym(p).initialloc:=localcopyloc;
-            end;
-         end;
+          (paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
+          begin
+            location_get_data_ref(list,tparavarsym(p).initialloc,href,true);
+            if is_open_array(tparavarsym(p).vardef) or
+               is_array_of_const(tparavarsym(p).vardef) then
+              begin
+                { cdecl functions don't have a high pointer so it is not possible to generate
+                  a local copy }
+                if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+                  begin
+                    hsym:=tparavarsym(tsym(p).owner.Find('high'+tsym(p).name));
+                    if not assigned(hsym) then
+                      internalerror(200306061);
+                    hreg:=cg.getaddressregister(list);
+                    if not is_packed_array(tparavarsym(p).vardef) then
+                      cg.g_copyvaluepara_openarray(list,href,hsym.initialloc,tarraydef(tparavarsym(p).vardef).elesize,hreg)
+                    else
+                      internalerror(2006080401);
+//                      cg.g_copyvaluepara_packedopenarray(list,href,hsym.intialloc,tarraydef(tparavarsym(p).vardef).elepackedbitsize,hreg);
+                    cg.a_load_reg_loc(list,OS_ADDR,hreg,tparavarsym(p).initialloc);
+                  end;
+              end
+            else
+              begin
+                { Allocate space for the local copy }
+                l:=tparavarsym(p).getsize;
+                localcopyloc.loc:=LOC_REFERENCE;
+                localcopyloc.size:=int_cgsize(l);
+                tg.GetLocal(list,l,tparavarsym(p).vardef,localcopyloc.reference);
+                { Copy data }
+                if is_shortstring(tparavarsym(p).vardef) then
+                  begin
+                    { this code is only executed before the code for the body and the entry/exit code is generated
+                      so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
+                    }
+                    include(current_procinfo.flags,pi_do_call);
+                    cg.g_copyshortstring(list,href,localcopyloc.reference,tstringdef(tparavarsym(p).vardef).len)
+                  end
+                else if tparavarsym(p).vardef.typ = variantdef then
+                  begin
+                    { this code is only executed before the code for the body and the entry/exit code is generated
+                      so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
+                    }
+                    include(current_procinfo.flags,pi_do_call);
+                    cg.g_copyvariant(list,href,localcopyloc.reference)
+                  end
+                else
+                  begin
+                    { pass proper alignment info }
+                    localcopyloc.reference.alignment:=tparavarsym(p).vardef.alignment;
+                    cg.g_concatcopy(list,href,localcopyloc.reference,tparavarsym(p).vardef.size);
+                  end;
+                { update localloc of varsym }
+                tg.Ungetlocal(list,tparavarsym(p).localloc.reference);
+                tparavarsym(p).localloc:=localcopyloc;
+                tparavarsym(p).initialloc:=localcopyloc;
+              end;
+          end;
       end;
 
 
@@ -1198,11 +1198,14 @@ implementation
              vs_value :
                if needs_inittable then
                  begin
-                   { variants are already handled by the call to fpc_variant_copy_overwrite }
-                   if tparavarsym(p).vardef.typ <> variantdef then begin
-                     location_get_data_ref(list,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef));
-                     cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
-                   end;
+                   { variants are already handled by the call to fpc_variant_copy_overwrite if
+                     they are passed by reference }
+                   if not((tparavarsym(p).vardef.typ=variantdef) and
+                     paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
+                     begin
+                       location_get_data_ref(list,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef));
+                       cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
+                     end;
                  end;
              vs_out :
                begin

compiler/ppu.pas

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

compiler/symdef.pas

@@ -169,6 +169,8 @@ interface
 
        tabstractrecorddef= class(tstoreddef)
           symtable : TSymtable;
+          cloneddef      : tabstractrecorddef;
+          cloneddefderef : tderef;
           procedure reset;override;
           function  GetSymtable(t:tGetSymtable):TSymtable;override;
           function is_packed:boolean;
@@ -228,6 +230,7 @@ interface
           dwarf_struct_lab : tasmsymbol;
           childof        : tobjectdef;
           childofderef   : tderef;
+
           objname,
           objrealname    : pshortstring;
           objectoptions  : tobjectoptions;
@@ -2445,7 +2448,9 @@ implementation
       begin
          inherited create(recorddef);
          symtable:=p;
-         symtable.defowner:=self;
+         { we can own the symtable only if nobody else owns a copy so far }
+         if symtable.refcount=1 then
+           symtable.defowner:=self;
          isunion:=false;
       end;
 
@@ -2453,15 +2458,20 @@ implementation
     constructor trecorddef.ppuload(ppufile:tcompilerppufile);
       begin
          inherited ppuload(recorddef,ppufile);
-         symtable:=trecordsymtable.create(0);
-         trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
-         trecordsymtable(symtable).recordalignment:=shortint(ppufile.getbyte);
-         trecordsymtable(symtable).padalignment:=shortint(ppufile.getbyte);
-         trecordsymtable(symtable).usefieldalignment:=shortint(ppufile.getbyte);
-         { requires usefieldalignment to be set }
-         trecordsymtable(symtable).datasize:=ppufile.getaint;
-         trecordsymtable(symtable).ppuload(ppufile);
-         symtable.defowner:=self;
+         if df_copied_def in defoptions then
+           ppufile.getderef(cloneddefderef)
+         else
+           begin
+             symtable:=trecordsymtable.create(0);
+             trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
+             trecordsymtable(symtable).recordalignment:=shortint(ppufile.getbyte);
+             trecordsymtable(symtable).padalignment:=shortint(ppufile.getbyte);
+             trecordsymtable(symtable).usefieldalignment:=shortint(ppufile.getbyte);
+             trecordsymtable(symtable).datasize:=ppufile.getaint;
+             trecordsymtable(symtable).ppuload(ppufile);
+             { requires usefieldalignment to be set }
+             symtable.defowner:=self;
+           end;
          isunion:=false;
       end;
 
@@ -2481,6 +2491,7 @@ implementation
       begin
         result:=trecorddef.create(symtable.getcopy);
         trecorddef(result).isunion:=isunion;
+        include(trecorddef(result).defoptions,df_copied_def);
       end;
 
 
@@ -2493,7 +2504,10 @@ implementation
     procedure trecorddef.buildderef;
       begin
          inherited buildderef;
-         tstoredsymtable(symtable).buildderef;
+         if df_copied_def in defoptions then
+           cloneddefderef.build(symtable.defowner)
+         else
+           tstoredsymtable(symtable).buildderef;
       end;
 
 
@@ -2501,7 +2515,13 @@ implementation
       begin
          inherited deref;
          { now dereference the definitions }
-         tstoredsymtable(symtable).deref;
+         if df_copied_def in defoptions then
+           begin
+             cloneddef:=trecorddef(cloneddefderef.resolve);
+             symtable:=cloneddef.symtable.getcopy;
+           end
+         else
+           tstoredsymtable(symtable).deref;
          { assign TGUID? load only from system unit }
          if not(assigned(rec_tguid)) and
             (upper(typename)='TGUID') and
@@ -2515,13 +2535,21 @@ implementation
     procedure trecorddef.ppuwrite(ppufile:tcompilerppufile);
       begin
          inherited ppuwrite(ppufile);
-         ppufile.putbyte(byte(trecordsymtable(symtable).fieldalignment));
-         ppufile.putbyte(byte(trecordsymtable(symtable).recordalignment));
-         ppufile.putbyte(byte(trecordsymtable(symtable).padalignment));
-         ppufile.putbyte(byte(trecordsymtable(symtable).usefieldalignment));
-         ppufile.putaint(trecordsymtable(symtable).datasize);
+         if df_copied_def in defoptions then
+           ppufile.putderef(cloneddefderef)
+         else
+           begin
+             ppufile.putbyte(byte(trecordsymtable(symtable).fieldalignment));
+             ppufile.putbyte(byte(trecordsymtable(symtable).recordalignment));
+             ppufile.putbyte(byte(trecordsymtable(symtable).padalignment));
+             ppufile.putbyte(byte(trecordsymtable(symtable).usefieldalignment));
+             ppufile.putaint(trecordsymtable(symtable).datasize);
+           end;
+
          ppufile.writeentry(ibrecorddef);
-         trecordsymtable(symtable).ppuwrite(ppufile);
+
+         if not(df_copied_def in defoptions) then
+           trecordsymtable(symtable).ppuwrite(ppufile);
       end;
 
 
@@ -3713,7 +3741,10 @@ implementation
          else
            ImplementedInterfaces:=nil;
 
-         tObjectSymtable(symtable).ppuload(ppufile);
+         if df_copied_def in defoptions then
+           ppufile.getderef(cloneddefderef)
+         else
+           tObjectSymtable(symtable).ppuload(ppufile);
 
          { handles the predefined class tobject  }
          { the last TOBJECT which is loaded gets }
@@ -3729,6 +3760,7 @@ implementation
          writing_class_record_dbginfo:=false;
        end;
 
+
     destructor tobjectdef.destroy;
       begin
          if assigned(symtable) then
@@ -3763,12 +3795,15 @@ implementation
         i : longint;
       begin
         result:=tobjectdef.create(objecttype,objname^,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^);
         tobjectdef(result).objectoptions:=objectoptions;
+        include(tobjectdef(result).defoptions,df_copied_def);
         tobjectdef(result).vmt_offset:=vmt_offset;
         if assigned(iidguid) then
           begin
@@ -3821,9 +3856,13 @@ implementation
                end;
            end;
 
+         if df_copied_def in defoptions then
+           ppufile.putderef(cloneddefderef);
+
          ppufile.writeentry(ibobjectdef);
 
-         tObjectSymtable(symtable).ppuwrite(ppufile);
+         if not(df_copied_def in defoptions) then
+           tObjectSymtable(symtable).ppuwrite(ppufile);
       end;
 
 
@@ -3846,7 +3885,11 @@ implementation
       begin
          inherited buildderef;
          childofderef.build(childof);
-         tstoredsymtable(symtable).buildderef;
+         if df_copied_def in defoptions then
+           cloneddefderef.build(symtable.defowner)
+         else
+           tstoredsymtable(symtable).buildderef;
+
          if objecttype in [odt_class,odt_interfacecorba] then
            begin
              for i:=0 to ImplementedInterfaces.count-1 do
@@ -3861,7 +3904,13 @@ implementation
       begin
          inherited deref;
          childof:=tobjectdef(childofderef.resolve);
-         tstoredsymtable(symtable).deref;
+         if df_copied_def in defoptions then
+           begin
+             cloneddef:=tobjectdef(cloneddefderef.resolve);
+             symtable:=cloneddef.symtable.getcopy;
+           end
+         else
+           tstoredsymtable(symtable).deref;
          if objecttype in [odt_class,odt_interfacecorba] then
            begin
              for i:=0 to ImplementedInterfaces.count-1 do