2
0
Эх сурвалжийг харах

+ 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 жил өмнө
parent
commit
edb2179730

+ 51 - 26
compiler/cgobj.pas

@@ -1309,15 +1309,18 @@ unit cgobj;
 {$ifdef FPC}
 {$ifdef FPC}
         {$warning FIX ME!}
         {$warning FIX ME!}
 {$endif}
 {$endif}
-        a_paramaddr_ref(list,dest,paramanager.getintparaloc(3));
+        a_paramaddr_ref(list,dest,paramanager.getintparaloc(list,3));
         if loadref then
         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
         else
-          a_paramaddr_ref(list,source,paramanager.getintparaloc(2));
+          a_paramaddr_ref(list,source,paramanager.getintparaloc(list,2));
         if delsource then
         if delsource then
          reference_release(list,source);
          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');
         a_call_name(list,'FPC_SHORTSTR_ASSIGN');
+        paramanager.freeintparaloc(list,3);
+        paramanager.freeintparaloc(list,2);
+        paramanager.freeintparaloc(list,1);
       end;
       end;
 
 
 
 
@@ -1342,19 +1345,21 @@ unit cgobj;
          if incrfunc<>'' then
          if incrfunc<>'' then
           begin
           begin
             { these functions get the pointer by value }
             { 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);
             a_call_name(list,incrfunc);
           end
           end
          else
          else
           begin
           begin
             reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
             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
             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
             else
-              a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
+              a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
             a_call_name(list,'FPC_ADDREF');
             a_call_name(list,'FPC_ADDREF');
+            paramanager.freeintparaloc(list,2);
          end;
          end;
+        paramanager.freeintparaloc(list,1);
       end;
       end;
 
 
 
 
@@ -1384,24 +1389,28 @@ unit cgobj;
             if needrtti then
             if needrtti then
              begin
              begin
                reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
                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;
              end;
             if loadref then
             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
             else
-              a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
+              a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
             a_call_name(list,decrfunc);
             a_call_name(list,decrfunc);
+            if needrtti then
+              paramanager.freeintparaloc(list,2);
           end
           end
          else
          else
           begin
           begin
             reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
             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
             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
             else
-              a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
+              a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
             a_call_name(list,'FPC_DECREF');
             a_call_name(list,'FPC_DECREF');
+            paramanager.freeintparaloc(list,2);
          end;
          end;
+        paramanager.freeintparaloc(list,1);
       end;
       end;
 
 
 
 
@@ -1416,12 +1425,14 @@ unit cgobj;
          else
          else
            begin
            begin
               reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
               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
               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
               else
-                a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
+                a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
               a_call_name(list,'FPC_INITIALIZE');
               a_call_name(list,'FPC_INITIALIZE');
+              paramanager.freeintparaloc(list,1);
+              paramanager.freeintparaloc(list,2);
            end;
            end;
       end;
       end;
 
 
@@ -1437,12 +1448,14 @@ unit cgobj;
          else
          else
            begin
            begin
               reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
               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
               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
               else
-                a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
+                a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
               a_call_name(list,'FPC_FINALIZE');
               a_call_name(list,'FPC_FINALIZE');
+              paramanager.freeintparaloc(list,1);
+              paramanager.freeintparaloc(list,2);
            end;
            end;
       end;
       end;
 
 
@@ -1568,8 +1581,9 @@ unit cgobj;
     procedure tcg.g_stackcheck(list : taasmoutput;stackframesize : longint);
     procedure tcg.g_stackcheck(list : taasmoutput;stackframesize : longint);
 
 
       begin
       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');
          a_call_name(list,'FPC_STACKCHECK');
+         paramanager.freeintparaloc(list,1);
       end;
       end;
 
 
 
 
@@ -1602,8 +1616,9 @@ unit cgobj;
          begin
          begin
            objectlibrary.getlabel(oklabel);
            objectlibrary.getlabel(oklabel);
            a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,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');
            a_call_name(list,'FPC_HANDLEERROR');
+           paramanager.freeintparaloc(list,1);
            a_label(list,oklabel);
            a_label(list,oklabel);
          end;
          end;
       end;
       end;
@@ -1616,15 +1631,18 @@ unit cgobj;
         if (cs_check_object in aktlocalswitches) then
         if (cs_check_object in aktlocalswitches) then
          begin
          begin
            reference_reset_symbol(hrefvmt,objectlibrary.newasmsymboldata(objdef.vmt_mangledname),0);
            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');
            a_call_name(list,'FPC_CHECK_OBJECT_EXT');
+           paramanager.freeintparaloc(list,2);
+           paramanager.freeintparaloc(list,1);
          end
          end
         else
         else
          if (cs_check_range in aktlocalswitches) then
          if (cs_check_range in aktlocalswitches) then
           begin
           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');
             a_call_name(list,'FPC_CHECK_OBJECT');
+            paramanager.freeintparaloc(list,1);
           end;
           end;
       end;
       end;
 
 
@@ -1700,7 +1718,14 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $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
     * g_copyopenarrayvalue gets length reference
     * don't copy open arrays for cdecl
     * don't copy open arrays for cdecl
 
 

+ 11 - 3
compiler/i386/cpupara.pas

@@ -29,6 +29,7 @@ unit cpupara;
   interface
   interface
 
 
     uses
     uses
+       aasmtai,
        cpubase,
        cpubase,
        globtype,
        globtype,
        cginfo,
        cginfo,
@@ -43,7 +44,7 @@ unit cpupara;
        ti386paramanager = class(tparamanager)
        ti386paramanager = class(tparamanager)
           function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override;
           function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override;
           function push_addr_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;
           function getparaloc(p : tdef) : tcgloc;
           procedure create_param_loc_info(p : tabstractprocdef);override;
           procedure create_param_loc_info(p : tabstractprocdef);override;
           function getselflocation(p : tabstractprocdef) : tparalocation;override;
           function getselflocation(p : tabstractprocdef) : tparalocation;override;
@@ -110,7 +111,7 @@ unit cpupara;
       end;
       end;
 
 
 
 
-    function ti386paramanager.getintparaloc(nr : longint) : tparalocation;
+    function ti386paramanager.getintparaloc(list: taasmoutput; nr : longint) : tparalocation;
       begin
       begin
          getintparaloc.loc:=LOC_REFERENCE;
          getintparaloc.loc:=LOC_REFERENCE;
          getintparaloc.reference.index.enum:=R_EBP;
          getintparaloc.reference.index.enum:=R_EBP;
@@ -168,7 +169,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * needs cpuinfo
 
 
   Revision 1.16  2003/06/06 07:36:06  michael
   Revision 1.16  2003/06/06 07:36:06  michael

+ 12 - 3
compiler/i386/n386add.pas

@@ -373,10 +373,10 @@ interface
                      {$endif newra}
                      {$endif newra}
                        secondpass(left);
                        secondpass(left);
                        location_release(exprasmlist,left.location);
                        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);
                        secondpass(right);
                        location_release(exprasmlist,right.location);
                        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}
                       {$ifdef newra}
                         r.enum:=R_INTREGISTER;
                         r.enum:=R_INTREGISTER;
                         for i:=first_supreg to last_supreg do
                         for i:=first_supreg to last_supreg do
@@ -389,6 +389,8 @@ interface
                         rg.saveintregvars(exprasmlist,regstopush);
                         rg.saveintregvars(exprasmlist,regstopush);
                       {$endif}
                       {$endif}
                        cg.a_call_name(exprasmlist,'FPC_SHORTSTR_COMPARE');
                        cg.a_call_name(exprasmlist,'FPC_SHORTSTR_COMPARE');
+                       paramanager.freeintparaloc(exprasmlist,2);
+                       paramanager.freeintparaloc(exprasmlist,1);
                       {$ifdef newra}
                       {$ifdef newra}
                         for i:=first_supreg to last_supreg do
                         for i:=first_supreg to last_supreg do
                           if i<>RS_FRAME_POINTER_REG then
                           if i<>RS_FRAME_POINTER_REG then
@@ -1642,7 +1644,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * Register allocator finished
 
 
   Revision 1.69  2003/05/30 23:49:18  jonas
   Revision 1.69  2003/05/30 23:49:18  jonas

+ 12 - 3
compiler/m68k/n68kmat.pas

@@ -146,8 +146,9 @@ implementation
          objectlibrary.getlabel(continuelabel);
          objectlibrary.getlabel(continuelabel);
          { compare against zero, if not zero continue }
          { compare against zero, if not zero continue }
          cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_NE,0,denum,continuelabel);
          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');
          cg.a_call_name(exprasmlist,'FPC_HANDLEERROR');
+         paramanager.freeintparaloc(exprasmlist,1);
          cg.a_label(exprasmlist, continuelabel);
          cg.a_label(exprasmlist, continuelabel);
          if signed then 
          if signed then 
             exprasmlist.concat(taicpu.op_reg_reg(A_DIVS,S_L,denum,num))
             exprasmlist.concat(taicpu.op_reg_reg(A_DIVS,S_L,denum,num))
@@ -188,8 +189,9 @@ implementation
          objectlibrary.getlabel(continuelabel);
          objectlibrary.getlabel(continuelabel);
          { compare against zero, if not zero continue }
          { compare against zero, if not zero continue }
          cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_NE,0,denum,continuelabel);
          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');
          cg.a_call_name(exprasmlist,'FPC_HANDLEERROR');
+         paramanager.freeintparaloc(exprasmlist,1);
          cg.a_label(exprasmlist, continuelabel);
          cg.a_label(exprasmlist, continuelabel);
 
 
          tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
          tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
@@ -242,7 +244,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * Code generator converted to new register notation
     - Horribily outdated todo.txt removed
     - 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
         if current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
           begin
           begin
             reference_reset_base(href,current_procinfo.framepointer,current_procinfo.framepointer_offset);
             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
           end
         { one nesting level }
         { one nesting level }
         else if (current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
         else if (current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
           begin
           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
           end
         { very complex nesting level ... }
         { very complex nesting level ... }
         else if (current_procdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
         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);
                 cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,hregister);
                 dec(i);
                 dec(i);
               end;
               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);
             rg.ungetaddressregister(exprasmlist,hregister);
           end;
           end;
       end;
       end;
@@ -949,8 +949,9 @@ implementation
          if iolabel<>nil then
          if iolabel<>nil then
            begin
            begin
               reference_reset_symbol(href,iolabel,0);
               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');
               cg.a_call_name(exprasmlist,'FPC_IOCHECK');
+              paramanager.freeintparaloc(exprasmlist,1);
            end;
            end;
 
 
          { restore registers }
          { restore registers }
@@ -1294,8 +1295,9 @@ implementation
          if iolabel<>nil then
          if iolabel<>nil then
            begin
            begin
               reference_reset_symbol(href,iolabel,0);
               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');
               cg.a_call_name(exprasmlist,'FPC_IOCHECK');
+              paramanager.freeintparaloc(exprasmlist,1);
            end;
            end;
 
 
          { restore registers }
          { restore registers }
@@ -1380,7 +1382,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * fixed double secondpassing of procvar loads
 
 
   Revision 1.84  2003/06/03 21:11:09  peter
   Revision 1.84  2003/06/03 21:11:09  peter

+ 27 - 12
compiler/ncgflw.pas

@@ -816,15 +816,15 @@ implementation
                       secondpass(frametree);
                       secondpass(frametree);
                       if codegenerror then
                       if codegenerror then
                        exit;
                        exit;
-                      cg.a_param_loc(exprasmlist,frametree.location,paramanager.getintparaloc(2));
+                      cg.a_param_loc(exprasmlist,frametree.location,paramanager.getintparaloc(exprasmlist,3));
                     end
                     end
                   else
                   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 }
                   { push address }
                   secondpass(right);
                   secondpass(right);
                   if codegenerror then
                   if codegenerror then
                    exit;
                    exit;
-                  cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(1));
+                  cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(exprasmlist,2));
                 end
                 end
               else
               else
                 begin
                 begin
@@ -835,16 +835,19 @@ implementation
                    { push current frame }
                    { push current frame }
                    r.enum:=R_INTREGISTER;
                    r.enum:=R_INTREGISTER;
                    r.number:=NR_FRAME_POINTER_REG;
                    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 }
                    { push current address }
-                   cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(1));
+                   cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(exprasmlist,2));
                 end;
                 end;
               { push object }
               { push object }
               secondpass(left);
               secondpass(left);
               if codegenerror then
               if codegenerror then
                 exit;
                 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');
               cg.a_call_name(exprasmlist,'FPC_RAISEEXCEPTION');
+              paramanager.freeintparaloc(exprasmlist,3);
+              paramanager.freeintparaloc(exprasmlist,2);
+              paramanager.freeintparaloc(exprasmlist,1);
            end
            end
          else
          else
            begin
            begin
@@ -893,8 +896,9 @@ implementation
          cg.a_call_name(exprasmlist,'FPC_POPOBJECTSTACK');
          cg.a_call_name(exprasmlist,'FPC_POPOBJECTSTACK');
          r.enum:=R_INTREGISTER;
          r.enum:=R_INTREGISTER;
          r.number:=NR_FUNCTION_RESULT_REG;
          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');
          cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
+         paramanager.freeintparaloc(exprasmlist,1);
       end;
       end;
 
 
 
 
@@ -998,8 +1002,9 @@ implementation
               { FPC_CATCHES must be called with
               { FPC_CATCHES must be called with
                 'default handler' flag (=-1)
                 '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');
               cg.a_call_name(exprasmlist,'FPC_CATCHES');
+              paramanager.freeintparaloc(exprasmlist,1);
 
 
               { the destruction of the exception object must be also }
               { the destruction of the exception object must be also }
               { guarded by an exception frame                        }
               { guarded by an exception frame                        }
@@ -1021,8 +1026,9 @@ implementation
 
 
               r.enum:=R_INTREGISTER;
               r.enum:=R_INTREGISTER;
               r.number:=NR_FUNCTION_RESULT_REG;
               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');
               cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
+              paramanager.freeintparaloc(exprasmlist,1);
               { we don't need to restore esi here because reraise never }
               { we don't need to restore esi here because reraise never }
               { returns                                                 }
               { returns                                                 }
               cg.a_call_name(exprasmlist,'FPC_RERAISE');
               cg.a_call_name(exprasmlist,'FPC_RERAISE');
@@ -1142,8 +1148,9 @@ implementation
 
 
          { send the vmt parameter }
          { send the vmt parameter }
          reference_reset_symbol(href2,objectlibrary.newasmsymboldata(excepttype.vmt_mangledname),0);
          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');
          cg.a_call_name(exprasmlist,'FPC_CATCHES');
+         paramanager.freeintparaloc(exprasmlist,1);
 
 
          { is it this catch? No. go to next onlabel }
          { is it this catch? No. go to next onlabel }
          r.enum:=R_INTREGISTER;
          r.enum:=R_INTREGISTER;
@@ -1187,8 +1194,9 @@ implementation
          try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,doobjectdestroy,false);
          try_free_exception(exprasmlist,tempbuf,tempaddr,href,0,doobjectdestroy,false);
 
 
          cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
          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');
          cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
+         paramanager.freeintparaloc(exprasmlist,1);
          { we don't need to restore esi here because reraise never }
          { we don't need to restore esi here because reraise never }
          { returns                                                 }
          { returns                                                 }
          cg.a_call_name(exprasmlist,'FPC_RERAISE');
          cg.a_call_name(exprasmlist,'FPC_RERAISE');
@@ -1419,7 +1427,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus
     * i386 uses generic tcgnotnode,tcgunaryminus

+ 16 - 5
compiler/ncginl.pas

@@ -192,22 +192,26 @@ implementation
        { erroraddr }
        { erroraddr }
        r.enum:=R_INTREGISTER;
        r.enum:=R_INTREGISTER;
        r.number:=NR_FRAME_POINTER_REG;
        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 }
        { 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 }
        { filename string }
        hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
        hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
        firstpass(tnode(hp2));
        firstpass(tnode(hp2));
        secondpass(tnode(hp2));
        secondpass(tnode(hp2));
        if codegenerror then
        if codegenerror then
           exit;
           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;
        hp2.free;
        { push msg }
        { push msg }
        secondpass(tcallparanode(tcallparanode(left).right).left);
        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 }
        { call }
        cg.a_call_name(exprasmlist,'FPC_ASSERT');
        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);
        cg.a_label(exprasmlist,truelabel);
        truelabel:=otlabel;
        truelabel:=otlabel;
        falselabel:=oflabel;
        falselabel:=oflabel;
@@ -682,7 +686,14 @@ end.
 
 
 {
 {
   $Log$
   $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
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus
     * 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]);
                        rg.saveusedintregisters(exprasmlist,pushed,[RS_FUNCTION_RESULT_REG]-[hregister.number shr 8]);
                     {$endif}
                     {$endif}
                        reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(symtableentry).mangledname),0);
                        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}
                     {$ifdef newra}
                        rg.ungetregisterint(exprasmlist,hregister);
                        rg.ungetregisterint(exprasmlist,hregister);
                        r:=rg.getexplicitregisterint(exprasmlist,NR_EAX);
                        r:=rg.getexplicitregisterint(exprasmlist,NR_EAX);
@@ -158,6 +158,7 @@ implementation
                        { the called procedure isn't allowed to change }
                        { the called procedure isn't allowed to change }
                        { any register except EAX                    }
                        { any register except EAX                    }
                        cg.a_call_reg(exprasmlist,hregister);
                        cg.a_call_reg(exprasmlist,hregister);
+                       paramanager.freeintparaloc(exprasmlist,1);
                     {$ifdef newra}
                     {$ifdef newra}
                        rg.ungetregisterint(exprasmlist,r);
                        rg.ungetregisterint(exprasmlist,r);
                        hregister:=rg.getregisterint(exprasmlist,OS_ADDR);
                        hregister:=rg.getregisterint(exprasmlist,OS_ADDR);
@@ -934,7 +935,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus
     * i386 uses generic tcgnotnode,tcgunaryminus

+ 9 - 2
compiler/ncgmat.pas

@@ -334,7 +334,7 @@ implementation
                   }
                   }
                   objectlibrary.getlabel(hl);
                   objectlibrary.getlabel(hl);
                   cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_NE,0,hdenom,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_call_name(exprasmlist,'FPC_HANDLERROR');
                   cg.a_label(exprasmlist,hl);
                   cg.a_label(exprasmlist,hl);
                   if nodetype = modn then
                   if nodetype = modn then
@@ -514,7 +514,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus
     * i386 uses generic tcgnotnode,tcgunaryminus

+ 30 - 12
compiler/ncgmem.pas

@@ -258,8 +258,9 @@ implementation
             not(cs_compilesystem in aktmoduleswitches) and
             not(cs_compilesystem in aktmoduleswitches) and
             (not tpointerdef(left.resulttype.def).is_far) then
             (not tpointerdef(left.resulttype.def).is_far) then
           begin
           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');
             cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
+            paramanager.freeintparaloc(exprasmlist,1);
           end;
           end;
       end;
       end;
 
 
@@ -305,8 +306,9 @@ implementation
                 (cs_checkpointer in aktglobalswitches) and
                 (cs_checkpointer in aktglobalswitches) and
                 not(cs_compilesystem in aktmoduleswitches) then
                 not(cs_compilesystem in aktmoduleswitches) then
               begin
               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');
                 cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
+                paramanager.freeintparaloc(exprasmlist,1);
               end;
               end;
            end
            end
          else if is_interfacecom(left.resulttype.def) then
          else if is_interfacecom(left.resulttype.def) then
@@ -318,8 +320,9 @@ implementation
                 (cs_checkpointer in aktglobalswitches) and
                 (cs_checkpointer in aktglobalswitches) and
                 not(cs_compilesystem in aktmoduleswitches) then
                 not(cs_compilesystem in aktmoduleswitches) then
               begin
               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');
                 cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
+                paramanager.freeintparaloc(exprasmlist,1);
               end;
               end;
 
 
            end
            end
@@ -512,8 +515,8 @@ implementation
             {$ifndef newra}
             {$ifndef newra}
                rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
             {$endif}
             {$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}
             {$ifdef newra}
                hreg.enum:=R_INTREGISTER;
                hreg.enum:=R_INTREGISTER;
                for i:=first_supreg to last_supreg do
                for i:=first_supreg to last_supreg do
@@ -526,6 +529,8 @@ implementation
                rg.saveintregvars(exprasmlist,all_intregisters);
                rg.saveintregvars(exprasmlist,all_intregisters);
             {$endif}
             {$endif}
                cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK');
                cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK');
+               paramanager.freeintparaloc(exprasmlist,2);
+               paramanager.freeintparaloc(exprasmlist,1);
             {$ifdef newra}
             {$ifdef newra}
                for i:=first_supreg to last_supreg do
                for i:=first_supreg to last_supreg do
                  if i<>RS_FRAME_POINTER_REG then
                  if i<>RS_FRAME_POINTER_REG then
@@ -578,7 +583,7 @@ implementation
                 {$ifndef newra}
                 {$ifndef newra}
                    rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                    rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                 {$endif}
                 {$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}
                 {$ifdef newra}
                    hreg.enum:=R_INTREGISTER;
                    hreg.enum:=R_INTREGISTER;
                    for i:=first_supreg to last_supreg do
                    for i:=first_supreg to last_supreg do
@@ -591,6 +596,7 @@ implementation
                    rg.saveintregvars(exprasmlist,all_intregisters);
                    rg.saveintregvars(exprasmlist,all_intregisters);
                 {$endif}
                 {$endif}
                    cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_UNIQUE');
                    cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_UNIQUE');
+                   paramanager.freeintparaloc(exprasmlist,1);
                 {$ifdef newra}
                 {$ifdef newra}
                    for i:=first_supreg to last_supreg do
                    for i:=first_supreg to last_supreg do
                      if i<>RS_FRAME_POINTER_REG then
                      if i<>RS_FRAME_POINTER_REG then
@@ -625,7 +631,7 @@ implementation
                 {$ifndef newra}
                 {$ifndef newra}
                    rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                    rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                 {$endif}
                 {$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}
                 {$ifdef newra}
                    hreg.enum:=R_INTREGISTER;
                    hreg.enum:=R_INTREGISTER;
                    for i:=first_supreg to last_supreg do
                    for i:=first_supreg to last_supreg do
@@ -638,6 +644,7 @@ implementation
                    rg.saveintregvars(exprasmlist,all_intregisters);
                    rg.saveintregvars(exprasmlist,all_intregisters);
                 {$endif}
                 {$endif}
                    cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
                    cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
+                   paramanager.freeintparaloc(exprasmlist,1);
                 {$ifdef newra}
                 {$ifdef newra}
                    for i:=first_supreg to last_supreg do
                    for i:=first_supreg to last_supreg do
                      if i<>RS_FRAME_POINTER_REG then
                      if i<>RS_FRAME_POINTER_REG then
@@ -723,10 +730,10 @@ implementation
                             {$ifndef newra}
                             {$ifndef newra}
                               rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                               rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                             {$endif}
                             {$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;
                               href:=location.reference;
                               dec(href.offset,7);
                               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}
                             {$ifdef newra}
                               hreg.enum:=R_INTREGISTER;
                               hreg.enum:=R_INTREGISTER;
                               for i:=first_supreg to last_supreg do
                               for i:=first_supreg to last_supreg do
@@ -739,6 +746,8 @@ implementation
                               rg.saveintregvars(exprasmlist,all_intregisters);
                               rg.saveintregvars(exprasmlist,all_intregisters);
                             {$endif}
                             {$endif}
                               cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
                               cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
+                              paramanager.freeintparaloc(exprasmlist,2);
+                              paramanager.freeintparaloc(exprasmlist,1);
                             {$ifdef newra}
                             {$ifdef newra}
                               for i:=first_supreg to last_supreg do
                               for i:=first_supreg to last_supreg do
                                if i<>RS_FRAME_POINTER_REG then
                                if i<>RS_FRAME_POINTER_REG then
@@ -878,10 +887,10 @@ implementation
                             {$ifndef newra}
                             {$ifndef newra}
                               rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                               rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
                             {$endif}
                             {$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;
                               href:=location.reference;
                               dec(href.offset,7);
                               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}
                             {$ifdef newra}
                               hreg.enum:=R_INTREGISTER;
                               hreg.enum:=R_INTREGISTER;
                               for i:=first_supreg to last_supreg do
                               for i:=first_supreg to last_supreg do
@@ -894,6 +903,8 @@ implementation
                               rg.saveintregvars(exprasmlist,all_intregisters);
                               rg.saveintregvars(exprasmlist,all_intregisters);
                             {$endif}
                             {$endif}
                               cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
                               cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
+                              paramanager.freeintparaloc(exprasmlist,2);
+                              paramanager.freeintparaloc(exprasmlist,1);
                             {$ifdef newra}
                             {$ifdef newra}
                               for i:=first_supreg to last_supreg do
                               for i:=first_supreg to last_supreg do
                                if i<>RS_FRAME_POINTER_REG then
                                if i<>RS_FRAME_POINTER_REG then
@@ -937,7 +948,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus
     * 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);
                   cg.a_load_loc_reg(exprasmlist,OS_INT,left.location,pleftreg);
                   location_freetemp(exprasmlist,left.location);
                   location_freetemp(exprasmlist,left.location);
                   location_release(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');
                   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 }
                   { result of value is always one full register }
                   r.enum:=R_INTREGISTER;
                   r.enum:=R_INTREGISTER;
                   r.number:=NR_FUNCTION_RESULT_REG;
                   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);
                   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);
                   location_release(exprasmlist,right.location);
                 end;
                 end;
              end;
              end;
@@ -1116,7 +1122,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus
     * i386 uses generic tcgnotnode,tcgunaryminus

+ 26 - 10
compiler/ncgutil.pas

@@ -264,16 +264,20 @@ implementation
     var r:Tregister;
     var r:Tregister;
 
 
      begin
      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 }
        { 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');
        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
+       paramanager.freeintparaloc(list,3);
+       paramanager.freeintparaloc(list,2);
+       paramanager.freeintparaloc(list,1);
 
 
        r.enum:=R_INTREGISTER;
        r.enum:=R_INTREGISTER;
        r.number:=NR_FUNCTION_RESULT_REG;
        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');
        cg.a_call_name(list,'FPC_SETJMP');
+       paramanager.freeintparaloc(list,1);
 
 
        cg.g_exception_reason_save(list, href);
        cg.g_exception_reason_save(list, href);
        cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,r,exceptlabel);
        cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,r,exceptlabel);
@@ -1202,21 +1206,24 @@ implementation
              tt_freeansistring :
              tt_freeansistring :
                begin
                begin
                  reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
                  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');
                  cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
+                 paramanager.freeintparaloc(list,1);
                end;
                end;
              tt_widestring,
              tt_widestring,
              tt_freewidestring :
              tt_freewidestring :
                begin
                begin
                  reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
                  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');
                  cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
+                 paramanager.freeintparaloc(list,1);
                end;
                end;
              tt_interfacecom :
              tt_interfacecom :
                begin
                begin
                  reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
                  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');
                  cg.a_call_name(list,'FPC_INTF_DECR_REF');
+                 paramanager.freeintparaloc(list,1);
                end;
                end;
            end;
            end;
            hp:=hp^.next;
            hp:=hp^.next;
@@ -1499,10 +1506,12 @@ implementation
                  (cs_profile in aktmoduleswitches) then
                  (cs_profile in aktmoduleswitches) then
                begin
                begin
                  reference_reset_symbol(href,objectlibrary.newasmsymboldata('etext'),0);
                  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);
                  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');
                  cg.a_call_name(list,'_monstartup');
+                 paramanager.freeintparaloc(list,2);
+                 paramanager.freeintparaloc(list,1);
                end;
                end;
 
 
               { initialize units }
               { initialize units }
@@ -1954,7 +1963,14 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * g_copyopenarrayvalue gets length reference
     * don't copy open arrays for cdecl
     * don't copy open arrays for cdecl
 
 

+ 9 - 1
compiler/nflw.pas

@@ -1187,6 +1187,7 @@ implementation
     function traisenode.pass_1 : tnode;
     function traisenode.pass_1 : tnode;
       begin
       begin
          result:=nil;
          result:=nil;
+         include(current_procinfo.flags,pi_do_call);
          expectloc:=LOC_VOID;
          expectloc:=LOC_VOID;
          if assigned(left) then
          if assigned(left) then
            begin
            begin
@@ -1426,7 +1427,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * procinlinenode removed
     * aktexit2label removed, fast exit removed
     * aktexit2label removed, fast exit removed
     + tcallnode.inlined_pass_2 added
     + 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
                 if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
                   registers32:=1;
                   registers32:=1;
+                { call to get address of threadvar }
                 if (vo_is_thread_var in tvarsym(symtableentry).varoptions) then
                 if (vo_is_thread_var in tvarsym(symtableentry).varoptions) then
                   include(current_procinfo.flags,pi_do_call);
                   include(current_procinfo.flags,pi_do_call);
                 if nf_write in flags then
                 if nf_write in flags then
@@ -811,6 +812,11 @@ implementation
 
 
          firstpass(left);
          firstpass(left);
          firstpass(right);
          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
          if codegenerror then
            exit;
            exit;
 
 
@@ -1247,7 +1253,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * set pi_do_call for accesses to threadvars
 
 
   Revision 1.96  2003/05/26 19:38:28  peter
   Revision 1.96  2003/05/26 19:38:28  peter

+ 13 - 1
compiler/nmem.pas

@@ -693,6 +693,11 @@ implementation
          if codegenerror then
          if codegenerror then
            exit;
            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 }
          { the register calculation is easy if a const index is used }
          if right.nodetype=ordconstn then
          if right.nodetype=ordconstn then
            begin
            begin
@@ -897,7 +902,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * added missing firstpass for withrefnode
 
 
   Revision 1.54  2003/05/11 14:45:12  peter
   Revision 1.54  2003/05/11 14:45:12  peter

+ 31 - 2
compiler/paramgr.pas

@@ -30,6 +30,7 @@ unit paramgr;
 
 
     uses
     uses
        cpubase,
        cpubase,
+       aasmtai,
        globtype,
        globtype,
        symconst,symtype,symdef;
        symconst,symtype,symdef;
 
 
@@ -61,9 +62,23 @@ unit paramgr;
             internal routines directly, where all parameters must
             internal routines directly, where all parameters must
             be 4-byte values.
             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)
             @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
           {# This is used to populate the location information on all parameters
              for the routine. This is used for normal call resolution.
              for the routine. This is used for normal call resolution.
           }
           }
@@ -97,6 +112,8 @@ unit paramgr;
           function getfuncresultloc(def : tdef;calloption:tproccalloption): tparalocation; virtual;
           function getfuncresultloc(def : tdef;calloption:tproccalloption): tparalocation; virtual;
        end;
        end;
 
 
+
+
     procedure setparalocs(p : tprocdef);
     procedure setparalocs(p : tprocdef);
     function getfuncretusedregisters(def : tdef;calloption:tproccalloption): tregisterset;
     function getfuncretusedregisters(def : tdef;calloption:tproccalloption): tregisterset;
 
 
@@ -231,6 +248,11 @@ unit paramgr;
       end;
       end;
 
 
 
 
+    procedure tparamanager.freeintparaloc(list: taasmoutput; nr : longint);
+      begin
+      end;
+
+
     function tparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
     function tparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
       begin
       begin
          result.loc:=LOC_REFERENCE;
          result.loc:=LOC_REFERENCE;
@@ -399,7 +421,14 @@ end.
 
 
 {
 {
    $Log$
    $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
      * FUNCTION_RESULT64_LOW/HIGH_REG added for int64 results
 
 
    Revision 1.39  2003/05/30 23:57:08  peter
    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_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_stackframe_entry(list : taasmoutput;localsize : longint);override;
         procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
         procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
         procedure g_restore_frame_pointer(list : taasmoutput);override;
         procedure g_restore_frame_pointer(list : taasmoutput);override;
@@ -252,7 +252,8 @@ const
          list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s)));
          list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s)));
          if target_info.system=system_powerpc_macos then
          if target_info.system=system_powerpc_macos then
            list.concat(taicpu.op_none(A_NOP));
            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;
       end;
 
 
     { calling a procedure by address }
     { calling a procedure by address }
@@ -283,7 +284,8 @@ const
         //if target_info.system=system_powerpc_macos then
         //if target_info.system=system_powerpc_macos then
         //  //NOP is not needed here.
         //  //NOP is not needed here.
         //  list.concat(taicpu.op_none(A_NOP));
         //  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')));
         //list.concat(tai_comment.create(strpnew('***** a_call_reg')));
       end;
       end;
 
 
@@ -315,7 +317,8 @@ const
         //if target_info.system=system_powerpc_macos then
         //if target_info.system=system_powerpc_macos then
         //  //NOP is not needed here.
         //  //NOP is not needed here.
         //  list.concat(taicpu.op_none(A_NOP));
         //  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')));
         //list.concat(tai_comment.create(strpnew('***** a_call_ref')));
       end;
       end;
 
 
@@ -2037,7 +2040,7 @@ const
          tg.ungetiftemp(list,source);
          tg.ungetiftemp(list,source);
       end;
       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
       var
         lenref : treference;
         lenref : treference;
         power,len  : longint;
         power,len  : longint;
@@ -2563,7 +2566,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * calculate localsize also in g_return_from_proc since it's now called
       before g_stackframe_entry (still have to fix macos)
       before g_stackframe_entry (still have to fix macos)
     * compilation fixes (cycle doesn't work yet though)
     * compilation fixes (cycle doesn't work yet though)

+ 31 - 3
compiler/powerpc/cpupara.pas

@@ -29,13 +29,15 @@ unit cpupara;
 
 
     uses
     uses
        globtype,
        globtype,
+       aasmtai,
        cpubase,
        cpubase,
        symconst,symbase,symtype,symdef,paramgr;
        symconst,symbase,symtype,symdef,paramgr;
 
 
     type
     type
        tppcparamanager = class(tparamanager)
        tppcparamanager = class(tparamanager)
           function push_addr_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;
+          procedure freeintparaloc(list: taasmoutput; nr : longint); override;
           procedure create_param_loc_info(p : tabstractprocdef);override;
           procedure create_param_loc_info(p : tabstractprocdef);override;
           function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
           function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
        end;
        end;
@@ -45,9 +47,10 @@ unit cpupara;
     uses
     uses
        verbose,systems,
        verbose,systems,
        cpuinfo,cginfo,cgbase,
        cpuinfo,cginfo,cgbase,
+       rgobj,
        defutil;
        defutil;
 
 
-    function tppcparamanager.getintparaloc(nr : longint) : tparalocation;
+    function tppcparamanager.getintparaloc(list: taasmoutput; nr : longint) : tparalocation;
 
 
       begin
       begin
          fillchar(result,sizeof(tparalocation),0);
          fillchar(result,sizeof(tparalocation),0);
@@ -58,6 +61,7 @@ unit cpupara;
               result.loc:=LOC_REGISTER;
               result.loc:=LOC_REGISTER;
               result.register.enum:=R_INTREGISTER;
               result.register.enum:=R_INTREGISTER;
               result.register.number:=NR_R2+nr*(NR_R1-NR_R0);
               result.register.number:=NR_R2+nr*(NR_R1-NR_R0);
+              rg.getexplicitregisterint(list,result.register.number);
            end
            end
          else
          else
            begin
            begin
@@ -69,6 +73,23 @@ unit cpupara;
          result.size := OS_INT;
          result.size := OS_INT;
       end;
       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;
     function getparaloc(p : tdef) : tcgloc;
 
 
       begin
       begin
@@ -337,7 +358,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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.
    * register skipping (aligning) for int64 parameters, sys V abi only.
 
 
   Revision 1.33  2003/05/30 22:54:19  marco
   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;
          procedure saveusedotherregisters(list:Taasmoutput;
                                            var saved:Tpushedsavedother;
                                            var saved:Tpushedsavedother;
                                            const s:Tregisterset);override;
                                            const s:Tregisterset);override;
+         procedure cleartempgen; override;
+        private
+         usedpararegs: Tsupregset;
        end;
        end;
 
 
   implementation
   implementation
 
 
     uses
     uses
-      cgobj;
+      cgobj, verbose;
 
 
     function trgcpu.getexplicitregisterint(list: taasmoutput; reg: Tnewregister): tregister;
     function trgcpu.getexplicitregisterint(list: taasmoutput; reg: Tnewregister): tregister;
 
 
     var r:Tregister;
     var r:Tregister;
 
 
       begin
       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
           begin
+            if (reg shr 8) in usedpararegs then
+              internalerror(2003060701);
+            include(usedpararegs,reg shr 8);
             r.enum:=R_INTREGISTER;
             r.enum:=R_INTREGISTER;
-            r.number:=NR_R0;
+            r.number:=reg;
             cg.a_reg_alloc(list,r);
             cg.a_reg_alloc(list,r);
             result := r;
             result := r;
           end
           end
@@ -69,8 +76,14 @@ unit rgcpu;
     procedure trgcpu.ungetregisterint(list: taasmoutput; reg: tregister);
     procedure trgcpu.ungetregisterint(list: taasmoutput; reg: tregister);
 
 
       begin
       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
         else
           inherited ungetregisterint(list,reg);
           inherited ungetregisterint(list,reg);
       end;
       end;
@@ -97,13 +110,28 @@ unit rgcpu;
         filldword(saved,sizeof(saved) div 4,reg_not_saved);
         filldword(saved,sizeof(saved) div 4,reg_not_saved);
       end;
       end;
 
 
+
+    procedure trgcpu.cleartempgen;
+
+      begin
+        inherited cleartempgen;
+        usedpararegs := [];
+      end;
+
 initialization
 initialization
   rg := trgcpu.create(32);  {PPC has 32 registers.}
   rg := trgcpu.create(32);  {PPC has 32 registers.}
 end.
 end.
 
 
 {
 {
   $Log$
   $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
     * 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
       that we generate is slow enough as it is without resorting to doing
       double work :)
       double work :)

+ 28 - 1
compiler/psub.pas

@@ -915,6 +915,21 @@ implementation
       end;
       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;
     procedure read_proc;
       {
       {
         Parses the procedure directives, then parses the procedure body, then
         Parses the procedure directives, then parses the procedure body, then
@@ -1052,6 +1067,11 @@ implementation
              { Insert local copies for value para }
              { Insert local copies for value para }
              pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
              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 }
              { Update parameter information }
              current_procinfo.allocate_implicit_parameter;
              current_procinfo.allocate_implicit_parameter;
 {$ifdef i386}
 {$ifdef i386}
@@ -1233,7 +1253,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * Register allocator finished
 
 
   Revision 1.121  2003/05/31 20:23:39  jonas
   Revision 1.121  2003/05/31 20:23:39  jonas

+ 16 - 4
compiler/regvars.pas

@@ -184,10 +184,15 @@ implementation
                   while assigned(hp) do
                   while assigned(hp) do
                     begin
                     begin
                       if (hp.paraloc.loc in [LOC_REGISTER,LOC_FPUREGISTER,
                       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
                          (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
                       else
                         begin
                         begin
                           searchregvars(hp.parasym,@parasym);
                           searchregvars(hp.parasym,@parasym);
@@ -611,7 +616,14 @@ end.
 
 
 {
 {
   $Log$
   $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
     * cg.a_load_* get a from and to size specifier
     * makeregsize only accepts newregister
     * makeregsize only accepts newregister
     * i386 uses generic tcgnotnode,tcgunaryminus
     * i386 uses generic tcgnotnode,tcgunaryminus