Browse Source

+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)
* ppc a_call_* now internalerrors if pi_do_call is not yet set
* fixed lot of missing pi_do_call's

Jonas Maebe 22 years ago
parent
commit
edb2179730

+ 51 - 26
compiler/cgobj.pas

@@ -1309,15 +1309,18 @@ unit cgobj;
 {$ifdef FPC}
         {$warning FIX ME!}
 {$endif}
-        a_paramaddr_ref(list,dest,paramanager.getintparaloc(3));
+        a_paramaddr_ref(list,dest,paramanager.getintparaloc(list,3));
         if loadref then
-          a_param_ref(list,OS_ADDR,source,paramanager.getintparaloc(2))
+          a_param_ref(list,OS_ADDR,source,paramanager.getintparaloc(list,2))
         else
-          a_paramaddr_ref(list,source,paramanager.getintparaloc(2));
+          a_paramaddr_ref(list,source,paramanager.getintparaloc(list,2));
         if delsource then
          reference_release(list,source);
-        a_param_const(list,OS_INT,len,paramanager.getintparaloc(1));
+        a_param_const(list,OS_INT,len,paramanager.getintparaloc(list,1));
         a_call_name(list,'FPC_SHORTSTR_ASSIGN');
+        paramanager.freeintparaloc(list,3);
+        paramanager.freeintparaloc(list,2);
+        paramanager.freeintparaloc(list,1);
       end;
 
 
@@ -1342,19 +1345,21 @@ unit cgobj;
          if incrfunc<>'' then
           begin
             { these functions get the pointer by value }
-            a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1));
+            a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1));
             a_call_name(list,incrfunc);
           end
          else
           begin
             reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-            a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
+            a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
             if loadref then
-              a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
+              a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
             else
-              a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
+              a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
             a_call_name(list,'FPC_ADDREF');
+            paramanager.freeintparaloc(list,2);
          end;
+        paramanager.freeintparaloc(list,1);
       end;
 
 
@@ -1384,24 +1389,28 @@ unit cgobj;
             if needrtti then
              begin
                reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-               a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
+               a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
              end;
             if loadref then
-              a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
+              a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
             else
-              a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
+              a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
             a_call_name(list,decrfunc);
+            if needrtti then
+              paramanager.freeintparaloc(list,2);
           end
          else
           begin
             reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-            a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
+            a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
             if loadref then
-              a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
+              a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
             else
-              a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
+              a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
             a_call_name(list,'FPC_DECREF');
+            paramanager.freeintparaloc(list,2);
          end;
+        paramanager.freeintparaloc(list,1);
       end;
 
 
@@ -1416,12 +1425,14 @@ unit cgobj;
          else
            begin
               reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-              a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
+              a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
               if loadref then
-                a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
+                a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
               else
-                a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
+                a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
               a_call_name(list,'FPC_INITIALIZE');
+              paramanager.freeintparaloc(list,1);
+              paramanager.freeintparaloc(list,2);
            end;
       end;
 
@@ -1437,12 +1448,14 @@ unit cgobj;
          else
            begin
               reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-              a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
+              a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
               if loadref then
-                a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
+                a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
               else
-                a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
+                a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
               a_call_name(list,'FPC_FINALIZE');
+              paramanager.freeintparaloc(list,1);
+              paramanager.freeintparaloc(list,2);
            end;
       end;
 
@@ -1568,8 +1581,9 @@ unit cgobj;
     procedure tcg.g_stackcheck(list : taasmoutput;stackframesize : longint);
 
       begin
-         a_param_const(list,OS_32,stackframesize,paramanager.getintparaloc(1));
+         a_param_const(list,OS_32,stackframesize,paramanager.getintparaloc(list,1));
          a_call_name(list,'FPC_STACKCHECK');
+         paramanager.freeintparaloc(list,1);
       end;
 
 
@@ -1602,8 +1616,9 @@ unit cgobj;
          begin
            objectlibrary.getlabel(oklabel);
            a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel);
-           a_param_const(list,OS_INT,210,paramanager.getintparaloc(1));
+           a_param_const(list,OS_INT,210,paramanager.getintparaloc(list,1));
            a_call_name(list,'FPC_HANDLEERROR');
+           paramanager.freeintparaloc(list,1);
            a_label(list,oklabel);
          end;
       end;
@@ -1616,15 +1631,18 @@ unit cgobj;
         if (cs_check_object in aktlocalswitches) then
          begin
            reference_reset_symbol(hrefvmt,objectlibrary.newasmsymboldata(objdef.vmt_mangledname),0);
-           a_paramaddr_ref(list,hrefvmt,paramanager.getintparaloc(2));
-           a_param_reg(list,OS_ADDR,reg,paramanager.getintparaloc(1));
+           a_paramaddr_ref(list,hrefvmt,paramanager.getintparaloc(list,2));
+           a_param_reg(list,OS_ADDR,reg,paramanager.getintparaloc(list,1));
            a_call_name(list,'FPC_CHECK_OBJECT_EXT');
+           paramanager.freeintparaloc(list,2);
+           paramanager.freeintparaloc(list,1);
          end
         else
          if (cs_check_range in aktlocalswitches) then
           begin
-            a_param_reg(list,OS_ADDR,reg,paramanager.getintparaloc(1));
+            a_param_reg(list,OS_ADDR,reg,paramanager.getintparaloc(list,1));
             a_call_name(list,'FPC_CHECK_OBJECT');
+            paramanager.freeintparaloc(list,1);
           end;
       end;
 
@@ -1700,7 +1718,14 @@ finalization
 end.
 {
   $Log$
-  Revision 1.108  2003-06-06 14:43:02  peter
+  Revision 1.109  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.108  2003/06/06 14:43:02  peter
     * g_copyopenarrayvalue gets length reference
     * don't copy open arrays for cdecl
 

+ 11 - 3
compiler/i386/cpupara.pas

@@ -29,6 +29,7 @@ unit cpupara;
   interface
 
     uses
+       aasmtai,
        cpubase,
        globtype,
        cginfo,
@@ -43,7 +44,7 @@ unit cpupara;
        ti386paramanager = class(tparamanager)
           function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override;
           function push_addr_param(def : tdef;calloption : tproccalloption) : boolean;override;
-          function getintparaloc(nr : longint) : tparalocation;override;
+          function getintparaloc(list: taasmoutput; nr : longint) : tparalocation;override;
           function getparaloc(p : tdef) : tcgloc;
           procedure create_param_loc_info(p : tabstractprocdef);override;
           function getselflocation(p : tabstractprocdef) : tparalocation;override;
@@ -110,7 +111,7 @@ unit cpupara;
       end;
 
 
-    function ti386paramanager.getintparaloc(nr : longint) : tparalocation;
+    function ti386paramanager.getintparaloc(list: taasmoutput; nr : longint) : tparalocation;
       begin
          getintparaloc.loc:=LOC_REFERENCE;
          getintparaloc.reference.index.enum:=R_EBP;
@@ -168,7 +169,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2003-06-06 14:41:22  peter
+  Revision 1.18  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.17  2003/06/06 14:41:22  peter
     * needs cpuinfo
 
   Revision 1.16  2003/06/06 07:36:06  michael

+ 12 - 3
compiler/i386/n386add.pas

@@ -373,10 +373,10 @@ interface
                      {$endif newra}
                        secondpass(left);
                        location_release(exprasmlist,left.location);
-                       cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(2));
+                       cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(exprasmlist,2));
                        secondpass(right);
                        location_release(exprasmlist,right.location);
-                       cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
+                       cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(exprasmlist,1));
                       {$ifdef newra}
                         r.enum:=R_INTREGISTER;
                         for i:=first_supreg to last_supreg do
@@ -389,6 +389,8 @@ interface
                         rg.saveintregvars(exprasmlist,regstopush);
                       {$endif}
                        cg.a_call_name(exprasmlist,'FPC_SHORTSTR_COMPARE');
+                       paramanager.freeintparaloc(exprasmlist,2);
+                       paramanager.freeintparaloc(exprasmlist,1);
                       {$ifdef newra}
                         for i:=first_supreg to last_supreg do
                           if i<>RS_FRAME_POINTER_REG then
@@ -1642,7 +1644,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.70  2003-06-03 13:01:59  daniel
+  Revision 1.71  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.70  2003/06/03 13:01:59  daniel
     * Register allocator finished
 
   Revision 1.69  2003/05/30 23:49:18  jonas

+ 12 - 3
compiler/m68k/n68kmat.pas

@@ -146,8 +146,9 @@ implementation
          objectlibrary.getlabel(continuelabel);
          { compare against zero, if not zero continue }
          cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_NE,0,denum,continuelabel);
-         cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(1));
+         cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(exprasmlist,1));
          cg.a_call_name(exprasmlist,'FPC_HANDLEERROR');
+         paramanager.freeintparaloc(exprasmlist,1);
          cg.a_label(exprasmlist, continuelabel);
          if signed then 
             exprasmlist.concat(taicpu.op_reg_reg(A_DIVS,S_L,denum,num))
@@ -188,8 +189,9 @@ implementation
          objectlibrary.getlabel(continuelabel);
          { compare against zero, if not zero continue }
          cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_NE,0,denum,continuelabel);
-         cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(1));
+         cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(exprasmlist,1));
          cg.a_call_name(exprasmlist,'FPC_HANDLEERROR');
+         paramanager.freeintparaloc(exprasmlist,1);
          cg.a_label(exprasmlist, continuelabel);
 
          tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
@@ -242,7 +244,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2003-02-19 22:00:16  daniel
+  Revision 1.7  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.6  2003/02/19 22:00:16  daniel
     * Code generator converted to new register notation
     - Horribily outdated todo.txt removed
 

+ 15 - 6
compiler/ncgcal.pas

@@ -379,12 +379,12 @@ implementation
         if current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
           begin
             reference_reset_base(href,current_procinfo.framepointer,current_procinfo.framepointer_offset);
-            cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
+            cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(exprasmlist,1));
           end
         { one nesting level }
         else if (current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
           begin
-            cg.a_param_reg(exprasmlist,OS_ADDR,current_procinfo.framepointer,paramanager.getintparaloc(1));
+            cg.a_param_reg(exprasmlist,OS_ADDR,current_procinfo.framepointer,paramanager.getintparaloc(exprasmlist,1));
           end
         { very complex nesting level ... }
         else if (current_procdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
@@ -399,7 +399,7 @@ implementation
                 cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,hregister);
                 dec(i);
               end;
-            cg.a_param_reg(exprasmlist,OS_ADDR,hregister,paramanager.getintparaloc(1));
+            cg.a_param_reg(exprasmlist,OS_ADDR,hregister,paramanager.getintparaloc(exprasmlist,1));
             rg.ungetaddressregister(exprasmlist,hregister);
           end;
       end;
@@ -949,8 +949,9 @@ implementation
          if iolabel<>nil then
            begin
               reference_reset_symbol(href,iolabel,0);
-              cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
+              cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(exprasmlist,1));
               cg.a_call_name(exprasmlist,'FPC_IOCHECK');
+              paramanager.freeintparaloc(exprasmlist,1);
            end;
 
          { restore registers }
@@ -1294,8 +1295,9 @@ implementation
          if iolabel<>nil then
            begin
               reference_reset_symbol(href,iolabel,0);
-              cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
+              cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(exprasmlist,1));
               cg.a_call_name(exprasmlist,'FPC_IOCHECK');
+              paramanager.freeintparaloc(exprasmlist,1);
            end;
 
          { restore registers }
@@ -1380,7 +1382,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.85  2003-06-04 06:43:36  jonas
+  Revision 1.86  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.85  2003/06/04 06:43:36  jonas
     * fixed double secondpassing of procvar loads
 
   Revision 1.84  2003/06/03 21:11:09  peter

+ 27 - 12
compiler/ncgflw.pas

@@ -816,15 +816,15 @@ implementation
                       secondpass(frametree);
                       if codegenerror then
                        exit;
-                      cg.a_param_loc(exprasmlist,frametree.location,paramanager.getintparaloc(2));
+                      cg.a_param_loc(exprasmlist,frametree.location,paramanager.getintparaloc(exprasmlist,3));
                     end
                   else
-                    cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(2));
+                    cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(exprasmlist,3));
                   { push address }
                   secondpass(right);
                   if codegenerror then
                    exit;
-                  cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(1));
+                  cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(exprasmlist,2));
                 end
               else
                 begin
@@ -835,16 +835,19 @@ implementation
                    { push current frame }
                    r.enum:=R_INTREGISTER;
                    r.number:=NR_FRAME_POINTER_REG;
-                   cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(2));
+                   cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(exprasmlist,3));
                    { push current address }
-                   cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(1));
+                   cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(exprasmlist,2));
                 end;
               { push object }
               secondpass(left);
               if codegenerror then
                 exit;
-              cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(1));
+              cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(exprasmlist,1));
               cg.a_call_name(exprasmlist,'FPC_RAISEEXCEPTION');
+              paramanager.freeintparaloc(exprasmlist,3);
+              paramanager.freeintparaloc(exprasmlist,2);
+              paramanager.freeintparaloc(exprasmlist,1);
            end
          else
            begin
@@ -893,8 +896,9 @@ implementation
          cg.a_call_name(exprasmlist,'FPC_POPOBJECTSTACK');
          r.enum:=R_INTREGISTER;
          r.number:=NR_FUNCTION_RESULT_REG;
-         cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(1));
+         cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(exprasmlist,1));
          cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
+         paramanager.freeintparaloc(exprasmlist,1);
       end;
 
 
@@ -998,8 +1002,9 @@ implementation
               { FPC_CATCHES must be called with
                 'default handler' flag (=-1)
               }
-              cg.a_param_const(exprasmlist,OS_ADDR,aword(-1),paramanager.getintparaloc(1));
+              cg.a_param_const(exprasmlist,OS_ADDR,aword(-1),paramanager.getintparaloc(exprasmlist,1));
               cg.a_call_name(exprasmlist,'FPC_CATCHES');
+              paramanager.freeintparaloc(exprasmlist,1);
 
               { the destruction of the exception object must be also }
               { guarded by an exception frame                        }
@@ -1021,8 +1026,9 @@ implementation
 
               r.enum:=R_INTREGISTER;
               r.number:=NR_FUNCTION_RESULT_REG;
-              cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(1));
+              cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(exprasmlist,1));
               cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
+              paramanager.freeintparaloc(exprasmlist,1);
               { we don't need to restore esi here because reraise never }
               { returns                                                 }
               cg.a_call_name(exprasmlist,'FPC_RERAISE');
@@ -1142,8 +1148,9 @@ implementation
 
          { send the vmt parameter }
          reference_reset_symbol(href2,objectlibrary.newasmsymboldata(excepttype.vmt_mangledname),0);
-         cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(1));
+         cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(exprasmlist,1));
          cg.a_call_name(exprasmlist,'FPC_CATCHES');
+         paramanager.freeintparaloc(exprasmlist,1);
 
          { is it this catch? No. go to next onlabel }
          r.enum:=R_INTREGISTER;
@@ -1187,8 +1194,9 @@ implementation
          try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,doobjectdestroy,false);
 
          cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
-         cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(1));
+         cg.a_param_reg(exprasmlist, OS_ADDR, r, paramanager.getintparaloc(exprasmlist,1));
          cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
+         paramanager.freeintparaloc(exprasmlist,1);
          { we don't need to restore esi here because reraise never }
          { returns                                                 }
          cg.a_call_name(exprasmlist,'FPC_RERAISE');
@@ -1419,7 +1427,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.68  2003-06-03 21:11:09  peter
+  Revision 1.69  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.68  2003/06/03 21:11:09  peter
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus

+ 16 - 5
compiler/ncginl.pas

@@ -192,22 +192,26 @@ implementation
        { erroraddr }
        r.enum:=R_INTREGISTER;
        r.number:=NR_FRAME_POINTER_REG;
-       cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(4));
+       cg.a_param_reg(exprasmlist,OS_ADDR,r,paramanager.getintparaloc(exprasmlist,4));
        { lineno }
-       cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paramanager.getintparaloc(3));
+       cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paramanager.getintparaloc(exprasmlist,3));
        { filename string }
        hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
        firstpass(tnode(hp2));
        secondpass(tnode(hp2));
        if codegenerror then
           exit;
-       cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paramanager.getintparaloc(2));
+       cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paramanager.getintparaloc(exprasmlist,2));
        hp2.free;
        { push msg }
        secondpass(tcallparanode(tcallparanode(left).right).left);
-       cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,paramanager.getintparaloc(1));
+       cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,paramanager.getintparaloc(exprasmlist,1));
        { call }
        cg.a_call_name(exprasmlist,'FPC_ASSERT');
+       paramanager.freeintparaloc(exprasmlist,4);
+       paramanager.freeintparaloc(exprasmlist,3);
+       paramanager.freeintparaloc(exprasmlist,2);
+       paramanager.freeintparaloc(exprasmlist,1);
        cg.a_label(exprasmlist,truelabel);
        truelabel:=otlabel;
        falselabel:=oflabel;
@@ -682,7 +686,14 @@ end.
 
 {
   $Log$
-  Revision 1.35  2003-06-03 21:11:09  peter
+  Revision 1.36  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.35  2003/06/03 21:11:09  peter
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus

+ 10 - 2
compiler/ncgld.pas

@@ -150,7 +150,7 @@ implementation
                        rg.saveusedintregisters(exprasmlist,pushed,[RS_FUNCTION_RESULT_REG]-[hregister.number shr 8]);
                     {$endif}
                        reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(symtableentry).mangledname),0);
-                       cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
+                       cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(exprasmlist,1));
                     {$ifdef newra}
                        rg.ungetregisterint(exprasmlist,hregister);
                        r:=rg.getexplicitregisterint(exprasmlist,NR_EAX);
@@ -158,6 +158,7 @@ implementation
                        { the called procedure isn't allowed to change }
                        { any register except EAX                    }
                        cg.a_call_reg(exprasmlist,hregister);
+                       paramanager.freeintparaloc(exprasmlist,1);
                     {$ifdef newra}
                        rg.ungetregisterint(exprasmlist,r);
                        hregister:=rg.getregisterint(exprasmlist,OS_ADDR);
@@ -934,7 +935,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.66  2003-06-03 21:11:09  peter
+  Revision 1.67  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.66  2003/06/03 21:11:09  peter
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus

+ 9 - 2
compiler/ncgmat.pas

@@ -334,7 +334,7 @@ implementation
                   }
                   objectlibrary.getlabel(hl);
                   cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_NE,0,hdenom,hl);
-                  cg.a_param_const(exprasmlist,OS_S32,200,paramanager.getintparaloc(1));
+                  cg.a_param_const(exprasmlist,OS_S32,200,paramanager.getintparaloc(exprasmlist,1));
                   cg.a_call_name(exprasmlist,'FPC_HANDLERROR');
                   cg.a_label(exprasmlist,hl);
                   if nodetype = modn then
@@ -514,7 +514,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2003-06-03 21:11:09  peter
+  Revision 1.14  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.13  2003/06/03 21:11:09  peter
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus

+ 30 - 12
compiler/ncgmem.pas

@@ -258,8 +258,9 @@ implementation
             not(cs_compilesystem in aktmoduleswitches) and
             (not tpointerdef(left.resulttype.def).is_far) then
           begin
-            cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
+            cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
             cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
+            paramanager.freeintparaloc(exprasmlist,1);
           end;
       end;
 
@@ -305,8 +306,9 @@ implementation
                 (cs_checkpointer in aktglobalswitches) and
                 not(cs_compilesystem in aktmoduleswitches) then
               begin
-                cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
+                cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
                 cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
+                paramanager.freeintparaloc(exprasmlist,1);
               end;
            end
          else if is_interfacecom(left.resulttype.def) then
@@ -318,8 +320,9 @@ implementation
                 (cs_checkpointer in aktglobalswitches) and
                 not(cs_compilesystem in aktmoduleswitches) then
               begin
-                cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
+                cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
                 cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
+                paramanager.freeintparaloc(exprasmlist,1);
               end;
 
            end
@@ -512,8 +515,8 @@ implementation
             {$ifndef newra}
                rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
             {$endif}
-               cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(2));
-               cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(1));
+               cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(exprasmlist,2));
+               cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(exprasmlist,1));
             {$ifdef newra}
                hreg.enum:=R_INTREGISTER;
                for i:=first_supreg to last_supreg do
@@ -526,6 +529,8 @@ implementation
                rg.saveintregvars(exprasmlist,all_intregisters);
             {$endif}
                cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK');
+               paramanager.freeintparaloc(exprasmlist,2);
+               paramanager.freeintparaloc(exprasmlist,1);
             {$ifdef newra}
                for i:=first_supreg to last_supreg do
                  if i<>RS_FRAME_POINTER_REG then
@@ -578,7 +583,7 @@ implementation
                 {$ifndef newra}
                    rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                 {$endif}
-                   cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(1));
+                   cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(exprasmlist,1));
                 {$ifdef newra}
                    hreg.enum:=R_INTREGISTER;
                    for i:=first_supreg to last_supreg do
@@ -591,6 +596,7 @@ implementation
                    rg.saveintregvars(exprasmlist,all_intregisters);
                 {$endif}
                    cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_UNIQUE');
+                   paramanager.freeintparaloc(exprasmlist,1);
                 {$ifdef newra}
                    for i:=first_supreg to last_supreg do
                      if i<>RS_FRAME_POINTER_REG then
@@ -625,7 +631,7 @@ implementation
                 {$ifndef newra}
                    rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                 {$endif}
-                   cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
+                   cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
                 {$ifdef newra}
                    hreg.enum:=R_INTREGISTER;
                    for i:=first_supreg to last_supreg do
@@ -638,6 +644,7 @@ implementation
                    rg.saveintregvars(exprasmlist,all_intregisters);
                 {$endif}
                    cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
+                   paramanager.freeintparaloc(exprasmlist,1);
                 {$ifdef newra}
                    for i:=first_supreg to last_supreg do
                      if i<>RS_FRAME_POINTER_REG then
@@ -723,10 +730,10 @@ implementation
                             {$ifndef newra}
                               rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                             {$endif}
-                              cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paramanager.getintparaloc(2));
+                              cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paramanager.getintparaloc(exprasmlist,2));
                               href:=location.reference;
                               dec(href.offset,7);
-                              cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
+                              cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(exprasmlist,1));
                             {$ifdef newra}
                               hreg.enum:=R_INTREGISTER;
                               for i:=first_supreg to last_supreg do
@@ -739,6 +746,8 @@ implementation
                               rg.saveintregvars(exprasmlist,all_intregisters);
                             {$endif}
                               cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
+                              paramanager.freeintparaloc(exprasmlist,2);
+                              paramanager.freeintparaloc(exprasmlist,1);
                             {$ifdef newra}
                               for i:=first_supreg to last_supreg do
                                if i<>RS_FRAME_POINTER_REG then
@@ -878,10 +887,10 @@ implementation
                             {$ifndef newra}
                               rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                             {$endif}
-                              cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paramanager.getintparaloc(2));
+                              cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paramanager.getintparaloc(exprasmlist,2));
                               href:=location.reference;
                               dec(href.offset,7);
-                              cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
+                              cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(exprasmlist,1));
                             {$ifdef newra}
                               hreg.enum:=R_INTREGISTER;
                               for i:=first_supreg to last_supreg do
@@ -894,6 +903,8 @@ implementation
                               rg.saveintregvars(exprasmlist,all_intregisters);
                             {$endif}
                               cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
+                              paramanager.freeintparaloc(exprasmlist,2);
+                              paramanager.freeintparaloc(exprasmlist,1);
                             {$ifdef newra}
                               for i:=first_supreg to last_supreg do
                                if i<>RS_FRAME_POINTER_REG then
@@ -937,7 +948,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.59  2003-06-03 21:11:09  peter
+  Revision 1.60  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.59  2003/06/03 21:11:09  peter
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus

+ 19 - 6
compiler/ncgset.pas

@@ -608,16 +608,22 @@ implementation
                   cg.a_load_loc_reg(exprasmlist,OS_INT,left.location,pleftreg);
                   location_freetemp(exprasmlist,left.location);
                   location_release(exprasmlist,left.location);
-                  cg.a_param_reg(exprasmlist,OS_8,pleftreg,paramanager.getintparaloc(2));
-                  cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
+                  cg.a_param_reg(exprasmlist,OS_8,pleftreg,paramanager.getintparaloc(exprasmlist,2));
+                  { release the allocated register  }
+                  if not (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                    rg.ungetregisterint(exprasmlist,pleftreg);
+                  cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(exprasmlist,1));
                   cg.a_call_name(exprasmlist,'FPC_SET_IN_BYTE');
+                  paramanager.freeintparaloc(exprasmlist,2);
+                  paramanager.freeintparaloc(exprasmlist,1);
                   { result of value is always one full register }
                   r.enum:=R_INTREGISTER;
                   r.number:=NR_FUNCTION_RESULT_REG;
+{$ifdef newra}
+                  rg.getexplicitregisterint(exprasmlist,NR_FUNCTION_RESULT_REG);
+                  rg.ungetregisterint(exprasmlist,r);
+{$endif newra}
                   cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,r,location.register);
-                  { release the allocated register  }
-                  if not (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
-                    rg.ungetregisterint(exprasmlist,pleftreg);
                   location_release(exprasmlist,right.location);
                 end;
              end;
@@ -1116,7 +1122,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.40  2003-06-03 21:11:09  peter
+  Revision 1.41  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.40  2003/06/03 21:11:09  peter
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus

+ 26 - 10
compiler/ncgutil.pas

@@ -264,16 +264,20 @@ implementation
     var r:Tregister;
 
      begin
-       cg.a_paramaddr_ref(list,envbuf,paramanager.getintparaloc(3));
-       cg.a_paramaddr_ref(list,jmpbuf,paramanager.getintparaloc(2));
+       cg.a_paramaddr_ref(list,envbuf,paramanager.getintparaloc(list,3));
+       cg.a_paramaddr_ref(list,jmpbuf,paramanager.getintparaloc(list,2));
        { push type of exceptionframe }
-       cg.a_param_const(list,OS_S32,1,paramanager.getintparaloc(1));
+       cg.a_param_const(list,OS_S32,1,paramanager.getintparaloc(list,1));
        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
+       paramanager.freeintparaloc(list,3);
+       paramanager.freeintparaloc(list,2);
+       paramanager.freeintparaloc(list,1);
 
        r.enum:=R_INTREGISTER;
        r.number:=NR_FUNCTION_RESULT_REG;
-       cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(1));
+       cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(list,1));
        cg.a_call_name(list,'FPC_SETJMP');
+       paramanager.freeintparaloc(list,1);
 
        cg.g_exception_reason_save(list, href);
        cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,r,exceptlabel);
@@ -1202,21 +1206,24 @@ implementation
              tt_freeansistring :
                begin
                  reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
-                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
+                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
                  cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
+                 paramanager.freeintparaloc(list,1);
                end;
              tt_widestring,
              tt_freewidestring :
                begin
                  reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
-                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
+                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
                  cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
+                 paramanager.freeintparaloc(list,1);
                end;
              tt_interfacecom :
                begin
                  reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
-                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
+                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
                  cg.a_call_name(list,'FPC_INTF_DECR_REF');
+                 paramanager.freeintparaloc(list,1);
                end;
            end;
            hp:=hp^.next;
@@ -1499,10 +1506,12 @@ implementation
                  (cs_profile in aktmoduleswitches) then
                begin
                  reference_reset_symbol(href,objectlibrary.newasmsymboldata('etext'),0);
-                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
+                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
                  reference_reset_symbol(href,objectlibrary.newasmsymboldata('__image_base__'),0);
-                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
+                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
                  cg.a_call_name(list,'_monstartup');
+                 paramanager.freeintparaloc(list,2);
+                 paramanager.freeintparaloc(list,1);
                end;
 
               { initialize units }
@@ -1954,7 +1963,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.122  2003-06-06 14:43:02  peter
+  Revision 1.123  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.122  2003/06/06 14:43:02  peter
     * g_copyopenarrayvalue gets length reference
     * don't copy open arrays for cdecl
 

+ 9 - 1
compiler/nflw.pas

@@ -1187,6 +1187,7 @@ implementation
     function traisenode.pass_1 : tnode;
       begin
          result:=nil;
+         include(current_procinfo.flags,pi_do_call);
          expectloc:=LOC_VOID;
          if assigned(left) then
            begin
@@ -1426,7 +1427,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.75  2003-05-26 21:17:17  peter
+  Revision 1.76  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.75  2003/05/26 21:17:17  peter
     * procinlinenode removed
     * aktexit2label removed, fast exit removed
     + tcallnode.inlined_pass_2 added

+ 14 - 1
compiler/nld.pas

@@ -492,6 +492,7 @@ implementation
 
                 if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
                   registers32:=1;
+                { call to get address of threadvar }
                 if (vo_is_thread_var in tvarsym(symtableentry).varoptions) then
                   include(current_procinfo.flags,pi_do_call);
                 if nf_write in flags then
@@ -811,6 +812,11 @@ implementation
 
          firstpass(left);
          firstpass(right);
+         { assignment to refcounted variable -> inc/decref }
+         if (not is_class(left.resulttype.def) and
+            left.resulttype.def.needs_inittable) then
+           include(current_procinfo.flags,pi_do_call);
+
          if codegenerror then
            exit;
 
@@ -1247,7 +1253,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.97  2003-06-07 14:39:18  jonas
+  Revision 1.98  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.97  2003/06/07 14:39:18  jonas
     * set pi_do_call for accesses to threadvars
 
   Revision 1.96  2003/05/26 19:38:28  peter

+ 13 - 1
compiler/nmem.pas

@@ -693,6 +693,11 @@ implementation
          if codegenerror then
            exit;
 
+         if (nf_callunique in flags) and
+            (is_ansistring(left.resulttype.def) or
+             is_widestring(left.resulttype.def)) then
+           include(current_procinfo.flags,pi_do_call);
+
          { the register calculation is easy if a const index is used }
          if right.nodetype=ordconstn then
            begin
@@ -897,7 +902,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.55  2003-05-24 17:15:24  jonas
+  Revision 1.56  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.55  2003/05/24 17:15:24  jonas
     * added missing firstpass for withrefnode
 
   Revision 1.54  2003/05/11 14:45:12  peter

+ 31 - 2
compiler/paramgr.pas

@@ -30,6 +30,7 @@ unit paramgr;
 
     uses
        cpubase,
+       aasmtai,
        globtype,
        symconst,symtype,symdef;
 
@@ -61,9 +62,23 @@ unit paramgr;
             internal routines directly, where all parameters must
             be 4-byte values.
 
+            In case the location is a register, this register is allocated.
+            Call freeintparaloc() after the call to free the locations again.
+            Default implementation: don't do anything at all (in case you don't
+            use register parameter passing)
+
+            @param(list Current assembler list)
             @param(nr Parameter number of routine, starting from 1)
           }
-          function getintparaloc(nr : longint) : tparalocation;virtual;abstract;
+          function getintparaloc(list: taasmoutput; nr : longint) : tparalocation;virtual;abstract;
+
+          {# frees a parameter location allocated with getintparaloc
+
+            @param(list Current assembler list)
+            @param(nr Parameter numver of routine, starting from 1)
+          }
+          procedure freeintparaloc(list: taasmoutput; nr : longint); virtual;
+
           {# This is used to populate the location information on all parameters
              for the routine. This is used for normal call resolution.
           }
@@ -97,6 +112,8 @@ unit paramgr;
           function getfuncresultloc(def : tdef;calloption:tproccalloption): tparalocation; virtual;
        end;
 
+
+
     procedure setparalocs(p : tprocdef);
     function getfuncretusedregisters(def : tdef;calloption:tproccalloption): tregisterset;
 
@@ -231,6 +248,11 @@ unit paramgr;
       end;
 
 
+    procedure tparamanager.freeintparaloc(list: taasmoutput; nr : longint);
+      begin
+      end;
+
+
     function tparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
       begin
          result.loc:=LOC_REFERENCE;
@@ -399,7 +421,14 @@ end.
 
 {
    $Log$
-   Revision 1.40  2003-05-31 15:05:28  peter
+   Revision 1.41  2003-06-07 18:57:04  jonas
+     + added freeintparaloc
+     * ppc get/freeintparaloc now check whether the parameter regs are
+       properly allocated/deallocated (and get an extra list para)
+     * ppc a_call_* now internalerrors if pi_do_call is not yet set
+     * fixed lot of missing pi_do_call's
+
+   Revision 1.40  2003/05/31 15:05:28  peter
      * FUNCTION_RESULT64_LOW/HIGH_REG added for int64 results
 
    Revision 1.39  2003/05/30 23:57:08  peter

+ 16 - 6
compiler/powerpc/cgcpu.pas

@@ -77,7 +77,7 @@ unit cgcpu;
 
         procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); override;
 
-        procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);override;
+        procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:integer);override;
         procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
         procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
         procedure g_restore_frame_pointer(list : taasmoutput);override;
@@ -252,7 +252,8 @@ const
          list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s)));
          if target_info.system=system_powerpc_macos then
            list.concat(taicpu.op_none(A_NOP));
-         include(current_procinfo.flags,pi_do_call);
+         if not(pi_do_call in current_procinfo.flags) then
+           internalerror(2003060703);
       end;
 
     { calling a procedure by address }
@@ -283,7 +284,8 @@ const
         //if target_info.system=system_powerpc_macos then
         //  //NOP is not needed here.
         //  list.concat(taicpu.op_none(A_NOP));
-        include(current_procinfo.flags,pi_do_call);
+        if not(pi_do_call in current_procinfo.flags) then
+          internalerror(2003060704);
         //list.concat(tai_comment.create(strpnew('***** a_call_reg')));
       end;
 
@@ -315,7 +317,8 @@ const
         //if target_info.system=system_powerpc_macos then
         //  //NOP is not needed here.
         //  list.concat(taicpu.op_none(A_NOP));
-        include(current_procinfo.flags,pi_do_call);
+        if not(pi_do_call in current_procinfo.flags) then
+          internalerror(2003060705);
         //list.concat(tai_comment.create(strpnew('***** a_call_ref')));
       end;
 
@@ -2037,7 +2040,7 @@ const
          tg.ungetiftemp(list,source);
       end;
 
-    procedure tcgppc.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);
+    procedure tcgppc.g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:integer);
       var
         lenref : treference;
         power,len  : longint;
@@ -2563,7 +2566,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.104  2003-06-04 11:58:58  jonas
+  Revision 1.105  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.104  2003/06/04 11:58:58  jonas
     * calculate localsize also in g_return_from_proc since it's now called
       before g_stackframe_entry (still have to fix macos)
     * compilation fixes (cycle doesn't work yet though)

+ 31 - 3
compiler/powerpc/cpupara.pas

@@ -29,13 +29,15 @@ unit cpupara;
 
     uses
        globtype,
+       aasmtai,
        cpubase,
        symconst,symbase,symtype,symdef,paramgr;
 
     type
        tppcparamanager = class(tparamanager)
           function push_addr_param(def : tdef;calloption : tproccalloption) : boolean;override;
-          function getintparaloc(nr : longint) : tparalocation;override;
+          function getintparaloc(list: taasmoutput; nr : longint) : tparalocation;override;
+          procedure freeintparaloc(list: taasmoutput; nr : longint); override;
           procedure create_param_loc_info(p : tabstractprocdef);override;
           function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
        end;
@@ -45,9 +47,10 @@ unit cpupara;
     uses
        verbose,systems,
        cpuinfo,cginfo,cgbase,
+       rgobj,
        defutil;
 
-    function tppcparamanager.getintparaloc(nr : longint) : tparalocation;
+    function tppcparamanager.getintparaloc(list: taasmoutput; nr : longint) : tparalocation;
 
       begin
          fillchar(result,sizeof(tparalocation),0);
@@ -58,6 +61,7 @@ unit cpupara;
               result.loc:=LOC_REGISTER;
               result.register.enum:=R_INTREGISTER;
               result.register.number:=NR_R2+nr*(NR_R1-NR_R0);
+              rg.getexplicitregisterint(list,result.register.number);
            end
          else
            begin
@@ -69,6 +73,23 @@ unit cpupara;
          result.size := OS_INT;
       end;
 
+
+    procedure tppcparamanager.freeintparaloc(list: taasmoutput; nr : longint);
+
+      var
+        r: tregister;
+
+      begin
+         if nr<1 then
+           internalerror(2003060401)
+         else if nr<=8 then
+           begin
+             r.enum := R_INTREGISTER;
+             r.number := NR_R2+nr*(NR_R1-NR_R0);
+             rg.ungetregisterint(list,r);
+           end;
+      end;
+
     function getparaloc(p : tdef) : tcgloc;
 
       begin
@@ -337,7 +358,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.34  2003-05-30 23:45:49  marco
+  Revision 1.35  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.34  2003/05/30 23:45:49  marco
    * register skipping (aligning) for int64 parameters, sys V abi only.
 
   Revision 1.33  2003/05/30 22:54:19  marco

+ 34 - 6
compiler/powerpc/rgcpu.pas

@@ -43,22 +43,29 @@ unit rgcpu;
          procedure saveusedotherregisters(list:Taasmoutput;
                                            var saved:Tpushedsavedother;
                                            const s:Tregisterset);override;
+         procedure cleartempgen; override;
+        private
+         usedpararegs: Tsupregset;
        end;
 
   implementation
 
     uses
-      cgobj;
+      cgobj, verbose;
 
     function trgcpu.getexplicitregisterint(list: taasmoutput; reg: Tnewregister): tregister;
 
     var r:Tregister;
 
       begin
-        if reg = NR_R0 then
+        if ((reg shr 8) in [RS_R0,RS_R2..RS_R12]) and
+           not((reg shr 8) in is_reg_var_int) then
           begin
+            if (reg shr 8) in usedpararegs then
+              internalerror(2003060701);
+            include(usedpararegs,reg shr 8);
             r.enum:=R_INTREGISTER;
-            r.number:=NR_R0;
+            r.number:=reg;
             cg.a_reg_alloc(list,r);
             result := r;
           end
@@ -69,8 +76,14 @@ unit rgcpu;
     procedure trgcpu.ungetregisterint(list: taasmoutput; reg: tregister);
 
       begin
-        if reg.enum = R_0 then
-          cg.a_reg_dealloc(list,reg)
+        if ((reg.number shr 8) in [RS_R0,RS_R2..RS_R12]) and
+            not((reg.number shr 8) in is_reg_var_int) then
+          begin
+            if not((reg.number shr 8) in usedpararegs) then
+              internalerror(2003060702);
+            exclude(usedpararegs,reg.number shr 8);
+            cg.a_reg_dealloc(list,reg);
+          end
         else
           inherited ungetregisterint(list,reg);
       end;
@@ -97,13 +110,28 @@ unit rgcpu;
         filldword(saved,sizeof(saved) div 4,reg_not_saved);
       end;
 
+
+    procedure trgcpu.cleartempgen;
+
+      begin
+        inherited cleartempgen;
+        usedpararegs := [];
+      end;
+
 initialization
   rg := trgcpu.create(32);  {PPC has 32 registers.}
 end.
 
 {
   $Log$
-  Revision 1.7  2003-05-24 13:38:04  jonas
+  Revision 1.8  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.7  2003/05/24 13:38:04  jonas
     * don't save callee-save registers in the caller as well (the ppc code
       that we generate is slow enough as it is without resorting to doing
       double work :)

+ 28 - 1
compiler/psub.pas

@@ -915,6 +915,21 @@ implementation
       end;
 
 
+    procedure check_init_paras(p:tnamedindexitem;arg:pointer);
+      var
+        vs : tvarsym;
+        pd : tprocdef;
+      begin
+        if tsym(p).typ<>varsym then
+         exit;
+        with tvarsym(p) do
+          if (not is_class(vartype.def) and
+             vartype.def.needs_inittable and
+             (varspez in [vs_value,vs_out])) then
+            include(current_procinfo.flags,pi_do_call);
+      end;
+
+
     procedure read_proc;
       {
         Parses the procedure directives, then parses the procedure body, then
@@ -1052,6 +1067,11 @@ implementation
              { Insert local copies for value para }
              pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
 
+             { check if there are para's which require initing -> set }
+             { pi_do_call (if not yet set)                            }
+             if not(pi_do_call in current_procinfo.flags) then
+               pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_init_paras,nil);
+
              { Update parameter information }
              current_procinfo.allocate_implicit_parameter;
 {$ifdef i386}
@@ -1233,7 +1253,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.122  2003-06-03 13:01:59  daniel
+  Revision 1.123  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.122  2003/06/03 13:01:59  daniel
     * Register allocator finished
 
   Revision 1.121  2003/05/31 20:23:39  jonas

+ 16 - 4
compiler/regvars.pas

@@ -184,10 +184,15 @@ implementation
                   while assigned(hp) do
                     begin
                       if (hp.paraloc.loc in [LOC_REGISTER,LOC_FPUREGISTER,
-                            LOC_MMREGISTER,LOC_CREGISTER,LOC_CFPUREGISTER,
-                            LOC_CMMREGISTER]) and
+                            LOC_CREGISTER,LOC_CFPUREGISTER]) and
                          (TCGSize2Size[hp.paraloc.size] <= sizeof(aword)) then
-                        tvarsym(hp.parasym).reg := hp.paraloc.register
+                        begin
+                          tvarsym(hp.parasym).reg := hp.paraloc.register;
+                          if (hp.paraloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                            rg.makeregvarint(hp.paraloc.register.number shr 8)
+                          else
+                            rg.makeregvarother(hp.paraloc.register);
+                        end
                       else
                         begin
                           searchregvars(hp.parasym,@parasym);
@@ -611,7 +616,14 @@ end.
 
 {
   $Log$
-  Revision 1.55  2003-06-03 21:11:09  peter
+  Revision 1.56  2003-06-07 18:57:04  jonas
+    + added freeintparaloc
+    * ppc get/freeintparaloc now check whether the parameter regs are
+      properly allocated/deallocated (and get an extra list para)
+    * ppc a_call_* now internalerrors if pi_do_call is not yet set
+    * fixed lot of missing pi_do_call's
+
+  Revision 1.55  2003/06/03 21:11:09  peter
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus