* fix for referencecounted temps

compiler/cgbase.pas

@@ -167,11 +167,7 @@ interface
       { Temp types }
       ttemptype = (tt_none,
                    tt_free,tt_normal,tt_persistent,
-                   tt_noreuse,tt_freenoreuse,
-                   tt_ansistring,tt_freeansistring,
-                   tt_widestring,tt_freewidestring,
-                   tt_interfacecom,tt_freeinterfacecom);
-      ttemptypeset = set of ttemptype;
+                   tt_noreuse,tt_freenoreuse);
 
       pmmshuffle = ^tmmshuffle;
 
@@ -462,7 +458,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.76  2003-11-03 17:48:04  peter
+  Revision 1.77  2003-11-04 15:35:13  peter
+    * fix for referencecounted temps
+
+  Revision 1.76  2003/11/03 17:48:04  peter
     * int_cgsize returned garbage for a=0
 
   Revision 1.75  2003/10/31 15:51:11  peter

compiler/nbas.pas

@@ -29,7 +29,7 @@ interface
     uses
        cpubase,cgbase,
        aasmbase,aasmtai,aasmcpu,
-       node,
+       node,tgobj,
        symtype,symppu;
 
     type
@@ -854,7 +854,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.71  2003-10-31 15:51:47  peter
+  Revision 1.72  2003-11-04 15:35:13  peter
+    * fix for referencecounted temps
+
+  Revision 1.71  2003/10/31 15:51:47  peter
     * fix crashes in asmnode.deref when p_asm=nil
 
   Revision 1.70  2003/10/29 20:34:20  peter

compiler/ncgbas.pas

@@ -341,7 +341,10 @@ interface
           internalerror(200108222);
 
         { get a (persistent) temp }
-        tg.GetTemp(exprasmlist,size,tempinfo^.temptype,tempinfo^.ref);
+        if tempinfo^.restype.def.needs_inittable then
+          tg.GetTempTyped(exprasmlist,tempinfo^.restype.def,tempinfo^.temptype,tempinfo^.ref)
+        else
+          tg.GetTemp(exprasmlist,size,tempinfo^.temptype,tempinfo^.ref);
         tempinfo^.valid := true;
       end;
 
@@ -404,7 +407,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.49  2003-11-02 13:30:05  jonas
+  Revision 1.50  2003-11-04 15:35:13  peter
+    * fix for referencecounted temps
+
+  Revision 1.49  2003/11/02 13:30:05  jonas
     * fixed ppc compilation
 
   Revision 1.48  2003/10/30 19:59:00  peter

compiler/ncgcal.pas

@@ -436,8 +436,7 @@ implementation
          end
         else
         { ansi/widestrings must be registered, so we can dispose them }
-         if is_ansistring(resulttype.def) or
-            is_widestring(resulttype.def) then
+         if resulttype.def.needs_inittable then
           begin
             { the FUNCTION_RESULT_REG is already allocated }
             cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT_REG);
@@ -682,20 +681,12 @@ implementation
          if assigned(varargsparas) then
            paramanager.create_varargs_paraloc_info(procdefinition,varargsparas);
 
-         if not assigned(funcretnode) then
+         if resulttype.def.needs_inittable and
+            not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) and
+            not assigned(funcretnode) then
            begin
-             { if we allocate the temp. location for ansi- or widestrings }
-             { already here, we avoid later a push/pop                    }
-             if is_widestring(resulttype.def) then
-               begin
-                 tg.gettemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
-                 cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
-               end
-             else if is_ansistring(resulttype.def) then
-               begin
-                 tg.GetTemp(exprasmlist,pointer_size,tt_ansistring,refcountedtemp);
-                 cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
-               end;
+             tg.gettemptyped(exprasmlist,resulttype.def,tt_persistent,refcountedtemp);
+             cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
            end;
 
         regs_to_alloc:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
@@ -1014,14 +1005,10 @@ implementation
 
          { if we allocate the temp. location for ansi- or widestrings }
          { already here, we avoid later a push/pop                    }
-         if is_widestring(resulttype.def) then
+         if resulttype.def.needs_inittable and
+            not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
            begin
-             tg.GetTemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
-             cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
-           end
-         else if is_ansistring(resulttype.def) then
-           begin
-             tg.GetTemp(exprasmlist,pointer_size,tt_ansistring,refcountedtemp);
+             tg.gettemptyped(exprasmlist,resulttype.def,tt_persistent,refcountedtemp);
              cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
            end;
 
@@ -1146,7 +1133,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.135  2003-10-30 17:12:49  peter
+  Revision 1.136  2003-11-04 15:35:13  peter
+    * fix for referencecounted temps
+
+  Revision 1.135  2003/10/30 17:12:49  peter
     * fixed rangecheck error
 
   Revision 1.134  2003/10/29 21:24:14  jonas

compiler/ncgmem.pas

@@ -353,7 +353,7 @@ implementation
            end
          else if is_interfacecom(left.resulttype.def) then
            begin
-             tg.GetTemp(exprasmlist,pointer_size,tt_interfacecom,location.reference);
+             tg.GetTempTyped(exprasmlist,left.resulttype.def,tt_normal,location.reference);
              cg.a_load_loc_ref(exprasmlist,OS_ADDR,left.location,location.reference);
              { implicit deferencing also for interfaces }
              if (cs_gdb_heaptrc in aktglobalswitches) and
@@ -876,7 +876,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.79  2003-10-10 17:48:13  peter
+  Revision 1.80  2003-11-04 15:35:13  peter
+    * fix for referencecounted temps
+
+  Revision 1.79  2003/10/10 17:48:13  peter
     * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
     * tregisteralloctor renamed to trgobj
     * removed rgobj from a lot of units

compiler/ncgutil.pas

@@ -903,14 +903,12 @@ implementation
         hp:=tg.templist;
         while assigned(hp) do
          begin
-           if hp^.temptype in [tt_ansistring,tt_freeansistring,
-                               tt_widestring,tt_freewidestring,
-                               tt_interfacecom,tt_freeinterfacecom] then
+           if assigned(hp^.def) then
             begin
               if (cs_implicit_exceptions in aktmoduleswitches) then
                 include(current_procinfo.flags,pi_needs_implicit_finally);
               reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
-              cg.a_load_const_ref(list,OS_ADDR,0,href);
+              cg.g_initialize(list,hp^.def,href,false);
             end;
            hp:=hp^.next;
          end;
@@ -927,40 +925,11 @@ implementation
         hp:=tg.templist;
         while assigned(hp) do
          begin
-           case hp^.temptype of
-             tt_ansistring,
-             tt_freeansistring :
-               begin
-                 reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
-                 paramanager.allocparaloc(list,paraloc1);
-                 cg.a_paramaddr_ref(list,href,paraloc1);
-                 paramanager.freeparaloc(list,paraloc1);
-                 cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-                 cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
-                 cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-               end;
-             tt_widestring,
-             tt_freewidestring :
-               begin
-                 reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
-                 paramanager.allocparaloc(list,paraloc1);
-                 cg.a_paramaddr_ref(list,href,paraloc1);
-                 paramanager.freeparaloc(list,paraloc1);
-                 cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-                 cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
-                 cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-               end;
-             tt_interfacecom :
-               begin
-                 reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
-                 paramanager.allocparaloc(list,paraloc1);
-                 cg.a_paramaddr_ref(list,href,paraloc1);
-                 paramanager.freeparaloc(list,paraloc1);
-                 cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-                 cg.a_call_name(list,'FPC_INTF_DECR_REF');
-                 cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-               end;
-           end;
+           if assigned(hp^.def) then
+            begin
+              reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
+              cg.g_finalize(list,hp^.def,href,false);
+            end;
            hp:=hp^.next;
          end;
       end;
@@ -1974,7 +1943,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.162  2003-10-25 11:34:02  florian
+  Revision 1.163  2003-11-04 15:35:13  peter
+    * fix for referencecounted temps
+
+  Revision 1.162  2003/10/25 11:34:02  florian
     * fixed compilation of ppc system unit
 
   Revision 1.161  2003/10/19 01:34:30  florian

compiler/tgobj.pas

@@ -35,15 +35,19 @@ unit tgobj;
     uses
       cclasses,
       globals,globtype,
+      symtype,
       cpubase,cpuinfo,cgbase,
-      aasmbase,aasmtai,aasmcpu;
+      aasmbase,aasmtai;
 
     type
+      ttemptypeset = set of ttemptype;
+
       ptemprecord = ^ttemprecord;
       ttemprecord = record
          temptype   : ttemptype;
          pos        : longint;
          size       : longint;
+         def        : tdef;
          next       : ptemprecord;
          nextfree   : ptemprecord; { for faster freeblock checking }
 {$ifdef EXTDEBUG}
@@ -58,7 +62,7 @@ unit tgobj;
        private
           { contains all free temps using nextfree links }
           tempfreelist  : ptemprecord;
-          function alloctemp(list: taasmoutput; size : longint; temptype : ttemptype) : longint;
+          function alloctemp(list: taasmoutput; size : longint; temptype : ttemptype; def:tdef) : longint;
           procedure freetemp(list: taasmoutput; pos:longint;temptypes:ttemptypeset);
        public
           { contains all temps }
@@ -80,6 +84,7 @@ unit tgobj;
           procedure setfirsttemp(l : longint);
 
           procedure gettemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
+          procedure gettemptyped(list: taasmoutput; def:tdef;temptype:ttemptype;var ref : treference);
           procedure ungettemp(list: taasmoutput; const ref : treference);
 
           function sizeoftemp(list: taasmoutput; const ref: treference): longint;
@@ -116,27 +121,21 @@ unit tgobj;
 
 
     const
-      FreeTempTypes = [tt_free,tt_freenoreuse,tt_freeansistring,
-                       tt_freewidestring,tt_freeinterfacecom];
+      FreeTempTypes = [tt_free,tt_freenoreuse];
 
 {$ifdef EXTDEBUG}
       TempTypeStr : array[ttemptype] of string[18] = (
           '<none>',
           'free','normal','persistant',
-          'noreuse','freenoreuse',
-          'ansistring','freeansistring',
-          'widestring','freewidestring',
-          'interfacecom','freeinterfacecom'
+          'noreuse','freenoreuse'
       );
 {$endif EXTDEBUG}
 
       Used2Free : array[ttemptype] of ttemptype = (
         tt_none,
         tt_none,tt_free,tt_free,
-        tt_freenoreuse,tt_none,
-        tt_freeansistring,tt_none,
-        tt_freewidestring,tt_none,
-        tt_freeinterfacecom,tt_none);
+        tt_freenoreuse,tt_none
+      );
 
 
 {*****************************************************************************
@@ -199,7 +198,7 @@ unit tgobj;
       end;
 
 
-    function ttgobj.AllocTemp(list: taasmoutput; size : longint; temptype : ttemptype) : longint;
+    function ttgobj.AllocTemp(list: taasmoutput; size : longint; temptype : ttemptype;def : tdef) : longint;
       var
          tl,
          bestslot,bestprev,
@@ -223,7 +222,7 @@ unit tgobj;
 
          freetype:=Used2Free[temptype];
          if freetype=tt_none then
-          internalerror(200208201);
+           internalerror(200208201);
          { Align needed size on 4 bytes }
          size:=align(size,4);
          { First check the tmpfreelist, but not when
@@ -241,6 +240,7 @@ unit tgobj;
                  Comment(V_Warning,'tgobj: (AllocTemp) temp at pos '+tostr(hp^.pos)+ ' in freelist is not set to tt_free !');
 {$endif}
                if (hp^.temptype=freetype) and
+                  (hp^.def=def) and
                   (hp^.size>=size) then
                 begin
                   { Slot is the same size, then leave immediatly }
@@ -272,6 +272,7 @@ unit tgobj;
              begin
                tl:=bestslot;
                tl^.temptype:=temptype;
+               tl^.def:=def;
                { Remove from the tempfreelist }
                if assigned(bestprev) then
                  bestprev^.nextfree:=tl^.nextfree
@@ -286,6 +287,7 @@ unit tgobj;
                { Create new block and link after bestslot }
                new(tl);
                tl^.temptype:=temptype;
+               tl^.def:=def;
                if direction=1 then
                  begin
                    tl^.pos:=bestslot^.pos;
@@ -310,6 +312,7 @@ unit tgobj;
             { now we can create the templist entry }
             new(tl);
             tl^.temptype:=temptype;
+            tl^.def:=def;
 
             if direction=-1 then
               begin
@@ -331,7 +334,10 @@ unit tgobj;
           end;
 {$ifdef EXTDEBUG}
          tl^.posinfo:=aktfilepos;
-         list.concat(tai_tempalloc.allocinfo(tl^.pos,tl^.size,'allocated with type '+TempTypeStr[tl^.temptype]));
+         if assigned(tl^.def) then
+           list.concat(tai_tempalloc.allocinfo(tl^.pos,tl^.size,'allocated with type '+TempTypeStr[tl^.temptype]+' for def '+tl^.def.typename))
+         else
+           list.concat(tai_tempalloc.allocinfo(tl^.pos,tl^.size,'allocated with type '+TempTypeStr[tl^.temptype]));
 {$else}
          list.concat(tai_tempalloc.alloc(tl^.pos,tl^.size));
 {$endif}
@@ -422,10 +428,20 @@ unit tgobj;
     procedure ttgobj.gettemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
       begin
         { can't use reference_reset_base, because that will let tgobj depend
-          on rgobj (PFV) }
+          on cgobj (PFV) }
         fillchar(ref,sizeof(ref),0);
         ref.base:=current_procinfo.framepointer;
-        ref.offset:=alloctemp(list,size,temptype);
+        ref.offset:=alloctemp(list,size,temptype,nil);
+      end;
+
+
+    procedure ttgobj.gettemptyped(list: taasmoutput; def:tdef;temptype:ttemptype;var ref : treference);
+      begin
+        { can't use reference_reset_base, because that will let tgobj depend
+          on cgobj (PFV) }
+        fillchar(ref,sizeof(ref),0);
+        ref.base:=current_procinfo.framepointer;
+        ref.offset:=alloctemp(list,def.size,temptype,def);
       end;
 
 
@@ -481,7 +497,7 @@ unit tgobj;
           begin
             if (hp^.pos=ref.offset) then
              begin
-               if not(hp^.temptype in [tt_free,tt_freeansistring,tt_freewidestring,tt_freeinterfacecom]) then
+               if hp^.temptype<>tt_free then
                 begin
 {$ifdef EXTDEBUG}
                   if hp^.temptype=temptype then
@@ -514,21 +530,21 @@ unit tgobj;
 
     procedure ttgobj.UnGetTemp(list: taasmoutput; const ref : treference);
       begin
-        FreeTemp(list,ref.offset,[tt_normal,tt_noreuse,tt_persistent,tt_ansistring,tt_widestring,tt_interfacecom]);
+        FreeTemp(list,ref.offset,[tt_normal,tt_noreuse,tt_persistent]);
       end;
 
 
     procedure ttgobj.UnGetIfTemp(list: taasmoutput; const ref : treference);
       begin
         if istemp(ref) then
-          FreeTemp(list,ref.offset,[tt_normal,tt_ansistring,tt_widestring,tt_interfacecom]);
+          FreeTemp(list,ref.offset,[tt_normal]);
       end;
 
 
     procedure ttgobj.getlocal(list: taasmoutput; size : longint;var ref : tparareference);
       begin
         ref.index:=current_procinfo.framepointer;
-        ref.offset:=alloctemp(list,size,tt_persistent);
+        ref.offset:=alloctemp(list,size,tt_persistent,nil);
       end;
 
 
@@ -541,7 +557,10 @@ unit tgobj;
 end.
 {
   $Log$
-  Revision 1.40  2003-10-01 20:34:49  peter
+  Revision 1.41  2003-11-04 15:35:13  peter
+    * fix for referencecounted temps
+
+  Revision 1.40  2003/10/01 20:34:49  peter
     * procinfo unit contains tprocinfo
     * cginfo renamed to cgbase
     * moved cgmessage to verbose