Przeglądaj źródła

* start of the new generic parameter handling

florian 23 lat temu
rodzic
commit
336808f6c3

+ 63 - 36
compiler/cgobj.pas

@@ -109,7 +109,7 @@ unit cgobj;
              @param(r register source of the operand)
              @param(nr parameter number (starting from one) of routine (from left to right))
           }
-          procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);virtual; abstract;
+          procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);virtual;
           {# Pass a parameter, which is a constant, to a routine.
 
              A generic version is provided.
@@ -386,7 +386,8 @@ unit cgobj;
 
     uses
        globals,globtype,options,systems,cgbase,
-       verbose,types,tgobj,symdef,rgobj;
+       verbose,types,tgobj,symdef,paramgr,
+       rgobj;
 
     const
       max_scratch_regs = high(scratch_regs) - low(scratch_regs) + 1;
@@ -467,6 +468,29 @@ unit cgobj;
           for better code generation these methods should be overridden
 ******************************************************************************}
 
+    procedure tcg.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);
+
+      var
+         ref : treference;
+
+      begin
+         case locpara.loc of
+            LOC_REGISTER:
+              a_load_reg_reg(list,size,r,locpara.register);
+            LOC_REFERENCE:
+              begin
+                 reference_reset(ref);
+                 ref.base:=locpara.reference.index;
+                 ref.offset:=locpara.reference.offset;
+                 a_load_reg_ref(list,size,r,ref);
+                 {!!!! FIX ME!, take sp_fixup into account }
+                 internalerror(2002071005);
+              end
+            else
+              internalerror(2002071004);
+         end;
+      end;
+
     procedure tcg.a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);
 
       var
@@ -895,14 +919,14 @@ unit cgobj;
     procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
       begin
         {$warning FIX ME!}
-        a_paramaddr_ref(list,dest,getintparaloc(3));
+        a_paramaddr_ref(list,dest,paramanager.getintparaloc(3));
         if loadref then
-          a_param_ref(list,OS_ADDR,source,getintparaloc(2))
+          a_param_ref(list,OS_ADDR,source,paramanager.getintparaloc(2))
         else
-          a_paramaddr_ref(list,source,getintparaloc(2));
+          a_paramaddr_ref(list,source,paramanager.getintparaloc(2));
         if delsource then
          reference_release(list,source);
-        a_param_const(list,OS_INT,len,getintparaloc(1));
+        a_param_const(list,OS_INT,len,paramanager.getintparaloc(1));
         a_call_name(list,'FPC_SHORTSTR_COPY');
         g_maybe_loadself(list);
       end;
@@ -928,14 +952,14 @@ unit cgobj;
          { call the special incr function or the generic addref }
          if incrfunc<>'' then
           begin
-            a_param_ref(list,OS_ADDR,ref,getintparaloc(1));
+            a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(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,getintparaloc(2));
-            a_paramaddr_ref(list,ref,getintparaloc(1));
+            a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
+            a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_ADDREF');
          end;
       end;
@@ -959,14 +983,14 @@ unit cgobj;
          { call the special decr function or the generic decref }
          if decrfunc<>'' then
           begin
-            a_paramaddr_ref(list,ref,getintparaloc(1));
+            a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
             a_call_name(list,decrfunc);
           end
          else
           begin
             reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-            a_paramaddr_ref(list,href,getintparaloc(2));
-            a_paramaddr_ref(list,ref,getintparaloc(1));
+            a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
+            a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_DECREF');
          end;
       end;
@@ -983,11 +1007,11 @@ unit cgobj;
          else
            begin
               reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-              a_paramaddr_ref(list,href,getintparaloc(2));
+              a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
               if loadref then
-                a_param_ref(list,OS_ADDR,ref,getintparaloc(1))
+                a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
               else
-                a_paramaddr_ref(list,ref,getintparaloc(1));
+                a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
               a_call_name(list,'FPC_INITIALIZE');
            end;
       end;
@@ -1004,11 +1028,11 @@ unit cgobj;
          else
            begin
               reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-              a_paramaddr_ref(list,href,getintparaloc(2));
+              a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
               if loadref then
-                a_param_ref(list,OS_ADDR,ref,getintparaloc(1))
+                a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(1))
               else
-                a_paramaddr_ref(list,ref,getintparaloc(1));
+                a_paramaddr_ref(list,ref,paramanager.getintparaloc(1));
               a_call_name(list,'FPC_FINALIZE');
            end;
       end;
@@ -1138,7 +1162,7 @@ unit cgobj;
     procedure tcg.g_stackcheck(list : taasmoutput;stackframesize : longint);
 
       begin
-         a_param_const(list,OS_32,stackframesize,getintparaloc(1));
+         a_param_const(list,OS_32,stackframesize,paramanager.getintparaloc(1));
          a_call_name(list,'FPC_STACKCHECK');
       end;
 
@@ -1191,11 +1215,11 @@ unit cgobj;
             {!! this is a terrible hack, normally the helper should get three params : }
             {    one with self register, one with flag and one with VMT pointer        }
             {reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset+POINTER_SIZE);}
-            a_param_reg(list, OS_ADDR, SELF_POINTER_REG, getintparaloc(2));
+            a_param_reg(list, OS_ADDR, SELF_POINTER_REG, paramanager.getintparaloc(2));
 
             { parameter 1 : vmt pointer (stored at the selfpointer address on stack)  }
             reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
-            a_param_ref(list, OS_ADDR,href,getintparaloc(1));
+            a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_NEW_CLASS');
             a_load_reg_reg(list,OS_ADDR,accumulator,SELF_POINTER_REG);
             { save the self pointer result }
@@ -1205,19 +1229,19 @@ unit cgobj;
         else if is_object(procinfo^._class) then
           begin
             { parameter 3 :vmt_offset     }
-            a_param_const(list, OS_32, procinfo^._class.vmt_offset, getintparaloc(3));
+            a_param_const(list, OS_32, procinfo^._class.vmt_offset, paramanager.getintparaloc(3));
             { parameter 2 : address of pointer to vmt }
             {  this is the first(?) parameter which was pushed to the constructor }
             reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset-POINTER_SIZE);
             hregister:=get_scratch_reg_address(list);
             a_loadaddr_ref_reg(list, href, hregister);
-            a_param_reg(list, OS_ADDR,hregister,getintparaloc(2));
+            a_param_reg(list, OS_ADDR,hregister,paramanager.getintparaloc(2));
             free_scratch_reg(list, hregister);
             { parameter 1 : address of self pointer   }
             reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
             hregister:=get_scratch_reg_address(list);
             a_loadaddr_ref_reg(list, href, hregister);
-            a_param_reg(list, OS_ADDR,hregister,getintparaloc(1));
+            a_param_reg(list, OS_ADDR,hregister,paramanager.getintparaloc(1));
             free_scratch_reg(list, hregister);
             a_call_name(list,'FPC_HELP_CONSTRUCTOR');
             a_load_reg_reg(list,OS_ADDR,accumulator,SELF_POINTER_REG);
@@ -1238,10 +1262,10 @@ unit cgobj;
          begin
            { 2nd parameter  : flag }
            reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset+POINTER_SIZE);
-           a_param_ref(list, OS_ADDR,href,getintparaloc(2));
+           a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(2));
            { 1st parameter to destructor : self }
            reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
-           a_param_ref(list, OS_ADDR,href,getintparaloc(1));
+           a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
            a_call_name(list,'FPC_DISPOSE_CLASS')
          end
         else if is_object(procinfo^._class) then
@@ -1258,16 +1282,16 @@ unit cgobj;
             end;
            { actually call destructor }
             { parameter 3 :vmt_offset     }
-            a_param_const(list, OS_32, procinfo^._class.vmt_offset, getintparaloc(3));
+            a_param_const(list, OS_32, procinfo^._class.vmt_offset, paramanager.getintparaloc(3));
             { parameter 2 : pointer to vmt }
             {  this is the first parameter which was pushed to the destructor }
             reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset-POINTER_SIZE);
-            a_param_ref(list, OS_ADDR, href ,getintparaloc(2));
+            a_param_ref(list, OS_ADDR, href ,paramanager.getintparaloc(2));
             { parameter 1 : address of self pointer   }
             reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
             hregister:=get_scratch_reg_address(list);
             a_loadaddr_ref_reg(list, href, hregister);
-            a_param_reg(list, OS_ADDR,hregister,getintparaloc(1));
+            a_param_reg(list, OS_ADDR,hregister,paramanager.getintparaloc(1));
             free_scratch_reg(list, hregister);
             a_call_name(list,'FPC_HELP_DESTRUCTOR');
          end
@@ -1288,10 +1312,10 @@ unit cgobj;
               both in stack and in self register.
             }
             { 2nd parameter  : flag }
-            a_param_const(list,OS_32,1,getintparaloc(2));
+            a_param_const(list,OS_32,1,paramanager.getintparaloc(2));
             { 1st parameter to destructor : self }
             reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
-            a_param_ref(list, OS_ADDR,href,getintparaloc(1));
+            a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_DISPOSE_CLASS');
             { SET SELF TO NIL }
             a_load_const_reg(list,OS_ADDR,0,SELF_POINTER_REG);
@@ -1301,19 +1325,19 @@ unit cgobj;
         else if is_object(procinfo^._class) then
           begin
             { parameter 3 :vmt_offset     }
-            a_param_const(list, OS_32, procinfo^._class.vmt_offset, getintparaloc(3));
+            a_param_const(list, OS_32, procinfo^._class.vmt_offset, paramanager.getintparaloc(3));
             { parameter 2 : address of pointer to vmt }
             {  this is the first(?) parameter which was pushed to the constructor }
             reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset-POINTER_SIZE);
             hregister:=get_scratch_reg_address(list);
             a_loadaddr_ref_reg(list, href, hregister);
-            a_param_reg(list, OS_ADDR,hregister,getintparaloc(2));
+            a_param_reg(list, OS_ADDR,hregister,paramanager.getintparaloc(2));
             free_scratch_reg(list, hregister);
             { parameter 1 : address of self pointer   }
             reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
             hregister:=get_scratch_reg_address(list);
             a_loadaddr_ref_reg(list, href, hregister);
-            a_param_reg(list, OS_ADDR,hregister,getintparaloc(1));
+            a_param_reg(list, OS_ADDR,hregister,paramanager.getintparaloc(1));
             free_scratch_reg(list, hregister);
             a_call_name(list,'FPC_HELP_FAIL');
             { SET SELF TO NIL }
@@ -1344,7 +1368,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.35  2002-07-07 10:16:29  florian
+  Revision 1.36  2002-07-11 14:41:27  florian
+    * start of the new generic parameter handling
+
+  Revision 1.35  2002/07/07 10:16:29  florian
     * problems with last commit fixed
 
   Revision 1.33  2002/07/07 09:52:32  florian
@@ -1491,4 +1518,4 @@ end.
   Revision 1.7  2002/03/04 19:10:11  peter
     * removed compiler warnings
 
-}
+}

+ 8 - 3
compiler/compiler.pas

@@ -64,7 +64,7 @@ unit compiler;
      {$fatal cannot define two CPU switches}
    {$endif}
    {$endif}
-   
+
    {$ifdef SPARC}
    {$ifndef CPUOK}
    {$DEFINE CPUOK}
@@ -123,6 +123,8 @@ uses
 {$endif}
   { cpu targets }
   ,cputarg
+  { cpu parameter handling }
+  ,cpupara
   ;
 
 function Compile(const cmd:string):longint;
@@ -347,7 +349,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.31  2002-07-04 19:00:23  florian
+  Revision 1.32  2002-07-11 14:41:27  florian
+    * start of the new generic parameter handling
+
+  Revision 1.31  2002/07/04 19:00:23  florian
     + x86_64 define added
 
   Revision 1.30  2002/07/01 18:46:22  peter
@@ -389,4 +394,4 @@ end.
   Revision 1.23  2002/03/24 19:05:31  carl
   + patch for SPARC from Mazen NEIFER
 
-}
+}

+ 10 - 7
compiler/i386/cgcpu.pas

@@ -161,7 +161,7 @@ unit cgcpu;
 
     uses
        globtype,globals,verbose,systems,cutils,
-       symdef,symsym,types,
+       symdef,symsym,types,paramgr,
        rgobj,tgobj,rgcpu;
 
 {$ifndef NOTARGETWIN32}
@@ -1342,13 +1342,13 @@ unit cgcpu;
          tempaddr:=exceptbuf;
          tempbuf:=exceptbuf;
          inc(tempbuf.offset,12);
-         a_paramaddr_ref(list,tempaddr,getintparaloc(3));
-         a_paramaddr_ref(list,tempbuf,getintparaloc(2));
-         a_param_const(list,OS_INT,l,getintparaloc(1));
+         a_paramaddr_ref(list,tempaddr,paramanager.getintparaloc(3));
+         a_paramaddr_ref(list,tempbuf,paramanager.getintparaloc(2));
+         a_param_const(list,OS_INT,l,paramanager.getintparaloc(1));
          a_call_name(list,'FPC_PUSHEXCEPTADDR');
 
          a_reg_alloc(list,accumulator);
-         a_param_reg(list,OS_ADDR,accumulator,getintparaloc(1));
+         a_param_reg(list,OS_ADDR,accumulator,paramanager.getintparaloc(1));
          a_reg_dealloc(list,accumulator);
          a_call_name(list,'FPC_SETJMP');
          list.concat(tai_regalloc.Alloc(accumulator));
@@ -1611,7 +1611,7 @@ unit cgcpu;
         if (po_clearstack in aktprocdef.procoptions) then
          begin
            { complex return values are removed from stack in C code PM }
-           if ret_in_param(aktprocdef.rettype.def) then
+           if paramanager.ret_in_param(aktprocdef.rettype.def) then
              list.concat(Taicpu.Op_const(A_RET,S_NO,4))
            else
              list.concat(Taicpu.Op_none(A_RET,S_NO));
@@ -1785,7 +1785,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.26  2002-07-07 09:52:33  florian
+  Revision 1.27  2002-07-11 14:41:32  florian
+    * start of the new generic parameter handling
+
+  Revision 1.26  2002/07/07 09:52:33  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 24 - 16
compiler/i386/cpupara.pas

@@ -24,31 +24,35 @@
 }
 unit cpupara;
 
+{$i fpcdefs.inc}
+
   interface
 
     uses
        cpubase,
-       symdef;
-
-    var
-       paralocdummy : tparalocation;
-
-    { Returns the location for the nr-st 32 Bit int parameter
-      if every parameter before is an 32 Bit int parameter as well
-      and if the calling conventions for the helper routines of the
-      rtl are used.
-    }
-    function getintparaloc(nr : longint) : tparalocation;
-    procedure create_param_loc_info(const p : tparaitem);
+       symdef,paramgr;
+
+    type
+       { Returns the location for the nr-st 32 Bit int parameter
+         if every parameter before is an 32 Bit int parameter as well
+         and if the calling conventions for the helper routines of the
+         rtl are used.
+       }
+       ti386paramanager = class(tparamanager)
+          function getintparaloc(nr : longint) : tparalocation;override;
+          procedure create_param_loc_info(p : tabstractprocdef);override;
+       end;
 
   implementation
 
-    function getintparaloc(nr : longint) : tparalocation;
+    uses
+       verbose;
 
+    function ti386paramanager.getintparaloc(nr : longint) : tparalocation;
       begin
       end;
-    procedure create_param_loc_info(const p : tparaitem);
 
+    procedure ti386paramanager.create_param_loc_info(p : tabstractprocdef);
       begin
          { set default para_alignment to target_info.stackalignment }
          { if para_alignment=0 then
@@ -57,11 +61,15 @@ unit cpupara;
       end;
 
 
-
+begin
+   paramanager:=ti386paramanager.create;
 end.
 {
   $Log$
-  Revision 1.1  2002-07-07 09:52:33  florian
+  Revision 1.2  2002-07-11 14:41:32  florian
+    * start of the new generic parameter handling
+
+  Revision 1.1  2002/07/07 09:52:33  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 10 - 6
compiler/i386/n386add.pas

@@ -56,7 +56,8 @@ interface
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,aasmbase,aasmtai,aasmcpu,types,htypechk,
+      symconst,symdef,paramgr,
+      aasmbase,aasmtai,aasmcpu,types,htypechk,
       cgbase,pass_2,regvars,
       cpupara,
       ncon,nset,
@@ -379,13 +380,13 @@ interface
                         remove_non_regvars_from_loc(right.location,regstopush);
                         rg.saveusedregisters(exprasmlist,pushed,regstopush);
                         { push the maximum possible length of the result }
-                        cg.a_paramaddr_ref(exprasmlist,left.location.reference,getintparaloc(2));
+                        cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(2));
                         { the optimizer can more easily put the          }
                         { deallocations in the right place if it happens }
                         { too early than when it happens too late (if    }
                         { the pushref needs a "lea (..),edi; push edi")  }
                         location_release(exprasmlist,right.location);
-                        cg.a_paramaddr_ref(exprasmlist,right.location.reference,getintparaloc(1));
+                        cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
                         rg.saveregvars(exprasmlist,regstopush);
                         cg.a_call_name(exprasmlist,'FPC_SHORTSTR_CONCAT');
                         tg.ungetiftemp(exprasmlist,right.location.reference);
@@ -399,10 +400,10 @@ interface
                        rg.saveusedregisters(exprasmlist,pushed,all_registers);
                        secondpass(left);
                        location_release(exprasmlist,left.location);
-                       cg.a_paramaddr_ref(exprasmlist,left.location.reference,getintparaloc(2));
+                       cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(2));
                        secondpass(right);
                        location_release(exprasmlist,right.location);
-                       cg.a_paramaddr_ref(exprasmlist,right.location.reference,getintparaloc(1));
+                       cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
                        rg.saveregvars(exprasmlist,all_registers);
                        cg.a_call_name(exprasmlist,'FPC_SHORTSTR_COMPARE');
                        cg.g_maybe_loadself(exprasmlist);
@@ -1572,7 +1573,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.42  2002-07-07 09:52:33  florian
+  Revision 1.43  2002-07-11 14:41:32  florian
+    * start of the new generic parameter handling
+
+  Revision 1.42  2002/07/07 09:52:33  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 42 - 39
compiler/i386/n386cal.pas

@@ -61,7 +61,7 @@ implementation
       gdb,
 {$endif GDB}
       cginfo,cgbase,pass_2,
-      cpubase,cpupara,
+      cpubase,paramgr,
       aasmbase,aasmtai,aasmcpu,
       nmem,nld,ncnv,
       ncgutil,cga,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu;
@@ -117,7 +117,7 @@ implementation
          { handle varargs first, because defcoll is not valid }
          if (nf_varargs_para in flags) then
            begin
-             if push_addr_param(left.resulttype.def) then
+             if paramanager.push_addr_param(left.resulttype.def) then
                begin
                  inc(pushedparasize,4);
                  cg.a_paramaddr_ref(exprasmlist,left.location.reference,paralocdummy);
@@ -217,7 +217,7 @@ implementation
                    is_array_of_const(defcoll.paratype.def))
                  ) or
                  (
-                  push_addr_param(resulttype.def) and
+                  paramanager.push_addr_param(resulttype.def) and
                   not is_cdecl
                  ) then
                 begin
@@ -505,7 +505,7 @@ implementation
            inlinecode.retoffset:=tg.gettempofsizepersistant(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign));
 
          { Allocate return value when returned in argument }
-         if ret_in_param(resulttype.def) then
+         if paramanager.ret_in_param(resulttype.def) then
            begin
              if assigned(funcretrefnode) then
               begin
@@ -640,15 +640,15 @@ implementation
                                     if is_class(tobjectdef(methodpointer.resulttype.def)) and
                                        (procdefinition.proctypeoption=potype_destructor) then
                                       begin
-                                        cg.a_param_const(exprasmlist,OS_ADDR,0,getintparaloc(2));
-                                        cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,getintparaloc(1));
+                                        cg.a_param_const(exprasmlist,OS_ADDR,0,paramanager.getintparaloc(2));
+                                        cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
                                       end;
 
                                     if not(is_con_or_destructor and
                                            is_class(methodpointer.resulttype.def) and
                                            (procdefinition.proctypeoption in [potype_constructor,potype_destructor])
                                           ) then
-                                      cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,getintparaloc(1));
+                                      cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
                                     { if an inherited con- or destructor should be  }
                                     { called in a con- or destructor then a warning }
                                     { will be made                                  }
@@ -671,8 +671,8 @@ implementation
                                       begin
                                          { a constructor needs also a flag }
                                          if is_class(methodpointer.resulttype.def) then
-                                           cg.a_param_const(exprasmlist,OS_ADDR,0,getintparaloc(2));
-                                         cg.a_param_const(exprasmlist,OS_ADDR,0,getintparaloc(1));
+                                           cg.a_param_const(exprasmlist,OS_ADDR,0,paramanager.getintparaloc(2));
+                                         cg.a_param_const(exprasmlist,OS_ADDR,0,paramanager.getintparaloc(1));
                                       end;
                                  end;
                                hnewn:
@@ -681,10 +681,10 @@ implementation
                                     { ESI must be zero }
                                     rg.getexplicitregisterint(exprasmlist,R_ESI);
                                     cg.a_load_const_reg(exprasmlist,OS_ADDR,0,self_pointer_reg);
-                                    cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,getintparaloc(2));
+                                    cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(2));
                                     { insert the vmt }
                                     reference_reset_symbol(href,newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
-                                    cg.a_paramaddr_ref(exprasmlist,href,getintparaloc(1));
+                                    cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
                                     extended_new:=true;
                                  end;
                                hdisposen:
@@ -696,9 +696,9 @@ implementation
                                     rg.getexplicitregisterint(exprasmlist,R_ESI);
                                     emit_ref_reg(A_LEA,S_L,methodpointer.location.reference,R_ESI);
                                     reference_release(exprasmlist,methodpointer.location.reference);
-                                    cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,getintparaloc(2));
+                                    cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(2));
                                     reference_reset_symbol(href,newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
-                                    cg.a_paramaddr_ref(exprasmlist,href,getintparaloc(1));
+                                    cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
                                  end;
                                else
                                  begin
@@ -741,14 +741,14 @@ implementation
                                         { direct call to destructor: remove data }
                                         if (procdefinition.proctypeoption=potype_destructor) and
                                            is_class(methodpointer.resulttype.def) then
-                                          cg.a_param_const(exprasmlist,OS_INT,1,getintparaloc(1));
+                                          cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1));
 
                                         { direct call to class constructor, don't allocate memory }
                                         if (procdefinition.proctypeoption=potype_constructor) and
                                            is_class(methodpointer.resulttype.def) then
                                           begin
-                                             cg.a_param_const(exprasmlist,OS_INT,0,getintparaloc(2));
-                                             cg.a_param_const(exprasmlist,OS_INT,0,getintparaloc(1));
+                                             cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(2));
+                                             cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(1));
                                           end
                                         else
                                           begin
@@ -756,8 +756,8 @@ implementation
                                              if (procdefinition.proctypeoption=potype_constructor) and
                                                 (methodpointer.resulttype.def.deftype=classrefdef) and
                                                 is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
-                                               cg.a_param_const(exprasmlist,OS_INT,1,getintparaloc(1));
-                                             cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,getintparaloc(1));
+                                               cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1));
+                                             cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
                                           end;
                                       end;
 
@@ -771,12 +771,12 @@ implementation
                                                   { it's no bad idea, to insert the VMT }
                                                   reference_reset_symbol(href,newasmsymbol(
                                                      tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
-                                                  cg.a_paramaddr_ref(exprasmlist,href,getintparaloc(1));
+                                                  cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
                                                 end
                                               { destructors haven't to dispose the instance, if this is }
                                               { a direct call                                           }
                                               else
-                                                cg.a_param_const(exprasmlist,OS_INT,0,getintparaloc(1));
+                                                cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(1));
                                            end;
                                       end;
                                  end;
@@ -806,32 +806,32 @@ implementation
                           begin
                              if (procdefinition.proctypeoption=potype_destructor) then
                                begin
-                                  cg.a_param_const(exprasmlist,OS_INT,0,getintparaloc(2));
-                                  cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,getintparaloc(1));
+                                  cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(2));
+                                  cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,paramanager.getintparaloc(1));
                                end
                              else if (procdefinition.proctypeoption=potype_constructor) then
                                begin
-                                  cg.a_param_const(exprasmlist,OS_INT,0,getintparaloc(2));
-                                  cg.a_param_const(exprasmlist,OS_INT,0,getintparaloc(1));
+                                  cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(2));
+                                  cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(1));
                                end
                              else
-                               cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,getintparaloc(1));
+                               cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,paramanager.getintparaloc(1));
                           end
                         else if is_object(procinfo^._class) then
                           begin
-                             cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,getintparaloc(1));
+                             cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,paramanager.getintparaloc(1));
                              if is_con_or_destructor then
                                begin
                                   if (procdefinition.proctypeoption=potype_constructor) then
                                     begin
                                       { it's no bad idea, to insert the VMT }
                                       reference_reset_symbol(href,newasmsymbol(procinfo^._class.vmt_mangledname),0);
-                                      cg.a_paramaddr_ref(exprasmlist,href,getintparaloc(1));
+                                      cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
                                     end
                                   { destructors haven't to dispose the instance, if this is }
                                   { a direct call                                           }
                                   else
-                                    cg.a_param_const(exprasmlist,OS_INT,0,getintparaloc(1));
+                                    cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(1));
                                end;
                           end
                         else
@@ -847,7 +847,7 @@ implementation
                    (inlined or
                    (right=nil)) then
                   begin
-                     cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,getintparaloc(1));
+                     cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
                      reference_reset_base(href,self_pointer_reg,0);
                      tmpreg:=cg.get_scratch_reg_address(exprasmlist);
                      cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
@@ -957,13 +957,13 @@ implementation
                         if (cs_check_object in aktlocalswitches) then
                           begin
                              reference_reset_symbol(hrefvmt,newasmsymbol(tprocdef(procdefinition)._class.vmt_mangledname),0);
-                             cg.a_paramaddr_ref(exprasmlist,hrefvmt,getintparaloc(2));
-                             cg.a_param_reg(exprasmlist,OS_ADDR,href.base,getintparaloc(1));
+                             cg.a_paramaddr_ref(exprasmlist,hrefvmt,paramanager.getintparaloc(2));
+                             cg.a_param_reg(exprasmlist,OS_ADDR,href.base,paramanager.getintparaloc(1));
                              cg.a_call_name(exprasmlist,'FPC_CHECK_OBJECT_EXT');
                           end
                         else if (cs_check_range in aktlocalswitches) then
                           begin
-                             cg.a_param_reg(exprasmlist,OS_ADDR,href.base,getintparaloc(1));
+                             cg.a_param_reg(exprasmlist,OS_ADDR,href.base,paramanager.getintparaloc(1));
                              cg.a_call_name(exprasmlist,'FPC_CHECK_OBJECT');
                           end;
                      end;
@@ -1111,11 +1111,11 @@ implementation
             (aktprocdef.proctypeoption=potype_constructor) then
            begin
              emitjmp(C_Z,faillabel);
-{$ifdef TEST_GENERIC}             
+{$ifdef TEST_GENERIC}
 { should be moved to generic version! }
              reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
              cg.a_load_ref_reg(exprasmlist, OS_ADDR, href, SELF_POINTER_REG);
-{$endif}             
+{$endif}
            end;
 
          { call to AfterConstruction? }
@@ -1128,7 +1128,7 @@ implementation
            begin
               getlabel(constructorfailed);
               emitjmp(C_Z,constructorfailed);
-              cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,getintparaloc(1));
+              cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
               reference_reset_base(href,self_pointer_reg,0);
               tmpreg:=cg.get_scratch_reg_address(exprasmlist);
               cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
@@ -1145,7 +1145,7 @@ implementation
           begin
             { structured results are easy to handle.... }
             { needed also when result_no_used !! }
-            if ret_in_param(resulttype.def) then
+            if paramanager.ret_in_param(resulttype.def) then
              begin
                location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
                location.reference.symbol:=nil;
@@ -1235,7 +1235,7 @@ implementation
          if iolabel<>nil then
            begin
               reference_reset_symbol(href,iolabel,0);
-              cg.a_paramaddr_ref(exprasmlist,href,getintparaloc(1));
+              cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
               cg.a_call_name(exprasmlist,'FPC_IOCHECK');
            end;
          if pop_size>0 then
@@ -1279,7 +1279,7 @@ implementation
            params.free;
 
          { from now on the result can be freed normally }
-         if inlined and ret_in_param(resulttype.def) then
+         if inlined and paramanager.ret_in_param(resulttype.def) then
            tg.persistanttemptonormal(funcretref.offset);
 
          { if return value is not used }
@@ -1481,7 +1481,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.58  2002-07-07 09:52:34  florian
+  Revision 1.59  2002-07-11 14:41:33  florian
+    * start of the new generic parameter handling
+
+  Revision 1.58  2002/07/07 09:52:34  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 23 - 20
compiler/i386/n386flw.pas

@@ -54,7 +54,7 @@ implementation
       verbose,systems,
       symsym,aasmbase,aasmtai,aasmcpu,
       cgbase,pass_2,
-      cpuinfo,cpubase,cpupara,
+      cpuinfo,cpubase,paramgr,
       nld,ncon,
       cga,cgobj,tgobj,rgobj;
 
@@ -78,28 +78,28 @@ implementation
                       secondpass(frametree);
                       if codegenerror then
                        exit;
-                      cg.a_param_loc(exprasmlist,frametree.location,getintparaloc(2));
+                      cg.a_param_loc(exprasmlist,frametree.location,paramanager.getintparaloc(2));
                     end
                   else
-                    cg.a_param_const(exprasmlist,OS_INT,0,getintparaloc(2));
+                    cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(2));
                   { push address }
                   secondpass(right);
                   if codegenerror then
                    exit;
-                  cg.a_param_loc(exprasmlist,right.location,getintparaloc(1));
+                  cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(1));
                 end
               else
                 begin
                    getaddrlabel(a);
                    cg.a_label(exprasmlist,a);
-                   cg.a_param_reg(exprasmlist,OS_INT,R_EBP,getintparaloc(2));
+                   cg.a_param_reg(exprasmlist,OS_INT,R_EBP,paramanager.getintparaloc(2));
                    emit_sym(A_PUSH,S_L,a);
                 end;
               { push object }
               secondpass(left);
               if codegenerror then
                 exit;
-              cg.a_param_loc(exprasmlist,left.location,getintparaloc(1));
+              cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(1));
               cg.a_call_name(exprasmlist,'FPC_RAISEEXCEPTION');
            end
          else
@@ -202,10 +202,10 @@ implementation
 
          tg.gettempofsizereferencepersistant(exprasmlist,24,tempbuf);
          tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
-         cg.a_paramaddr_ref(exprasmlist,tempaddr,getintparaloc(3));
-         cg.a_paramaddr_ref(exprasmlist,tempbuf,getintparaloc(2));
+         cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
+         cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
          { push type of exceptionframe }
-         cg.a_param_const(exprasmlist,OS_INT,1,getintparaloc(1));
+         cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1));
          cg.a_call_name(exprasmlist,'FPC_PUSHEXCEPTADDR');
 
          { allocate eax }
@@ -269,7 +269,7 @@ implementation
               { FPC_CATCHES must be called with
                 'default handler' flag (=-1)
               }
-              cg.a_param_const(exprasmlist,OS_INT,aword(-1),getintparaloc(1));
+              cg.a_param_const(exprasmlist,OS_INT,aword(-1),paramanager.getintparaloc(1));
               cg.a_call_name(exprasmlist,'FPC_CATCHES');
               cg.g_maybe_loadself(exprasmlist);
 
@@ -280,10 +280,10 @@ implementation
 
               tg.gettempofsizereferencepersistant(exprasmlist,24,tempbuf);
               tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
-              cg.a_paramaddr_ref(exprasmlist,tempaddr,getintparaloc(3));
-              cg.a_paramaddr_ref(exprasmlist,tempbuf,getintparaloc(2));
+              cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
+              cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
               { push type of exceptionframe }
-              cg.a_param_const(exprasmlist,OS_INT,1,getintparaloc(1));
+              cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1));
               cg.a_call_name(exprasmlist,'FPC_PUSHEXCEPTADDR');
 
               { allocate eax }
@@ -449,9 +449,9 @@ implementation
 
          tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
          tg.gettempofsizereferencepersistant(exprasmlist,24,tempbuf);
-         cg.a_paramaddr_ref(exprasmlist,tempaddr,getintparaloc(3));
-         cg.a_paramaddr_ref(exprasmlist,tempbuf,getintparaloc(2));
-         cg.a_param_const(exprasmlist,OS_INT,1,getintparaloc(1));
+         cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
+         cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
+         cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1));
          cg.a_call_name(exprasmlist,'FPC_PUSHEXCEPTADDR');
 
          exprasmList.concat(tai_regalloc.Alloc(R_EAX));
@@ -603,10 +603,10 @@ implementation
 
          tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
          tg.gettempofsizereferencepersistant(exprasmlist,24,tempbuf);
-         cg.a_paramaddr_ref(exprasmlist,tempaddr,getintparaloc(3));
-         cg.a_paramaddr_ref(exprasmlist,tempbuf,getintparaloc(2));
+         cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
+         cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
          { Type of stack-frame must be pushed}
-         cg.a_param_const(exprasmlist,OS_INT,1,getintparaloc(1));
+         cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1));
          cg.a_call_name(exprasmlist,'FPC_PUSHEXCEPTADDR');
 
          { allocate eax }
@@ -726,7 +726,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.29  2002-07-07 09:52:34  florian
+  Revision 1.30  2002-07-11 14:41:33  florian
+    * start of the new generic parameter handling
+
+  Revision 1.29  2002/07/07 09:52:34  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 9 - 6
compiler/i386/n386inl.pas

@@ -42,7 +42,7 @@ implementation
       symconst,symdef,types,
       aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_1,pass_2,
-      cpubase,cpupara,
+      cpubase,paramgr,
       nbas,ncon,ncal,ncnv,nld,
       cga,tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu;
 
@@ -92,20 +92,20 @@ implementation
                  maketojumpbool(exprasmlist,tcallparanode(left).left,lr_load_regvars);
                  cg.a_label(exprasmlist,falselabel);
                  { erroraddr }
-                 cg.a_param_reg(exprasmlist,OS_ADDR,R_EBP,getintparaloc(4));
+                 cg.a_param_reg(exprasmlist,OS_ADDR,R_EBP,paramanager.getintparaloc(4));
                  { lineno }
-                 cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,getintparaloc(3));
+                 cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paramanager.getintparaloc(3));
                  { filename string }
                  hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
                  firstpass(hp2);
                  secondpass(hp2);
                  if codegenerror then
                   exit;
-                 cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,getintparaloc(2));
+                 cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paramanager.getintparaloc(2));
                  hp2.free;
                  { push msg }
                  secondpass(tcallparanode(tcallparanode(left).right).left);
-                 cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,getintparaloc(1));
+                 cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,paramanager.getintparaloc(1));
                  { call }
                  cg.a_call_name(exprasmlist,'FPC_ASSERT');
                  cg.a_label(exprasmlist,truelabel);
@@ -461,7 +461,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.47  2002-07-07 09:52:34  florian
+  Revision 1.48  2002-07-11 14:41:33  florian
+    * start of the new generic parameter handling
+
+  Revision 1.47  2002/07/07 09:52:34  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 13 - 10
compiler/i386/n386mem.pas

@@ -50,11 +50,11 @@ implementation
 {$endif}
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symtype,symdef,symsym,symtable,types,
+      symconst,symtype,symdef,symsym,symtable,types,paramgr,
       aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_2,
       pass_1,nld,ncon,nadd,
-      cpubase,cpupara,
+      cpubase,
       cgobj,cga,tgobj,rgobj,ncgutil;
 
 {*****************************************************************************
@@ -89,7 +89,7 @@ implementation
             (cs_gdb_heaptrc in aktglobalswitches) and
             (cs_checkpointer in aktglobalswitches) then
           begin
-            cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,getintparaloc(1));
+            cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
             cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
           end;
       end;
@@ -165,7 +165,7 @@ implementation
                         exit;
                      end;
                    rg.saveusedregisters(exprasmlist,pushed,all_registers);
-                   cg.a_paramaddr_ref(exprasmlist,left.location.reference,getintparaloc(1));
+                   cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(1));
                    rg.saveregvars(exprasmlist,all_registers);
                    cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_UNIQUE');
                    cg.g_maybe_loadself(exprasmlist);
@@ -192,7 +192,7 @@ implementation
               if (cs_check_range in aktlocalswitches) then
                 begin
                    rg.saveusedregisters(exprasmlist,pushed,all_registers);
-                   cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,getintparaloc(1));
+                   cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
                    rg.saveregvars(exprasmlist,all_registers);
                    cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
                    cg.g_maybe_loadself(exprasmlist);
@@ -294,10 +294,10 @@ implementation
                         st_ansistring:
                           begin
                              rg.saveusedregisters(exprasmlist,pushed,all_registers);
-                             cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,getintparaloc(2));
+                             cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paramanager.getintparaloc(2));
                              href:=location.reference;
                              dec(href.offset,7);
-                             cg.a_param_ref(exprasmlist,OS_INT,href,getintparaloc(1));
+                             cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
                              rg.saveregvars(exprasmlist,all_registers);
                              cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
                              rg.restoreusedregisters(exprasmlist,pushed);
@@ -451,10 +451,10 @@ implementation
                          st_ansistring:
                            begin
                               rg.saveusedregisters(exprasmlist,pushed,all_registers);
-                              cg.a_param_reg(exprasmlist,OS_INT,right.location.register,getintparaloc(1));
+                              cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paramanager.getintparaloc(1));
                               href:=location.reference;
                               dec(href.offset,7);
-                              cg.a_param_ref(exprasmlist,OS_INT,href,getintparaloc(1));
+                              cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
                               rg.saveregvars(exprasmlist,all_registers);
                               cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
                               rg.restoreusedregisters(exprasmlist,pushed);
@@ -520,7 +520,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  2002-07-07 09:52:34  florian
+  Revision 1.37  2002-07-11 14:41:33  florian
+    * start of the new generic parameter handling
+
+  Revision 1.36  2002/07/07 09:52:34  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 8 - 5
compiler/i386/n386opt.pas

@@ -43,10 +43,10 @@ implementation
 
 uses
   pass_1, types, htypechk,
-  symdef,
+  symdef,paramgr,
   aasmbase,aasmtai,aasmcpu,
   ncnv, ncon, pass_2,
-  cginfo, cgbase, cpubase, cpupara,
+  cginfo, cgbase, cpubase,
   tgobj, rgobj, cgobj, ncgutil;
 
 
@@ -226,13 +226,13 @@ begin
   remove_non_regvars_from_loc(right.location,regstopush);
   rg.saveusedregisters(exprasmlist,pushedregs,regstopush);
   { push the maximum possible length of the result }
-  cg.a_paramaddr_ref(exprasmlist,left.location.reference,getintparaloc(2));
+  cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(2));
   { the optimizer can more easily put the          }
   { deallocations in the right place if it happens }
   { too early than when it happens too late (if    }
   { the pushref needs a "lea (..),edi; push edi")  }
   reference_release(exprasmlist,right.location.reference);
-  cg.a_paramaddr_ref(exprasmlist,right.location.reference,getintparaloc(1));
+  cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
   rg.saveregvars(exprasmlist,regstopush);
   cg.a_call_name(exprasmlist,'FPC_SHORTSTR_CONCAT');
   tg.ungetiftemp(exprasmlist,right.location.reference);
@@ -248,7 +248,10 @@ end.
 
 {
   $Log$
-  Revision 1.19  2002-07-07 09:52:34  florian
+  Revision 1.20  2002-07-11 14:41:34  florian
+    * start of the new generic parameter handling
+
+  Revision 1.19  2002/07/07 09:52:34  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 7 - 4
compiler/i386/n386set.pas

@@ -65,7 +65,7 @@ implementation
          result:=nil;
          { this is the only difference from the generic version }
          location.loc:=LOC_FLAGS;
-         
+
          firstpass(right);
          firstpass(left);
          if codegenerror then
@@ -85,7 +85,7 @@ implementation
                 inc(registers32);
            end;
       end;
-      
+
 
 
     procedure ti386innode.pass_2;
@@ -1011,12 +1011,15 @@ implementation
 begin
 {$ifndef TEST_GENERIC}
    cinnode:=ti386innode;
-{$endif}   
+{$endif}
    ccasenode:=ti386casenode;
 end.
 {
   $Log$
-  Revision 1.33  2002-07-06 20:27:26  carl
+  Revision 1.34  2002-07-11 14:41:34  florian
+    * start of the new generic parameter handling
+
+  Revision 1.33  2002/07/06 20:27:26  carl
   + generic set handling
 
   Revision 1.32  2002/07/01 18:46:33  peter

+ 6 - 3
compiler/i386/ra386dir.pas

@@ -42,7 +42,7 @@ interface
        { aasm }
        aasmbase,aasmtai,aasmcpu,
        { symtable }
-       symconst,symbase,symtype,symsym,symtable,types,
+       symconst,symbase,symtype,symsym,symtable,types,paramgr,
        { pass 1 }
        nbas,
        { parser }
@@ -138,7 +138,7 @@ interface
                                  { is the last written character an special }
                                  { char ?                                   }
                                  if (s[length(s)]='%') and
-                                    ret_in_acc(aktprocdef.rettype.def) and
+                                    paramanager.ret_in_acc(aktprocdef.rettype.def) and
                                     ((pos('AX',upper(hs))>0) or
                                     (pos('AL',upper(hs))>0)) then
                                    tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
@@ -304,7 +304,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.19  2002-07-01 18:46:34  peter
+  Revision 1.20  2002-07-11 14:41:34  florian
+    * start of the new generic parameter handling
+
+  Revision 1.19  2002/07/01 18:46:34  peter
     * internal linker
     * reorganized aasm layer
 

+ 14 - 11
compiler/ncal.pas

@@ -123,7 +123,7 @@ implementation
     uses
       cutils,globtype,systems,
       verbose,globals,
-      symconst,types,
+      symconst,paramgr,types,
       htypechk,pass_1,cpuinfo,cpubase,
       ncnv,nld,ninl,nadd,ncon,
       rgobj,cgbase
@@ -364,7 +364,7 @@ implementation
          if not(assigned(aktcallprocdef) and
                 (aktcallprocdef.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
                 (po_external in aktcallprocdef.procoptions)) and
-            push_high_param(defcoll.paratype.def) then
+            paramanager.push_high_param(defcoll.paratype.def) then
            gen_high_tree(is_open_string(defcoll.paratype.def));
 
          { test conversions }
@@ -411,7 +411,7 @@ implementation
                        left.resulttype.def.typename,defcoll.paratype.def.typename);
                   end;
               { Process open parameters }
-              if push_high_param(defcoll.paratype.def) then
+              if paramanager.push_high_param(defcoll.paratype.def) then
                begin
                  { insert type conv but hold the ranges of the array }
                  oldtype:=left.resulttype;
@@ -676,7 +676,7 @@ implementation
         restypeset := true;
         { both the normal and specified resulttype either have to be returned via a }
         { parameter or not, but no mixing (JM)                                      }
-        if ret_in_param(restype.def) xor ret_in_param(symtableprocentry.defs^.def.rettype.def) then
+        if paramanager.ret_in_param(restype.def) xor paramanager.ret_in_param(symtableprocentry.defs^.def.rettype.def) then
           internalerror(200108291);
       end;
 
@@ -685,7 +685,7 @@ implementation
       begin
         self.createintern(name,params);
         funcretrefnode:=returnnode;
-        if not ret_in_param(symtableprocentry.defs^.def.rettype.def) then
+        if not paramanager.ret_in_param(symtableprocentry.defs^.def.rettype.def) then
           internalerror(200204247);
       end;
 
@@ -1503,7 +1503,7 @@ implementation
          { get a register for the return value }
          if (not is_void(resulttype.def)) then
           begin
-            if ret_in_acc(resulttype.def) then
+            if paramanager.ret_in_acc(resulttype.def) then
              begin
                { wide- and ansistrings are returned in EAX    }
                { but they are imm. moved to a memory location }
@@ -1632,13 +1632,13 @@ implementation
 
              { It doesn't hurt to calculate it already though :) (JM) }
              rg.incrementregisterpushed(tprocdef(procdefinition).usedregisters);
-             
+
            end;
 
          { get a register for the return value }
          if (not is_void(resulttype.def)) then
            begin
-             if ret_in_param(resulttype.def) then
+             if paramanager.ret_in_param(resulttype.def) then
               begin
                 location.loc:=LOC_CREFERENCE;
               end
@@ -1802,7 +1802,7 @@ implementation
          retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) }
          para_offset:=0;
          para_size:=inlineprocdef.para_size(target_info.alignment.paraalign);
-         if ret_in_param(inlineprocdef.rettype.def) then
+         if paramanager.ret_in_param(inlineprocdef.rettype.def) then
            inc(para_size,POINTER_SIZE);
          { copy args }
          if assigned(code) then
@@ -1870,7 +1870,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.78  2002-07-04 20:43:00  florian
+  Revision 1.79  2002-07-11 14:41:27  florian
+    * start of the new generic parameter handling
+
+  Revision 1.78  2002/07/04 20:43:00  florian
     * first x86-64 patches
 
   Revision 1.77  2002/07/01 16:23:52  peter
@@ -1984,4 +1987,4 @@ end.
   Revision 1.62  2002/01/19 11:57:05  peter
     * fixed path appending for lib
 
-}
+}

+ 1507 - 0
compiler/ncgcal.pas

@@ -0,0 +1,1507 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Generate i386 assembler for in call nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published bymethodpointer
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit ncgcal;
+
+{$i fpcdefs.inc}
+
+interface
+
+{ $define AnsiStrRef}
+
+    uses
+      symdef,node,ncal;
+
+    type
+       tcgcallparanode = class(tcallparanode)
+          procedure secondcallparan(defcoll : TParaItem;
+                   push_from_left_to_right,inlined,is_cdecl : boolean;
+                   para_alignment,para_offset : longint);override;
+       end;
+
+       tcgcallnode = class(tcallnode)
+          procedure pass_2;override;
+       end;
+
+       tcgprocinlinenode = class(tprocinlinenode)
+          procedure pass_2;override;
+       end;
+
+implementation
+
+    uses
+      globtype,systems,
+      cutils,verbose,globals,
+      symconst,symbase,symsym,symtable,types,paramgr,
+{$ifdef GDB}
+  {$ifdef delphi}
+      sysutils,
+  {$else}
+      strings,
+  {$endif}
+      gdb,
+{$endif GDB}
+      cginfo,cgbase,pass_2,
+      cpubase,aasmbase,aasmtai,aasmcpu,
+      nmem,nld,ncnv,
+      ncgutil,cga,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu;
+
+{*****************************************************************************
+                             TCGCALLPARANODE
+*****************************************************************************}
+
+    procedure tcgcallparanode.secondcallparan(defcoll : TParaItem;
+                push_from_left_to_right,inlined,is_cdecl : boolean;para_alignment,para_offset : longint);
+
+      { goes to pass 1 }
+      procedure maybe_push_high;
+        begin
+           { open array ? }
+           { defcoll.data can be nil for read/write }
+           if assigned(defcoll.paratype.def) and
+              assigned(hightree) then
+            begin
+              secondpass(hightree);
+              { this is a longint anyway ! }
+              push_value_para(hightree,inlined,false,para_offset,4,defcoll.paraloc);
+            end;
+        end;
+      var
+         otlabel,oflabel : tasmlabel;
+         { temporary variables: }
+         tempdeftype : tdeftype;
+         tmpreg : tregister;
+         href   : treference;
+
+      begin
+         { push from left to right if specified }
+         if push_from_left_to_right and assigned(right) then
+          begin
+            if (nf_varargs_para in flags) then
+              tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
+                                                   inlined,is_cdecl,para_alignment,para_offset)
+            else
+              tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
+                                                   inlined,is_cdecl,para_alignment,para_offset);
+          end;
+
+         otlabel:=truelabel;
+         oflabel:=falselabel;
+         getlabel(truelabel);
+         getlabel(falselabel);
+         secondpass(left);
+         { handle varargs first, because defcoll is not valid }
+         if (nf_varargs_para in flags) then
+           begin
+             if paramanager.push_addr_param(left.resulttype.def) then
+               begin
+                 inc(pushedparasize,4);
+                 cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc);
+                 location_release(exprasmlist,left.location);
+               end
+             else
+               push_value_para(left,inlined,is_cdecl,para_offset,para_alignment,defcoll.paraloc);
+           end
+         { filter array constructor with c styled args }
+         else if is_array_constructor(left.resulttype.def) and (nf_cargs in left.flags) then
+           begin
+             { nothing, everything is already pushed }
+           end
+         { in codegen.handleread.. defcoll.data is set to nil }
+         else if assigned(defcoll.paratype.def) and
+                 (defcoll.paratype.def.deftype=formaldef) then
+           begin
+              { allow passing of a constant to a const formaldef }
+              if (defcoll.paratyp=vs_const) and
+                 (left.location.loc=LOC_CONSTANT) then
+                location_force_mem(exprasmlist,left.location);
+
+              { allow @var }
+              inc(pushedparasize,4);
+              if (left.nodetype=addrn) and
+                 (not(nf_procvarload in left.flags)) then
+                begin
+                  if inlined then
+                    begin
+                       reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                       cg.a_load_loc_ref(exprasmlist,left.location,href);
+                    end
+                  else
+                    cg.a_param_loc(exprasmlist,left.location,defcoll.paraloc);
+                  location_release(exprasmlist,left.location);
+                end
+              else
+                begin
+                   if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
+                     CGMessage(type_e_mismatch)
+                   else
+                     begin
+                       if inlined then
+                         begin
+                           tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                           cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
+                           reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                           cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
+                           cg.free_scratch_reg(exprasmlist,tmpreg);
+                         end
+                       else
+                         cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc);
+                       location_release(exprasmlist,left.location);
+                     end;
+                end;
+           end
+         { handle call by reference parameter }
+         else if (defcoll.paratyp in [vs_var,vs_out]) then
+           begin
+              if (left.location.loc<>LOC_REFERENCE) then
+               begin
+                 { passing self to a var parameter is allowed in
+                   TP and delphi }
+                 if not((left.location.loc=LOC_CREFERENCE) and
+                        (left.nodetype=selfn)) then
+                  internalerror(200106041);
+               end;
+              maybe_push_high;
+              if (defcoll.paratyp=vs_out) and
+                 assigned(defcoll.paratype.def) and
+                 not is_class(defcoll.paratype.def) and
+                 defcoll.paratype.def.needs_inittable then
+                cg.g_finalize(exprasmlist,defcoll.paratype.def,left.location.reference,false);
+              inc(pushedparasize,4);
+              if inlined then
+                begin
+                   tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                   cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
+                   reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                   cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
+                   cg.free_scratch_reg(exprasmlist,tmpreg);
+                end
+              else
+                cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc);
+              location_release(exprasmlist,left.location);
+           end
+         else
+           begin
+              tempdeftype:=resulttype.def.deftype;
+              if tempdeftype=filedef then
+               CGMessage(cg_e_file_must_call_by_reference);
+              { open array must always push the address, this is needed to
+                also push addr of small open arrays and with cdecl functions (PFV) }
+              if (
+                  assigned(defcoll.paratype.def) and
+                  (is_open_array(defcoll.paratype.def) or
+                   is_array_of_const(defcoll.paratype.def))
+                 ) or
+                 (
+                  paramanager.push_addr_param(resulttype.def) and
+                  not is_cdecl
+                 ) then
+                begin
+                   if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
+                    begin
+                      { allow passing nil to a procvardef (methodpointer) }
+                      if (left.nodetype=typeconvn) and
+                         (left.resulttype.def.deftype=procvardef) and
+                         (ttypeconvnode(left).left.nodetype=niln) then
+                       begin
+                         tg.gettempofsizereference(exprasmlist,tcgsize2size[left.location.size],href);
+                         cg.a_load_loc_ref(exprasmlist,left.location,href);
+                         location_reset(left.location,LOC_REFERENCE,left.location.size);
+                         left.location.reference:=href;
+                       end
+                      else
+                       internalerror(200204011);
+                    end;
+
+                   maybe_push_high;
+                   inc(pushedparasize,4);
+                   if inlined then
+                     begin
+                        tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                        cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
+                        reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
+                        cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
+                        cg.free_scratch_reg(exprasmlist,tmpreg);
+                     end
+                   else
+                     cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc);
+                   location_release(exprasmlist,left.location);
+                end
+              else
+                begin
+                   push_value_para(left,inlined,is_cdecl,
+                     para_offset,para_alignment,defcoll.paraloc);
+                end;
+           end;
+         truelabel:=otlabel;
+         falselabel:=oflabel;
+         { push from right to left }
+         if not push_from_left_to_right and assigned(right) then
+          begin
+            if (nf_varargs_para in flags) then
+              tcallparanode(right).secondcallparan(defcoll,push_from_left_to_right,
+                                                   inlined,is_cdecl,para_alignment,para_offset)
+            else
+              tcallparanode(right).secondcallparan(TParaItem(defcoll.next),push_from_left_to_right,
+                                                   inlined,is_cdecl,para_alignment,para_offset);
+          end;
+      end;
+
+
+{*****************************************************************************
+                             TCGCALLNODE
+*****************************************************************************}
+
+    procedure tcgcallnode.pass_2;
+      var
+         regs_to_push : tregisterset;
+         unusedstate: pointer;
+         pushed : tpushedsaved;
+         funcretref,refcountedtemp : treference;
+         tmpreg : tregister;
+         hregister : tregister;
+         oldpushedparasize : longint;
+         { true if ESI must be loaded again after the subroutine }
+         loadesi : boolean;
+         { true if a virtual method must be called directly }
+         no_virtual_call : boolean;
+         { true if we produce a con- or destrutor in a call }
+         is_con_or_destructor : boolean;
+         { true if a constructor is called again }
+         extended_new : boolean;
+         { adress returned from an I/O-error }
+         iolabel : tasmlabel;
+         { lexlevel count }
+         i : longint;
+         { help reference pointer }
+         href : treference;
+         hrefvmt : treference;
+         hp : tnode;
+         pp : tbinarynode;
+         params : tnode;
+         inlined : boolean;
+         inlinecode : tprocinlinenode;
+         store_parast_fixup,
+         para_alignment,
+         para_offset : longint;
+         cgsize : tcgsize;
+         { instruction for alignement correction }
+{        corr : paicpu;}
+         { we must pop this size also after !! }
+{        must_pop : boolean; }
+         pop_size : longint;
+{$ifdef OPTALIGN}
+         pop_esp : boolean;
+         push_size : longint;
+{$endif OPTALIGN}
+         pop_allowed : boolean;
+         release_tmpreg : boolean;
+         constructorfailed : tasmlabel;
+
+      label
+         dont_call;
+
+      begin
+         extended_new:=false;
+         iolabel:=nil;
+         inlinecode:=nil;
+         inlined:=false;
+         loadesi:=true;
+         no_virtual_call:=false;
+         rg.saveunusedstate(unusedstate);
+
+         { if we allocate the temp. location for ansi- or widestrings }
+         { already here, we avoid later a push/pop                    }
+         if is_widestring(resulttype.def) then
+           begin
+             tg.gettempwidestringreference(exprasmlist,refcountedtemp);
+             cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
+           end
+         else if is_ansistring(resulttype.def) then
+           begin
+             tg.gettempansistringreference(exprasmlist,refcountedtemp);
+             cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp);
+           end;
+
+         if (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_stdcall]) then
+          para_alignment:=4
+         else
+          para_alignment:=aktalignment.paraalign;
+
+         if not assigned(procdefinition) then
+          exit;
+
+         { Deciding whether we may still need the parameters happens next (JM) }
+         if assigned(left) then
+           params:=left.getcopy
+         else params := nil;
+
+         if (procdefinition.proccalloption=pocall_inline) then
+           begin
+              inlined:=true;
+              inlinecode:=tprocinlinenode(right);
+              right:=nil;
+              { set it to the same lexical level as the local symtable, becuase
+                the para's are stored there }
+              tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel;
+              if assigned(params) then
+                inlinecode.para_offset:=tg.gettempofsizepersistant(exprasmlist,inlinecode.para_size);
+              store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup;
+              tprocdef(procdefinition).parast.address_fixup:=inlinecode.para_offset;
+{$ifdef extdebug}
+             Comment(V_debug,
+               'inlined parasymtable is at offset '
+               +tostr(tprocdef(procdefinition).parast.address_fixup));
+             exprasmList.concat(Tai_asm_comment.Create(
+               strpnew('inlined parasymtable is at offset '
+               +tostr(tprocdef(procdefinition).parast.address_fixup))));
+{$endif extdebug}
+           end;
+         { only if no proc var }
+         if inlined or
+            not(assigned(right)) then
+           is_con_or_destructor:=(procdefinition.proctypeoption in [potype_constructor,potype_destructor]);
+         { proc variables destroy all registers }
+         if (inlined or
+            (right=nil)) and
+            { virtual methods too }
+            not(po_virtualmethod in procdefinition.procoptions) then
+           begin
+              if (cs_check_io in aktlocalswitches) and
+                 (po_iocheck in procdefinition.procoptions) and
+                 not(po_iocheck in aktprocdef.procoptions) then
+                begin
+                   getaddrlabel(iolabel);
+                   cg.a_label(exprasmlist,iolabel);
+                end
+              else
+                iolabel:=nil;
+
+              { save all used registers }
+              regs_to_push := tprocdef(procdefinition).usedregisters;
+              rg.saveusedregisters(exprasmlist,pushed,regs_to_push);
+
+              { give used registers through }
+              rg.usedinproc:=rg.usedinproc + tprocdef(procdefinition).usedregisters;
+           end
+         else
+           begin
+              regs_to_push := all_registers;
+              rg.saveusedregisters(exprasmlist,pushed,regs_to_push);
+              rg.usedinproc:=all_registers;
+              { no IO check for methods and procedure variables }
+              iolabel:=nil;
+           end;
+
+         { generate the code for the parameter and push them }
+         oldpushedparasize:=pushedparasize;
+         pushedparasize:=0;
+         pop_size:=0;
+
+{$ifdef dummy}
+         { no inc esp for inlined procedure
+           and for objects constructors PM }
+         if inlined or
+            ((procdefinition.proctypeoption=potype_constructor) and
+            { quick'n'dirty check if it is a class or an object }
+             (resulttype.def.deftype=orddef)) then
+           pop_allowed:=false
+         else
+           pop_allowed:=true;
+         if pop_allowed then
+          begin
+          { Old pushedsize aligned on 4 ? }
+            i:=oldpushedparasize and 3;
+            if i>0 then
+             inc(pop_size,4-i);
+          { This parasize aligned on 4 ? }
+            i:=procdefinition.para_size(para_alignment) and 3;
+            if i>0 then
+             inc(pop_size,4-i);
+          { insert the opcode and update pushedparasize }
+          { never push 4 or more !! }
+            pop_size:=pop_size mod 4;
+            if pop_size>0 then
+             begin
+               inc(pushedparasize,pop_size);
+               cg.a_const_reg(A_SUB,S_L,pop_size,R_ESP);
+{$ifdef GDB}
+               if (cs_debuginfo in aktmoduleswitches) and
+                  (exprasmList.first=exprasmList.last) then
+                 exprasmList.concat(Tai_force_line.Create);
+{$endif GDB}
+             end;
+          end;
+{$endif dummy}
+
+{$ifdef OPTALIGN}
+         if pop_allowed and (cs_align in aktglobalswitches) then
+           begin
+              pop_esp:=true;
+              push_size:=procdefinition.para_size(para_alignment);
+              { !!!! here we have to take care of return type, self
+                and nested procedures
+              }
+              inc(push_size,12);
+              emit_reg_reg(A_MOV,S_L,R_ESP,R_EDI);
+              if (push_size mod 8)=0 then
+                emit_const_reg(A_AND,S_L,$fffffff8,R_ESP)
+              else
+                begin
+                   emit_const_reg(A_SUB,S_L,push_size,R_ESP);
+                   emit_const_reg(A_AND,S_L,$fffffff8,R_ESP);
+                   emit_const_reg(A_SUB,S_L,push_size,R_ESP);
+                end;
+              emit_reg(A_PUSH,S_L,R_EDI);
+           end
+         else
+           pop_esp:=false;
+{$endif OPTALIGN}
+
+         { Push parameters }
+         if assigned(params) then
+           begin
+              { be found elsewhere }
+              if inlined then
+                para_offset:=tprocdef(procdefinition).parast.address_fixup+
+                  tprocdef(procdefinition).parast.datasize
+              else
+                para_offset:=0;
+              if not(inlined) and
+                 assigned(right) then
+                tcallparanode(params).secondcallparan(TParaItem(tabstractprocdef(right.resulttype.def).Para.first),
+                  (po_leftright in procdefinition.procoptions),inlined,
+                  (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
+                  para_alignment,para_offset)
+              else
+                tcallparanode(params).secondcallparan(TParaItem(procdefinition.Para.first),
+                  (po_leftright in procdefinition.procoptions),inlined,
+                  (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
+                  para_alignment,para_offset);
+           end;
+
+         { Allocate return value for inlined routines }
+         if inlined then
+           inlinecode.retoffset:=tg.gettempofsizepersistant(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign));
+
+         { Allocate return value when returned in argument }
+         if paramanager.ret_in_param(resulttype.def) then
+           begin
+             if assigned(funcretrefnode) then
+              begin
+                secondpass(funcretrefnode);
+                if codegenerror then
+                 exit;
+                if (funcretrefnode.location.loc<>LOC_REFERENCE) then
+                 internalerror(200204246);
+                funcretref:=funcretrefnode.location.reference;
+              end
+             else
+              begin
+                if inlined then
+                 begin
+                   reference_reset(funcretref);
+                   funcretref.offset:=tg.gettempofsizepersistant(exprasmlist,resulttype.def.size);
+                   funcretref.base:=procinfo^.framepointer;
+{$ifdef extdebug}
+                   Comment(V_debug,'function return value is at offset '
+                                   +tostr(funcretref.offset));
+                   exprasmlist.concat(tai_asm_comment.create(
+                                       strpnew('function return value is at offset '
+                                               +tostr(funcretref.offset))));
+{$endif extdebug}
+                 end
+                else
+                 tg.gettempofsizereference(exprasmlist,resulttype.def.size,funcretref);
+              end;
+
+             { This must not be counted for C code
+               complex return address is removed from stack
+               by function itself !   }
+{$ifdef OLD_C_STACK}
+             inc(pushedparasize,4); { lets try without it PM }
+{$endif not OLD_C_STACK}
+             if inlined then
+               begin
+                  hregister:=cg.get_scratch_reg_address(exprasmlist);
+                  cg.a_loadaddr_ref_reg(exprasmlist,funcretref,hregister);
+                  reference_reset_base(href,procinfo^.framepointer,inlinecode.retoffset);
+                  cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
+                  cg.free_scratch_reg(exprasmlist,hregister);
+               end
+             else
+               cg.a_paramaddr_ref(exprasmlist,funcretref,
+                 paramanager.getfuncretloc(procdefinition));
+           end;
+
+         { procedure variable or normal function call ? }
+         if inlined or
+            (right=nil) then
+           begin
+              { Normal function call }
+
+{$ifdef dummy}
+              { overloaded operator has no symtable }
+              { push self }
+              if assigned(symtableproc) and
+                (symtableproc.symtabletype=withsymtable) then
+                begin
+                   { dirty trick to avoid the secondcall below }
+                   methodpointer:=ccallparanode.create(nil,nil);
+                   location_reset(methodpointer.location,LOC_REGISTER,OS_ADDR);
+                   rg.getexplicitregisterint(exprasmlist,R_ESI);
+                   methodpointer.location.register:=R_ESI;
+                   { ARGHHH this is wrong !!!
+                     if we can init from base class for a child
+                     class that the wrong VMT will be
+                     transfered to constructor !! }
+                   methodpointer.resulttype:=
+                     twithnode(twithsymtable(symtableproc).withnode).left.resulttype;
+                   { make a reference }
+                   href:=twithnode(twithsymtable(symtableproc).withnode).withreference;
+                   if ((not(nf_islocal in twithnode(twithsymtable(symtableproc).withnode).flags)) and
+                       (not twithsymtable(symtableproc).direct_with)) or
+                      is_class_or_interface(methodpointer.resulttype.def) then
+                     cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg)
+                   else
+                     cg.a_loadaddr_ref_reg(exprasmlist,href,self_pointer_reg);
+                end;
+
+              { push self }
+              if assigned(symtableproc) and
+                ((symtableproc.symtabletype=objectsymtable) or
+                (symtableproc.symtabletype=withsymtable)) then
+                begin
+                   if assigned(methodpointer) then
+                     begin
+                        {
+                        if methodpointer^.resulttype.def=classrefdef then
+                          begin
+                              two possibilities:
+                               1. constructor
+                               2. class method
+
+                          end
+                        else }
+                          begin
+                             case methodpointer.nodetype of
+                               typen:
+                                 begin
+                                    { direct call to inherited method }
+                                    if (po_abstractmethod in procdefinition.procoptions) then
+                                      begin
+                                         CGMessage(cg_e_cant_call_abstract_method);
+                                         goto dont_call;
+                                      end;
+                                    { generate no virtual call }
+                                    no_virtual_call:=true;
+
+                                    if (sp_static in symtableprocentry.symoptions) then
+                                      begin
+                                         { well lets put the VMT address directly into ESI }
+                                         { it is kind of dirty but that is the simplest    }
+                                         { way to accept virtual static functions (PM)     }
+                                         loadesi:=true;
+                                         { if no VMT just use $0 bug0214 PM }
+                                         rg.getexplicitregisterint(exprasmlist,R_ESI);
+                                         if not(oo_has_vmt in tobjectdef(methodpointer.resulttype.def).objectoptions) then
+                                           cg.a_load_const_reg(exprasmlist,OS_ADDR,0,self_pointer_reg)
+                                         else
+                                           begin
+                                             reference_reset_symbol(href,newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
+                                             cg.a_loadaddr_ref_reg(exprasmlist,href,self_pointer_reg);
+                                           end;
+                                         { emit_reg(A_PUSH,S_L,R_ESI);
+                                           this is done below !! }
+                                      end
+                                    else
+                                      { this is a member call, so ESI isn't modfied }
+                                      loadesi:=false;
+
+                                    { a class destructor needs a flag }
+                                    if is_class(tobjectdef(methodpointer.resulttype.def)) and
+                                       (procdefinition.proctypeoption=potype_destructor) then
+                                      begin
+                                        cg.a_param_const(exprasmlist,OS_ADDR,0,2);
+                                        cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
+                                      end;
+
+                                    if not(is_con_or_destructor and
+                                           is_class(methodpointer.resulttype.def) and
+                                           (procdefinition.proctypeoption in [potype_constructor,potype_destructor])
+                                          ) then
+                                      cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
+                                    { if an inherited con- or destructor should be  }
+                                    { called in a con- or destructor then a warning }
+                                    { will be made                                  }
+                                    { con- and destructors need a pointer to the vmt }
+                                    if is_con_or_destructor and
+                                      is_object(methodpointer.resulttype.def) and
+                                      assigned(aktprocdef) then
+                                      begin
+                                         if not(aktprocdef.proctypeoption in
+                                                [potype_constructor,potype_destructor]) then
+                                          CGMessage(cg_w_member_cd_call_from_method);
+                                      end;
+                                    { class destructors get there flag above }
+                                    { constructor flags ?                    }
+                                    if is_con_or_destructor and
+                                      not(
+                                        is_class(methodpointer.resulttype.def) and
+                                        assigned(aktprocdef) and
+                                        (aktprocdef.proctypeoption=potype_destructor)) then
+                                      begin
+                                         { a constructor needs also a flag }
+                                         if is_class(methodpointer.resulttype.def) then
+                                           cg.a_param_const(exprasmlist,OS_ADDR,0,2);
+                                         cg.a_param_const(exprasmlist,OS_ADDR,0,1);
+                                      end;
+                                 end;
+                               hnewn:
+                                 begin
+                                    { extended syntax of new }
+                                    { ESI must be zero }
+                                    rg.getexplicitregisterint(exprasmlist,R_ESI);
+                                    cg.a_load_const_reg(exprasmlist,OS_ADDR,0,self_pointer_reg);
+                                    cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,2);
+                                    { insert the vmt }
+                                    reference_reset_symbol(href,newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
+                                    cg.a_paramaddr_ref(exprasmlist,href,1);
+                                    extended_new:=true;
+                                 end;
+                               hdisposen:
+                                 begin
+                                    secondpass(methodpointer);
+
+                                    { destructor with extended syntax called from dispose }
+                                    { hdisposen always deliver LOC_REFERENCE          }
+                                    rg.getexplicitregisterint(exprasmlist,R_ESI);
+                                    emit_ref_reg(A_LEA,S_L,methodpointer.location.reference,R_ESI);
+                                    reference_release(exprasmlist,methodpointer.location.reference);
+                                    cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,2);
+                                    reference_reset_symbol(href,newasmsymbol(tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
+                                    cg.a_paramaddr_ref(exprasmlist,href,1);
+                                 end;
+                               else
+                                 begin
+                                    { call to an instance member }
+                                    if (symtableproc.symtabletype<>withsymtable) then
+                                      begin
+                                         secondpass(methodpointer);
+                                         rg.getexplicitregisterint(exprasmlist,R_ESI);
+                                         case methodpointer.location.loc of
+                                            LOC_CREGISTER,
+                                            LOC_REGISTER:
+                                              begin
+                                                 cg.a_load_reg_reg(exprasmlist,OS_ADDR,methodpointer.location.register,R_ESI);
+                                                 rg.ungetregisterint(exprasmlist,methodpointer.location.register);
+                                              end;
+                                            else
+                                              begin
+                                                 if (methodpointer.resulttype.def.deftype=classrefdef) or
+                                                    is_class_or_interface(methodpointer.resulttype.def) then
+                                                   cg.a_load_ref_reg(exprasmlist,OS_ADDR,methodpointer.location.reference,R_ESI)
+                                                 else
+                                                   cg.a_loadaddr_ref_reg(exprasmlist,methodpointer.location.reference,R_ESI);
+                                                 reference_release(exprasmlist,methodpointer.location.reference);
+                                              end;
+                                         end;
+                                      end;
+                                    { when calling a class method, we have to load ESI with the VMT !
+                                      But, not for a class method via self }
+                                    if not(po_containsself in procdefinition.procoptions) then
+                                      begin
+                                        if (po_classmethod in procdefinition.procoptions) and
+                                           not(methodpointer.resulttype.def.deftype=classrefdef) then
+                                          begin
+                                             { class method needs current VMT }
+                                             rg.getexplicitregisterint(exprasmlist,R_ESI);
+                                             reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
+                                             cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg);
+                                          end;
+
+                                        { direct call to destructor: remove data }
+                                        if (procdefinition.proctypeoption=potype_destructor) and
+                                           is_class(methodpointer.resulttype.def) then
+                                          cg.a_param_const(exprasmlist,OS_INT,1,1);
+
+                                        { direct call to class constructor, don't allocate memory }
+                                        if (procdefinition.proctypeoption=potype_constructor) and
+                                           is_class(methodpointer.resulttype.def) then
+                                          begin
+                                             cg.a_param_const(exprasmlist,OS_INT,0,2);
+                                             cg.a_param_const(exprasmlist,OS_INT,0,1);
+                                          end
+                                        else
+                                          begin
+                                             { constructor call via classreference => allocate memory }
+                                             if (procdefinition.proctypeoption=potype_constructor) and
+                                                (methodpointer.resulttype.def.deftype=classrefdef) and
+                                                is_class(tclassrefdef(methodpointer.resulttype.def).pointertype.def) then
+                                               cg.a_param_const(exprasmlist,OS_INT,1,1);
+                                             cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
+                                          end;
+                                      end;
+
+                                    if is_con_or_destructor then
+                                      begin
+                                         { classes don't get a VMT pointer pushed }
+                                         if is_object(methodpointer.resulttype.def) then
+                                           begin
+                                              if (procdefinition.proctypeoption=potype_constructor) then
+                                                begin
+                                                  { it's no bad idea, to insert the VMT }
+                                                  reference_reset_symbol(href,newasmsymbol(
+                                                     tobjectdef(methodpointer.resulttype.def).vmt_mangledname),0);
+                                                  cg.a_paramaddr_ref(exprasmlist,href,1);
+                                                end
+                                              { destructors haven't to dispose the instance, if this is }
+                                              { a direct call                                           }
+                                              else
+                                                cg.a_param_const(exprasmlist,OS_INT,0,1);
+                                           end;
+                                      end;
+                                 end;
+                             end;
+                          end;
+                     end
+                   else
+                     begin
+                        if (po_classmethod in procdefinition.procoptions) and
+                          not(
+                            assigned(aktprocdef) and
+                            (po_classmethod in aktprocdef.procoptions)
+                          ) then
+                          begin
+                             { class method needs current VMT }
+                             rg.getexplicitregisterint(exprasmlist,R_ESI);
+                             reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
+                             cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,R_ESI);
+                          end
+                        else
+                          begin
+                             { member call, ESI isn't modified }
+                             loadesi:=false;
+                          end;
+                        { direct call to destructor: don't remove data! }
+                        if is_class(procinfo^._class) then
+                          begin
+                             if (procdefinition.proctypeoption=potype_destructor) then
+                               begin
+                                  cg.a_param_const(exprasmlist,OS_INT,0,2);
+                                  cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
+                               end
+                             else if (procdefinition.proctypeoption=potype_constructor) then
+                               begin
+                                  cg.a_param_const(exprasmlist,OS_INT,0,2);
+                                  cg.a_param_const(exprasmlist,OS_INT,0,1);
+                               end
+                             else
+                               cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
+                          end
+                        else if is_object(procinfo^._class) then
+                          begin
+                             cg.a_param_reg(exprasmlist,OS_ADDR,R_ESI,1);
+                             if is_con_or_destructor then
+                               begin
+                                  if (procdefinition.proctypeoption=potype_constructor) then
+                                    begin
+                                      { it's no bad idea, to insert the VMT }
+                                      reference_reset_symbol(href,newasmsymbol(procinfo^._class.vmt_mangledname),0);
+                                      cg.a_paramaddr_ref(exprasmlist,href,1);
+                                    end
+                                  { destructors haven't to dispose the instance, if this is }
+                                  { a direct call                                           }
+                                  else
+                                    cg.a_param_const(exprasmlist,OS_INT,0,1);
+                               end;
+                          end
+                        else
+                          Internalerror(200006165);
+                     end;
+                end;
+
+                { call to BeforeDestruction? }
+                if (procdefinition.proctypeoption=potype_destructor) and
+                   assigned(methodpointer) and
+                   (methodpointer.nodetype<>typen) and
+                   is_class(tobjectdef(methodpointer.resulttype.def)) and
+                   (inlined or
+                   (right=nil)) then
+                  begin
+                     cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
+                     reference_reset_base(href,self_pointer_reg,0);
+                     tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                     cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
+                     reference_reset_base(href,tmpreg,72);
+                     cg.a_call_ref(exprasmlist,href);
+                     cg.free_scratch_reg(exprasmlist,tmpreg);
+                  end;
+
+              { push base pointer ?}
+              { never when inlining, since if necessary, the base pointer }
+              { can/will be gottten from the current procedure's symtable }
+              { (JM)                                                      }
+              if not inlined then
+                if (lexlevel>=normal_function_level) and assigned(tprocdef(procdefinition).parast) and
+                  ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
+                  begin
+                     { if we call a nested function in a method, we must      }
+                     { push also SELF!                                    }
+                     { THAT'S NOT TRUE, we have to load ESI via frame pointer }
+                     { access                                              }
+                     {
+                       begin
+                          loadesi:=false;
+                          emit_reg(A_PUSH,S_L,R_ESI);
+                       end;
+                     }
+                     if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
+                       begin
+                          reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
+                          cg.a_param_ref(exprasmlist,OS_ADDR,href,-1);
+                       end
+                       { this is only true if the difference is one !!
+                         but it cannot be more !! }
+                     else if (lexlevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
+                       begin
+                          cg.a_param_reg(exprasmlist,OS_ADDR,procinfo^.framepointer,-1);
+                       end
+                     else if (lexlevel>(tprocdef(procdefinition).parast.symtablelevel)) then
+                       begin
+                          hregister:=rg.getregisterint(exprasmlist);
+                          reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
+                          cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
+                          for i:=(tprocdef(procdefinition).parast.symtablelevel) to lexlevel-1 do
+                            begin
+                               {we should get the correct frame_pointer_offset at each level
+                               how can we do this !!! }
+                               reference_reset_base(href,hregister,procinfo^.framepointer_offset);
+                               cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
+                            end;
+                          cg.a_param_reg(exprasmlist,OS_ADDR,hregister,-1);
+                          rg.ungetregisterint(exprasmlist,hregister);
+                       end
+                     else
+                       internalerror(25000);
+                  end;
+{$endif dummy}
+              rg.saveregvars(exprasmlist,regs_to_push);
+
+{$ifdef dummy}
+              if (po_virtualmethod in procdefinition.procoptions) and
+                 not(no_virtual_call) then
+                begin
+                   { static functions contain the vmt_address in ESI }
+                   { also class methods                       }
+                   { Here it is quite tricky because it also depends }
+                   { on the methodpointer                        PM }
+                   release_tmpreg:=false;
+                   rg.getexplicitregisterint(exprasmlist,R_ESI);
+                   if assigned(aktprocdef) then
+                     begin
+                       if (((sp_static in aktprocdef.procsym.symoptions) or
+                        (po_classmethod in aktprocdef.procoptions)) and
+                        ((methodpointer=nil) or (methodpointer.nodetype=typen)))
+                        or
+                        (po_staticmethod in procdefinition.procoptions) or
+                        ((procdefinition.proctypeoption=potype_constructor) and
+                        { esi contains the vmt if we call a constructor via a class ref }
+                         assigned(methodpointer) and
+                         (methodpointer.resulttype.def.deftype=classrefdef)
+                        ) or
+                        { is_interface(tprocdef(procdefinition)._class) or }
+                        { ESI is loaded earlier }
+                        (po_classmethod in procdefinition.procoptions) then
+                         begin
+                            reference_reset_base(href,R_ESI,0);
+                         end
+                       else
+                         begin
+                            { this is one point where we need vmt_offset (PM) }
+                            reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset);
+                            tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                            cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
+                            reference_reset_base(href,tmpreg,0);
+                            release_tmpreg:=true;
+                         end;
+                     end
+                   else
+                     { aktprocdef should be assigned, also in main program }
+                     internalerror(12345);
+
+                   if tprocdef(procdefinition).extnumber=-1 then
+                     internalerror(44584);
+
+                   href.offset:=tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber);
+                   if not(is_interface(tprocdef(procdefinition)._class)) and
+                      not(is_cppclass(tprocdef(procdefinition)._class)) then
+                     begin
+                        if (cs_check_object in aktlocalswitches) then
+                          begin
+                             reference_reset_symbol(hrefvmt,newasmsymbol(tprocdef(procdefinition)._class.vmt_mangledname),0);
+                             cg.a_paramaddr_ref(exprasmlist,hrefvmt,2);
+                             cg.a_param_reg(exprasmlist,OS_ADDR,href.base,1);
+                             cg.a_call_name(exprasmlist,'FPC_CHECK_OBJECT_EXT');
+                          end
+                        else if (cs_check_range in aktlocalswitches) then
+                          begin
+                             cg.a_param_reg(exprasmlist,OS_ADDR,href.base,1);
+                             cg.a_call_name(exprasmlist,'FPC_CHECK_OBJECT');
+                          end;
+                     end;
+                   cg.a_call_ref(exprasmlist,href);
+                   if release_tmpreg then
+                     cg.free_scratch_reg(exprasmlist,tmpreg);
+                end
+              else
+{$endif dummy}
+              if not inlined then
+                begin
+{$ifdef i386}
+                  { We can call interrupts from within the smae code
+                    by just pushing the flags and CS PM }
+                  if (po_interrupt in procdefinition.procoptions) then
+                    begin
+                        emit_none(A_PUSHF,S_L);
+                        emit_reg(A_PUSH,S_L,R_CS);
+                    end;
+{$endif i386}
+                  cg.a_call_name(exprasmlist,tprocdef(procdefinition).mangledname);
+                end
+              else { inlined proc }
+                { inlined code is in inlinecode }
+                begin
+                   { process the inlinecode }
+                   secondpass(inlinecode);
+                   { free the args }
+                   if tprocdef(procdefinition).parast.datasize>0 then
+                     tg.ungetpersistanttemp(exprasmlist,tprocdef(procdefinition).parast.address_fixup);
+                end;
+           end;
+{$ifdef dummy}
+         else
+           { now procedure variable case }
+           begin
+              secondpass(right);
+{$ifdef i386}
+              if (po_interrupt in procdefinition.procoptions) then
+                begin
+                    emit_none(A_PUSHF,S_L);
+                    emit_reg(A_PUSH,S_L,R_CS);
+                end;
+{$endif i386}
+              { procedure of object? }
+              if (po_methodpointer in procdefinition.procoptions) then
+                begin
+                   { method pointer can't be in a register }
+                   hregister:=R_NO;
+
+                   { do some hacking if we call a method pointer }
+                   { which is a class member                 }
+                   { else ESI is overwritten !             }
+                   if (right.location.reference.base=R_ESI) or
+                      (right.location.reference.index=R_ESI) then
+                     begin
+                        reference_release(exprasmlist,right.location.reference);
+                        hregister:=cg.get_scratch_reg_address(exprasmlist);
+                        cg.a_load_ref_reg(exprasmlist,OS_ADDR,right.location.reference,hregister);
+                     end;
+
+                   { load self, but not if it's already explicitly pushed }
+                   if not(po_containsself in procdefinition.procoptions) then
+                     begin
+                       { load ESI }
+                       href:=right.location.reference;
+                       inc(href.offset,4);
+                       rg.getexplicitregisterint(exprasmlist,R_ESI);
+                       cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg);
+                       { push self pointer }
+                       cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,-1);
+                     end;
+
+                   rg.saveregvars(exprasmlist,ALL_REGISTERS);
+                   if hregister<>R_NO then
+                     reference_reset_base(href,hregister,0)
+                   else
+                     href:=right.location.reference;
+                   cg.a_call_ref(exprasmlist,href);
+
+                   if hregister<>R_NO then
+                     cg.free_scratch_reg(exprasmlist,hregister);
+                   reference_release(exprasmlist,right.location.reference);
+                end
+              else
+                begin
+                   rg.saveregvars(exprasmlist,ALL_REGISTERS);
+                   case right.location.loc of
+                      LOC_REGISTER,LOC_CREGISTER:
+                        reference_reset_base(href,right.location.register,0);
+                      LOC_REFERENCE,LOC_CREFERENCE :
+                        href:=right.location.reference;
+                      else
+                        internalerror(200203311);
+                   end;
+                   cg.a_call_ref(exprasmlist,href);
+                   location_release(exprasmlist,right.location);
+                end;
+           end;
+{$endif dummy}
+
+{$ifdef dummy}
+           { this was only for normal functions
+             displaced here so we also get
+             it to work for procvars PM }
+           if (not inlined) and (po_clearstack in procdefinition.procoptions) then
+             begin
+                { we also add the pop_size which is included in pushedparasize }
+                pop_size:=0;
+                { better than an add on all processors }
+                if pushedparasize=4 then
+                  begin
+                    rg.getexplicitregisterint(exprasmlist,R_EDI);
+                    emit_reg(A_POP,S_L,R_EDI);
+                    rg.ungetregisterint(exprasmlist,R_EDI);
+                  end
+                { the pentium has two pipes and pop reg is pairable }
+                { but the registers must be different!        }
+                else if (pushedparasize=8) and
+                  not(cs_littlesize in aktglobalswitches) and
+                  (aktoptprocessor=ClassP5) and
+                  (procinfo^._class=nil) then
+                    begin
+                       rg.getexplicitregisterint(exprasmlist,R_EDI);
+                       emit_reg(A_POP,S_L,R_EDI);
+                       rg.ungetregisterint(exprasmlist,R_EDI);
+                       exprasmList.concat(tai_regalloc.Alloc(R_ESI));
+                       emit_reg(A_POP,S_L,R_ESI);
+                       exprasmList.concat(tai_regalloc.DeAlloc(R_ESI));
+                    end
+                else if pushedparasize<>0 then
+                  emit_const_reg(A_ADD,S_L,pushedparasize,R_ESP);
+             end;
+{$endif dummy}
+
+{$ifdef OPTALIGN}
+         if pop_esp then
+           emit_reg(A_POP,S_L,R_ESP);
+{$endif OPTALIGN}
+      dont_call:
+         pushedparasize:=oldpushedparasize;
+         rg.restoreunusedstate(unusedstate);
+{$ifdef TEMPREGDEBUG}
+         testregisters32;
+{$endif TEMPREGDEBUG}
+
+{$ifdef dummy}
+         { a constructor could be a function with boolean result }
+         { if calling constructor called fail we
+           must jump directly to quickexitlabel  PM
+           but only if it is a call of an inherited constructor }
+         if (inlined or
+             (right=nil)) and
+            (procdefinition.proctypeoption=potype_constructor) and
+            assigned(methodpointer) and
+            (methodpointer.nodetype=typen) and
+            (aktprocdef.proctypeoption=potype_constructor) then
+           begin
+             emitjmp(C_Z,faillabel);
+           end;
+
+         { call to AfterConstruction? }
+         if is_class(resulttype.def) and
+           (inlined or
+           (right=nil)) and
+           (procdefinition.proctypeoption=potype_constructor) and
+           assigned(methodpointer) and
+           (methodpointer.nodetype<>typen) then
+           begin
+              getlabel(constructorfailed);
+              emitjmp(C_Z,constructorfailed);
+              cg.a_param_reg(exprasmlist,OS_ADDR,self_pointer_reg,1);
+              reference_reset_base(href,self_pointer_reg,0);
+              tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+              cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg);
+              reference_reset_base(href,tmpreg,68);
+              cg.a_call_ref(exprasmlist,href);
+              cg.free_scratch_reg(exprasmlist,tmpreg);
+              exprasmList.concat(tai_regalloc.Alloc(accumulator));
+              cg.a_label(exprasmlist,constructorfailed);
+              cg.a_load_reg_reg(exprasmlist,OS_ADDR,self_pointer_reg,accumulator);
+           end;
+
+{$endif dummy}
+         { handle function results }
+         if (not is_void(resulttype.def)) then
+          begin
+            { structured results are easy to handle.... }
+            { needed also when result_no_used !! }
+            if paramanager.ret_in_param(resulttype.def) then
+             begin
+               location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
+               location.reference.symbol:=nil;
+               location.reference:=funcretref;
+             end
+            else
+            { ansi/widestrings must be registered, so we can dispose them }
+             if is_ansistring(resulttype.def) or
+                is_widestring(resulttype.def) then
+              begin
+                location_reset(location,LOC_CREFERENCE,OS_ADDR);
+                location.reference:=refcountedtemp;
+                cg.a_reg_alloc(exprasmlist,accumulator);
+                cg.a_load_reg_ref(exprasmlist,OS_ADDR,accumulator,location.reference);
+                cg.a_reg_dealloc(exprasmlist,accumulator);
+              end
+            else
+            { we have only to handle the result if it is used }
+             if (nf_return_value_used in flags) then
+              begin
+                case resulttype.def.deftype of
+                  enumdef,
+                  orddef :
+                    begin
+                      cgsize:=def_cgsize(resulttype.def);
+                      { an object constructor is a function with boolean result }
+                      if (inlined or (right=nil)) and
+                         (procdefinition.proctypeoption=potype_constructor) then
+                       begin
+                         if extended_new then
+                          cgsize:=OS_INT
+                         else
+                          begin
+{$ifdef dummy}
+                            cgsize:=OS_NO;
+                            { this fails if popsize > 0 PM }
+                            location_reset(location,LOC_FLAGS,OS_NO);
+                            location.resflags:=F_NE;
+{$endif dummy}
+                          end;
+                       end;
+
+                      if cgsize<>OS_NO then
+                       begin
+                         location_reset(location,LOC_REGISTER,cgsize);
+                         cg.a_reg_alloc(exprasmlist,accumulator);
+                         if cgsize in [OS_64,OS_S64] then
+                          begin
+                            cg.a_reg_alloc(exprasmlist,accumulatorhigh);
+                            if accumulatorhigh in rg.unusedregsint then
+                              begin
+                                 location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
+                                 location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
+                              end
+                            else
+                              begin
+                                 location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
+                                 location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
+                              end;
+                            cg64.a_load64_reg_reg(exprasmlist,joinreg64(accumulator,accumulatorhigh),
+                                location.register64);
+                          end
+                         else
+                          begin
+                            location.register:=rg.getexplicitregisterint(exprasmlist,accumulator);
+                            hregister:=rg.makeregsize(accumulator,cgsize);
+                            location.register:=rg.makeregsize(location.register,cgsize);
+                            cg.a_load_reg_reg(exprasmlist,cgsize,hregister,location.register);
+                          end;
+                       end;
+                    end;
+                  floatdef :
+                    begin
+{$ifdef dummy}
+                      location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
+                      location.register:=R_ST;
+                      inc(trgcpu(rg).fpuvaroffset);
+{$endif dummy}
+
+                    end;
+                  else
+                    begin
+                      location_reset(location,LOC_REGISTER,OS_INT);
+                      location.register:=rg.getexplicitregisterint(exprasmlist,accumulator);
+                      cg.a_load_reg_reg(exprasmlist,OS_INT,accumulator,location.register);
+                    end;
+                end;
+             end;
+          end;
+
+         { perhaps i/o check ? }
+         if iolabel<>nil then
+           begin
+              reference_reset_symbol(href,iolabel,0);
+              cg.a_paramaddr_ref(exprasmlist,href,paramanager.getintparaloc(1));
+              cg.a_call_name(exprasmlist,'FPC_IOCHECK');
+           end;
+
+{$ifdef i386}
+         if pop_size>0 then
+           emit_const_reg(A_ADD,S_L,pop_size,R_ESP);
+{$endif i386}
+
+         { restore registers }
+         rg.restoreusedregisters(exprasmlist,pushed);
+
+         { at last, restore instance pointer (SELF) }
+         if loadesi then
+           cg.g_maybe_loadself(exprasmlist);
+         pp:=tbinarynode(params);
+         while assigned(pp) do
+           begin
+              if assigned(pp.left) then
+                begin
+                  location_freetemp(exprasmlist,pp.left.location);
+                  { process also all nodes of an array of const }
+                  if pp.left.nodetype=arrayconstructorn then
+                    begin
+                      if assigned(tarrayconstructornode(pp.left).left) then
+                       begin
+                         hp:=pp.left;
+                         while assigned(hp) do
+                          begin
+                            location_freetemp(exprasmlist,tarrayconstructornode(hp).left.location);
+                            hp:=tarrayconstructornode(hp).right;
+                          end;
+                       end;
+                    end;
+                end;
+              pp:=tbinarynode(pp.right);
+           end;
+         if inlined then
+           begin
+             tg.ungetpersistanttemp(exprasmlist,inlinecode.retoffset);
+             tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup;
+             right:=inlinecode;
+           end;
+         if assigned(params) then
+           params.free;
+
+         { from now on the result can be freed normally }
+         if inlined and paramanager.ret_in_param(resulttype.def) then
+           tg.persistanttemptonormal(funcretref.offset);
+
+         { if return value is not used }
+         if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then
+           begin
+              if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
+                begin
+                   { data which must be finalized ? }
+                   if (resulttype.def.needs_inittable) then
+                      cg.g_finalize(exprasmlist,resulttype.def,location.reference,false);
+                   { release unused temp }
+                   tg.ungetiftemp(exprasmlist,location.reference)
+                end
+              else if location.loc=LOC_FPUREGISTER then
+                begin
+{$ifdef i386}
+                  { release FPU stack }
+                  emit_reg(A_FSTP,S_NO,R_ST);
+                  {
+                    dec(trgcpu(rg).fpuvaroffset);
+                    do NOT decrement as the increment before
+                    is not called for unused results PM }
+{$endif i386}
+                end;
+           end;
+      end;
+
+
+
+{*****************************************************************************
+                             TCGPROCINLINENODE
+*****************************************************************************}
+
+
+    procedure tcgprocinlinenode.pass_2;
+       var st : tsymtable;
+           oldprocdef : tprocdef;
+           ps, i : longint;
+           tmpreg: tregister;
+           oldprocinfo : pprocinfo;
+           oldinlining_procedure,
+           nostackframe,make_global : boolean;
+           inlineentrycode,inlineexitcode : TAAsmoutput;
+           oldexitlabel,oldexit2label,oldquickexitlabel:tasmlabel;
+           oldregstate: pointer;
+{$ifdef GDB}
+           startlabel,endlabel : tasmlabel;
+           pp : pchar;
+           mangled_length  : longint;
+{$endif GDB}
+       begin
+          { deallocate the registers used for the current procedure's regvars }
+          if assigned(aktprocdef.regvarinfo) then
+            begin
+              with pregvarinfo(aktprocdef.regvarinfo)^ do
+                for i := 1 to maxvarregs do
+                  if assigned(regvars[i]) then
+                    store_regvar(exprasmlist,regvars[i].reg);
+              rg.saveStateForInline(oldregstate);
+              { make sure the register allocator knows what the regvars in the }
+              { inlined code block are (JM)                                    }
+              rg.resetusableregisters;
+              rg.clearregistercount;
+              rg.cleartempgen;
+              if assigned(inlineprocdef.regvarinfo) then
+                with pregvarinfo(inlineprocdef.regvarinfo)^ do
+                  for i := 1 to maxvarregs do
+                    if assigned(regvars[i]) then
+                      begin
+                        tmpreg:=rg.makeregsize(regvars[i].reg,OS_INT);
+                        rg.makeregvar(tmpreg);
+                      end;
+            end;
+          oldinlining_procedure:=inlining_procedure;
+          oldexitlabel:=aktexitlabel;
+          oldexit2label:=aktexit2label;
+          oldquickexitlabel:=quickexitlabel;
+          getlabel(aktexitlabel);
+          getlabel(aktexit2label);
+          { we're inlining a procedure }
+          inlining_procedure:=true;
+          { save old procinfo }
+          oldprocdef:=aktprocdef;
+          getmem(oldprocinfo,sizeof(tprocinfo));
+          move(procinfo^,oldprocinfo^,sizeof(tprocinfo));
+          { set new procinfo }
+          aktprocdef:=inlineprocdef;
+          procinfo^.return_offset:=retoffset;
+          procinfo^.para_offset:=para_offset;
+          procinfo^.no_fast_exit:=false;
+          { arg space has been filled by the parent secondcall }
+          st:=aktprocdef.localst;
+          { set it to the same lexical level }
+          st.symtablelevel:=oldprocdef.localst.symtablelevel;
+          if st.datasize>0 then
+            begin
+              st.address_fixup:=tg.gettempofsizepersistant(exprasmlist,st.datasize)+st.datasize;
+{$ifdef extdebug}
+              Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup));
+              exprasmList.concat(Tai_asm_comment.Create(strpnew(
+                'local symtable is at offset '+tostr(st.address_fixup))));
+{$endif extdebug}
+            end;
+          exprasmList.concat(Tai_Marker.Create(InlineStart));
+{$ifdef extdebug}
+          exprasmList.concat(Tai_asm_comment.Create(strpnew('Start of inlined proc')));
+{$endif extdebug}
+{$ifdef GDB}
+          if (cs_debuginfo in aktmoduleswitches) then
+            begin
+              getaddrlabel(startlabel);
+              getaddrlabel(endlabel);
+              cg.a_label(exprasmlist,startlabel);
+              inlineprocdef.localst.symtabletype:=inlinelocalsymtable;
+              inlineprocdef.parast.symtabletype:=inlineparasymtable;
+
+              { Here we must include the para and local symtable info }
+              inlineprocdef.concatstabto(withdebuglist);
+
+              { set it back for safety }
+              inlineprocdef.localst.symtabletype:=localsymtable;
+              inlineprocdef.parast.symtabletype:=parasymtable;
+
+              mangled_length:=length(oldprocdef.mangledname);
+              getmem(pp,mangled_length+50);
+              strpcopy(pp,'192,0,0,'+startlabel.name);
+              if (target_info.use_function_relative_addresses) then
+                begin
+                  strpcopy(strend(pp),'-');
+                  strpcopy(strend(pp),oldprocdef.mangledname);
+                end;
+              withdebugList.concat(Tai_stabn.Create(strnew(pp)));
+            end;
+{$endif GDB}
+          { takes care of local data initialization }
+          inlineentrycode:=TAAsmoutput.Create;
+          inlineexitcode:=TAAsmoutput.Create;
+          ps:=para_size;
+          make_global:=false; { to avoid warning }
+          genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
+          if po_assembler in aktprocdef.procoptions then
+            inlineentrycode.insert(Tai_marker.Create(asmblockstart));
+          exprasmList.concatlist(inlineentrycode);
+          secondpass(inlinetree);
+          genexitcode(inlineexitcode,0,false,true);
+          if po_assembler in aktprocdef.procoptions then
+            inlineexitcode.concat(Tai_marker.Create(asmblockend));
+          exprasmList.concatlist(inlineexitcode);
+
+          inlineentrycode.free;
+          inlineexitcode.free;
+{$ifdef extdebug}
+          exprasmList.concat(Tai_asm_comment.Create(strpnew('End of inlined proc')));
+{$endif extdebug}
+          exprasmList.concat(Tai_Marker.Create(InlineEnd));
+
+          {we can free the local data now, reset also the fixup address }
+          if st.datasize>0 then
+            begin
+              tg.ungetpersistanttemp(exprasmlist,st.address_fixup-st.datasize);
+              st.address_fixup:=0;
+            end;
+          { restore procinfo }
+          move(oldprocinfo^,procinfo^,sizeof(tprocinfo));
+          freemem(oldprocinfo,sizeof(tprocinfo));
+{$ifdef GDB}
+          if (cs_debuginfo in aktmoduleswitches) then
+            begin
+              cg.a_label(exprasmlist,endlabel);
+              strpcopy(pp,'224,0,0,'+endlabel.name);
+             if (target_info.use_function_relative_addresses) then
+               begin
+                 strpcopy(strend(pp),'-');
+                 strpcopy(strend(pp),oldprocdef.mangledname);
+               end;
+              withdebugList.concat(Tai_stabn.Create(strnew(pp)));
+              freemem(pp,mangled_length+50);
+            end;
+{$endif GDB}
+          { restore }
+          aktprocdef:=oldprocdef;
+          aktexitlabel:=oldexitlabel;
+          aktexit2label:=oldexit2label;
+          quickexitlabel:=oldquickexitlabel;
+          inlining_procedure:=oldinlining_procedure;
+
+          { reallocate the registers used for the current procedure's regvars, }
+          { since they may have been used and then deallocated in the inlined  }
+          { procedure (JM)                                                     }
+          if assigned(aktprocdef.regvarinfo) then
+            begin
+              rg.restoreStateAfterInline(oldregstate);
+            end;
+       end;
+
+
+begin
+   ccallparanode:=tcgcallparanode;
+   ccallnode:=tcgcallnode;
+   cprocinlinenode:=tcgprocinlinenode;
+end.
+{
+  $Log$
+  Revision 1.1  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+}

+ 9 - 6
compiler/ncgcnv.pas

@@ -62,7 +62,7 @@ interface
 
     uses
       cutils,verbose,
-      aasmbase,aasmtai,aasmcpu,symconst,symdef,
+      aasmbase,aasmtai,aasmcpu,symconst,symdef,paramgr,
       ncon,ncal,
       cpubase,cpuinfo,cpupara,
       pass_2,
@@ -450,10 +450,10 @@ interface
            { instance to check }
            secondpass(left);
            rg.saveusedregisters(exprasmlist,pushed,all_registers);
-           cg.a_param_loc(exprasmlist,left.location,getintparaloc(2));
+           cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(2));
            { type information }
            secondpass(right);
-           cg.a_paramaddr_ref(exprasmlist,right.location.reference,getintparaloc(1));
+           cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
            location_release(exprasmlist,right.location);
            { call helper }
            if is_class(left.resulttype.def) then
@@ -468,10 +468,10 @@ interface
            { instance to check }
            secondpass(left);
            rg.saveusedregisters(exprasmlist,pushed,all_registers);
-           cg.a_param_loc(exprasmlist,left.location,getintparaloc(2));
+           cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(2));
            { type information }
            secondpass(right);
-           cg.a_param_loc(exprasmlist,right.location,getintparaloc(1));
+           cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(1));
            location_release(exprasmlist,right.location);
            { call helper }
            cg.a_call_name(exprasmlist,'FPC_DO_AS');
@@ -490,7 +490,10 @@ end.
 
 {
   $Log$
-  Revision 1.19  2002-07-07 09:52:32  florian
+  Revision 1.20  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.19  2002/07/07 09:52:32  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 8 - 5
compiler/ncgld.pas

@@ -53,7 +53,7 @@ implementation
     uses
       systems,
       verbose,globals,
-      symconst,symtype,symdef,symsym,symtable,types,
+      symconst,symtype,symdef,symsym,symtable,types,paramgr,
       ncnv,ncon,nmem,
       aasmbase,aasmtai,aasmcpu,regvars,
       cginfo,cgbase,pass_2,
@@ -132,7 +132,7 @@ implementation
                     begin
                        rg.saveusedregisters(exprasmlist,pushed,[accumulator]);
                        reference_reset_symbol(href,newasmsymbol(tvarsym(symtableentry).mangledname),0);
-                       cg.a_param_ref(exprasmlist,OS_ADDR,href,getintparaloc(1));
+                       cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
                        { the called procedure isn't allowed to change }
                        { any register except EAX                    }
                        cg.a_call_name(exprasmlist,'FPC_RELOCATE_THREADVAR');
@@ -248,7 +248,7 @@ implementation
                           is_open_array(tvarsym(symtableentry).vartype.def) or
                           is_array_of_const(tvarsym(symtableentry).vartype.def) or
                           ((tvarsym(symtableentry).varspez=vs_const) and
-                           push_addr_param(tvarsym(symtableentry).vartype.def)) then
+                           paramanager.push_addr_param(tvarsym(symtableentry).vartype.def)) then
                          begin
                             if hregister=R_NO then
                               hregister:=rg.getaddressregister(exprasmlist);
@@ -694,7 +694,7 @@ implementation
              location.reference.base:=procinfo^.framepointer;
              location.reference.offset:=procinfo^.return_offset;
            end;
-         if ret_in_param(resulttype.def) then
+         if paramanager.ret_in_param(resulttype.def) then
            begin
               if not hr_valid then
                 hreg:=rg.getregisterint(exprasmlist);
@@ -921,7 +921,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2002-07-07 09:52:32  florian
+  Revision 1.13  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.12  2002/07/07 09:52:32  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 6 - 3
compiler/ncgmem.pas

@@ -74,7 +74,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,symsym,
+      symconst,symdef,symsym,paramgr,
       aasmbase,aasmtai,aasmcpu,
       cgbase,pass_2,
       nld,ncon,nadd,
@@ -246,7 +246,7 @@ implementation
          if (cs_gdb_heaptrc in aktglobalswitches) and
             (cs_checkpointer in aktglobalswitches) then
           begin
-            cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,getintparaloc(1));
+            cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
             cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
           end;
       end;
@@ -466,7 +466,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.16  2002-07-07 09:52:32  florian
+  Revision 1.17  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.16  2002/07/07 09:52:32  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 7 - 4
compiler/ncgset.pas

@@ -55,7 +55,7 @@ implementation
       globtype,systems,
       verbose,globals,
       symconst,symdef,types,
-      cpupara,
+      paramgr,
       pass_2,
       ncon,
       cga,tgobj,ncgutil,regvars,rgobj;
@@ -562,8 +562,8 @@ implementation
                   cg.a_load_loc_reg(exprasmlist,left.location,pleftreg);
                   location_freetemp(exprasmlist,left.location);
                   location_release(exprasmlist,left.location);
-                  cg.a_param_reg(exprasmlist,OS_8,pleftreg,getintparaloc(2));
-                  cg.a_param_ref(exprasmlist,OS_ADDR,right.location.reference,getintparaloc(1));
+                  cg.a_param_reg(exprasmlist,OS_8,pleftreg,paramanager.getintparaloc(2));
+                  cg.a_param_ref(exprasmlist,OS_ADDR,right.location.reference,paramanager.getintparaloc(1));
                   cg.a_call_name(exprasmlist,'FPC_SET_IN_BYTE');
                   { result of value is always one full register }
                   cg.a_load_reg_reg(exprasmlist,OS_INT,ACCUMULATOR,location.register);
@@ -585,7 +585,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2002-07-07 10:16:29  florian
+  Revision 1.5  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.4  2002/07/07 10:16:29  florian
     * problems with last commit fixed
 
   Revision 1.3  2002/07/06 20:19:25  carl

+ 22 - 19
compiler/ncgutil.pas

@@ -75,7 +75,7 @@ implementation
     strings,
 {$endif}
     cutils,cclasses,globtype,globals,systems,verbose,
-    symbase,symconst,symtype,symsym,symdef,symtable,types,
+    symbase,symconst,symtype,symsym,symdef,symtable,types,paramgr,
     fmodule,
     cgbase,regvars,
 {$ifdef GDB}
@@ -686,7 +686,7 @@ implementation
          begin
            { call by value open array ? }
            if is_cdecl and
-              push_addr_param(p.resulttype.def) then
+              paramanager.push_addr_param(p.resulttype.def) then
             begin
               if not (p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
                 internalerror(200204241);
@@ -788,7 +788,7 @@ implementation
         list:=taasmoutput(arg);
         if (tsym(p).typ=varsym) and
            (tvarsym(p).varspez=vs_value) and
-           (push_addr_param(tvarsym(p).vartype.def)) then
+           (paramanager.push_addr_param(tvarsym(p).vartype.def)) then
          begin
            reference_reset_base(href1,procinfo^.framepointer,tvarsym(p).address+procinfo^.para_offset);
            if is_open_array(tvarsym(p).vartype.def) or
@@ -815,9 +815,9 @@ implementation
         if (tsym(p).typ=varsym) and
            (vo_is_thread_var in tvarsym(p).varoptions) then
          begin
-           cg.a_param_const(list,OS_INT,tvarsym(p).getsize,getintparaloc(2));
+           cg.a_param_const(list,OS_INT,tvarsym(p).getsize,paramanager.getintparaloc(2));
            reference_reset_symbol(href,newasmsymbol(tvarsym(p).mangledname),0);
-           cg.a_paramaddr_ref(list,href,getintparaloc(1));
+           cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
            rg.saveregvars(list,all_registers);
            cg.a_call_name(list,'FPC_INIT_THREADVAR');
          end;
@@ -965,20 +965,20 @@ implementation
              tt_freeansistring :
                begin
                  reference_reset_base(href,procinfo^.framepointer,hp^.pos);
-                 cg.a_paramaddr_ref(list,href,getintparaloc(1));
+                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
                  cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
                end;
              tt_widestring,
              tt_freewidestring :
                begin
                  reference_reset_base(href,procinfo^.framepointer,hp^.pos);
-                 cg.a_paramaddr_ref(list,href,getintparaloc(2));
+                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
                  cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
                end;
              tt_interfacecom :
                begin
                  reference_reset_base(href,procinfo^.framepointer,hp^.pos);
-                 cg.a_paramaddr_ref(list,href,getintparaloc(2));
+                 cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
                  cg.a_call_name(list,'FPC_INTF_DECR_REF');
                end;
            end;
@@ -1024,7 +1024,7 @@ implementation
                end;
              else
                begin
-                 if ret_in_acc(aktprocdef.rettype.def) then
+                 if paramanager.ret_in_acc(aktprocdef.rettype.def) then
                   begin
                     uses_acc:=true;
                     cg.a_reg_alloc(list,accumulator);
@@ -1064,7 +1064,7 @@ implementation
                end;
              else
                begin
-                 if ret_in_acc(aktprocdef.rettype.def) then
+                 if paramanager.ret_in_acc(aktprocdef.rettype.def) then
                   cg.a_load_reg_ref(list,cgsize,accumulator,href);
                end;
            end;
@@ -1194,7 +1194,7 @@ implementation
           begin
              procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
              reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
-             cg.g_initialize(list,aktprocdef.rettype.def,href,ret_in_param(aktprocdef.rettype.def));
+             cg.g_initialize(list,aktprocdef.rettype.def,href,paramanager.ret_in_param(aktprocdef.rettype.def));
           end;
 
         { initialisize local data like ansistrings }
@@ -1360,14 +1360,14 @@ implementation
                             cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nodestroycall);
                             if is_class(procinfo^._class) then
                              begin
-                               cg.a_param_const(list,OS_INT,1,getintparaloc(2));
-                               cg.a_param_reg(list,OS_ADDR,self_pointer_reg,getintparaloc(1));
+                               cg.a_param_const(list,OS_INT,1,paramanager.getintparaloc(2));
+                               cg.a_param_reg(list,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(1));
                              end
                             else if is_object(procinfo^._class) then
                              begin
-                               cg.a_param_reg(list,OS_ADDR,self_pointer_reg,getintparaloc(2));
+                               cg.a_param_reg(list,OS_ADDR,self_pointer_reg,paramanager.getintparaloc(2));
                                reference_reset_symbol(href,newasmsymbol(procinfo^._class.vmt_mangledname),0);
-                               cg.a_paramaddr_ref(list,href,getintparaloc(1));
+                               cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
                              end
                             else
                              Internalerror(200006164);
@@ -1398,7 +1398,7 @@ implementation
                     not is_class(aktprocdef.rettype.def)) then
                   begin
                      reference_reset_base(href,procinfo^.framepointer,procinfo^.return_offset);
-                     cg.g_finalize(list,aktprocdef.rettype.def,href,ret_in_param(aktprocdef.rettype.def));
+                     cg.g_finalize(list,aktprocdef.rettype.def,href,paramanager.ret_in_param(aktprocdef.rettype.def));
                   end;
               end;
 
@@ -1540,7 +1540,7 @@ implementation
 
             if (not is_void(aktprocdef.rettype.def)) then
               begin
-                if ret_in_param(aktprocdef.rettype.def) then
+                if paramanager.ret_in_param(aktprocdef.rettype.def) then
                   list.concat(Tai_stabs.Create(strpnew(
                    '"'+aktprocsym.name+':X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
                    tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))))
@@ -1549,7 +1549,7 @@ implementation
                    '"'+aktprocsym.name+':X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
                    tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))));
                 if (m_result in aktmodeswitches) then
-                  if ret_in_param(aktprocdef.rettype.def) then
+                  if paramanager.ret_in_param(aktprocdef.rettype.def) then
                     list.concat(Tai_stabs.Create(strpnew(
                      '"RESULT:X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
                      tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))))
@@ -1629,7 +1629,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.21  2002-07-11 07:33:25  jonas
+  Revision 1.22  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.21  2002/07/11 07:33:25  jonas
     * big-endian fixes for location_force_reg*()
 
   Revision 1.20  2002/07/07 09:52:32  florian

+ 6 - 3
compiler/nflw.pas

@@ -178,7 +178,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symtable,types,htypechk,pass_1,
+      symconst,symtable,paramgr,types,htypechk,pass_1,
       ncon,nmem,nld,ncnv,nbas,rgobj,
       cgbase
       ;
@@ -607,7 +607,7 @@ implementation
            if assigned(left) then
             begin
               inserttypeconv(left,aktprocdef.rettype);
-              if ret_in_param(aktprocdef.rettype.def) or
+              if paramanager.ret_in_param(aktprocdef.rettype.def) or
                  (procinfo^.no_fast_exit) or
                  ((procinfo^.flags and pi_uses_exceptions)<>0) then
                begin
@@ -1113,7 +1113,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.33  2002-07-01 18:46:23  peter
+  Revision 1.34  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.33  2002/07/01 18:46:23  peter
     * internal linker
     * reorganized aasm layer
 

+ 6 - 3
compiler/ninl.pas

@@ -57,7 +57,7 @@ implementation
     uses
       verbose,globals,systems,
       globtype, cutils,
-      symbase,symconst,symtype,symdef,symsym,symtable,types,
+      symbase,symconst,symtype,symdef,symsym,symtable,paramgr,types,
       pass_1,
       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,
       cpubase,tgobj,cgbase
@@ -1951,7 +1951,7 @@ implementation
             end;
           in_sizeof_x:
             begin
-              if push_high_param(left.resulttype.def) then
+              if paramanager.push_high_param(left.resulttype.def) then
                begin
                  srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
                  hp:=caddnode.create(addn,cloadnode.create(srsym,tloadnode(left).symtable),
@@ -2265,7 +2265,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.77  2002-06-06 18:53:53  jonas
+  Revision 1.78  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.77  2002/06/06 18:53:53  jonas
     * fixed fpu stack overflow in compiler when compiled with -Or
 
   Revision 1.76  2002/05/18 13:34:10  peter

+ 7 - 4
compiler/nld.pas

@@ -122,7 +122,7 @@ implementation
 
     uses
       cutils,verbose,globtype,globals,systems,
-      symtable,types,
+      symtable,paramgr,types,
       htypechk,pass_1,
       ncon,ninl,ncnv,nmem,ncal,cpubase,rgobj,cginfo,cgbase
       ;
@@ -345,7 +345,7 @@ implementation
                    { we need a register for call by reference parameters }
                    if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
                       ((tvarsym(symtableentry).varspez=vs_const) and
-                      push_addr_param(tvarsym(symtableentry).vartype.def)) or
+                      paramanager.push_addr_param(tvarsym(symtableentry).vartype.def)) or
                       { call by value open arrays are also indirect addressed }
                       is_open_array(tvarsym(symtableentry).vartype.def) then
                      registers32:=1;
@@ -603,7 +603,7 @@ implementation
       begin
          result:=nil;
          location.loc:=LOC_REFERENCE;
-         if ret_in_param(resulttype.def) or
+         if paramanager.ret_in_param(resulttype.def) or
             (lexlevel<>funcretsym.owner.symtablelevel) then
            registers32:=1;
       end;
@@ -955,7 +955,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.42  2002-05-18 13:34:10  peter
+  Revision 1.43  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.42  2002/05/18 13:34:10  peter
     * readded missing revisions
 
   Revision 1.41  2002/05/16 19:46:38  carl

+ 136 - 0
compiler/paramgr.pas

@@ -0,0 +1,136 @@
+{
+    $Id$
+    Copyright (c) 2002 by Florian Klaempfl
+
+    PowerPC specific calling conventions
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+{
+}
+unit paramgr;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       cpubase,
+       symtype,symdef;
+
+    type
+       tparamanager = class
+          { Returns true if the return value can be put in accumulator }
+          function ret_in_acc(def : tdef) : boolean;virtual;
+
+          { Returns true if uses a parameter as return value (???) }
+          function ret_in_param(def : tdef) : boolean;virtual;
+
+          function push_high_param(def : tdef) : boolean;virtual;
+
+          { Returns true if a parameter is too large to copy and only the address is pushed
+          }
+          function push_addr_param(def : tdef) : boolean;virtual;
+          function getintparaloc(nr : longint) : tparalocation;virtual;abstract;
+          procedure create_param_loc_info(p : tabstractprocdef);virtual;abstract;
+
+          { Returns the location where the invisible parameter for structured
+            function results will be passed.
+          }
+          function getfuncretloc(p : tabstractprocdef) : tparalocation;virtual;abstract;
+       end;
+
+    var
+       paralocdummy : tparalocation;
+       paramanager : tparamanager;
+
+  implementation
+
+    uses
+       cpuinfo,
+       symconst,symbase,
+       types;
+
+    { true if the return value is in accumulator (EAX for i386), D0 for 68k }
+    function tparamanager.ret_in_acc(def : tdef) : boolean;
+      begin
+         ret_in_acc:=(def.deftype in [orddef,pointerdef,enumdef,classrefdef]) or
+                     ((def.deftype=stringdef) and (tstringdef(def).string_typ in [st_ansistring,st_widestring])) or
+                     ((def.deftype=procvardef) and not(po_methodpointer in tprocvardef(def).procoptions)) or
+                     ((def.deftype=objectdef) and not is_object(def)) or
+                     ((def.deftype=setdef) and (tsetdef(def).settype=smallset));
+      end;
+
+
+    { true if uses a parameter as return value }
+    function tparamanager.ret_in_param(def : tdef) : boolean;
+      begin
+         ret_in_param:=(def.deftype in [arraydef,recorddef]) or
+           ((def.deftype=stringdef) and (tstringdef(def).string_typ in [st_shortstring,st_longstring])) or
+           ((def.deftype=procvardef) and (po_methodpointer in tprocvardef(def).procoptions)) or
+           ((def.deftype=objectdef) and is_object(def)) or
+           (def.deftype=variantdef) or
+           ((def.deftype=setdef) and (tsetdef(def).settype<>smallset));
+      end;
+
+
+    function tparamanager.push_high_param(def : tdef) : boolean;
+      begin
+         push_high_param:=is_open_array(def) or
+                          is_open_string(def) or
+                          is_array_of_const(def);
+      end;
+
+
+    { true if a parameter is too large to copy and only the address is pushed }
+    function tparamanager.push_addr_param(def : tdef) : boolean;
+      begin
+        push_addr_param:=false;
+        if never_copy_const_param then
+         push_addr_param:=true
+        else
+         begin
+           case def.deftype of
+             variantdef,
+             formaldef :
+               push_addr_param:=true;
+             recorddef :
+               push_addr_param:=(def.size>pointer_size);
+             arraydef :
+               push_addr_param:=((tarraydef(def).highrange>=tarraydef(def).lowrange) and (def.size>pointer_size)) or
+                                is_open_array(def) or
+                                is_array_of_const(def) or
+                                is_array_constructor(def);
+             objectdef :
+               push_addr_param:=is_object(def);
+             stringdef :
+               push_addr_param:=tstringdef(def).string_typ in [st_shortstring,st_longstring];
+             procvardef :
+               push_addr_param:=(po_methodpointer in tprocvardef(def).procoptions);
+             setdef :
+               push_addr_param:=(tsetdef(def).settype<>smallset);
+           end;
+         end;
+      end;
+
+end.
+
+{
+   $Log$
+   Revision 1.1  2002-07-11 14:41:28  florian
+     * start of the new generic parameter handling
+
+}

+ 9 - 6
compiler/pdecsub.pas

@@ -71,7 +71,7 @@ implementation
        { aasm }
        aasmbase,aasmtai,aasmcpu,
        { symtable }
-       symbase,symtable,types,
+       symbase,symtable,types,paramgr,
        { pass 1 }
        node,htypechk,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
@@ -282,7 +282,7 @@ implementation
                    { but I suppose the comment is wrong and                         }
                    { it means that the address of var parameters can be placed      }
                    { in a register (FK)                                             }
-                     if (varspez in [vs_var,vs_const,vs_out]) and push_addr_param(tt.def) then
+                     if (varspez in [vs_var,vs_const,vs_out]) and paramanager.push_addr_param(tt.def) then
                        include(vs.varoptions,vo_regable);
 
                    { insert the sym in the parasymtable }
@@ -291,7 +291,7 @@ implementation
                    { do we need a local copy? Then rename the varsym, do this after the
                      insert so the dup id checking is done correctly }
                      if (varspez=vs_value) and
-                        push_addr_param(tt.def) and
+                        paramanager.push_addr_param(tt.def) and
                         not(is_open_array(tt.def) or is_array_of_const(tt.def)) then
                        tprocdef(aktprocdef).parast.rename(vs.name,'val'+vs.name);
 
@@ -1929,7 +1929,7 @@ const
          begin
            if not parse_only then
             begin
-              if ret_in_param(aprocdef.rettype.def) then
+              if paramanager.ret_in_param(aprocdef.rettype.def) then
                begin
                  aprocdef.parast.insert(otsym);
                  { this increases the data size }
@@ -1950,14 +1950,17 @@ const
               otsym:=nil;
             end;
          end;
-
+        paramanager.create_param_loc_info(aprocdef);
         proc_add_definition:=forwardfound;
       end;
 
 end.
 {
   $Log$
-  Revision 1.58  2002-07-01 18:46:25  peter
+  Revision 1.59  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.58  2002/07/01 18:46:25  peter
     * internal linker
     * reorganized aasm layer
 

+ 5 - 17
compiler/powerpc/agppcgas.pas

@@ -337,7 +337,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2002-07-11 07:34:55  jonas
+  Revision 1.4  2002-07-11 14:41:34  florian
+    * start of the new generic parameter handling
+
+  Revision 1.3  2002/07/11 07:34:55  jonas
     * fixed mullw entry in instruction list
 
   Revision 1.2  2002/07/09 19:45:01  jonas
@@ -348,19 +351,4 @@ end.
 
   Revision 1.1  2002/07/07 09:44:31  florian
     * powerpc target fixed, very simple units can be compiled
-
-  Revision 1.6  2002/05/18 13:34:26  peter
-    * readded missing revisions
-
-  Revision 1.5  2002/05/16 19:46:52  carl
-  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
-  + try to fix temp allocation (still in ifdef)
-  + generic constructor calls
-  + start of tassembler / tmodulebase class cleanup
-
-  Revision 1.3  2002/04/20 21:41:51  carl
-  * renamed some constants
-
-  Revision 1.2  2002/04/06 18:13:01  jonas
-    * several powerpc-related additions and fixes
-}
+}

+ 38 - 48
compiler/powerpc/cgcpu.pas

@@ -38,7 +38,6 @@ unit cgcpu;
         { left to right), this allows to move the parameter to    }
         { register, if the cpu supports register calling          }
         { conventions                                             }
-        procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);override;
         procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);override;
         procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);override;
         procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
@@ -146,43 +145,27 @@ const
 { parameter passing... Still needs extra support from the processor }
 { independent code generator                                        }
 
-    procedure tcgppc.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);
-
-      var
-        ref: treference;
-
-      begin
-  {$ifdef para_sizes_known}
-        if (nr <= max_param_regs_int) then
-          a_load_reg_reg(list,size,r,param_regs_int[nr])
-        else
-          begin
-            reset_reference(ref);
-            ref.base := STACK_POINTER_REG;
-            ref.offset := LinkageAreaSize+para_size_till_now;
-            a_load_reg_ref(list,size,reg,ref);
-          end;
-  {$endif para_sizes_known}
-      end;
-
-
     procedure tcgppc.a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);
 
       var
         ref: treference;
 
       begin
-  {$ifdef para_sizes_known}
-        if (nr <= max_param_regs_int) then
-          a_load_const_reg(list,size,a,param_regs_int[nr])
-        else
-          begin
-            reset_reference(ref);
-            ref.base := STACK_POINTER_REG;
-            ref.offset := LinkageAreaSize+para_size_till_now;
-            a_load_const_ref(list,size,a,ref);
-          end;
-  {$endif para_sizes_known}
+        case locpara.loc of
+          LOC_REGISTER:
+            a_load_const_reg(list,size,a,locpara.register);
+          LOC_REFERENCE:
+            begin
+               reference_reset(ref);
+               ref.base:=locpara.reference.index;
+               ref.offset:=locpara.reference.offset;
+               a_load_const_ref(list,size,a,ref);
+            end;
+          else
+            internalerror(2002081101);
+        end;
+        if locpara.sp_fixup<>0 then
+          internalerror(2002081102);
       end;
 
 
@@ -193,20 +176,24 @@ const
         tmpreg: tregister;
 
       begin
-  {$ifdef para_sizes_known}
-        if (nr <= max_param_regs_int) then
-          a_load_ref_reg(list,size,r,param_regs_int[nr])
-        else
-          begin
-            reset_reference(ref);
-            ref.base := STACK_POINTER_REG;
-            ref.offset := LinkageAreaSize+para_size_till_now;
-            tmpreg := get_scratch_reg_int(list);
-            a_load_ref_reg(list,size,r,tmpreg);
-            a_load_reg_ref(list,size,tmpreg,ref);
-            free_scratch_reg(list,tmpreg);
-          end;
-  {$endif para_sizes_known}
+        case locpara.loc of
+          LOC_REGISTER:
+            a_load_ref_reg(list,size,r,locpara.register);
+          LOC_REFERENCE:
+            begin
+               reference_reset(ref);
+               ref.base:=locpara.reference.index;
+               ref.offset:=locpara.reference.offset;
+               tmpreg := get_scratch_reg_int(list);
+               a_load_ref_reg(list,size,r,tmpreg);
+               a_load_reg_ref(list,size,tmpreg,ref);
+               free_scratch_reg(list,tmpreg);
+            end;
+          else
+            internalerror(2002081103);
+        end;
+        if locpara.sp_fixup<>0 then
+          internalerror(2002081104);
       end;
 
 
@@ -606,7 +593,7 @@ const
          a_jmp(list,A_BC,TOpCmp2AsmCond[cond],0,l);
        end;
 
-     procedure tcgppc.a_jmp_always(list : taasmoutput;l: tasmlabel); 
+     procedure tcgppc.a_jmp_always(list : taasmoutput;l: tasmlabel);
 
        begin
          a_jmp(list,A_B,C_None,0,l);
@@ -1306,7 +1293,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  2002-07-11 07:38:28  jonas
+  Revision 1.23  2002-07-11 14:41:34  florian
+    * start of the new generic parameter handling
+
+  Revision 1.22  2002/07/11 07:38:28  jonas
     + tcg64fpc implementation (only a_op64_reg_reg and a_op64_const_reg for
       now)
     * fixed and improved tcgppc.a_load_const_reg

+ 6 - 3
compiler/powerpc/cpubase.pas

@@ -283,7 +283,7 @@ uses
       pparareference = ^tparareference;
       tparareference = packed record
          index       : tregister;
-         offset      : longint;
+         offset      : aword;
       end;
 
     const
@@ -569,7 +569,7 @@ implementation
         end;
       end;
 
- 
+
     procedure inverse_flags(var r: TResFlags);
       const
         inv_flags: array[F_EQ..F_GE] of TResFlagsEnum =
@@ -627,7 +627,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.17  2002-07-11 07:35:36  jonas
+  Revision 1.18  2002-07-11 14:41:34  florian
+    * start of the new generic parameter handling
+
+  Revision 1.17  2002/07/11 07:35:36  jonas
     * some available registers fixes
 
   Revision 1.16  2002/07/09 19:45:01  jonas

+ 12 - 5
compiler/powerpc/cpunode.pas

@@ -29,26 +29,33 @@ unit cpunode;
   implementation
 
     uses
+       { generic nodes }
+       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,
+       { to be able to only parts of the generic code,
+         the processor specific nodes must be included
+         after the generic one (FK)
+       }
 //       nppcadd,
 //       nppccal,
-         nppccnv,
 //       nppccon,
 //       nppcflw,
-       nppcmat,
 //       nppcmem,
 //       nppcset,
 //       nppcinl,
 //       nppcopt,
        { this not really a node }
 //       nppcobj,
-       { generic nodes }
-       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon
+       nppcmat,
+       nppccnv
        ;
 
 end.
 {
   $Log$
-  Revision 1.6  2002-07-11 07:42:31  jonas
+  Revision 1.7  2002-07-11 14:41:34  florian
+    * start of the new generic parameter handling
+
+  Revision 1.6  2002/07/11 07:42:31  jonas
     * fixed nppccnv and enabled it
     - removed PPC specific second_int_to_int and use the generic one instead
 

+ 106 - 8
compiler/powerpc/cpupara.pas

@@ -23,27 +23,125 @@
 }
 unit cpupara;
 
+{$i fpcdefs.inc}
+
   interface
 
     uses
-       cpubase;
-
-    var
-       paralocdummy : tparalocation;
+       cpubase,
+       symconst,symbase,symdef,paramgr;
 
-    function getintparaloc(nr : longint) : tparalocation;
+    type
+       tppcparamanager = class(tparamanager)
+          function getintparaloc(nr : longint) : tparalocation;override;
+          procedure create_param_loc_info(p : tabstractprocdef);override;
+          function getfuncretloc(p : tabstractprocdef) : tparalocation;override;
+       end;
 
   implementation
 
-    function getintparaloc(nr : longint) : tparalocation;
+    uses
+       verbose,
+       cpuinfo,
+       symtype;
+
+    function tppcparamanager.getintparaloc(nr : longint) : tparalocation;
+
+      begin
+         fillchar(result,sizeof(tparalocation),0);
+         if nr<1 then
+           internalerror(2002070801)
+         else if nr<=8 then
+           begin
+              result.loc:=LOC_REGISTER;
+              result.register:=tregister(longint(R_2)+nr);
+           end
+         else
+           begin
+              result.loc:=LOC_REFERENCE;
+              result.reference.index:=stack_pointer_reg;
+              result.reference.offset:=(nr-8)*4;
+           end;
+      end;
+
+    function getparaloc(p : tdef) : tloc;
+
+      begin
+         case p.deftype of
+            orddef:
+              getparaloc:=LOC_REGISTER;
+            floatdef:
+              getparaloc:=LOC_FPUREGISTER;
+            enumdef:
+              getparaloc:=LOC_REGISTER;
+            pointerdef:
+              getparaloc:=LOC_REGISTER;
+            else
+              internalerror(2002071001);
+         end;
+      end;
+
+    procedure tppcparamanager.create_param_loc_info(p : tabstractprocdef);
+
+      var
+         nextintreg,nextfloatreg,nextmmreg : tregister;
+         stack_offset : aword;
+         hp : tparaitem;
+         loc : tloc;
+
+      begin
+         nextintreg:=R_3;
+         nextfloatreg:=R_F1;
+         nextmmreg:=R_M1;
+         stack_offset:=0;
+         { pointer for structured results ? }
+         { !!!nextintreg:=R_4;              }
+
+         { frame pointer for nested procedures? }
+         { inc(nextintreg);                     }
+         { constructor? }
+         { destructor? }
+         hp:=tparaitem(p.para.last);
+         while assigned(hp) do
+           begin
+              loc:=getparaloc(hp.paratype.def);
+              case loc of
+                 LOC_REGISTER:
+                   begin
+                      if nextintreg<=R_8 then
+                        begin
+                           hp.paraloc.loc:=LOC_REGISTER;
+                           hp.paraloc.register:=nextintreg;
+                           inc(nextintreg);
+                        end
+                      else
+                         begin
+                            {!!!!!!!}
+                            internalerror(2002071003);
+                        end;
+                   end;
+                 else
+                   internalerror(2002071002);
+              end;
+              hp:=tparaitem(hp.previous);
+           end;
+      end;
+
+    function tppcparamanager.getfuncretloc(p : tabstractprocdef) : tparalocation;
 
       begin
+         getfuncretloc.loc:=LOC_REGISTER;
+         getfuncretloc.register:=R_3;
       end;
 
+begin
+   paramanager:=tppcparamanager.create;
 end.
 {
   $Log$
-  Revision 1.1  2002-07-07 09:44:32  florian
-    * powerpc target fixed, very simple units can be compiled
+  Revision 1.2  2002-07-11 14:41:34  florian
+    * start of the new generic parameter handling
 
+  Revision 1.1  2002/07/07 09:44:32  florian
+    * powerpc target fixed, very simple units can be compiled
 }

+ 4 - 2
compiler/powerpc/nppccnv.pas

@@ -152,7 +152,6 @@ implementation
           tempconst :=
             crealconstnode.create(double(dummyrec($4330000000000000)),
             pbestrealtype^);
-
         resulttypepass(tempconst);
         firstpass(tempconst);
         secondpass(tempconst);
@@ -373,7 +372,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2002-07-11 07:42:31  jonas
+  Revision 1.11  2002-07-11 14:41:34  florian
+    * start of the new generic parameter handling
+
+  Revision 1.10  2002/07/11 07:42:31  jonas
     * fixed nppccnv and enabled it
     - removed PPC specific second_int_to_int and use the generic one instead
 

+ 351 - 0
compiler/powerpc/rappcdir.pas

@@ -0,0 +1,351 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Reads inline assembler and writes the lines direct to the output
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit Ra386dir;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node;
+
+     function assemble : tnode;
+
+  implementation
+
+    uses
+       { common }
+       cutils,
+       { global }
+       globals,verbose,
+       systems,
+       { aasm }
+       aasmbase,aasmtai,aasmcpu,
+       { symtable }
+       symconst,symbase,symtype,symsym,symtable,types,
+       { pass 1 }
+       nbas,
+       { parser }
+       scanner,
+       ra386,
+       { codegen }
+       cgbase,
+       { constants }
+       ag386att
+       ;
+
+    function assemble : tnode;
+
+      var
+         retstr,s,hs : string;
+         c : char;
+         ende : boolean;
+         srsym,sym : tsym;
+         srsymtable : tsymtable;
+         code : TAAsmoutput;
+         i,l : longint;
+
+       procedure writeasmline;
+         var
+           i : longint;
+         begin
+           i:=length(s);
+           while (i>0) and (s[i] in [' ',#9]) do
+            dec(i);
+           s[0]:=chr(i);
+           if s<>'' then
+            code.concat(Tai_direct.Create(strpnew(s)));
+            { consider it set function set if the offset was loaded }
+           if assigned(aktprocdef.funcretsym) and
+              (pos(retstr,upper(s))>0) then
+             tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+           s:='';
+         end;
+
+     begin
+       ende:=false;
+       s:='';
+       if assigned(aktprocdef.funcretsym) and
+          is_fpu(aktprocdef.rettype.def) then
+         tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+       if (not is_void(aktprocdef.rettype.def)) then
+         retstr:=upper(tostr(procinfo^.return_offset)+'('+gas_reg2str[procinfo^.framepointer]+')')
+       else
+         retstr:='';
+         c:=current_scanner.asmgetchar;
+         code:=TAAsmoutput.Create;
+         while not(ende) do
+           begin
+              { wrong placement
+              current_scanner.gettokenpos; }
+              case c of
+                 'A'..'Z','a'..'z','_' : begin
+                      current_scanner.gettokenpos;
+                      i:=0;
+                      hs:='';
+                      while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
+                         or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
+                         or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
+                         or (c='_') do
+                        begin
+                           inc(i);
+                           hs[i]:=c;
+                           c:=current_scanner.asmgetchar;
+                        end;
+                      hs[0]:=chr(i);
+                      if upper(hs)='END' then
+                         ende:=true
+                      else
+                         begin
+                            if c=':' then
+                              begin
+                                searchsym(upper(hs),srsym,srsymtable);
+                                if srsym<>nil then
+                                  if (srsym.typ = labelsym) then
+                                    Begin
+                                       hs:=tlabelsym(srsym).lab.name;
+                                       tlabelsym(srsym).lab.is_set:=true;
+                                    end
+                                  else
+                                    Message(asmr_w_using_defined_as_local);
+                              end
+                            else if upper(hs)='FWAIT' then
+                             FwaitWarning
+                            else
+                            { access to local variables }
+                            if assigned(aktprocdef) then
+                              begin
+                                 { is the last written character an special }
+                                 { char ?                                   }
+                                 if (s[length(s)]='%') and
+                                    ret_in_acc(aktprocdef.rettype.def) and
+                                    ((pos('AX',upper(hs))>0) or
+                                    (pos('AL',upper(hs))>0)) then
+                                   tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+                                 if (s[length(s)]<>'%') and
+                                   (s[length(s)]<>'$') and
+                                   ((s[length(s)]<>'0') or (hs[1]<>'x')) then
+                                   begin
+                                      if assigned(aktprocdef.localst) and
+                                         (lexlevel >= normal_function_level) then
+                                        sym:=tsym(aktprocdef.localst.search(upper(hs)))
+                                      else
+                                        sym:=nil;
+                                      if assigned(sym) then
+                                        begin
+                                           if (sym.typ = labelsym) then
+                                             Begin
+                                                hs:=tlabelsym(sym).lab.name;
+                                             end
+                                           else if sym.typ=varsym then
+                                             begin
+                                             {variables set are after a comma }
+                                             {like in movl %eax,I }
+                                             if pos(',',s) > 0 then
+                                               tvarsym(sym).varstate:=vs_used
+                                             else
+                                             if (pos('MOV',upper(s)) > 0) and (tvarsym(sym).varstate=vs_declared) then
+                                              Message1(sym_n_uninitialized_local_variable,hs);
+                                             if (vo_is_external in tvarsym(sym).varoptions) then
+                                               hs:=tvarsym(sym).mangledname
+                                             else
+                                               hs:='-'+tostr(tvarsym(sym).address)+
+                                                   '('+gas_reg2str[procinfo^.framepointer]+')';
+                                             end
+                                           else
+                                           { call to local function }
+                                           if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or
+                                              (pos('LEA',upper(s))>0)) then
+                                             begin
+                                                hs:=tprocsym(sym).defs^.def.mangledname;
+                                             end;
+                                        end
+                                      else
+                                        begin
+                                           if assigned(aktprocdef.parast) then
+                                             sym:=tsym(aktprocdef.parast.search(upper(hs)))
+                                           else
+                                             sym:=nil;
+                                           if assigned(sym) then
+                                             begin
+                                                if sym.typ=varsym then
+                                                  begin
+                                                     l:=tvarsym(sym).address;
+                                                     { set offset }
+                                                     inc(l,aktprocdef.parast.address_fixup);
+                                                     hs:=tostr(l)+'('+gas_reg2str[procinfo^.framepointer]+')';
+                                                     if pos(',',s) > 0 then
+                                                       tvarsym(sym).varstate:=vs_used;
+                                                  end;
+                                             end
+                                      { I added that but it creates a problem in line.ppi
+                                      because there is a local label wbuffer and
+                                      a static variable WBUFFER ...
+                                      what would you decide, florian ?}
+                                      else
+
+                                        begin
+                                           searchsym(upper(hs),sym,srsymtable);
+                                           if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
+                                             begin
+                                               case sym.typ of
+                                                 varsym :
+                                                   begin
+                                                     Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
+                                                     hs:=tvarsym(sym).mangledname;
+                                                     inc(tvarsym(sym).refs);
+                                                   end;
+                                                 typedconstsym :
+                                                   begin
+                                                     Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
+                                                     hs:=ttypedconstsym(sym).mangledname;
+                                                   end;
+                                                 procsym :
+                                                   begin
+                                                     { procs can be called or the address can be loaded }
+                                                     if ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
+                                                      begin
+                                                        if assigned(tprocsym(sym).defs^.def) then
+                                                          Message1(asmr_w_direct_global_is_overloaded_func,hs);
+                                                        Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).defs^.def.mangledname);
+                                                        hs:=tprocsym(sym).defs^.def.mangledname;
+                                                      end;
+                                                   end;
+                                                 else
+                                                   Message(asmr_e_wrong_sym_type);
+                                               end;
+                                             end
+                                           else if upper(hs)='__SELF' then
+                                             begin
+                                                if assigned(procinfo^._class) then
+                                                  hs:=tostr(procinfo^.selfpointer_offset)+
+                                                      '('+gas_reg2str[procinfo^.framepointer]+')'
+                                                else
+                                                 Message(asmr_e_cannot_use_SELF_outside_a_method);
+                                             end
+                                           else if upper(hs)='__RESULT' then
+                                             begin
+                                                if (not is_void(aktprocdef.rettype.def)) then
+                                                  hs:=retstr
+                                                else
+                                                  Message(asmr_e_void_function);
+                                             end
+                                           else if upper(hs)='__OLDEBP' then
+                                             begin
+                                                { complicate to check there }
+                                                { we do it: }
+                                                if lexlevel>normal_function_level then
+                                                  hs:=tostr(procinfo^.framepointer_offset)+
+                                                    '('+gas_reg2str[procinfo^.framepointer]+')'
+                                                else
+                                                  Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
+                                             end;
+                                           end;
+                                        end;
+                                   end;
+                              end;
+                            s:=s+hs;
+                         end;
+                   end;
+ '{',';',#10,#13 : begin
+                      if pos(retstr,s) > 0 then
+                        tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+                     writeasmline;
+                     c:=current_scanner.asmgetchar;
+                   end;
+             #26 : Message(scan_f_end_of_file);
+             else
+               begin
+                 current_scanner.gettokenpos;
+                 inc(byte(s[0]));
+                 s[length(s)]:=c;
+                 c:=current_scanner.asmgetchar;
+               end;
+           end;
+         end;
+       writeasmline;
+       assemble:=casmnode.create(code);
+     end;
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+const
+  asmmode_i386_direct_info : tasmmodeinfo =
+          (
+            id    : asmmode_i386_direct;
+            idtxt : 'DIRECT'
+          );
+
+initialization
+  RegisterAsmMode(asmmode_i386_direct_info);
+
+end.
+{
+  $Log$
+  Revision 1.1  2002-07-11 14:41:34  florian
+    * start of the new generic parameter handling
+
+  Revision 1.19  2002/07/01 18:46:34  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.18  2002/05/18 13:34:26  peter
+    * readded missing revisions
+
+  Revision 1.17  2002/05/16 19:46:52  carl
+  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+  + try to fix temp allocation (still in ifdef)
+  + generic constructor calls
+  + start of tassembler / tmodulebase class cleanup
+
+  Revision 1.15  2002/05/12 16:53:18  peter
+    * moved entry and exitcode to ncgutil and cgobj
+    * foreach gets extra argument for passing local data to the
+      iterator function
+    * -CR checks also class typecasts at runtime by changing them
+      into as
+    * fixed compiler to cycle with the -CR option
+    * fixed stabs with elf writer, finally the global variables can
+      be watched
+    * removed a lot of routines from cga unit and replaced them by
+      calls to cgobj
+    * u32bit-s32bit updates for and,or,xor nodes. When one element is
+      u32bit then the other is typecasted also to u32bit without giving
+      a rangecheck warning/error.
+    * fixed pascal calling method with reversing also the high tree in
+      the parast, detected by tcalcst3 test
+
+  Revision 1.14  2002/04/15 19:12:09  carl
+  + target_info.size_of_pointer -> pointer_size
+  + some cleanup of unused types/variables
+  * move several constants from cpubase to their specific units
+    (where they are used)
+  + att_Reg2str -> gas_reg2str
+  + int_reg2str -> std_reg2str
+
+  Revision 1.13  2002/04/14 17:01:52  carl
+  + att_reg2str -> gas_reg2str
+
+}

+ 9 - 6
compiler/pstatmnt.pas

@@ -46,7 +46,7 @@ implementation
        { aasm }
        cpubase,aasmbase,aasmtai,aasmcpu,
        { symtable }
-       symconst,symbase,symtype,symdef,symsym,symtable,types,
+       symconst,symbase,symtype,symdef,symsym,symtable,types,paramgr,
        { pass 1 }
        pass_1,htypechk,
        nbas,nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
@@ -1208,7 +1208,7 @@ implementation
               if not haslocals then
                symtablestack.datasize:=0;
               { set the used flag for the return }
-              if ret_in_acc(aktprocdef.rettype.def) then
+              if paramanager.ret_in_acc(aktprocdef.rettype.def) then
                  include(rg.usedinproc,accumulator);
             end;
          { force the asm statement }
@@ -1232,7 +1232,7 @@ implementation
             (aktprocdef.owner.symtabletype<>objectsymtable) and
             (not assigned(aktprocdef.funcretsym) or
              (tfuncretsym(aktprocdef.funcretsym).refcount<=1)) and
-            not(ret_in_param(aktprocdef.rettype.def)) and
+            not(paramanager.ret_in_param(aktprocdef.rettype.def)) and
             (target_cpu in [cpu_i386,cpu_m68k,cpu_vm])
 {$ifdef CHECKFORPUSH}
             and not(UsesPush(tasmnode(p)))
@@ -1244,7 +1244,7 @@ implementation
           accumulator or on the fpu stack }
         if assigned(aktprocdef.funcretsym) and
            (is_fpu(aktprocdef.rettype.def) or
-           ret_in_acc(aktprocdef.rettype.def)) then
+           paramanager.ret_in_acc(aktprocdef.rettype.def)) then
           tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
 
         { because the END is already read we need to get the
@@ -1257,7 +1257,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.60  2002-07-04 20:43:01  florian
+  Revision 1.61  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.60  2002/07/04 20:43:01  florian
     * first x86-64 patches
 
   Revision 1.59  2002/07/01 18:46:25  peter
@@ -1333,4 +1336,4 @@ end.
    * implicit result variable generation for assembler routines
    * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
 
-}
+}

+ 8 - 5
compiler/psub.pas

@@ -46,7 +46,7 @@ implementation
        { aasm }
        cpubase,cpuinfo,aasmbase,aasmtai,
        { symtable }
-       symconst,symbase,symdef,symsym,symtype,symtable,types,
+       symconst,symbase,symdef,symsym,symtype,symtable,types,paramgr,
        ppu,fmodule,
        { pass 1 }
        node,
@@ -103,7 +103,7 @@ implementation
               { insert in local symtable }
               symtablestack.insert(aktprocdef.funcretsym);
               akttokenpos:=storepos;
-              if ret_in_acc(aktprocdef.rettype.def) or
+              if paramanager.ret_in_acc(aktprocdef.rettype.def) or
                  (aktprocdef.rettype.def.deftype=floatdef) then
                 procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
               { insert result also if support is on }
@@ -127,7 +127,7 @@ implementation
          { because we don't know yet where the address is }
          if not is_void(aktprocdef.rettype.def) then
            begin
-              if ret_in_acc(aktprocdef.rettype.def) or (aktprocdef.rettype.def.deftype=floatdef) then
+              if paramanager.ret_in_acc(aktprocdef.rettype.def) or (aktprocdef.rettype.def.deftype=floatdef) then
                 begin
                    { the space has been set in the local symtable }
                    procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
@@ -641,7 +641,7 @@ implementation
 {$endif i386}
 
          { pointer to the return value ? }
-         if ret_in_param(aktprocdef.rettype.def) then
+         if paramanager.ret_in_param(aktprocdef.rettype.def) then
           begin
             procinfo^.return_offset:=procinfo^.para_offset;
             inc(procinfo^.para_offset,pointer_size);
@@ -816,7 +816,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.56  2002-07-07 09:52:32  florian
+  Revision 1.57  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.56  2002/07/07 09:52:32  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 8 - 5
compiler/rautils.pas

@@ -217,7 +217,7 @@ uses
   strings,
 {$endif}
   types,systems,verbose,globals,
-  symsym,symtable,
+  symsym,symtable,paramgr,
   aasmcpu,
   cpuinfo,cgbase;
 
@@ -736,7 +736,7 @@ Begin
   if (not is_void(aktprocdef.rettype.def)) then
    begin
      if (m_tp7 in aktmodeswitches) and
-        ret_in_acc(aktprocdef.rettype.def) then
+        paramanager.ret_in_acc(aktprocdef.rettype.def) then
        begin
          Message(asmr_e_cannot_use_RESULT_here);
          exit;
@@ -874,7 +874,7 @@ Begin
                 end;
               if (tvarsym(sym).varspez=vs_var) or
                  ((tvarsym(sym).varspez=vs_const) and
-                 push_addr_param(tvarsym(sym).vartype.def)) then
+                 paramanager.push_addr_param(tvarsym(sym).vartype.def)) then
                 SetSize(pointer_size,false);
             end;
           localsymtable :
@@ -914,7 +914,7 @@ Begin
                 end;
               if (tvarsym(sym).varspez in [vs_var,vs_out]) or
                  ((tvarsym(sym).varspez=vs_const) and
-                  push_addr_param(tvarsym(sym).vartype.def)) then
+                  paramanager.push_addr_param(tvarsym(sym).vartype.def)) then
                 SetSize(pointer_size,false);
             end;
         end;
@@ -1592,7 +1592,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.36  2002-07-01 18:46:25  peter
+  Revision 1.37  2002-07-11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.36  2002/07/01 18:46:25  peter
     * internal linker
     * reorganized aasm layer
 

+ 7 - 4
compiler/regvars.pas

@@ -48,7 +48,7 @@ implementation
     uses
       globtype,systems,comphook,
       cutils,cclasses,verbose,globals,
-      symconst,symbase,symtype,symdef,types,
+      symconst,symbase,symtype,symdef,paramgr,types,
       cgbase,cgobj,cgcpu,rgcpu;
 
 
@@ -178,7 +178,7 @@ implementation
                       { call by reference/const ? }
                       if (regvarinfo^.regvars[i].varspez in [vs_var,vs_out]) or
                          ((regvarinfo^.regvars[i].varspez=vs_const) and
-                           push_addr_param(regvarinfo^.regvars[i].vartype.def)) then
+                           paramanager.push_addr_param(regvarinfo^.regvars[i].vartype.def)) then
                         begin
                            regvarinfo^.regvars[i].reg:=varregs[i];
                         end
@@ -311,7 +311,7 @@ implementation
           hr.base:=procinfo^.framepointer;
           if (vsym.varspez in [vs_var,vs_out]) or
              ((vsym.varspez=vs_const) and
-               push_addr_param(vsym.vartype.def)) then
+               paramanager.push_addr_param(vsym.vartype.def)) then
             opsize := OS_ADDR
           else
             opsize := def_cgsize(vsym.vartype.def);
@@ -464,7 +464,10 @@ end.
 
 {
   $Log$
-  Revision 1.35  2002-07-01 18:46:25  peter
+  Revision 1.36  2002-07-11 14:41:30  florian
+    * start of the new generic parameter handling
+
+  Revision 1.35  2002/07/01 18:46:25  peter
     * internal linker
     * reorganized aasm layer
 

+ 6 - 3
compiler/symdef.pas

@@ -722,7 +722,7 @@ implementation
        { target }
        systems,
        { symtable }
-       symsym,symtable,
+       symsym,symtable,paramgr,
        types,
        { module }
 {$ifdef GDB}
@@ -3213,7 +3213,7 @@ implementation
               vs_out,
               vs_var   : inc(l,POINTER_SIZE);
               vs_value,
-              vs_const : if push_addr_param(pdc.paratype.def) then
+              vs_const : if paramanager.push_addr_param(pdc.paratype.def) then
                           inc(l,POINTER_SIZE)
                          else
                           inc(l,pdc.paratype.def.size);
@@ -5482,7 +5482,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.82  2002-07-07 09:52:32  florian
+  Revision 1.83  2002-07-11 14:41:30  florian
+    * start of the new generic parameter handling
+
+  Revision 1.82  2002/07/07 09:52:32  florian
     * powerpc target fixed, very simple units can be compiled
     * some basic stuff for better callparanode handling, far from being finished
 

+ 8 - 5
compiler/symsym.pas

@@ -366,7 +366,7 @@ implementation
        { module }
        fmodule,
        { codegen }
-       cgbase,cresstr
+       paramgr,cgbase,cresstr
        ;
 
 {****************************************************************************
@@ -1153,7 +1153,7 @@ implementation
         else
          begin
            { allocate space in local if ret in acc or in fpu }
-           if ret_in_acc(returntype.def) or
+           if paramanager.ret_in_acc(returntype.def) or
               (returntype.def.deftype=floatdef) then
             begin
               l:=returntype.def.size;
@@ -1432,7 +1432,7 @@ implementation
                 vs_value,
                 vs_const :
                   begin
-                      if push_addr_param(vartype.def) then
+                      if paramanager.push_addr_param(vartype.def) then
                         getpushsize:=pointer_size
                       else
                         getpushsize:=vartype.def.size;
@@ -1645,7 +1645,7 @@ implementation
                vs_out,
                vs_var   : st := 'v'+st;
                vs_value,
-               vs_const : if push_addr_param(vartype.def) then
+               vs_const : if paramanager.push_addr_param(vartype.def) then
                             st := 'v'+st { should be 'i' but 'i' doesn't work }
                           else
                             st := 'p'+st;
@@ -2517,7 +2517,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.41  2002-07-10 07:24:40  jonas
+  Revision 1.42  2002-07-11 14:41:31  florian
+    * start of the new generic parameter handling
+
+  Revision 1.41  2002/07/10 07:24:40  jonas
     * memory leak fixes from Sergey Korshunoff
 
   Revision 1.40  2002/07/01 18:46:27  peter

+ 4 - 75
compiler/types.pas

@@ -154,21 +154,9 @@ interface
     {# Returns true, if def is a currency type }
     function is_currency(def : tdef) : boolean;
 
-    {# Returns true if the return value can be put in accumulator }
-    function ret_in_acc(def : tdef) : boolean;
-
-    {# Returns true if uses a parameter as return value (???) }
-    function ret_in_param(def : tdef) : boolean;
-
     {# Returns true, if def is a 64 bit integer type }
     function is_64bitint(def : tdef) : boolean;
 
-    function push_high_param(def : tdef) : boolean;
-
-    {# Returns true if a parameter is too large to copy and only the address is pushed
-    }
-    function push_addr_param(def : tdef) : boolean;
-
     {# Returns true, if def1 and def2 are semantically the same }
     function is_equal(def1,def2 : tdef) : boolean;
 
@@ -838,17 +826,6 @@ implementation
       end;
 
 
-    { true if the return value is in accumulator (EAX for i386), D0 for 68k }
-    function ret_in_acc(def : tdef) : boolean;
-      begin
-         ret_in_acc:=(def.deftype in [orddef,pointerdef,enumdef,classrefdef]) or
-                     ((def.deftype=stringdef) and (tstringdef(def).string_typ in [st_ansistring,st_widestring])) or
-                     ((def.deftype=procvardef) and not(po_methodpointer in tprocvardef(def).procoptions)) or
-                     ((def.deftype=objectdef) and not is_object(def)) or
-                     ((def.deftype=setdef) and (tsetdef(def).settype=smallset));
-      end;
-
-
     { true, if def is a 64 bit int type }
     function is_64bitint(def : tdef) : boolean;
       begin
@@ -856,57 +833,6 @@ implementation
       end;
 
 
-    { true if uses a parameter as return value }
-    function ret_in_param(def : tdef) : boolean;
-      begin
-         ret_in_param:=(def.deftype in [arraydef,recorddef]) or
-           ((def.deftype=stringdef) and (tstringdef(def).string_typ in [st_shortstring,st_longstring])) or
-           ((def.deftype=procvardef) and (po_methodpointer in tprocvardef(def).procoptions)) or
-           ((def.deftype=objectdef) and is_object(def)) or
-           (def.deftype=variantdef) or
-           ((def.deftype=setdef) and (tsetdef(def).settype<>smallset));
-      end;
-
-
-    function push_high_param(def : tdef) : boolean;
-      begin
-         push_high_param:=is_open_array(def) or
-                          is_open_string(def) or
-                          is_array_of_const(def);
-      end;
-
-
-    { true if a parameter is too large to copy and only the address is pushed }
-    function push_addr_param(def : tdef) : boolean;
-      begin
-        push_addr_param:=false;
-        if never_copy_const_param then
-         push_addr_param:=true
-        else
-         begin
-           case def.deftype of
-             variantdef,
-             formaldef :
-               push_addr_param:=true;
-             recorddef :
-               push_addr_param:=(def.size>pointer_size);
-             arraydef :
-               push_addr_param:=((tarraydef(def).highrange>=tarraydef(def).lowrange) and (def.size>pointer_size)) or
-                                is_open_array(def) or
-                                is_array_of_const(def) or
-                                is_array_constructor(def);
-             objectdef :
-               push_addr_param:=is_object(def);
-             stringdef :
-               push_addr_param:=tstringdef(def).string_typ in [st_shortstring,st_longstring];
-             procvardef :
-               push_addr_param:=(po_methodpointer in tprocvardef(def).procoptions);
-             setdef :
-               push_addr_param:=(tsetdef(def).settype<>smallset);
-           end;
-         end;
-      end;
-
     { if l isn't in the range of def a range check error (if not explicit) is generated and
       the value is placed within the range }
     procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
@@ -1980,7 +1906,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.74  2002-07-01 16:23:54  peter
+  Revision 1.75  2002-07-11 14:41:32  florian
+    * start of the new generic parameter handling
+
+  Revision 1.74  2002/07/01 16:23:54  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)