* paraloc branch merged

compiler/cg64f32.pas

@@ -33,8 +33,8 @@ unit cg64f32;
 
     uses
        aasmbase,aasmtai,aasmcpu,
-       cpuinfo, cpubase,cpupara,
-       cgbase, cgobj,
+       cpuinfo,cpubase,cpupara,
+       cgbase,cgobj,parabase,
        node,symtype
 {$ifdef delphi}
        ,dmisc
@@ -46,8 +46,6 @@ unit cg64f32;
          to handle 64-bit integers.
       }
       tcg64f32 = class(tcg64)
-        procedure a_reg_alloc(list : taasmoutput;r : tregister64);override;
-        procedure a_reg_dealloc(list : taasmoutput;r : tregister64);override;
         procedure a_load64_const_ref(list : taasmoutput;value : int64;const ref : treference);override;
         procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
         procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);override;
@@ -72,10 +70,10 @@ unit cg64f32;
         procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);override;
         procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : int64;const ref : treference);override;
 
-        procedure a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);override;
-        procedure a_param64_const(list : taasmoutput;value : int64;const locpara : tparalocation);override;
-        procedure a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
-        procedure a_param64_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);override;
+        procedure a_param64_reg(list : taasmoutput;reg : tregister64;const paraloc : tcgpara);override;
+        procedure a_param64_const(list : taasmoutput;value : int64;const paraloc : tcgpara);override;
+        procedure a_param64_ref(list : taasmoutput;const r : treference;const paraloc : tcgpara);override;
+        procedure a_param64_loc(list : taasmoutput;const l : tlocation;const paraloc : tcgpara);override;
 
         {# This routine tries to optimize the a_op64_const_reg operation, by
            removing superfluous opcodes. Returns TRUE if normal processing
@@ -93,9 +91,9 @@ unit cg64f32;
   implementation
 
     uses
-       globtype,globals,systems,
+       globtype,systems,
        verbose,
-       symbase,symconst,symdef,defutil,tgobj,paramgr;
+       symbase,symconst,symdef,defutil,paramgr;
 
 {****************************************************************************
                                      Helpers
@@ -114,23 +112,67 @@ unit cg64f32;
       end;
 
 
-{****************************************************************************
-                                   TCG64F32
-****************************************************************************}
-
-    procedure tcg64f32.a_reg_alloc(list : taasmoutput;r : tregister64);
+    procedure splitparaloc64(const cgpara:tcgpara;var cgparalo,cgparahi:tcgpara);
+      var
+        paraloclo,
+        paralochi : pcgparalocation;
       begin
-         list.concat(tai_regalloc.alloc(r.reglo));
-         list.concat(tai_regalloc.alloc(r.reghi));
+        if not(cgpara.size in [OS_64,OS_S64]) then
+          internalerror(200408231);
+        if not assigned(cgpara.location) then
+          internalerror(200408201);
+        { init lo/hi para }
+        cgparahi.reset;
+        if cgpara.size=OS_S64 then
+          cgparahi.size:=OS_S32
+        else
+          cgparahi.size:=OS_32;
+        cgparahi.alignment:=cgpara.alignment;
+        paralochi:=cgparahi.add_location;
+        cgparalo.reset;
+        cgparalo.size:=OS_32;
+        cgparalo.alignment:=cgpara.alignment;
+        paraloclo:=cgparalo.add_location;
+        { 2 parameter fields? }
+        if assigned(cgpara.location^.next) then
+          begin
+            if target_info.endian = endian_big then
+              begin
+                { low is in second location }
+                move(cgpara.location^.next^,paraloclo^,sizeof(paraloclo^));
+                move(cgpara.location^,paralochi^,sizeof(paralochi^));
+              end
+            else
+              begin
+                { low is in first location }
+                move(cgpara.location^,paraloclo^,sizeof(paraloclo^));
+                move(cgpara.location^.next^,paralochi^,sizeof(paralochi^));
+              end;
+          end
+        else
+          begin
+            { single parameter, this can only be in memory }
+            if cgpara.location^.loc<>LOC_REFERENCE then
+              internalerror(200408282);
+            move(cgpara.location^,paraloclo^,sizeof(paraloclo^));
+            move(cgpara.location^,paralochi^,sizeof(paralochi^));
+            { for big endian low is at +4, for little endian high }
+            if target_info.endian = endian_big then
+              inc(cgparalo.location^.reference.offset,tcgsize2size[cgparahi.size])
+            else
+              inc(cgparahi.location^.reference.offset,tcgsize2size[cgparalo.size]);
+          end;
+        { fix size }
+        paraloclo^.size:=cgparalo.size;
+        paraloclo^.next:=nil;
+        paralochi^.size:=cgparahi.size;
+        paralochi^.next:=nil;
       end;
 
 
-    procedure tcg64f32.a_reg_dealloc(list : taasmoutput;r : tregister64);
-      begin
-         list.concat(tai_regalloc.dealloc(r.reglo));
-         list.concat(tai_regalloc.dealloc(r.reghi));
-      end;
-
+{****************************************************************************
+                                   TCG64F32
+****************************************************************************}
 
     procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);
       var
@@ -450,32 +492,42 @@ unit cg64f32;
       end;
 
 
-    procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);
+    procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;const paraloc : tcgpara);
       var
-        tmplochi,tmploclo: tparalocation;
+        tmplochi,tmploclo: tcgpara;
       begin
-        paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
+        tmploclo.init;
+        tmplochi.init;
+        splitparaloc64(paraloc,tmploclo,tmplochi);
         cg.a_param_reg(list,OS_32,reg.reghi,tmplochi);
         cg.a_param_reg(list,OS_32,reg.reglo,tmploclo);
+        tmploclo.done;
+        tmplochi.done;
       end;
 
 
-    procedure tcg64f32.a_param64_const(list : taasmoutput;value : int64;const locpara : tparalocation);
+    procedure tcg64f32.a_param64_const(list : taasmoutput;value : int64;const paraloc : tcgpara);
       var
-        tmplochi,tmploclo: tparalocation;
+        tmplochi,tmploclo: tcgpara;
       begin
-        paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
+        tmploclo.init;
+        tmplochi.init;
+        splitparaloc64(paraloc,tmploclo,tmplochi);
         cg.a_param_const(list,OS_32,aint(hi(value)),tmplochi);
         cg.a_param_const(list,OS_32,aint(lo(value)),tmploclo);
+        tmploclo.done;
+        tmplochi.done;
       end;
 
 
-    procedure tcg64f32.a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
+    procedure tcg64f32.a_param64_ref(list : taasmoutput;const r : treference;const paraloc : tcgpara);
       var
         tmprefhi,tmpreflo : treference;
-        tmploclo,tmplochi : tparalocation;
+        tmploclo,tmplochi : tcgpara;
       begin
-        paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
+        tmploclo.init;
+        tmplochi.init;
+        splitparaloc64(paraloc,tmploclo,tmplochi);
         tmprefhi:=r;
         tmpreflo:=r;
         if target_info.endian=endian_big then
@@ -484,20 +536,22 @@ unit cg64f32;
           inc(tmprefhi.offset,4);
         cg.a_param_ref(list,OS_32,tmprefhi,tmplochi);
         cg.a_param_ref(list,OS_32,tmpreflo,tmploclo);
+        tmploclo.done;
+        tmplochi.done;
       end;
 
 
-    procedure tcg64f32.a_param64_loc(list : taasmoutput;const l:tlocation;const locpara : tparalocation);
+    procedure tcg64f32.a_param64_loc(list : taasmoutput;const l:tlocation;const paraloc : tcgpara);
       begin
         case l.loc of
           LOC_REGISTER,
           LOC_CREGISTER :
-            a_param64_reg(list,l.register64,locpara);
+            a_param64_reg(list,l.register64,paraloc);
           LOC_CONSTANT :
-            a_param64_const(list,l.value64,locpara);
+            a_param64_const(list,l.value64,paraloc);
           LOC_CREFERENCE,
           LOC_REFERENCE :
-            a_param64_ref(list,l.reference,locpara);
+            a_param64_ref(list,l.reference,paraloc);
           else
             internalerror(200203287);
         end;
@@ -753,7 +807,17 @@ unit cg64f32;
 end.
 {
   $Log$
-  Revision 1.61  2004-06-20 08:55:28  florian
+  Revision 1.62  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.61.4.2  2004/09/20 20:46:34  peter
+    * register allocation optimized for 64bit loading of parameters
+      and return values
+
+  Revision 1.61.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.61  2004/06/20 08:55:28  florian
     * logs truncated
 
   Revision 1.60  2004/06/18 15:16:46  peter

compiler/cgobj.pas

@@ -41,7 +41,7 @@ unit cgobj;
        dmisc,
 {$endif}
        cclasses,globtype,
-       cpubase,cpuinfo,cgbase,
+       cpubase,cpuinfo,cgbase,parabase,
        aasmbase,aasmtai,aasmcpu,
        symconst,symbase,symtype,symdef,symtable,rgobj
        ;
@@ -121,9 +121,9 @@ unit cgobj;
 
              @param(size size of the operand in the register)
              @param(r register source of the operand)
-             @param(locpara where the parameter will be stored)
+             @param(paraloc where the parameter will be stored)
           }
-          procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);virtual;
+          procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const paraloc : TCGPara);virtual;
           {# Pass a parameter, which is a constant, to a routine.
 
              A generic version is provided. This routine should
@@ -132,9 +132,9 @@ unit cgobj;
 
              @param(size size of the operand in constant)
              @param(a value of constant to send)
-             @param(locpara where the parameter will be stored)
+             @param(paraloc where the parameter will be stored)
           }
-          procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;const locpara : tparalocation);virtual;
+          procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;const paraloc : TCGPara);virtual;
           {# Pass the value of a parameter, which is located in memory, to a routine.
 
              A generic version is provided. This routine should
@@ -143,9 +143,9 @@ unit cgobj;
 
              @param(size size of the operand in constant)
              @param(r Memory reference of value to send)
-             @param(locpara where the parameter will be stored)
+             @param(paraloc where the parameter will be stored)
           }
-          procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);virtual;
+          procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const paraloc : TCGPara);virtual;
           {# Pass the value of a parameter, which can be located either in a register or memory location,
              to a routine.
 
@@ -153,9 +153,9 @@ unit cgobj;
 
              @param(l location of the operand to send)
              @param(nr parameter number (starting from one) of routine (from left to right))
-             @param(locpara where the parameter will be stored)
+             @param(paraloc where the parameter will be stored)
           }
-          procedure a_param_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);
+          procedure a_param_loc(list : taasmoutput;const l : tlocation;const paraloc : TCGPara);
           {# Pass the address of a reference to a routine. This routine
              will calculate the address of the reference, and pass this
              calculated address as a parameter.
@@ -167,10 +167,10 @@ unit cgobj;
              @param(r reference to get address from)
              @param(nr parameter number (starting from one) of routine (from left to right))
           }
-          procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);virtual;
+          procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const paraloc : TCGPara);virtual;
 
-          { Copies a whole memory block to the stack, the locpara must be a memory location }
-          procedure a_param_copy_ref(list : taasmoutput;size : aint;const r : treference;const locpara : tparalocation);
+          { Copies a whole memory block to the stack, the paraloc must be a memory location }
+          procedure a_param_copy_ref(list : taasmoutput;size : aint;const r : treference;const paraloc : TCGPara);
           { Remarks:
             * If a method specifies a size you have only to take care
               of that number of bits, i.e. load_const_reg with OP_8 must
@@ -189,9 +189,9 @@ unit cgobj;
           }
 
           { Copy a parameter to a (temporary) reference }
-          procedure a_loadany_param_ref(list : taasmoutput;const locpara : tparalocation;const ref:treference;shuffle : pmmshuffle);virtual;
+          procedure a_loadany_param_ref(list : taasmoutput;const paraloc : TCGPara;const ref:treference;shuffle : pmmshuffle);virtual;
           { Copy a parameter to a register }
-          procedure a_loadany_param_reg(list : taasmoutput;const locpara : tparalocation;const reg:tregister;shuffle : pmmshuffle);virtual;
+          procedure a_loadany_param_reg(list : taasmoutput;const paraloc : TCGPara;const reg:tregister;shuffle : pmmshuffle);virtual;
 
           {# Emits instruction to call the method specified by symbol name.
              This routine must be overriden for each new target cpu.
@@ -222,8 +222,8 @@ unit cgobj;
           procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); virtual; abstract;
           procedure a_loadfpu_loc_reg(list: taasmoutput; const loc: tlocation; const reg: tregister);
           procedure a_loadfpu_reg_loc(list: taasmoutput; size: tcgsize; const reg: tregister; const loc: tlocation);
-          procedure a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const locpara : tparalocation);virtual;
-          procedure a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const locpara : tparalocation);virtual;
+          procedure a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const paraloc : TCGPara);virtual;
+          procedure a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const paraloc : TCGPara);virtual;
 
           { vector register move instructions }
           procedure a_loadmm_reg_reg(list: taasmoutput; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); virtual; abstract;
@@ -231,9 +231,9 @@ unit cgobj;
           procedure a_loadmm_reg_ref(list: taasmoutput; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); virtual; abstract;
           procedure a_loadmm_loc_reg(list: taasmoutput; size: tcgsize; const loc: tlocation; const reg: tregister;shuffle : pmmshuffle);
           procedure a_loadmm_reg_loc(list: taasmoutput; size: tcgsize; const reg: tregister; const loc: tlocation;shuffle : pmmshuffle);
-          procedure a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : tparalocation;shuffle : pmmshuffle); virtual;
-          procedure a_parammm_ref(list: taasmoutput; size: tcgsize; const ref: treference;const locpara : tparalocation;shuffle : pmmshuffle); virtual;
-          procedure a_parammm_loc(list: taasmoutput; const loc: tlocation; const locpara : tparalocation;shuffle : pmmshuffle); virtual;
+          procedure a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const paraloc : TCGPara;shuffle : pmmshuffle); virtual;
+          procedure a_parammm_ref(list: taasmoutput; size: tcgsize; const ref: treference;const paraloc : TCGPara;shuffle : pmmshuffle); virtual;
+          procedure a_parammm_loc(list: taasmoutput; const loc: tlocation; const paraloc : TCGPara;shuffle : pmmshuffle); virtual;
           procedure a_opmm_reg_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle); virtual;abstract;
           procedure a_opmm_ref_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual;
           procedure a_opmm_loc_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const loc: tlocation; reg: tregister;shuffle : pmmshuffle); virtual;
@@ -344,6 +344,20 @@ unit cgobj;
 
           }
           procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint;delsource,loadref : boolean);virtual; abstract;
+          {# This should emit the opcode to copy len bytes from the an unaligned source
+             to destination, if loadref is true, it assumes that it first must load
+             the source address from the memory location where
+             source points to.
+
+             It must be overriden for each new target processor.
+
+             @param(source Source reference of copy)
+             @param(dest Destination reference of copy)
+             @param(delsource Indicates if the source reference's resources should be freed)
+             @param(loadref Is the source reference a pointer to the actual source (TRUE), is it the actual source address (FALSE))
+
+          }
+          procedure g_concatcopy_unaligned(list : taasmoutput;const source,dest : treference;len : aint;delsource,loadref : boolean);virtual;
           {# This should emit the opcode to a shortrstring from the source
              to destination, if loadref is true, it assumes that it first must load
              the source address from the memory location where
@@ -420,7 +434,7 @@ unit cgobj;
           }
           procedure g_restore_standard_registers(list:Taasmoutput);virtual;abstract;
           procedure g_save_all_registers(list : taasmoutput);virtual;abstract;
-          procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);virtual;abstract;
+          procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:TCGPara);virtual;abstract;
        end;
 
 {$ifndef cpu64bit}
@@ -429,10 +443,6 @@ unit cgobj;
        for 64 Bit operations.
     }
     tcg64 = class
-        { Allocates 64 Bit register r by inserting a pai_realloc record }
-        procedure a_reg_alloc(list : taasmoutput;r : tregister64);virtual;abstract;
-        { Deallocates 64 Bit register r by inserting a pa_regdealloc record}
-        procedure a_reg_dealloc(list : taasmoutput;r : tregister64);virtual;abstract;
         procedure a_load64_const_ref(list : taasmoutput;value : int64;const ref : treference);virtual;abstract;
         procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);virtual;abstract;
         procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);virtual;abstract;
@@ -461,10 +471,10 @@ unit cgobj;
         procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : int64;regsrc,regdst : tregister64);virtual;
         procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);virtual;
 
-        procedure a_param64_reg(list : taasmoutput;reg64 : tregister64;const loc : tparalocation);virtual;abstract;
-        procedure a_param64_const(list : taasmoutput;value : int64;const loc : tparalocation);virtual;abstract;
-        procedure a_param64_ref(list : taasmoutput;const r : treference;const loc : tparalocation);virtual;abstract;
-        procedure a_param64_loc(list : taasmoutput;const l : tlocation;const loc : tparalocation);virtual;abstract;
+        procedure a_param64_reg(list : taasmoutput;reg64 : tregister64;const loc : TCGPara);virtual;abstract;
+        procedure a_param64_const(list : taasmoutput;value : int64;const loc : TCGPara);virtual;abstract;
+        procedure a_param64_ref(list : taasmoutput;const r : treference;const loc : TCGPara);virtual;abstract;
+        procedure a_param64_loc(list : taasmoutput;const l : tlocation;const loc : TCGPara);virtual;abstract;
 
         {
              This routine tries to optimize the const_reg opcode, and should be
@@ -729,19 +739,18 @@ implementation
           for better code generation these methods should be overridden
 ******************************************************************************}
 
-    procedure tcg.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);
+    procedure tcg.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const paraloc : TCGPara);
       var
          ref : treference;
       begin
-         case locpara.loc of
+         paraloc.check_simple_location;
+         case paraloc.location^.loc of
             LOC_REGISTER,LOC_CREGISTER:
-              a_load_reg_reg(list,size,locpara.size,r,locpara.register);
+              a_load_reg_reg(list,size,paraloc.location^.size,r,paraloc.location^.register);
             LOC_REFERENCE,LOC_CREFERENCE:
               begin
-                 reference_reset(ref);
-                 ref.base:=locpara.reference.index;
-                 ref.offset:=locpara.reference.offset;
-                 a_load_reg_ref(list,size,locpara.size,r,ref);
+                 reference_reset_base(ref,paraloc.location^.reference.index,paraloc.location^.reference.offset);
+                 a_load_reg_ref(list,size,paraloc.location^.size,r,ref);
               end
             else
               internalerror(2002071004);
@@ -749,19 +758,18 @@ implementation
       end;
 
 
-    procedure tcg.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const locpara : tparalocation);
+    procedure tcg.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const paraloc : TCGPara);
       var
          ref : treference;
       begin
-         case locpara.loc of
+         paraloc.check_simple_location;
+         case paraloc.location^.loc of
             LOC_REGISTER,LOC_CREGISTER:
-              a_load_const_reg(list,locpara.size,a,locpara.register);
+              a_load_const_reg(list,paraloc.location^.size,a,paraloc.location^.register);
             LOC_REFERENCE,LOC_CREFERENCE:
               begin
-                 reference_reset(ref);
-                 ref.base:=locpara.reference.index;
-                 ref.offset:=locpara.reference.offset;
-                 a_load_const_ref(list,locpara.size,a,ref);
+                 reference_reset_base(ref,paraloc.location^.reference.index,paraloc.location^.reference.offset);
+                 a_load_const_ref(list,paraloc.location^.size,a,ref);
               end
             else
               internalerror(2002071004);
@@ -769,18 +777,19 @@ implementation
       end;
 
 
-    procedure tcg.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);
+    procedure tcg.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const paraloc : TCGPara);
       var
          ref : treference;
       begin
-         case locpara.loc of
+         paraloc.check_simple_location;
+         case paraloc.location^.loc of
             LOC_REGISTER,LOC_CREGISTER:
-              a_load_ref_reg(list,size,locpara.size,r,locpara.register);
+              a_load_ref_reg(list,size,paraloc.location^.size,r,paraloc.location^.register);
             LOC_REFERENCE,LOC_CREFERENCE:
               begin
                  reference_reset(ref);
-                 ref.base:=locpara.reference.index;
-                 ref.offset:=locpara.reference.offset;
+                 ref.base:=paraloc.location^.reference.index;
+                 ref.offset:=paraloc.location^.reference.offset;
                  { use concatcopy, because it can also be a float which fails when
                    load_ref_ref is used }
                  g_concatcopy(list,r,ref,tcgsize2size[size],false,false);
@@ -791,162 +800,149 @@ implementation
       end;
 
 
-    procedure tcg.a_param_loc(list : taasmoutput;const l:tlocation;const locpara : tparalocation);
+    procedure tcg.a_param_loc(list : taasmoutput;const l:tlocation;const paraloc : TCGPara);
       begin
         case l.loc of
           LOC_REGISTER,
           LOC_CREGISTER :
-            a_param_reg(list,l.size,l.register,locpara);
+            a_param_reg(list,l.size,l.register,paraloc);
           LOC_CONSTANT :
-            a_param_const(list,l.size,l.value,locpara);
+            a_param_const(list,l.size,l.value,paraloc);
           LOC_CREFERENCE,
           LOC_REFERENCE :
-            a_param_ref(list,l.size,l.reference,locpara);
-        else
-          internalerror(2002032211);
+            a_param_ref(list,l.size,l.reference,paraloc);
+          else
+            internalerror(2002032211);
         end;
       end;
 
 
-    procedure tcg.a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
+    procedure tcg.a_paramaddr_ref(list : taasmoutput;const r : treference;const paraloc : TCGPara);
       var
          hr : tregister;
       begin
          hr:=getaddressregister(list);
          a_loadaddr_ref_reg(list,r,hr);
          ungetregister(list,hr);
-         a_param_reg(list,OS_ADDR,hr,locpara);
+         a_param_reg(list,OS_ADDR,hr,paraloc);
       end;
 
 
-    procedure tcg.a_param_copy_ref(list : taasmoutput;size : aint;const r : treference;const locpara : tparalocation);
+    procedure tcg.a_param_copy_ref(list : taasmoutput;size : aint;const r : treference;const paraloc : TCGPara);
       var
         ref : treference;
       begin
-         if not(locpara.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+         paraloc.check_simple_location;
+         if not(paraloc.location^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
            internalerror(2003010901);
-         reference_reset_base(ref,locpara.reference.index,locpara.reference.offset);
+         reference_reset_base(ref,paraloc.location^.reference.index,paraloc.location^.reference.offset);
          g_concatcopy(list,r,ref,size,false,false);
       end;
 
 
-    procedure tcg.a_loadany_param_ref(list : taasmoutput;const locpara : tparalocation;const ref:treference;shuffle : pmmshuffle);
-      begin
-        case locpara.loc of
-          LOC_CREGISTER,
-          LOC_REGISTER:
-            begin
-{$ifndef cpu64bit}
-              if (locpara.size in [OS_S64,OS_64]) then
+    procedure tcg.a_loadany_param_ref(list : taasmoutput;const paraloc : TCGPara;const ref:treference;shuffle : pmmshuffle);
+
+       procedure gen_load(paraloc:TCGParaLocation;const ref:treference);
+         var
+           href : treference;
+         begin
+            case paraloc.loc of
+              LOC_CREGISTER,
+              LOC_REGISTER:
                 begin
-                  if getsupreg(locpara.registerlow)<first_int_imreg then
+                  if getsupreg(paraloc.register)<first_int_imreg then
                     begin
-                      getexplicitregister(list,locpara.registerlow);
-                      getexplicitregister(list,locpara.registerhigh);
-                      ungetregister(list,locpara.registerlow);
-                      ungetregister(list,locpara.registerhigh);
+                      getexplicitregister(list,paraloc.register);
+                      ungetregister(list,paraloc.register);
                     end;
-                  cg64.a_load64_reg_ref(list,locpara.register64,ref)
-                end
-              else
-{$endif cpu64bit}
+                  a_load_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref);
+                end;
+              LOC_MMREGISTER,
+              LOC_CMMREGISTER:
                 begin
-                  if getsupreg(locpara.register)<first_int_imreg then
+                  if getsupreg(paraloc.register)<first_mm_imreg then
                     begin
-                      getexplicitregister(list,locpara.register);
-                      ungetregister(list,locpara.register);
+                      getexplicitregister(list,paraloc.register);
+                      ungetregister(list,paraloc.register);
                     end;
-                  a_load_reg_ref(list,locpara.size,locpara.size,locpara.register,ref);
+                  a_loadmm_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref,shuffle);
                 end;
-            end;
-          LOC_MMREGISTER,
-          LOC_CMMREGISTER:
-            begin
-              if getsupreg(locpara.register)<first_mm_imreg then
+              LOC_FPUREGISTER,
+              LOC_CFPUREGISTER:
                 begin
-                  getexplicitregister(list,locpara.register);
-                  ungetregister(list,locpara.register);
+                  if getsupreg(paraloc.register)<first_fpu_imreg then
+                    begin
+                      getexplicitregister(list,paraloc.register);
+                      ungetregister(list,paraloc.register);
+                    end;
+                  a_loadfpu_reg_ref(list,paraloc.size,paraloc.register,ref);
                 end;
-              a_loadmm_reg_ref(list,locpara.size,locpara.size,locpara.register,ref,shuffle);
-            end;
-          LOC_FPUREGISTER,
-          LOC_CFPUREGISTER:
-            begin
-              if getsupreg(locpara.register)<first_fpu_imreg then
+              LOC_REFERENCE:
                 begin
-                  getexplicitregister(list,locpara.register);
-                  ungetregister(list,locpara.register);
+                  reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset);
+                  { use concatcopy, because it can also be a float which fails when
+                    load_ref_ref is used }
+                  g_concatcopy(list,href,ref,tcgsize2size[paraloc.size],false,false);
                 end;
-              a_loadfpu_reg_ref(list,locpara.size,locpara.register,ref);
+              else
+                internalerror(2002081302);
             end;
-          else
-            internalerror(2002081302);
         end;
+
+      var
+        href : treference;
+      begin
+        href:=ref;
+        gen_load(paraloc.location^,href);
+        if assigned(paraloc.location^.next) then
+          begin
+            inc(href.offset,TCGSize2Size[paraloc.location^.size]);
+            gen_load(paraloc.location^.next^,href);
+          end;
       end;
 
 
-    procedure tcg.a_loadany_param_reg(list : taasmoutput;const locpara : tparalocation;const reg:tregister;shuffle : pmmshuffle);
+    procedure tcg.a_loadany_param_reg(list : taasmoutput;const paraloc : TCGPara;const reg:tregister;shuffle : pmmshuffle);
       var
         href : treference;
       begin
-        case locpara.loc of
+        paraloc.check_simple_location;
+        case paraloc.location^.loc of
           LOC_CREGISTER,
           LOC_REGISTER:
             begin
-              if not(locpara.size in [OS_S64,OS_64]) then
+              if getsupreg(paraloc.location^.register)<first_int_imreg then
                 begin
-                  if getsupreg(locpara.register)<first_int_imreg then
-                    begin
-                      getexplicitregister(list,locpara.register);
-                      ungetregister(list,locpara.register);
-                    end;
-{
-                  This is now a normal imaginary register, allocated the usual way (JM)
-                  getexplicitregister(list,reg);
-}
-                  a_load_reg_reg(list,locpara.size,locpara.size,locpara.register,reg)
-                end
-              else
-                internalerror(2003053011);
+                  getexplicitregister(list,paraloc.location^.register);
+                  ungetregister(list,paraloc.location^.register);
+                end;
+              a_load_reg_reg(list,paraloc.location^.size,paraloc.location^.size,paraloc.location^.register,reg)
             end;
           LOC_CFPUREGISTER,
           LOC_FPUREGISTER:
             begin
-
-              if getsupreg(locpara.register)<first_fpu_imreg then
+              if getsupreg(paraloc.location^.register)<first_fpu_imreg then
                 begin
-                  getexplicitregister(list,locpara.register);
-                  ungetregister(list,locpara.register);
+                  getexplicitregister(list,paraloc.location^.register);
+                  ungetregister(list,paraloc.location^.register);
                 end;
-{
-              This is now a normal imaginary register, allocated the usual way (JM)
-              getexplicitregister(list,reg);
-}
-              a_loadfpu_reg_reg(list,locpara.size,locpara.register,reg);
+              a_loadfpu_reg_reg(list,paraloc.location^.size,paraloc.location^.register,reg);
             end;
           LOC_MMREGISTER,
           LOC_CMMREGISTER:
             begin
-              if getsupreg(locpara.register)<first_mm_imreg then
+              if getsupreg(paraloc.location^.register)<first_mm_imreg then
                 begin
-                  getexplicitregister(list,locpara.register);
-                  ungetregister(list,locpara.register);
+                  getexplicitregister(list,paraloc.location^.register);
+                  ungetregister(list,paraloc.location^.register);
                 end;
-{
-              This is now a normal imaginary register, allocated the usual way (JM)
-              getexplicitregister(list,reg);
-}
-              a_loadmm_reg_reg(list,locpara.size,locpara.size,locpara.register,reg,shuffle);
+              a_loadmm_reg_reg(list,paraloc.location^.size,paraloc.location^.size,paraloc.location^.register,reg,shuffle);
             end;
           LOC_REFERENCE,
           LOC_CREFERENCE:
             begin
-              reference_reset_base(href,locpara.reference.index,locpara.reference.offset);
-{
-              This is now a normal imaginary register, allocated the usual way (JM)
-              getexplicitregister(list,reg);
-}
-              a_load_ref_reg(list,locpara.size,locpara.size,href,reg);
+              reference_reset_base(href,paraloc.location^.reference.index,paraloc.location^.reference.offset);
+              a_load_ref_reg(list,paraloc.location^.size,paraloc.location^.size,href,reg);
             end;
           else
             internalerror(2003053010);
@@ -1119,18 +1115,17 @@ implementation
       end;
 
 
-    procedure tcg.a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const locpara : tparalocation);
+    procedure tcg.a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const paraloc : TCGPara);
       var
          ref : treference;
       begin
-         case locpara.loc of
+         paraloc.check_simple_location;
+         case paraloc.location^.loc of
             LOC_FPUREGISTER,LOC_CFPUREGISTER:
-              a_loadfpu_reg_reg(list,size,r,locpara.register);
+              a_loadfpu_reg_reg(list,size,r,paraloc.location^.register);
             LOC_REFERENCE,LOC_CREFERENCE:
               begin
-                 reference_reset(ref);
-                 ref.base:=locpara.reference.index;
-                 ref.offset:=locpara.reference.offset;
+                 reference_reset_base(ref,paraloc.location^.reference.index,paraloc.location^.reference.offset);
                  a_loadfpu_reg_ref(list,size,r,ref);
               end
             else
@@ -1139,18 +1134,17 @@ implementation
       end;
 
 
-    procedure tcg.a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const locpara : tparalocation);
+    procedure tcg.a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const paraloc : TCGPara);
       var
          href : treference;
       begin
-        case locpara.loc of
+         paraloc.check_simple_location;
+         case paraloc.location^.loc of
           LOC_FPUREGISTER,LOC_CFPUREGISTER:
-            a_loadfpu_ref_reg(list,size,ref,locpara.register);
+            a_loadfpu_ref_reg(list,size,ref,paraloc.location^.register);
           LOC_REFERENCE,LOC_CREFERENCE:
             begin
-              reference_reset(href);
-              href.base:=locpara.reference.index;
-              href.offset:=locpara.reference.offset;
+              reference_reset_base(href,paraloc.location^.reference.index,paraloc.location^.reference.offset);
               { concatcopy should choose the best way to copy the data }
               g_concatcopy(list,ref,href,tcgsize2size[size],false,false);
             end
@@ -1161,10 +1155,8 @@ implementation
 
 
     procedure tcg.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: aint; const ref: TReference);
-
       var
-        tmpreg: tregister;
-
+        tmpreg : tregister;
       begin
         tmpreg:=getintregister(list,size);
         a_load_ref_reg(list,size,size,ref,tmpreg);
@@ -1175,7 +1167,6 @@ implementation
 
 
     procedure tcg.a_op_const_loc(list : taasmoutput; Op: TOpCG; a: aint; const loc: tlocation);
-
       begin
         case loc.loc of
           LOC_REGISTER, LOC_CREGISTER:
@@ -1189,10 +1180,8 @@ implementation
 
 
     procedure tcg.a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister;  const ref: TReference);
-
       var
-        tmpreg: tregister;
-
+        tmpreg : tregister;
       begin
         tmpreg:=getintregister(list,size);
         a_load_ref_reg(list,size,size,ref,tmpreg);
@@ -1405,19 +1394,18 @@ implementation
       end;
 
 
-    procedure tcg.a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : tparalocation;shuffle : pmmshuffle);
+    procedure tcg.a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const paraloc : TCGPara;shuffle : pmmshuffle);
       var
-        ref : treference;
+        href : treference;
       begin
-        case locpara.loc of
+         paraloc.check_simple_location;
+         case paraloc.location^.loc of
           LOC_MMREGISTER,LOC_CMMREGISTER:
-            a_loadmm_reg_reg(list,size,locpara.size,reg,locpara.register,shuffle);
+            a_loadmm_reg_reg(list,size,paraloc.location^.size,reg,paraloc.location^.register,shuffle);
           LOC_REFERENCE,LOC_CREFERENCE:
             begin
-              reference_reset(ref);
-              ref.base:=locpara.reference.index;
-              ref.offset:=locpara.reference.offset;
-              a_loadmm_reg_ref(list,size,locpara.size,reg,ref,shuffle);
+              reference_reset_base(href,paraloc.location^.reference.index,paraloc.location^.reference.offset);
+              a_loadmm_reg_ref(list,size,paraloc.location^.size,reg,href,shuffle);
             end
           else
             internalerror(200310123);
@@ -1425,32 +1413,33 @@ implementation
       end;
 
 
-    procedure tcg.a_parammm_ref(list: taasmoutput; size: tcgsize;const ref: treference;const locpara : tparalocation;shuffle : pmmshuffle);
+    procedure tcg.a_parammm_ref(list: taasmoutput; size: tcgsize;const ref: treference;const paraloc : TCGPara;shuffle : pmmshuffle);
       var
          hr : tregister;
          hs : tmmshuffle;
       begin
-         hr:=getmmregister(list,locpara.size);
-         a_loadmm_ref_reg(list,size,locpara.size,ref,hr,shuffle);
+         paraloc.check_simple_location;
+         hr:=getmmregister(list,paraloc.location^.size);
+         a_loadmm_ref_reg(list,size,paraloc.location^.size,ref,hr,shuffle);
          if realshuffle(shuffle) then
            begin
              hs:=shuffle^;
              removeshuffles(hs);
-             a_parammm_reg(list,locpara.size,hr,locpara,@hs);
+             a_parammm_reg(list,paraloc.location^.size,hr,paraloc,@hs);
            end
          else
-           a_parammm_reg(list,locpara.size,hr,locpara,shuffle);
+           a_parammm_reg(list,paraloc.location^.size,hr,paraloc,shuffle);
          ungetregister(list,hr);
       end;
 
 
-    procedure tcg.a_parammm_loc(list: taasmoutput;const loc: tlocation; const locpara : tparalocation;shuffle : pmmshuffle);
+    procedure tcg.a_parammm_loc(list: taasmoutput;const loc: tlocation; const paraloc : TCGPara;shuffle : pmmshuffle);
       begin
         case loc.loc of
           LOC_MMREGISTER,LOC_CMMREGISTER:
-            a_parammm_reg(list,loc.size,loc.register,locpara,shuffle);
+            a_parammm_reg(list,loc.size,loc.register,paraloc,shuffle);
           LOC_REFERENCE,LOC_CREFERENCE:
-            a_parammm_ref(list,loc.size,loc.reference,locpara,shuffle);
+            a_parammm_ref(list,loc.size,loc.reference,paraloc,shuffle);
           else
             internalerror(200310123);
         end;
@@ -1512,16 +1501,51 @@ implementation
       end;
 
 
+    procedure tcg.g_concatcopy_unaligned(list : taasmoutput;const source,dest : treference;len : aint;delsource,loadref : boolean);
+      var
+        paraloc1,paraloc2,paraloc3 : TCGPara;
+      begin
+        paraloc1.init;
+        paraloc2.init;
+        paraloc3.init;
+        paramanager.getintparaloc(pocall_default,1,paraloc1);
+        paramanager.getintparaloc(pocall_default,2,paraloc2);
+        paramanager.getintparaloc(pocall_default,3,paraloc3);
+        paramanager.allocparaloc(list,paraloc3);
+        a_param_const(list,OS_INT,len,paraloc3);
+        paramanager.allocparaloc(list,paraloc2);
+        a_paramaddr_ref(list,dest,paraloc2);
+        paramanager.allocparaloc(list,paraloc2);
+        if loadref then
+          a_param_ref(list,OS_ADDR,source,paraloc1)
+        else
+          a_paramaddr_ref(list,source,paraloc1);
+        if delsource then
+         reference_release(list,source);
+        paramanager.freeparaloc(list,paraloc3);
+        paramanager.freeparaloc(list,paraloc2);
+        paramanager.freeparaloc(list,paraloc1);
+        allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        allocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
+        a_call_name(list,'FPC_MOVE');
+        deallocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
+        deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        paraloc3.done;
+        paraloc2.done;
+        paraloc1.done;
+      end;
+
+
     procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
       var
-        paraloc1,paraloc2,paraloc3 : tparalocation;
-      begin
-{$ifdef FPC}
-        {$warning FIX ME!}
-{$endif}
-        paraloc1:=paramanager.getintparaloc(pocall_default,1);
-        paraloc2:=paramanager.getintparaloc(pocall_default,2);
-        paraloc3:=paramanager.getintparaloc(pocall_default,3);
+        paraloc1,paraloc2,paraloc3 : TCGPara;
+      begin
+        paraloc1.init;
+        paraloc2.init;
+        paraloc3.init;
+        paramanager.getintparaloc(pocall_default,1,paraloc1);
+        paramanager.getintparaloc(pocall_default,2,paraloc2);
+        paramanager.getintparaloc(pocall_default,3,paraloc3);
         paramanager.allocparaloc(list,paraloc3);
         a_paramaddr_ref(list,dest,paraloc3);
         paramanager.allocparaloc(list,paraloc2);
@@ -1537,8 +1561,13 @@ implementation
         paramanager.freeparaloc(list,paraloc2);
         paramanager.freeparaloc(list,paraloc1);
         allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        allocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         a_call_name(list,'FPC_SHORTSTR_ASSIGN');
+        deallocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        paraloc3.done;
+        paraloc2.done;
+        paraloc1.done;
       end;
 
 
@@ -1546,10 +1575,12 @@ implementation
       var
         href : treference;
         incrfunc : string;
-        paraloc1,paraloc2 : tparalocation;
+        paraloc1,paraloc2 : TCGPara;
       begin
-         paraloc1:=paramanager.getintparaloc(pocall_default,1);
-         paraloc2:=paramanager.getintparaloc(pocall_default,2);
+         paraloc1.init;
+         paraloc2.init;
+         paramanager.getintparaloc(pocall_default,1,paraloc1);
+         paramanager.getintparaloc(pocall_default,2,paraloc2);
          { These functions should not change the registers (they use
            the saveregister proc directive }
          if is_interfacecom(t) then
@@ -1601,7 +1632,9 @@ implementation
             allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
             a_call_name(list,'FPC_ADDREF');
             deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-         end;
+          end;
+         paraloc2.done;
+         paraloc1.done;
       end;
 
 
@@ -1611,14 +1644,16 @@ implementation
         href : treference;
         decrfunc : string;
         needrtti : boolean;
-        paraloc1,paraloc2 : tparalocation;
-      begin
-         paraloc1:=paramanager.getintparaloc(pocall_default,1);
-         paraloc2:=paramanager.getintparaloc(pocall_default,2);
-         needrtti:=false;
-         if is_interfacecom(t) then
+        paraloc1,paraloc2 : TCGPara;
+      begin
+        paraloc1.init;
+        paraloc2.init;
+        paramanager.getintparaloc(pocall_default,1,paraloc1);
+        paramanager.getintparaloc(pocall_default,2,paraloc2);
+        needrtti:=false;
+        if is_interfacecom(t) then
           decrfunc:='FPC_INTF_DECR_REF'
-         else if is_ansistring(t) then
+        else if is_ansistring(t) then
        {$ifdef ansistring_bits}
            begin
              case Tstringdef(t).string_typ of
@@ -1693,16 +1728,20 @@ implementation
             else
               a_load_const_ref(list,OS_ADDR,0,ref);
           end;
+        paraloc2.done;
+        paraloc1.done;
       end;
 
 
     procedure tcg.g_initialize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
       var
          href : treference;
-         paraloc1,paraloc2 : tparalocation;
+         paraloc1,paraloc2 : TCGPara;
       begin
-         paraloc1:=paramanager.getintparaloc(pocall_default,1);
-         paraloc2:=paramanager.getintparaloc(pocall_default,2);
+        paraloc1.init;
+        paraloc2.init;
+        paramanager.getintparaloc(pocall_default,1,paraloc1);
+        paramanager.getintparaloc(pocall_default,2,paraloc2);
          if is_ansistring(t) or
             is_widestring(t) or
             is_interfacecom(t) or
@@ -1721,9 +1760,13 @@ implementation
               paramanager.freeparaloc(list,paraloc1);
               paramanager.freeparaloc(list,paraloc2);
               allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+              allocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
               a_call_name(list,'FPC_INITIALIZE');
+              deallocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
               deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
            end;
+        paraloc1.done;
+        paraloc2.done;
       end;
 
 
@@ -1731,10 +1774,12 @@ implementation
       var
          hreg : tregister;
          href : treference;
-         paraloc1,paraloc2 : tparalocation;
+         paraloc1,paraloc2 : TCGPara;
       begin
-         paraloc1:=paramanager.getintparaloc(pocall_default,1);
-         paraloc2:=paramanager.getintparaloc(pocall_default,2);
+        paraloc1.init;
+        paraloc2.init;
+        paramanager.getintparaloc(pocall_default,1,paraloc1);
+        paramanager.getintparaloc(pocall_default,2,paraloc2);
          if is_ansistring(t) or
             is_widestring(t) or
             is_interfacecom(t) then
@@ -1768,9 +1813,13 @@ implementation
               paramanager.freeparaloc(list,paraloc1);
               paramanager.freeparaloc(list,paraloc2);
               allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+              allocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
               a_call_name(list,'FPC_FINALIZE');
+              deallocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
               deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
            end;
+        paraloc1.done;
+        paraloc2.done;
       end;
 
 
@@ -1927,19 +1976,21 @@ implementation
     procedure tcg.g_maybe_testself(list : taasmoutput;reg:tregister);
       var
         OKLabel : tasmlabel;
-        paraloc1 : tparalocation;
+        paraloc1 : TCGPara;
       begin
         if (cs_check_object in aktlocalswitches) or
            (cs_check_range in aktlocalswitches) then
          begin
            objectlibrary.getlabel(oklabel);
            a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel);
-           paraloc1:=paramanager.getintparaloc(pocall_default,1);
+           paraloc1.init;
+           paramanager.getintparaloc(pocall_default,1,paraloc1);
            paramanager.allocparaloc(list,paraloc1);
            a_param_const(list,OS_INT,210,paraloc1);
            paramanager.freeparaloc(list,paraloc1);
            a_call_name(list,'FPC_HANDLEERROR');
            a_label(list,oklabel);
+           paraloc1.done;
          end;
       end;
 
@@ -1947,10 +1998,12 @@ implementation
     procedure tcg.g_maybe_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef);
       var
         hrefvmt : treference;
-        paraloc1,paraloc2 : tparalocation;
+        paraloc1,paraloc2 : TCGPara;
       begin
-        paraloc1:=paramanager.getintparaloc(pocall_default,1);
-        paraloc2:=paramanager.getintparaloc(pocall_default,2);
+        paraloc1.init;
+        paraloc2.init;
+        paramanager.getintparaloc(pocall_default,1,paraloc1);
+        paramanager.getintparaloc(pocall_default,2,paraloc2);
         if (cs_check_object in aktlocalswitches) then
          begin
            reference_reset_symbol(hrefvmt,objectlibrary.newasmsymbol(objdef.vmt_mangledname,AB_EXTERNAL,AT_DATA),0);
@@ -1974,6 +2027,8 @@ implementation
             a_call_name(list,'FPC_CHECK_OBJECT');
             deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
           end;
+        paraloc1.done;
+        paraloc2.done;
       end;
 
 
@@ -1984,7 +2039,7 @@ implementation
     procedure tcg.g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aint);
       var
         sizereg,sourcereg,destreg : tregister;
-        paraloc1,paraloc2,paraloc3 : tparalocation;
+        paraloc1,paraloc2,paraloc3 : TCGPara;
       begin
         { because ppc abi doesn't support dynamic stack allocation properly
           open array value parameters are copied onto the heap
@@ -2002,20 +2057,27 @@ implementation
         a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,sourcereg);
 
         { do getmem call }
-        paraloc1:=paramanager.getintparaloc(pocall_default,1);
+        paraloc1.init;
+        paramanager.getintparaloc(pocall_default,1,paraloc1);
         paramanager.allocparaloc(list,paraloc1);
         a_param_reg(list,OS_INT,sizereg,paraloc1);
         paramanager.freeparaloc(list,paraloc1);
         allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        allocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         a_call_name(list,'FPC_GETMEM');
+        deallocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-	a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,destreg);
-	a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,ref);
+        a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,destreg);
+        a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,ref);
+        paraloc1.done;
 
         { do move call }
-        paraloc1:=paramanager.getintparaloc(pocall_default,1);
-        paraloc2:=paramanager.getintparaloc(pocall_default,2);
-        paraloc3:=paramanager.getintparaloc(pocall_default,3);
+        paraloc1.init;
+        paraloc2.init;
+        paraloc3.init;
+        paramanager.getintparaloc(pocall_default,1,paraloc1);
+        paramanager.getintparaloc(pocall_default,2,paraloc2);
+        paramanager.getintparaloc(pocall_default,3,paraloc3);
         { load size }
         paramanager.allocparaloc(list,paraloc3);
         a_param_reg(list,OS_INT,sizereg,paraloc3);
@@ -2029,8 +2091,13 @@ implementation
         paramanager.freeparaloc(list,paraloc2);
         paramanager.freeparaloc(list,paraloc1);
         allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        allocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         a_call_name(list,'FPC_MOVE');
+        deallocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        paraloc3.done;
+        paraloc2.done;
+        paraloc1.done;
 
         { release used registers }
         ungetregister(list,sizereg);
@@ -2041,17 +2108,21 @@ implementation
 
     procedure tcg.g_releasevaluepara_openarray(list : taasmoutput;const ref:treference);
       var
-        paraloc : tparalocation;
+        paraloc1 : TCGPara;
       begin
         { do move call }
-        paraloc:=paramanager.getintparaloc(pocall_default,1);
+        paraloc1.init;
+        paramanager.getintparaloc(pocall_default,1,paraloc1);
         { load source }
-        paramanager.allocparaloc(list,paraloc);
-        a_param_ref(list,OS_ADDR,ref,paraloc);
-        paramanager.freeparaloc(list,paraloc);
+        paramanager.allocparaloc(list,paraloc1);
+        a_param_ref(list,OS_ADDR,ref,paraloc1);
+        paramanager.freeparaloc(list,paraloc1);
         allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        allocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         a_call_name(list,'FPC_FREEMEM');
+        deallocexplicitregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+        paraloc1.done;
       end;
 
 
@@ -2195,7 +2266,24 @@ finalization
 end.
 {
   $Log$
-  Revision 1.168  2004-07-09 23:41:04  jonas
+  Revision 1.169  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.168.4.4  2004/09/20 20:45:57  peter
+    * remove cg64.a_reg_alloc, it should not be used since it
+      create more register conflicts
+
+  Revision 1.168.4.3  2004/09/18 20:22:40  jonas
+    * allocate the volatile fpu registers around procedures that might use
+      them (e.g. FPCMOVE may use them)
+
+  Revision 1.168.4.2  2004/09/12 13:36:40  peter
+    * fixed alignment issues
+
+  Revision 1.168.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.168  2004/07/09 23:41:04  jonas
     * support register parameters for inlined procedures + some inline
       cleanups
 

compiler/fpcdefs.inc

@@ -79,6 +79,7 @@
 {$ifdef sparc}
   {$define noopt}
   {$define oldset}
+  {$define cputargethasfixedstack}
 {$endif sparc}
 
 {$ifdef cpusparc}
@@ -106,7 +107,13 @@
 
 {
   $Log$
-  Revision 1.39  2004-08-15 13:30:18  florian
+  Revision 1.40  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.39.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.39  2004/08/15 13:30:18  florian
     * fixed alignment of variant records
     * more alignment problems fixed
 

compiler/globals.pas

@@ -310,7 +310,7 @@ interface
     function  GetEnvPChar(const envname:string):pchar;
     procedure FreeEnvPChar(p:pchar);
 
-    function SetFPUExceptionMask(const Mask : TFPUExceptionMask) : TFPUExceptionMask;
+    procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
     function is_number_float(d : double) : boolean;
 
     Function SetCompileMode(const s:string; changeInit: boolean):boolean;
@@ -461,12 +461,16 @@ implementation
                                File Handling
 ****************************************************************************}
 
-   function GetCurrentDir:string;
      var
-       CurrentDir : string;
+       CachedCurrentDir : string;
+   function GetCurrentDir:string;
      begin
-       GetDir(0,CurrentDir);
-       GetCurrentDir:=FixPath(CurrentDir,false);
+       if CachedCurrentDir='' then
+         begin
+           GetDir(0,CachedCurrentDir);
+           CachedCurrentDir:=FixPath(CachedCurrentDir,false);
+         end;
+       result:=CachedCurrentDir;
      end;
 
 
@@ -1398,7 +1402,8 @@ implementation
       {$endif}
 
 
-{$ifdef CPUI386}
+{$if defined(CPUI386) or defined(CPUX86_64)}
+  {$define HASSETFPUEXCEPTIONMASK}
       { later, this should be replaced by the math unit }
       const
         Default8087CW : word = $1332;
@@ -1420,17 +1425,18 @@ implementation
         end;
 
 
-      function SetFPUExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+      procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
         var
           CtlWord: Word;
         begin
           CtlWord:=Get8087CW;
           Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
-          Result:=TFPUExceptionMask(Longint(CtlWord and $3F));
         end;
-{$else CPUI386}
+{$endif CPUI386 OR CPUX86_64}
+
 {$ifdef CPUPOWERPC}
-      function SetFPUExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+  {$define HASSETFPUEXCEPTIONMASK}
+      procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
         var
           newmask: record
             case byte of
@@ -1480,12 +1486,59 @@ implementation
             mtfsf 255,f0
           end;
         end;
-{$else CPUPOWERPC}
+{$endif CPUPOWERPC}
+
+{$ifdef CPUSPARC}
+  {$define HASSETFPUEXCEPTIONMASK}
+      procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
+        var
+          fsr : cardinal;
+        begin
+          { load current control register contents }
+          asm
+            st %fsr,fsr
+          end;
+          { invalid operation: bit 27 }
+          if (exInvalidOp in mask) then
+            fsr:=fsr and not(1 shl 27)
+          else
+            fsr:=fsr or (1 shl 27);
+
+          { zero divide: bit 24 }
+          if (exZeroDivide in mask) then
+            fsr:=fsr and not(1 shl 24)
+          else
+            fsr:=fsr or (1 shl 24);
+
+          { overflow: bit 26 }
+          if (exOverflow in mask) then
+            fsr:=fsr and not(1 shl 26)
+          else
+            fsr:=fsr or (1 shl 26);
+
+          { underflow: bit 25 }
+          if (exUnderflow in mask) then
+            fsr:=fsr and not(1 shl 25)
+          else
+            fsr:=fsr or (1 shl 25);
+
+          { Precision (inexact result): bit 23 }
+          if (exPrecision in mask) then
+            fsr:=fsr and not(1 shl 23)
+          else
+            fsr:=fsr or (1 shl 23);
+          { update control register contents }
+          asm
+            ld fsr,%fsr
+          end;
+        end;
+{$endif CPUSPARC}
+
+{$ifndef HASSETFPUEXCEPTIONMASK}
       function SetFPUExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
         begin
         end;
-{$endif CPUPOWERPC}
-{$endif CPUI386}
+{$endif HASSETFPUEXCEPTIONMASK}
 
       function is_number_float(d : double) : boolean;
         var
@@ -1960,7 +2013,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.138  2004-09-08 11:23:31  michael
+  Revision 1.139  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.138  2004/09/08 11:23:31  michael
   + Check if outputdir exists,  Fix exitcode when displaying help pages
 
   Revision 1.137  2004/08/31 22:02:30  olle
@@ -1968,6 +2024,12 @@ end.
       compiler directives which take paths, will support quotes.
     * uppdated TranslateMacPath
 
+  Revision 1.136.4.2  2004/09/12 18:31:26  peter
+    * fpu exception support for sparc and x86_64
+
+  Revision 1.136.4.1  2004/09/12 15:30:16  peter
+    * cache currentdir
+
   Revision 1.136  2004/08/28 20:25:25  peter
     * optimized search for noncasesensitive names. It now searches
       first for NormalCase and skips double tests

compiler/i386/cgcpu.pas

@@ -20,8 +20,6 @@
 
  ****************************************************************************
 }
-{ This unit implements the code generator for the i386.
-}
 unit cgcpu;
 
 {$i fpcdefs.inc}
@@ -32,7 +30,7 @@ unit cgcpu;
        globtype,
        cgbase,cgobj,cg64f32,cgx86,
        aasmbase,aasmtai,aasmcpu,
-       cpubase,cpuinfo,
+       cpubase,cpuinfo,parabase,
        node,symconst
 {$ifdef delphi}
        ,dmisc
@@ -43,13 +41,13 @@ unit cgcpu;
       tcg386 = class(tcgx86)
         procedure init_register_allocators;override;
         { passing parameter using push instead of mov }
-        procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);override;
-        procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;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;
+        procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const cgpara : tcgpara);override;
+        procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;const cgpara : tcgpara);override;
+        procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const cgpara : tcgpara);override;
+        procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const cgpara : tcgpara);override;
 
         procedure g_save_all_registers(list : taasmoutput);override;
-        procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);override;
+        procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tcgpara);override;
         procedure g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);override;
         procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aint);override;
 
@@ -71,7 +69,7 @@ unit cgcpu;
 
     uses
        globals,verbose,systems,cutils,
-       symdef,symsym,defutil,paramgr,procinfo,
+       paramgr,procinfo,
        rgcpu,rgx86,tgobj,
        cgutils;
 
@@ -88,47 +86,50 @@ unit cgcpu;
       end;
 
 
-    procedure tcg386.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);
+    procedure tcg386.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const cgpara : tcgpara);
       var
         pushsize : tcgsize;
       begin
         check_register_size(size,r);
-        with locpara do
-          if (loc=LOC_REFERENCE) and
-             (reference.index=NR_STACK_POINTER_REG) then
+        with cgpara do
+          if assigned(location) and
+             (location^.loc=LOC_REFERENCE) and
+             (location^.reference.index=NR_STACK_POINTER_REG) then
             begin
               pushsize:=int_cgsize(alignment);
               list.concat(taicpu.op_reg(A_PUSH,tcgsize2opsize[pushsize],makeregsize(list,r,pushsize)));
             end
           else
-            inherited a_param_reg(list,size,r,locpara);
+            inherited a_param_reg(list,size,r,cgpara);
       end;
 
 
-    procedure tcg386.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const locpara : tparalocation);
+    procedure tcg386.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const cgpara : tcgpara);
       var
         pushsize : tcgsize;
       begin
-        with locpara do
-          if (loc=LOC_REFERENCE) and
-             (reference.index=NR_STACK_POINTER_REG) then
+        with cgpara do
+          if assigned(location) and
+             (location^.loc=LOC_REFERENCE) and
+             (location^.reference.index=NR_STACK_POINTER_REG) then
             begin
               pushsize:=int_cgsize(alignment);
               list.concat(taicpu.op_const(A_PUSH,tcgsize2opsize[pushsize],a));
             end
           else
-            inherited a_param_const(list,size,a,locpara);
+            inherited a_param_const(list,size,a,cgpara);
       end;
 
 
-    procedure tcg386.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);
+    procedure tcg386.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const cgpara : tcgpara);
       var
         pushsize : tcgsize;
         tmpreg : tregister;
       begin
-        with locpara do
-          if (loc=LOC_REFERENCE) and
-             (reference.index=NR_STACK_POINTER_REG) then
+        with cgpara do
+          if assigned(location) and
+             (location^.loc=LOC_REFERENCE) and
+             (location^.reference.index=NR_STACK_POINTER_REG) then
             begin
               pushsize:=int_cgsize(alignment);
               if tcgsize2size[size]<alignment then
@@ -142,11 +143,11 @@ unit cgcpu;
                 list.concat(taicpu.op_ref(A_PUSH,TCgsize2opsize[pushsize],r));
             end
           else
-            inherited a_param_ref(list,size,r,locpara);
+            inherited a_param_ref(list,size,r,cgpara);
       end;
 
 
-    procedure tcg386.a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
+    procedure tcg386.a_paramaddr_ref(list : taasmoutput;const r : treference;const cgpara : tcgpara);
       var
         tmpreg : tregister;
         opsize : topsize;
@@ -155,9 +156,10 @@ unit cgcpu;
           begin
             if (segment<>NR_NO) then
               cgmessage(cg_e_cant_use_far_pointer_there);
-            with locpara do
-              if (locpara.loc=LOC_REFERENCE) and
-                 (locpara.reference.index=NR_STACK_POINTER_REG) then
+            with cgpara do
+              if assigned(location) and
+                 (location^.loc=LOC_REFERENCE) and
+                 (location^.reference.index=NR_STACK_POINTER_REG) then
                 begin
                   opsize:=tcgsize2opsize[OS_ADDR];
                   if (base=NR_NO) and (index=NR_NO) then
@@ -182,7 +184,7 @@ unit cgcpu;
                     end;
                 end
               else
-                inherited a_paramaddr_ref(list,r,locpara);
+                inherited a_paramaddr_ref(list,r,cgpara);
         end;
       end;
 
@@ -195,13 +197,14 @@ unit cgcpu;
       end;
 
 
-    procedure tcg386.g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);
+    procedure tcg386.g_restore_all_registers(list : taasmoutput;const funcretparaloc:tcgpara);
       var
         href : treference;
       begin
         a_load_ref_reg(list,OS_ADDR,OS_ADDR,current_procinfo.save_regs_ref,NR_STACK_POINTER_REG);
         tg.UnGetTemp(list,current_procinfo.save_regs_ref);
-        if funcretparaloc.loc=LOC_REGISTER then
+        if assigned(funcretparaloc.location) and
+           (funcretparaloc.location^.loc=LOC_REGISTER) then
           begin
             if funcretparaloc.size in [OS_64,OS_S64] then
               begin
@@ -252,13 +255,16 @@ unit cgcpu;
         { return from proc }
         if (po_interrupt in current_procinfo.procdef.procoptions) then
           begin
-            if current_procinfo.procdef.funcret_paraloc[calleeside].loc=LOC_REGISTER then
+            if assigned(current_procinfo.procdef.funcret_paraloc[calleeside].location) and
+               (current_procinfo.procdef.funcret_paraloc[calleeside].location^.loc=LOC_REGISTER) then
               list.concat(Taicpu.Op_const_reg(A_ADD,S_L,4,NR_ESP))
             else
               list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EAX));
             list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EBX));
             list.concat(Taicpu.Op_reg(A_POP,S_L,NR_ECX));
-            if current_procinfo.procdef.funcret_paraloc[calleeside].lochigh=LOC_REGISTER then
+            if assigned(current_procinfo.procdef.funcret_paraloc[calleeside].location) and
+               assigned(current_procinfo.procdef.funcret_paraloc[calleeside].location^.next) and
+               (current_procinfo.procdef.funcret_paraloc[calleeside].location^.next^.loc=LOC_REGISTER) then
               list.concat(Taicpu.Op_const_reg(A_ADD,S_L,4,NR_ESP))
             else
               list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EDX));
@@ -552,7 +558,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.51  2004-07-09 23:30:13  jonas
+  Revision 1.52  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.51.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.51  2004/07/09 23:30:13  jonas
     *  changed first_sse_imreg to first_mm_imreg
 
   Revision 1.50  2004/06/20 08:55:31  florian

compiler/i386/cpupara.pas

@@ -20,8 +20,6 @@
 
  ****************************************************************************
 }
-{ Generates the argument location information for i386.
-}
 unit cpupara;
 
 {$i fpcdefs.inc}
@@ -30,10 +28,9 @@ unit cpupara;
 
     uses
        cclasses,globtype,
-       aasmtai,
-       cpubase,
-       cgbase,
-       symconst,symtype,symdef,paramgr;
+       aasmtai,cpubase,cgbase,
+       symconst,symtype,symdef,
+       parabase,paramgr;
 
     type
        ti386paramanager = class(tparamanager)
@@ -48,9 +45,10 @@ unit cpupara;
             and if the calling conventions for the helper routines of the
             rtl are used.
           }
-          function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
+          procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;override;
+          procedure createtempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var cgpara:TCGPara);override;
        private
           procedure create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
           procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;firstpara:tparaitem;
@@ -64,8 +62,7 @@ unit cpupara;
     uses
        cutils,
        systems,verbose,
-       defutil,
-       cpuinfo;
+       defutil;
 
       const
         parasupregs : array[0..2] of tsuperregister = (RS_EAX,RS_EDX,RS_ECX);
@@ -190,76 +187,105 @@ unit cpupara;
       end;
 
 
-    function ti386paramanager.getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;
+    procedure ti386paramanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);
+      var
+        paraloc : pcgparalocation;
       begin
-         fillchar(result,sizeof(tparalocation),0);
-         result.size:=OS_INT;
-         result.lochigh:=LOC_INVALID;
-         result.alignment:=get_para_align(calloption);
-         if calloption=pocall_register then
-           begin
-             if (nr<=high(parasupregs)+1) then
-               begin
-                 if nr=0 then
-                   internalerror(200309271);
-                 result.loc:=LOC_REGISTER;
-                 result.register:=newreg(R_INTREGISTER,parasupregs[nr-1],R_SUBWHOLE);
-               end
-             else
-               begin
-                 result.loc:=LOC_REFERENCE;
-                 result.reference.index:=NR_STACK_POINTER_REG;
-                 result.reference.offset:=sizeof(aint)*nr;
-               end;
-           end
-         else
-           begin
-             result.loc:=LOC_REFERENCE;
-             result.reference.index:=NR_STACK_POINTER_REG;
-             result.reference.offset:=sizeof(aint)*nr;
-           end;
+        cgpara.reset;
+        cgpara.size:=OS_INT;
+        cgpara.alignment:=get_para_align(calloption);
+        paraloc:=cgpara.add_location;
+        with paraloc^ do
+         begin
+           size:=OS_INT;
+           if calloption=pocall_register then
+             begin
+               if (nr<=high(parasupregs)+1) then
+                 begin
+                   if nr=0 then
+                     internalerror(200309271);
+                   loc:=LOC_REGISTER;
+                   register:=newreg(R_INTREGISTER,parasupregs[nr-1],R_SUBWHOLE);
+                 end
+               else
+                 begin
+                   loc:=LOC_REFERENCE;
+                   reference.index:=NR_STACK_POINTER_REG;
+                   reference.offset:=sizeof(aint)*nr;
+                 end;
+             end
+           else
+             begin
+               loc:=LOC_REFERENCE;
+               reference.index:=NR_STACK_POINTER_REG;
+               reference.offset:=sizeof(aint)*nr;
+             end;
+          end;
       end;
 
 
     procedure ti386paramanager.create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
       var
-        paraloc : tparalocation;
+        hiparaloc,
+        paraloc : pcgparalocation;
+        retcgsize  : tcgsize;
       begin
-        { Function return }
-        fillchar(paraloc,sizeof(tparalocation),0);
+        { Constructors return self instead of a boolean }
         if (p.proctypeoption=potype_constructor) then
-          paraloc.size:=OS_ADDR
+          retcgsize:=OS_ADDR
         else
-          paraloc.size:=def_cgsize(p.rettype.def);
-        paraloc.lochigh:=LOC_INVALID;
-        if paraloc.size<>OS_NO then
+          retcgsize:=def_cgsize(p.rettype.def);
+        p.funcret_paraloc[side].reset;
+        p.funcret_paraloc[side].Alignment:=std_param_align;
+        p.funcret_paraloc[side].size:=retcgsize;
+        { void has no location }
+        if is_void(p.rettype.def) then
+          exit;
+        paraloc:=p.funcret_paraloc[side].add_location;
+        { Return in FPU register? }
+        if p.rettype.def.deftype=floatdef then
           begin
-            { Return in FPU register? }
-            if p.rettype.def.deftype=floatdef then
-              begin
-                paraloc.loc:=LOC_FPUREGISTER;
-                paraloc.register:=NR_FPU_RESULT_REG;
-              end
-            else
-             { Return in register? }
-             if not ret_in_param(p.rettype.def,p.proccalloption) then
-              begin
-                paraloc.loc:=LOC_REGISTER;
-                if paraloc.size in [OS_64,OS_S64] then
-                  begin
-                    paraloc.lochigh:=LOC_REGISTER;
-                    paraloc.register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
-                    paraloc.register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
-                  end
-                else
-                  paraloc.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(paraloc.size));
-              end
+            paraloc^.loc:=LOC_FPUREGISTER;
+            paraloc^.register:=NR_FPU_RESULT_REG;
+            paraloc^.size:=retcgsize;
+          end
+        else
+         { Return in register? }
+         if not ret_in_param(p.rettype.def,p.proccalloption) then
+          begin
+            if retcgsize in [OS_64,OS_S64] then
+             begin
+               { low 32bits }
+               paraloc^.loc:=LOC_REGISTER;
+               paraloc^.size:=OS_32;
+               if side=callerside then
+                 paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
+               else
+                 paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG;
+               { high 32bits }
+               hiparaloc:=p.funcret_paraloc[side].add_location;
+               hiparaloc^.loc:=LOC_REGISTER;
+               hiparaloc^.size:=OS_32;
+               if side=callerside then
+                 hiparaloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
+               else
+                 hiparaloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
+             end
             else
-              begin
-                paraloc.loc:=LOC_REFERENCE;
-              end;
+             begin
+               paraloc^.loc:=LOC_REGISTER;
+               paraloc^.size:=retcgsize;
+               if side=callerside then
+                 paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(retcgsize))
+               else
+                 paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(retcgsize));
+             end;
+          end
+        else
+          begin
+            paraloc^.loc:=LOC_REFERENCE;
+            paraloc^.size:=retcgsize;
           end;
-        p.funcret_paraloc[side]:=paraloc;
       end;
 
 
@@ -267,10 +293,11 @@ unit cpupara;
                                                            var parasize:longint);
       var
         hp : tparaitem;
-        paraloc : tparalocation;
+        paraloc : pcgparalocation;
         l,
         varalign,
         paraalign : longint;
+        paracgsize : tcgsize;
       begin
         paraalign:=get_para_align(p.proccalloption);
         { we push Flags and CS as long
@@ -284,28 +311,34 @@ unit cpupara;
            mov [esp+4],para2
            mov [esp],para1
            call function
-          That means the for pushes the para with the
+          That means for pushes the para with the
           highest offset (see para3) needs to be pushed first
         }
         hp:=firstpara;
         while assigned(hp) do
           begin
-            if hp.paratyp in [vs_var,vs_out] then
-              paraloc.size:=OS_ADDR
+            if push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption) then
+              paracgsize:=OS_ADDR
             else
-              paraloc.size:=def_cgsize(hp.paratype.def);
-            paraloc.loc:=LOC_REFERENCE;
-            paraloc.lochigh:=LOC_INVALID;
-            paraloc.alignment:=paraalign;
+              begin
+                paracgsize:=def_cgSize(hp.paratype.def);
+                if paracgsize=OS_NO then
+                  paracgsize:=OS_ADDR;
+              end;
+            hp.paraloc[side].reset;
+            hp.paraloc[side].size:=paracgsize;
+            hp.paraloc[side].Alignment:=paraalign;
+            paraloc:=hp.paraloc[side].add_location;
+            paraloc^.loc:=LOC_REFERENCE;
+            paraloc^.size:=paracgsize;
             if side=callerside then
-              paraloc.reference.index:=NR_STACK_POINTER_REG
+              paraloc^.reference.index:=NR_STACK_POINTER_REG
             else
-              paraloc.reference.index:=NR_FRAME_POINTER_REG;
+              paraloc^.reference.index:=NR_FRAME_POINTER_REG;
             l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
             varalign:=used_align(size_2_align(l),paraalign,paraalign);
-            paraloc.reference.offset:=parasize;
+            paraloc^.reference.offset:=parasize;
             parasize:=align(parasize+l,varalign);
-            hp.paraloc[side]:=paraloc;
             hp:=tparaitem(hp.next);
           end;
         { Adapt offsets for left-to-right calling }
@@ -317,9 +350,12 @@ unit cpupara;
                 l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
                 varalign:=used_align(size_2_align(l),paraalign,paraalign);
                 l:=align(l,varalign);
-                hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l;
-                if side=calleeside then
-                  inc(hp.paraloc[side].reference.offset,target_info.first_parm_offset);
+                with hp.paraloc[side].location^ do
+                  begin
+                    reference.offset:=parasize-reference.offset-l;
+                    if side=calleeside then
+                      inc(reference.offset,target_info.first_parm_offset);
+                  end;
                 hp:=tparaitem(hp.next);
               end;
           end
@@ -332,7 +368,7 @@ unit cpupara;
                 hp:=tparaitem(p.para.first);
                 while assigned(hp) do
                   begin
-                    inc(hp.paraloc[side].reference.offset,target_info.first_parm_offset);
+                    inc(hp.paraloc[side].location^.reference.offset,target_info.first_parm_offset);
                     hp:=tparaitem(hp.next);
                   end;
                end;
@@ -344,10 +380,10 @@ unit cpupara;
                                                             var parareg,parasize:longint);
       var
         hp : tparaitem;
-        paraloc : tparalocation;
-        subreg : tsubregister;
+        paraloc : pcgparalocation;
         pushaddr,
         is_64bit : boolean;
+        paracgsize : tcgsize;
         l,
         varalign,
         paraalign : longint;
@@ -359,11 +395,13 @@ unit cpupara;
           begin
             pushaddr:=push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption);
             if pushaddr then
-              paraloc.size:=OS_ADDR
+              paracgsize:=OS_ADDR
             else
-              paraloc.size:=def_cgsize(hp.paratype.def);
-            paraloc.alignment:=paraalign;
-            is_64bit:=(paraloc.size in [OS_64,OS_S64,OS_F64]);
+              paracgsize:=def_cgsize(hp.paratype.def);
+            is_64bit:=(paracgsize in [OS_64,OS_S64,OS_F64]);
+            hp.paraloc[side].reset;
+            hp.paraloc[side].size:=paracgsize;
+            hp.paraloc[side].Alignment:=paraalign;
             {
               EAX
               EDX
@@ -374,6 +412,8 @@ unit cpupara;
               64bit values,floats,arrays and records are always
               on the stack.
             }
+            paraloc:=hp.paraloc[side].add_location;
+            paraloc^.size:=paracgsize;
             if (parareg<=high(parasupregs)) and
                not(
                    is_64bit or
@@ -381,31 +421,23 @@ unit cpupara;
                     (not pushaddr))
                   ) then
               begin
-                paraloc.loc:=LOC_REGISTER;
-                paraloc.lochigh:=LOC_INVALID;
-                if (paraloc.size=OS_NO) or is_64bit then
-                  subreg:=R_SUBWHOLE
-                else
-                  subreg:=cgsize2subreg(paraloc.size);
-                paraloc.alignment:=paraalign;
-                paraloc.register:=newreg(R_INTREGISTER,parasupregs[parareg],subreg);
+                paraloc^.loc:=LOC_REGISTER;
+                paraloc^.register:=newreg(R_INTREGISTER,parasupregs[parareg],cgsize2subreg(paracgsize));
                 inc(parareg);
               end
             else
               begin
-                paraloc.loc:=LOC_REFERENCE;
-                paraloc.lochigh:=LOC_INVALID;
+                paraloc^.loc:=LOC_REFERENCE;
                 if side=callerside then
-                  paraloc.reference.index:=NR_STACK_POINTER_REG
+                  paraloc^.reference.index:=NR_STACK_POINTER_REG
                 else
-                  paraloc.reference.index:=NR_FRAME_POINTER_REG;
+                  paraloc^.reference.index:=NR_FRAME_POINTER_REG;
                 l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
                 varalign:=size_2_align(l);
-                paraloc.reference.offset:=parasize;
+                paraloc^.reference.offset:=parasize;
                 varalign:=used_align(varalign,paraalign,paraalign);
                 parasize:=align(parasize+l,varalign);
               end;
-            hp.paraloc[side]:=paraloc;
             hp:=tparaitem(hp.next);
           end;
         { Register parameters are assigned from left-to-right, adapt offset
@@ -413,15 +445,18 @@ unit cpupara;
         hp:=tparaitem(p.para.first);
         while assigned(hp) do
           begin
-            if (hp.paraloc[side].loc=LOC_REFERENCE) then
+            with hp.paraloc[side].location^ do
               begin
-                l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
-                varalign:=used_align(size_2_align(l),paraalign,paraalign);
-                l:=align(l,varalign);
-                hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l;
-                if side=calleeside then
-                  inc(hp.paraloc[side].reference.offset,target_info.first_parm_offset);
-              end;
+                if (loc=LOC_REFERENCE) then
+                  begin
+                    l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+                    varalign:=used_align(size_2_align(l),paraalign,paraalign);
+                    l:=align(l,varalign);
+                    reference.offset:=parasize-reference.offset-l;
+                    if side=calleeside then
+                      inc(reference.offset,target_info.first_parm_offset);
+                  end;
+               end;
             hp:=tparaitem(hp.next);
           end;
       end;
@@ -468,13 +503,33 @@ unit cpupara;
       end;
 
 
+    procedure ti386paramanager.createtempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var cgpara:TCGPara);
+      var
+        paraloc : pcgparalocation;
+      begin
+        paraloc:=paraitem.paraloc[callerside].location;
+        { No need for temps when value is pushed }
+        if assigned(paraloc) and
+           (paraloc^.loc=LOC_REFERENCE) and
+           (paraloc^.reference.index=NR_STACK_POINTER_REG) then
+          duplicateparaloc(list,calloption,paraitem,cgpara)
+        else
+          inherited createtempparaloc(list,calloption,paraitem,cgpara);
+      end;
+
 
 begin
    paramanager:=ti386paramanager.create;
 end.
 {
   $Log$
-  Revision 1.54  2004-07-09 23:30:13  jonas
+  Revision 1.55  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.54.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.54  2004/07/09 23:30:13  jonas
     *  changed first_sse_imreg to first_mm_imreg
 
   Revision 1.53  2004/07/09 23:09:02  peter

compiler/i386/csopt386.pas

@@ -1988,7 +1988,7 @@ begin
                               if (memreg <> NR_NO) and
                                  (not getNextInstruction(p,hp1) or
                                   (RegLoadedWithNewValue(getsupreg(memreg),false,hp1) or
-                                   FindRegDealloc(regcounter,hp1))) then
+                                   FindRegDealloc(getsupreg(memreg),hp1))) then
                                 begin
                                   hp1 := Tai_Marker.Create(NoPropInfoEnd);
                                   insertllitem(asml,p,p.next,hp1);
@@ -2109,7 +2109,13 @@ end.
 
 {
   $Log$
-  Revision 1.64  2004-07-23 13:30:19  jonas
+  Revision 1.65  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.64.4.1  2004/09/20 19:28:23  peter
+    * fixed valgrind warning
+
+  Revision 1.64  2004/07/23 13:30:19  jonas
     * fixed some more potential regvar bugs
 
   Revision 1.63  2004/06/20 08:55:31  florian

compiler/nadd.pas

@@ -1758,11 +1758,7 @@ implementation
                   if nodetype in [addn,subn,muln,andn,orn,xorn] then
                     expectloc:=LOC_REGISTER
                   else
-{$ifdef sparc}
-                    expectloc:=LOC_FLAGS;
-{$else sparc}
                     expectloc:=LOC_JUMP;
-{$endif sparc}
                   calcregisters(self,2,0,0)
                end
 {$endif cpu64bit}
@@ -2034,10 +2030,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.128  2004-09-13 20:32:53  peter
+  Revision 1.129  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.128  2004/09/13 20:32:53  peter
     * only make both operands the same for xor,and,or when both are
       integer types
 
+  Revision 1.127.4.1  2004/09/19 18:08:30  peter
+    * int64 compare fixed
+
   Revision 1.127  2004/08/17 19:04:36  jonas
     * fixed "if @procvar_of_object <> nil" in Delphi/TP mode for for non-x86
 

compiler/ncal.pas

@@ -29,7 +29,7 @@ interface
     uses
        cutils,cclasses,
        globtype,cpuinfo,
-       paramgr,
+       paramgr,parabase,
        node,nbas,nutils,
        {$ifdef state_tracking}
        nstate,
@@ -1787,8 +1787,10 @@ type
               Used order:
                 1. LOC_REFERENCE with smallest offset (x86 only)
                 2. LOC_REFERENCE with most registers
-                3. LOC_REGISTER with most registers }
-            currloc:=hpcurr.paraitem.paraloc[callerside].loc;
+                3. LOC_REGISTER with most registers
+              For the moment we only look at the first parameter field. Combining it
+              with multiple parameter fields will make things a lot complexer (PFV) }
+            currloc:=hpcurr.paraitem.paraloc[callerside].location^.loc;
             hpprev:=nil;
             hp:=hpfirst;
             while assigned(hp) do
@@ -1796,7 +1798,7 @@ type
                 case currloc of
                   LOC_REFERENCE :
                     begin
-                      case hp.paraitem.paraloc[callerside].loc of
+                      case hp.paraitem.paraloc[callerside].location^.loc of
                         LOC_REFERENCE :
                           begin
                             { Offset is calculated like:
@@ -1810,7 +1812,7 @@ type
                             }
                             if (hpcurr.registersint>hp.registersint)
 {$ifdef x86}
-                               or (hpcurr.paraitem.paraloc[callerside].reference.offset>hp.paraitem.paraloc[callerside].reference.offset)
+                               or (hpcurr.paraitem.paraloc[callerside].location^.reference.offset>hp.paraitem.paraloc[callerside].location^.reference.offset)
 {$endif x86}
                                then
                               break;
@@ -1823,7 +1825,7 @@ type
                   LOC_FPUREGISTER,
                   LOC_REGISTER :
                     begin
-                      if (hp.paraitem.paraloc[callerside].loc=currloc) and
+                      if (hp.paraitem.paraloc[callerside].location^.loc=currloc) and
                          (hpcurr.registersint>hp.registersint) then
                         break;
                     end;
@@ -2384,9 +2386,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.247  2004-09-13 20:29:00  peter
+  Revision 1.248  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.247  2004/09/13 20:29:00  peter
     * use realname for abstract procs found
 
+  Revision 1.246.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
   Revision 1.246  2004/08/28 20:00:50  peter
     * use objrealname in Message1
 

compiler/ncgbas.pas

@@ -174,7 +174,7 @@ interface
                       begin
                         op.typ:=top_ref;
                         new(op.ref);
-                        reference_reset_base(op.ref^,sym.localloc.reference.index,sym.localloc.reference.offset+sofs);
+                        reference_reset_base(op.ref^,sym.localloc.reference.base,sym.localloc.reference.offset+sofs);
                         op.ref^.index:=indexreg;
 {$ifdef x86}
                         op.ref^.scalefactor:=scale;
@@ -496,7 +496,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.65  2004-07-16 19:45:15  jonas
+  Revision 1.66  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.65.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.65  2004/07/16 19:45:15  jonas
     + temps can now also hold fpu values in registers (take care with use,
       bacause of the x86 fpu stack)
     * fpu parameters to node-inlined procedures can now also be put in

compiler/ncgcal.pas

@@ -29,16 +29,18 @@ interface
     uses
       cpubase,
       globtype,
+      parabase,
       symdef,node,ncal;
 
     type
        tcgcallparanode = class(tcallparanode)
        private
-          tempparaloc : tparalocation;
-          procedure allocate_tempparaloc;
+          tempcgpara : tcgpara;
           procedure push_addr_para;
           procedure push_value_para;
        public
+          constructor create(expr,next : tnode);override;
+          destructor destroy;override;
           procedure secondcallparan;override;
        end;
 
@@ -50,7 +52,7 @@ interface
           procedure pushparas;
           procedure freeparas;
        protected
-          framepointer_paraloc : tparalocation;
+          framepointer_paraloc : tcgpara;
           refcountedtemp : treference;
           procedure handle_return_value;
           {# This routine is used to push the current frame pointer
@@ -100,22 +102,17 @@ implementation
                              TCGCALLPARANODE
 *****************************************************************************}
 
-    procedure tcgcallparanode.allocate_tempparaloc;
+    constructor tcgcallparanode.create(expr,next : tnode);
       begin
-         { Allocate (temporary) paralocation }
-         tempparaloc:=paraitem.paraloc[callerside];
-         case tempparaloc.loc of
-           LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER:
-             paramanager.alloctempregs(exprasmlist,tempparaloc);
-{$ifdef cputargethasfixedstack}
-           LOC_REFERENCE:
-             begin
-               { currently, we copy the value always to a secure location }
-               if not(assigned(aktcallnode.inlinecode)) then
-                 paramanager.alloctempparaloc(exprasmlist,aktcallnode.procdefinition.proccalloption,paraitem,tempparaloc);
-             end;
-{$endif cputargethasfixedstack}
-         end;
+        inherited create(expr,next);
+        tempcgpara.init;
+      end;
+
+
+    destructor tcgcallparanode.destroy;
+      begin
+        tempcgpara.done;
+        inherited destroy;
       end;
 
 
@@ -124,7 +121,7 @@ implementation
         if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
           internalerror(200304235);
         location_release(exprasmlist,left.location);
-        cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
+        cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempcgpara);
       end;
 
 
@@ -149,46 +146,46 @@ implementation
          begin
            location_release(exprasmlist,left.location);
 {$ifdef i386}
-           if tempparaloc.loc<>LOC_REFERENCE then
+           if tempcgpara.location^.loc<>LOC_REFERENCE then
              internalerror(200309291);
            case left.location.loc of
              LOC_FPUREGISTER,
              LOC_CFPUREGISTER:
                begin
-                 size:=align(TCGSize2Size[left.location.size],tempparaloc.alignment);
-                 if tempparaloc.reference.index=NR_STACK_POINTER_REG then
+                 size:=align(TCGSize2Size[left.location.size],tempcgpara.alignment);
+                 if tempcgpara.location^.reference.index=NR_STACK_POINTER_REG then
                    begin
                      cg.g_stackpointer_alloc(exprasmlist,size);
                      reference_reset_base(href,NR_STACK_POINTER_REG,0);
                    end
                  else
-                   reference_reset_base(href,tempparaloc.reference.index,tempparaloc.reference.offset);
+                   reference_reset_base(href,tempcgpara.location^.reference.index,tempcgpara.location^.reference.offset);
                  cg.a_loadfpu_reg_ref(exprasmlist,left.location.size,left.location.register,href);
                end;
              LOC_MMREGISTER,
              LOC_CMMREGISTER:
                begin
-                 size:=align(tfloatdef(left.resulttype.def).size,tempparaloc.alignment);
-                 if tempparaloc.reference.index=NR_STACK_POINTER_REG then
+                 size:=align(tfloatdef(left.resulttype.def).size,tempcgpara.alignment);
+                 if tempcgpara.location^.reference.index=NR_STACK_POINTER_REG then
                    begin
                      cg.g_stackpointer_alloc(exprasmlist,size);
                      reference_reset_base(href,NR_STACK_POINTER_REG,0);
                    end
                  else
-                   reference_reset_base(href,tempparaloc.reference.index,tempparaloc.reference.offset);
+                   reference_reset_base(href,tempcgpara.location^.reference.index,tempcgpara.location^.reference.offset);
                  cg.a_loadmm_reg_ref(exprasmlist,left.location.size,left.location.size,left.location.register,href,mms_movescalar);
                end;
              LOC_REFERENCE,
              LOC_CREFERENCE :
                begin
-                 size:=align(left.resulttype.def.size,tempparaloc.alignment);
-                 if tempparaloc.reference.index=NR_STACK_POINTER_REG then
+                 size:=align(left.resulttype.def.size,tempcgpara.alignment);
+                 if tempcgpara.location^.reference.index=NR_STACK_POINTER_REG then
                    begin
                      href:=left.location.reference;
                      inc(href.offset,size);
                      while (size>0) do
                       begin
-                        if (size>=4) or (tempparaloc.alignment>=4) then
+                        if (size>=4) or (tempcgpara.alignment>=4) then
                          begin
                            cgsize:=OS_32;
                            dec(href.offset,4);
@@ -200,12 +197,12 @@ implementation
                            dec(href.offset,2);
                            dec(size,2);
                          end;
-                        cg.a_param_ref(exprasmlist,cgsize,href,tempparaloc);
+                        cg.a_param_ref(exprasmlist,cgsize,href,tempcgpara);
                       end;
                    end
                  else
                    begin
-                     reference_reset_base(href,tempparaloc.reference.index,tempparaloc.reference.offset);
+                     reference_reset_base(href,tempcgpara.location^.reference.index,tempcgpara.location^.reference.offset);
                      cg.g_concatcopy(exprasmlist,left.location.reference,href,size,false,false);
                    end;
                end;
@@ -216,29 +213,29 @@ implementation
            case left.location.loc of
              LOC_MMREGISTER,
              LOC_CMMREGISTER:
-               case tempparaloc.loc of
+               case tempcgpara.location^.loc of
                  LOC_REFERENCE,
                  LOC_CREFERENCE,
                  LOC_MMREGISTER,
                  LOC_CMMREGISTER:
-                   cg.a_parammm_reg(exprasmlist,left.location.size,left.location.register,tempparaloc,mms_movescalar);
+                   cg.a_parammm_reg(exprasmlist,left.location.size,left.location.register,tempcgpara,mms_movescalar);
                  LOC_FPUREGISTER,
                  LOC_CFPUREGISTER:
                    begin
                      location_force_fpureg(exprasmlist,left.location,false);
-                     cg.a_paramfpu_reg(exprasmlist,left.location.size,left.location.register,tempparaloc);
+                     cg.a_paramfpu_reg(exprasmlist,left.location.size,left.location.register,tempcgpara);
                    end;
                  else
                    internalerror(2002042433);
                end;
              LOC_FPUREGISTER,
              LOC_CFPUREGISTER:
-               case tempparaloc.loc of
+               case tempcgpara.location^.loc of
                  LOC_MMREGISTER,
                  LOC_CMMREGISTER:
                    begin
                      location_force_mmregscalar(exprasmlist,left.location,false);
-                     cg.a_parammm_reg(exprasmlist,left.location.size,left.location.register,tempparaloc,mms_movescalar);
+                     cg.a_parammm_reg(exprasmlist,left.location.size,left.location.register,tempcgpara,mms_movescalar);
                    end;
 {$ifdef x86_64}
                  { x86_64 pushes s64comp in normal register }
@@ -248,7 +245,7 @@ implementation
                      location_force_mem(exprasmlist,left.location);
                      { force integer size }
                      left.location.size:=int_cgsize(tcgsize2size[left.location.size]);
-                     cg.a_param_ref(exprasmlist,left.location.size,left.location.reference,tempparaloc);
+                     cg.a_param_ref(exprasmlist,left.location.size,left.location.reference,tempcgpara);
                    end;
 {$endif x86_64}
 {$ifdef sparc}
@@ -260,16 +257,26 @@ implementation
                  LOC_CREFERENCE,
                  LOC_FPUREGISTER,
                  LOC_CFPUREGISTER:
-                   cg.a_paramfpu_reg(exprasmlist,left.location.size,left.location.register,tempparaloc);
+                   cg.a_paramfpu_reg(exprasmlist,left.location.size,left.location.register,tempcgpara);
                  else
                    internalerror(2002042433);
                end;
              LOC_REFERENCE,
              LOC_CREFERENCE:
-               case tempparaloc.loc of
+               case tempcgpara.location^.loc of
                  LOC_MMREGISTER,
                  LOC_CMMREGISTER:
-                   cg.a_parammm_ref(exprasmlist,left.location.size,left.location.reference,tempparaloc,mms_movescalar);
+                   cg.a_parammm_ref(exprasmlist,left.location.size,left.location.reference,tempcgpara,mms_movescalar);
+{$ifdef x86_64}
+                 { x86_64 pushes s64comp in normal register }
+                 LOC_REGISTER,
+                 LOC_CREGISTER :
+                   begin
+                     { force integer size }
+                     left.location.size:=int_cgsize(tcgsize2size[left.location.size]);
+                     cg.a_param_ref(exprasmlist,left.location.size,left.location.reference,tempcgpara);
+                   end;
+{$endif x86_64}
 {$ifdef sparc}
                  { sparc pushes floats in normal registers }
                  LOC_REGISTER,
@@ -279,7 +286,7 @@ implementation
                  LOC_CREFERENCE,
                  LOC_FPUREGISTER,
                  LOC_CFPUREGISTER:
-                   cg.a_paramfpu_ref(exprasmlist,left.location.size,left.location.reference,tempparaloc);
+                   cg.a_paramfpu_ref(exprasmlist,left.location.size,left.location.reference,tempcgpara);
                  else
                    internalerror(2002042431);
                end;
@@ -298,22 +305,22 @@ implementation
             begin
               location_release(exprasmlist,left.location);
 {$ifdef i386}
-              if tempparaloc.loc<>LOC_REFERENCE then
+              if tempcgpara.location^.loc<>LOC_REFERENCE then
                 internalerror(200309292);
               if not (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
                 internalerror(200204241);
               { push on stack }
-              size:=align(left.resulttype.def.size,tempparaloc.alignment);
-              if tempparaloc.reference.index=NR_STACK_POINTER_REG then
+              size:=align(left.resulttype.def.size,tempcgpara.alignment);
+              if tempcgpara.location^.reference.index=NR_STACK_POINTER_REG then
                 begin
                   cg.g_stackpointer_alloc(exprasmlist,size);
                   reference_reset_base(href,NR_STACK_POINTER_REG,0);
                 end
               else
-                reference_reset_base(href,tempparaloc.reference.index,tempparaloc.reference.offset);
+                reference_reset_base(href,tempcgpara.location^.reference.index,tempcgpara.location^.reference.offset);
               cg.g_concatcopy(exprasmlist,left.location.reference,href,size,false,false);
 {$else i386}
-              cg.a_param_copy_ref(exprasmlist,left.resulttype.def.size,left.location.reference,tempparaloc);
+              cg.a_param_copy_ref(exprasmlist,left.resulttype.def.size,left.location.reference,tempcgpara);
 {$endif i386}
             end
            else
@@ -328,14 +335,14 @@ implementation
 {$ifndef cpu64bit}
                     if left.location.size in [OS_64,OS_S64] then
                      begin
-                       cg64.a_param64_loc(exprasmlist,left.location,tempparaloc);
+                       cg64.a_param64_loc(exprasmlist,left.location,tempcgpara);
                        location_release(exprasmlist,left.location);
                      end
                     else
 {$endif cpu64bit}
                      begin
                        location_release(exprasmlist,left.location);
-                       cg.a_param_loc(exprasmlist,left.location,tempparaloc);
+                       cg.a_param_loc(exprasmlist,left.location,tempcgpara);
                      end;
                   end;
 {$ifdef SUPPORT_MMX}
@@ -376,7 +383,10 @@ implementation
              objectlibrary.getlabel(falselabel);
              secondpass(left);
 
-             allocate_tempparaloc;
+             if not(assigned(aktcallnode.inlinecode)) then
+               paramanager.createtempparaloc(exprasmlist,aktcallnode.procdefinition.proccalloption,paraitem,tempcgpara)
+             else
+               paramanager.duplicateparaloc(exprasmlist,aktcallnode.procdefinition.proccalloption,paraitem,tempcgpara);
 
              { handle varargs first, because paraitem.parasym is not valid }
              if (cpf_varargs_para in callparaflags) then
@@ -416,7 +426,7 @@ implementation
                      (not(nf_procvarload in hp.flags)) then
                     begin
                       location_release(exprasmlist,left.location);
-                      cg.a_param_loc(exprasmlist,left.location,tempparaloc);
+                      cg.a_param_loc(exprasmlist,left.location,tempcgpara);
                     end
                   else
                     push_addr_para;
@@ -488,13 +498,14 @@ implementation
 
     procedure tcgcallnode.handle_return_value;
       var
-        cgsize : tcgsize;
+        cgsize    : tcgsize;
+        retloc    : tlocation;
         hregister : tregister;
-        tempnode: tnode;
-        resultloc : tparalocation;
+        tempnode  : tnode;
+        resultparaloc : pcgparalocation;
       begin
-        resultloc:=procdefinition.funcret_paraloc[callerside];
-        cgsize:=resultloc.size;
+        resultparaloc:=procdefinition.funcret_paraloc[callerside].location;
+        cgsize:=procdefinition.funcret_paraloc[callerside].size;
 
         { structured results are easy to handle....
           needed also when result_no_used !! }
@@ -520,9 +531,9 @@ implementation
                 end
               else
                 begin
-                  cg.ungetregister(exprasmlist,resultloc.register);
+                  cg.ungetregister(exprasmlist,resultparaloc^.register);
                   hregister := cg.getaddressregister(exprasmlist);
-                  cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,resultloc.register,hregister);
+                  cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,resultparaloc^.register,hregister);
                   { in case of a regular funcretnode with ret_in_param, the }
                   { original funcretnode isn't touched -> make sure it's    }
                   { the same here (not sure if it's necessary)              }
@@ -549,12 +560,12 @@ implementation
             { we have only to handle the result if it is used }
             if (cnf_return_value_used in callnodeflags) then
               begin
-                location.loc:=resultloc.loc;
-                case resultloc.loc of
+                location.loc:=resultparaloc^.loc;
+                case resultparaloc^.loc of
                    LOC_FPUREGISTER:
                      begin
                        location_reset(location,LOC_FPUREGISTER,cgsize);
-                       location.register:=procdefinition.funcret_paraloc[callerside].register;
+                       location.register:=resultparaloc^.register;
 {$ifdef x86}
                        tcgx86(cg).inc_fpu_stack;
 {$else x86}
@@ -573,31 +584,29 @@ implementation
 {$ifndef cpu64bit}
                           if cgsize in [OS_64,OS_S64] then
                            begin
-                             { Move the function result to free registers, preferably the
-                               FUNCTION_RESULT_REG/FUNCTION_RESULTHIGH_REG, so no move is necessary.}
-                             { the FUNCTION_RESULT_LOW_REG/FUNCTION_RESULT_HIGH_REG
-                               are already allocated }
-                             cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT64_LOW_REG);
+                             procdefinition.funcret_paraloc[callerside].get_location(retloc);
+                             if retloc.loc<>LOC_REGISTER then
+                               internalerror(200409141);
+                             { the function result registers are already allocated }
+                             cg.ungetregister(exprasmlist,retloc.registerlow);
                              location.registerlow:=cg.getintregister(exprasmlist,OS_32);
-                             cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,NR_FUNCTION_RESULT64_LOW_REG,location.registerlow);
-                             cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT64_HIGH_REG);
+                             cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,retloc.registerlow,location.registerlow);
+                             cg.ungetregister(exprasmlist,retloc.registerhigh);
                              location.registerhigh:=cg.getintregister(exprasmlist,OS_32);
-                             cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,NR_FUNCTION_RESULT64_HIGH_REG,location.registerhigh);
+                             cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,retloc.registerhigh,location.registerhigh);
                            end
                           else
 {$endif cpu64bit}
                            begin
-                             { Move the function result to a free register, preferably the
-                               FUNCTION_RESULT_REG, so no move is necessary.}
-                             { the FUNCTION_RESULT_REG is already allocated }
-                             cg.ungetregister(exprasmlist,resultloc.register);
+                             { the function result register are already allocated }
+                             cg.ungetregister(exprasmlist,resultparaloc^.register);
                              { change register size after the unget because the
                                getregister was done for the full register
 
                                def_cgsize(resulttype.def) is used here because
                                it could be a constructor call }
                              location.register:=cg.getintregister(exprasmlist,def_cgsize(resulttype.def));
-                             cg.a_load_reg_reg(exprasmlist,cgsize,def_cgsize(resulttype.def),resultloc.register,location.register);
+                             cg.a_load_reg_reg(exprasmlist,cgsize,def_cgsize(resulttype.def),resultparaloc^.register,location.register);
                            end;
                         end
                        else
@@ -610,9 +619,9 @@ implementation
                    LOC_MMREGISTER:
                      begin
                        location_reset(location,LOC_MMREGISTER,cgsize);
-                       cg.ungetregister(exprasmlist,resultloc.register);
+                       cg.ungetregister(exprasmlist,resultparaloc^.register);
                        location.register:=cg.getmmregister(exprasmlist,cgsize);
-                       cg.a_loadmm_reg_reg(exprasmlist,cgsize,cgsize,resultloc.register,location.register,mms_movescalar);
+                       cg.a_loadmm_reg_reg(exprasmlist,cgsize,cgsize,resultparaloc^.register,location.register,mms_movescalar);
                      end;
 
                    else
@@ -623,11 +632,11 @@ implementation
               begin
 {$ifdef x86}
                 { release FPU stack }
-                if resultloc.loc=LOC_FPUREGISTER then
+                if resultparaloc^.loc=LOC_FPUREGISTER then
                   emit_reg(A_FSTP,S_NO,NR_FPU_RESULT_REG);
 {$endif x86}
                 if cgsize<>OS_NO then
-                  paramanager.freeparaloc(exprasmlist,resultloc);
+                  paramanager.freeparaloc(exprasmlist,procdefinition.funcret_paraloc[callerside]);
                 location_reset(location,LOC_VOID,OS_NO);
               end;
            end;
@@ -671,7 +680,10 @@ implementation
      procedure tcgcallnode.pushparas;
        var
          ppn : tcgcallparanode;
+         callerparaloc,
+         tmpparaloc : pcgparalocation;
 {$ifdef cputargethasfixedstack}
+         htempref,
          href : treference;
 {$endif cputargethasfixedstack}
        begin
@@ -682,97 +694,83 @@ implementation
              if (ppn.left.nodetype<>nothingn) then
                begin
                  { better check for the real location of the parameter here, when stack passed parameters
-                   are saved temporary in registers, checking for the tempparaloc.loc is wrong
+                   are saved temporary in registers, checking for the tmpparaloc.loc is wrong
                  }
-                 case ppn.paraitem.paraloc[callerside].loc of
-                   LOC_REGISTER:
-                     begin
-                       if not assigned(inlinecode) then
+                 if not assigned(inlinecode) then
+                   paramanager.freeparaloc(exprasmlist,ppn.tempcgpara);
+                 tmpparaloc:=ppn.tempcgpara.location;
+                 callerparaloc:=ppn.paraitem.paraloc[callerside].location;
+                 while assigned(callerparaloc) do
+                   begin
+                     { Every paraloc must have a matching tmpparaloc }
+                     if not assigned(tmpparaloc) then
+                       internalerror(200408224);
+                     if callerparaloc^.size<>tmpparaloc^.size then
+                       internalerror(200408225);
+                     case callerparaloc^.loc of
+                       LOC_REGISTER:
                          begin
-                           paramanager.freeparaloc(exprasmlist,ppn.tempparaloc);
-                           paramanager.allocparaloc(exprasmlist,ppn.paraitem.paraloc[callerside]);
+                           if tmpparaloc^.loc<>LOC_REGISTER then
+                             internalerror(200408221);
+                           if getsupreg(callerparaloc^.register)<first_int_imreg then
+                             cg.getexplicitregister(exprasmlist,callerparaloc^.register);
+                           cg.a_load_reg_reg(exprasmlist,tmpparaloc^.size,tmpparaloc^.size,
+                               tmpparaloc^.register,callerparaloc^.register);
                          end;
-  {$ifdef sparc}
-                       case ppn.tempparaloc.size of
-                         OS_F32 :
-                           ppn.tempparaloc.size:=OS_32;
-                         OS_F64 :
-                           ppn.tempparaloc.size:=OS_64;
-                       end;
-  {$endif sparc}
-  {$ifndef cpu64bit}
-                       if ppn.tempparaloc.size in [OS_64,OS_S64] then
-                         begin
-                           cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,ppn.tempparaloc.registerlow,
-                              ppn.paraitem.paraloc[callerside].registerlow);
-                           cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,ppn.tempparaloc.registerhigh,
-                              ppn.paraitem.paraloc[callerside].registerhigh);
-                         end
-                       else
-  {$endif cpu64bit}
-                         cg.a_load_reg_reg(exprasmlist,ppn.tempparaloc.size,ppn.tempparaloc.size,
-                             ppn.tempparaloc.register,ppn.paraitem.paraloc[callerside].register);
-                     end;
-                   LOC_FPUREGISTER:
-                     begin
-                       if not assigned(inlinecode) then
+                       LOC_FPUREGISTER:
                          begin
-                           paramanager.freeparaloc(exprasmlist,ppn.tempparaloc);
-                           paramanager.allocparaloc(exprasmlist,ppn.paraitem.paraloc[callerside]);
-                           cg.a_loadfpu_reg_reg(exprasmlist,ppn.tempparaloc.size,
-                             ppn.tempparaloc.register,ppn.paraitem.paraloc[callerside].register);
+                           if tmpparaloc^.loc<>LOC_FPUREGISTER then
+                             internalerror(200408222);
+                           if getsupreg(callerparaloc^.register)<first_fpu_imreg then
+                             cg.getexplicitregister(exprasmlist,callerparaloc^.register);
+                           cg.a_loadfpu_reg_reg(exprasmlist,ppn.tempcgpara.size,tmpparaloc^.register,callerparaloc^.register);
                          end;
-                     end;
-                   LOC_MMREGISTER:
-                     begin
-                       if not assigned(inlinecode) then
+                       LOC_MMREGISTER:
                          begin
-                           paramanager.freeparaloc(exprasmlist,ppn.tempparaloc);
-                           paramanager.allocparaloc(exprasmlist,ppn.paraitem.paraloc[callerside]);
+                           if tmpparaloc^.loc<>LOC_MMREGISTER then
+                             internalerror(200408223);
+                           if getsupreg(callerparaloc^.register)<first_mm_imreg then
+                             cg.getexplicitregister(exprasmlist,callerparaloc^.register);
+                           cg.a_loadmm_reg_reg(exprasmlist,tmpparaloc^.size,tmpparaloc^.size,
+                             tmpparaloc^.register,callerparaloc^.register,mms_movescalar);
                          end;
-                       cg.a_loadmm_reg_reg(exprasmlist,ppn.tempparaloc.size,
-                         ppn.tempparaloc.size,ppn.tempparaloc.register,ppn.paraitem.paraloc[callerside].register,mms_movescalar);
-                     end;
-                   LOC_REFERENCE:
-                     begin
-                       if not assigned(inlinecode) then
+                       LOC_REFERENCE:
                          begin
+                           if not assigned(inlinecode) then
+                             begin
 {$ifdef cputargethasfixedstack}
-                           { copy parameters in case they were moved to a temp. location because we've a fixed stack }
-                           paramanager.freeparaloc(exprasmlist,ppn.tempparaloc);
-                           paramanager.allocparaloc(exprasmlist,ppn.paraitem.paraloc[callerside]);
-                           case ppn.tempparaloc.loc of
-                             LOC_REFERENCE:
-                               begin
-                                 reference_reset_base(href,ppn.tempparaloc.reference.index,ppn.tempparaloc.reference.offset);
-                                 if ppn.paraitem.paraloc[callerside].size=OS_NO then
-                                   cg.a_param_copy_ref(exprasmlist,ppn.paraitem.paratype.def.size,href,ppn.paraitem.paraloc[callerside])
+                               reference_reset_base(href,callerparaloc^.reference.index,callerparaloc^.reference.offset);
+                               { copy parameters in case they were moved to a temp. location because we've a fixed stack }
+                               case tmpparaloc^.loc of
+                                 LOC_REFERENCE:
+                                   begin
+                                     reference_reset_base(htempref,tmpparaloc^.reference.index,tmpparaloc^.reference.offset);
+                                     { use concatcopy, because it can also be a float which fails when
+                                       load_ref_ref is used }
+                                     cg.g_concatcopy(exprasmlist,htempref,href,tcgsize2size[tmpparaloc^.size],false,false);
+                                   end;
+                                 LOC_REGISTER:
+                                   cg.a_load_reg_ref(exprasmlist,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href);
+                                 LOC_FPUREGISTER:
+                                   cg.a_loadfpu_reg_ref(exprasmlist,tmpparaloc^.size,tmpparaloc^.register,href);
+                                 LOC_MMREGISTER:
+                                   cg.a_loadmm_reg_ref(exprasmlist,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href,mms_movescalar);
                                  else
-                                   cg.a_param_ref(exprasmlist,ppn.paraitem.paraloc[callerside].size,href,ppn.paraitem.paraloc[callerside]);
+                                   internalerror(200402081);
                                end;
-                             LOC_REGISTER:
-      {$ifndef cpu64bit}
-                               if ppn.tempparaloc.size in [OS_64,OS_S64] then
-                                 cg64.a_param64_reg(exprasmlist,ppn.tempparaloc.register64,ppn.paraitem.paraloc[callerside])
-                               else
-      {$endif cpu64bit}
-                                 cg.a_param_reg(exprasmlist,ppn.paraitem.paraloc[callerside].size,ppn.tempparaloc.register,ppn.paraitem.paraloc[callerside]);
-                             LOC_FPUREGISTER:
-                               cg.a_paramfpu_reg(exprasmlist,ppn.paraitem.paraloc[callerside].size,ppn.tempparaloc.register,ppn.paraitem.paraloc[callerside]);
-                             else
-                               internalerror(200402081);
-                           end;
-  {$endif cputargethasfixedstack}
+{$endif cputargethasfixedstack}
+                             end;
                          end;
                      end;
-                   else
-                     internalerror(200402091);
-                 end;
+                     callerparaloc:=callerparaloc^.next;
+                     tmpparaloc:=tmpparaloc^.next;
+                   end;
                end;
              ppn:=tcgcallparanode(ppn.right);
            end;
        end;
 
+
      procedure tcgcallnode.freeparas;
        var
          ppn : tcgcallparanode;
@@ -782,7 +780,7 @@ implementation
          while assigned(ppn) do
            begin
              if not assigned(inlinecode) or
-                (ppn.paraitem.paraloc[callerside].loc <> LOC_REFERENCE) then
+                (ppn.paraitem.paraloc[callerside].location^.loc <> LOC_REFERENCE) then
                paramanager.freeparaloc(exprasmlist,ppn.paraitem.paraloc[callerside]);
              ppn:=tcgcallparanode(ppn.right);
            end;
@@ -792,15 +790,15 @@ implementation
 
     procedure tcgcallnode.normal_pass_2;
       var
-         regs_to_push_fpu,
-         regs_to_alloc,
-         regs_to_free : Tcpuregisterset;
+         regs_to_save_int,
+         regs_to_save_fpu,
+         regs_to_save_mm   : Tcpuregisterset;
          href : treference;
          pop_size : longint;
          pvreg,
          vmtreg : tregister;
          oldaktcallnode : tcallnode;
-
+         funcretloc : pcgparalocation;
       begin
          if not assigned(procdefinition) or
             not procdefinition.has_paraloc_info then
@@ -814,34 +812,29 @@ implementation
              cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
            end;
 
-        regs_to_alloc:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
-        regs_to_push_fpu:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption);
+        regs_to_save_int:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
+        regs_to_save_fpu:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption);
+        regs_to_save_mm:=paramanager.get_volatile_registers_mm(procdefinition.proccalloption);
 
         { Include Function result registers }
         if (not is_void(resulttype.def)) then
           begin
-            case procdefinition.funcret_paraloc[callerside].loc of
-              LOC_REGISTER,LOC_CREGISTER:
-                begin
-{$ifndef cpu64bit}
-                  if procdefinition.funcret_paraloc[callerside].size in [OS_S64,OS_64] then
-                    begin
-                      include(regs_to_alloc,getsupreg(procdefinition.funcret_paraloc[callerside].registerlow));
-                      include(regs_to_alloc,getsupreg(procdefinition.funcret_paraloc[callerside].registerhigh));
-                    end
-                 else
-{$endif cpu64bit}
-                   include(regs_to_alloc,getsupreg(procdefinition.funcret_paraloc[callerside].register));
-                end;
-              LOC_FPUREGISTER,LOC_CFPUREGISTER:
-                begin
-                  include(regs_to_push_fpu,getsupreg(procdefinition.funcret_paraloc[callerside].register));
-                end;
-              LOC_MMREGISTER,LOC_CMMREGISTER:
-                begin
-                  include(regs_to_alloc,getsupreg(procdefinition.funcret_paraloc[callerside].register));
+            funcretloc:=procdefinition.funcret_paraloc[callerside].location;
+            while assigned(funcretloc) do
+              begin
+                case funcretloc^.loc of
+                  LOC_REGISTER,
+                  LOC_CREGISTER:
+                    include(regs_to_save_int,getsupreg(funcretloc^.register));
+                  LOC_FPUREGISTER,
+                  LOC_CFPUREGISTER:
+                    include(regs_to_save_fpu,getsupreg(funcretloc^.register));
+                  LOC_MMREGISTER,
+                  LOC_CMMREGISTER:
+                    include(regs_to_save_mm,getsupreg(funcretloc^.register));
                 end;
-            end;
+                funcretloc:=funcretloc^.next;
+              end;
           end;
 
          { Process parameters, register parameters will be loaded
@@ -900,11 +893,11 @@ implementation
                    { Release register containing procvar }
                    cg.ungetregister(exprasmlist,pvreg);
 
-                   cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,regs_to_alloc);
+                   cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,regs_to_save_int);
                    if cg.uses_registers(R_FPUREGISTER) then
-                     cg.allocexplicitregisters(exprasmlist,R_FPUREGISTER,regs_to_push_fpu);
+                     cg.allocexplicitregisters(exprasmlist,R_FPUREGISTER,regs_to_save_fpu);
                    if cg.uses_registers(R_MMREGISTER) then
-                     cg.allocexplicitregisters(exprasmlist,R_MMREGISTER,paramanager.get_volatile_registers_mm(procdefinition.proccalloption));
+                     cg.allocexplicitregisters(exprasmlist,R_MMREGISTER,regs_to_save_mm);
 
                    { call method }
                    extra_call_code;
@@ -920,11 +913,11 @@ implementation
                   { free the resources allocated for the parameters }
                   freeparas;
 
-                  cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,regs_to_alloc);
+                  cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,regs_to_save_int);
                   if cg.uses_registers(R_FPUREGISTER) then
-                    cg.allocexplicitregisters(exprasmlist,R_FPUREGISTER,regs_to_push_fpu);
+                    cg.allocexplicitregisters(exprasmlist,R_FPUREGISTER,regs_to_save_fpu);
                   if cg.uses_registers(R_MMREGISTER) then
-                    cg.allocexplicitregisters(exprasmlist,R_MMREGISTER,paramanager.get_volatile_registers_mm(procdefinition.proccalloption));
+                    cg.allocexplicitregisters(exprasmlist,R_MMREGISTER,regs_to_save_mm);
 
                   if procdefinition.proccalloption=pocall_syscall then
                     do_syscall
@@ -964,11 +957,11 @@ implementation
               { Release register containing procvar }
               cg.ungetregister(exprasmlist,pvreg);
 
-              cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,regs_to_alloc);
+              cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,regs_to_save_int);
               if cg.uses_registers(R_FPUREGISTER) then
-                cg.allocexplicitregisters(exprasmlist,R_FPUREGISTER,regs_to_push_fpu);
+                cg.allocexplicitregisters(exprasmlist,R_FPUREGISTER,regs_to_save_fpu);
               if cg.uses_registers(R_MMREGISTER) then
-                cg.allocexplicitregisters(exprasmlist,R_MMREGISTER,paramanager.get_volatile_registers_mm(procdefinition.proccalloption));
+                cg.allocexplicitregisters(exprasmlist,R_MMREGISTER,regs_to_save_mm);
 
               { Calling interrupt from the same code requires some
                 extra code }
@@ -994,33 +987,30 @@ implementation
 
          { Release registers, but not the registers that contain the
            function result }
-         regs_to_free:=regs_to_alloc;
          if (not is_void(resulttype.def)) then
            begin
-             case procdefinition.funcret_paraloc[callerside].loc of
-               LOC_REGISTER,LOC_CREGISTER:
-                 begin
-{$ifndef cpu64bit}
-                   if procdefinition.funcret_paraloc[callerside].size in [OS_S64,OS_64] then
-                     begin
-                       exclude(regs_to_free,getsupreg(procdefinition.funcret_paraloc[callerside].registerlow));
-                       exclude(regs_to_free,getsupreg(procdefinition.funcret_paraloc[callerside].registerhigh));
-                     end
-                   else
-{$endif cpu64bit}
-                     exclude(regs_to_free,getsupreg(procdefinition.funcret_paraloc[callerside].register));
-                 end;
-               LOC_FPUREGISTER,LOC_CFPUREGISTER:
-                 begin
-                   exclude(regs_to_push_fpu,getsupreg(procdefinition.funcret_paraloc[callerside].register));
-                 end;
-             end;
+            funcretloc:=procdefinition.funcret_paraloc[callerside].location;
+            while assigned(funcretloc) do
+              begin
+                case funcretloc^.loc of
+                  LOC_REGISTER,
+                  LOC_CREGISTER:
+                    exclude(regs_to_save_int,getsupreg(funcretloc^.register));
+                  LOC_FPUREGISTER,
+                  LOC_CFPUREGISTER:
+                    exclude(regs_to_save_fpu,getsupreg(funcretloc^.register));
+                  LOC_MMREGISTER,
+                  LOC_CMMREGISTER:
+                    exclude(regs_to_save_mm,getsupreg(funcretloc^.register));
+                end;
+                funcretloc:=funcretloc^.next;
+              end;
            end;
          if cg.uses_registers(R_MMREGISTER) then
-           cg.deallocexplicitregisters(exprasmlist,R_MMREGISTER,paramanager.get_volatile_registers_mm(procdefinition.proccalloption));
+           cg.deallocexplicitregisters(exprasmlist,R_MMREGISTER,regs_to_save_mm);
          if cg.uses_registers(R_FPUREGISTER) then
-           cg.deallocexplicitregisters(exprasmlist,R_FPUREGISTER,regs_to_push_fpu);
-         cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,regs_to_free);
+           cg.deallocexplicitregisters(exprasmlist,R_FPUREGISTER,regs_to_save_fpu);
+         cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,regs_to_save_int);
 
          { handle function results }
          if (not is_void(resulttype.def)) then
@@ -1079,7 +1069,8 @@ implementation
          paramanager.create_inline_paraloc_info(procdefinition);
 
          { Allocate parameters and locals }
-         gen_alloc_inline_parast(exprasmlist,tparasymtable(procdefinition.parast));
+         gen_alloc_inline_parast(exprasmlist,tprocdef(procdefinition));
+         gen_alloc_inline_funcret(exprasmlist,tprocdef(procdefinition));
          if tprocdef(procdefinition).localst.symtabletype=localsymtable then
            gen_alloc_localst(exprasmlist,tlocalsymtable(tprocdef(procdefinition).localst));
 
@@ -1148,7 +1139,7 @@ implementation
          gen_load_para_value(inlineentrycode);
          { now that we've loaded the para's, free them }
          freeparas;
-         gen_initialize_code(inlineentrycode,true);
+         gen_initialize_code(inlineentrycode);
          if po_assembler in current_procinfo.procdef.procoptions then
            inlineentrycode.insert(Tai_marker.Create(asmblockstart));
          exprasmList.concatlist(inlineentrycode);
@@ -1157,7 +1148,7 @@ implementation
          secondpass(inlinecode);
 
          cg.a_label(exprasmlist,current_procinfo.aktexitlabel);
-         gen_finalize_code(inlineexitcode,true);
+         gen_finalize_code(inlineexitcode);
          gen_load_return_value(inlineexitcode);
          if po_assembler in current_procinfo.procdef.procoptions then
            inlineexitcode.concat(Tai_marker.Create(asmblockend));
@@ -1263,7 +1254,22 @@ begin
 end.
 {
   $Log$
-  Revision 1.173  2004-07-12 10:47:42  michael
+  Revision 1.174  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.173.4.3  2004/09/20 20:46:34  peter
+    * register allocation optimized for 64bit loading of parameters
+      and return values
+
+  Revision 1.173.4.2  2004/09/17 17:19:26  peter
+    * fixed 64 bit unaryminus for sparc
+    * fixed 64 bit inlining
+    * signness of not operation
+
+  Revision 1.173.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.173  2004/07/12 10:47:42  michael
   + Fix for bug 3207 from Peter
 
   Revision 1.172  2004/07/11 19:01:13  peter

compiler/ncgflw.pas

@@ -84,16 +84,13 @@ implementation
     uses
       verbose,globals,systems,globtype,
       symconst,symdef,symsym,aasmbase,aasmtai,aasmcpu,defutil,
-      procinfo,cgbase,pass_2,
+      procinfo,cgbase,pass_2,parabase,
       cpubase,cpuinfo,
       nld,ncon,
       ncgutil,
       tgobj,paramgr,
       regvars,
       cgutils,cgobj
-{$ifndef cpu64bit}
-      ,cg64f32
-{$endif cpu64bit}
       ;
 
 {*****************************************************************************
@@ -778,11 +775,14 @@ implementation
       var
          a : tasmlabel;
          href2: treference;
-         paraloc1,paraloc2,paraloc3 : tparalocation;
+         paraloc1,paraloc2,paraloc3 : tcgpara;
       begin
-         paraloc1:=paramanager.getintparaloc(pocall_default,1);
-         paraloc2:=paramanager.getintparaloc(pocall_default,2);
-         paraloc3:=paramanager.getintparaloc(pocall_default,3);
+         paraloc1.init;
+         paraloc2.init;
+         paraloc3.init;
+         paramanager.getintparaloc(pocall_default,1,paraloc1);
+         paramanager.getintparaloc(pocall_default,2,paraloc2);
+         paramanager.getintparaloc(pocall_default,3,paraloc3);
          location_reset(location,LOC_VOID,OS_NO);
 
          if assigned(left) then
@@ -847,6 +847,9 @@ implementation
               cg.a_call_name(exprasmlist,'FPC_RERAISE');
               cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
            end;
+         paraloc1.done;
+         paraloc2.done;
+         paraloc3.done;
        end;
 
 
@@ -862,18 +865,20 @@ implementation
     { in the except block                                    }
     procedure cleanupobjectstack;
       var
-        paraloc1 : tparalocation;
+        paraloc1 : tcgpara;
       begin
          cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
          cg.a_call_name(exprasmlist,'FPC_POPOBJECTSTACK');
          cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-         paraloc1:=paramanager.getintparaloc(pocall_default,1);
+         paraloc1.init;
+         paramanager.getintparaloc(pocall_default,1,paraloc1);
          paramanager.allocparaloc(exprasmlist,paraloc1);
          cg.a_param_reg(exprasmlist,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
          paramanager.freeparaloc(exprasmlist,paraloc1);
          cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
          cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
          cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+         paraloc1.done;
       end;
 
 
@@ -897,7 +902,7 @@ implementation
          exceptflowcontrol : tflowcontrol;
          destroytemps,
          excepttemps : texceptiontemps;
-         paraloc1 : tparalocation;
+         paraloc1 : tcgpara;
       label
          errorexit;
       begin
@@ -906,6 +911,8 @@ implementation
          oldflowcontrol:=flowcontrol;
          flowcontrol:=[];
          { this can be called recursivly }
+         oldaktbreaklabel:=nil;
+         oldaktcontinuelabel:=nil;
          oldendexceptlabel:=endexceptlabel;
 
          { save the old labels for control flow statements }
@@ -977,13 +984,15 @@ implementation
               { FPC_CATCHES must be called with
                 'default handler' flag (=-1)
               }
-              paraloc1:=paramanager.getintparaloc(pocall_default,1);
+              paraloc1.init;
+              paramanager.getintparaloc(pocall_default,1,paraloc1);
               paramanager.allocparaloc(exprasmlist,paraloc1);
               cg.a_param_const(exprasmlist,OS_ADDR,-1,paraloc1);
               paramanager.freeparaloc(exprasmlist,paraloc1);
               cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
               cg.a_call_name(exprasmlist,'FPC_CATCHES');
               cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+              paraloc1.done;
 
               { the destruction of the exception object must be also }
               { guarded by an exception frame                        }
@@ -1006,13 +1015,15 @@ implementation
               cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
               cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
 
-              paraloc1:=paramanager.getintparaloc(pocall_default,1);
+              paraloc1.init;
+              paramanager.getintparaloc(pocall_default,1,paraloc1);
               paramanager.allocparaloc(exprasmlist,paraloc1);
               cg.a_param_reg(exprasmlist, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1);
               paramanager.freeparaloc(exprasmlist,paraloc1);
               cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
               cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
               cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+              paraloc1.done;
               { we don't need to restore esi here because reraise never }
               { returns                                                 }
               cg.a_call_name(exprasmlist,'FPC_RERAISE');
@@ -1134,8 +1145,9 @@ implementation
          excepttemps : texceptiontemps;
          exceptref,
          href2: treference;
-         paraloc1 : tparalocation;
+         paraloc1 : tcgpara;
       begin
+         paraloc1.init;
          location_reset(location,LOC_VOID,OS_NO);
 
          oldflowcontrol:=flowcontrol;
@@ -1144,7 +1156,7 @@ implementation
 
          { send the vmt parameter }
          reference_reset_symbol(href2,objectlibrary.newasmsymbol(excepttype.vmt_mangledname,AB_EXTERNAL,AT_DATA),0);
-         paraloc1:=paramanager.getintparaloc(pocall_default,1);
+         paramanager.getintparaloc(pocall_default,1,paraloc1);
          paramanager.allocparaloc(exprasmlist,paraloc1);
          cg.a_paramaddr_ref(exprasmlist,href2,paraloc1);
          paramanager.freeparaloc(exprasmlist,paraloc1);
@@ -1161,9 +1173,7 @@ implementation
              tvarsym(exceptsymtable.symindex.first).localloc.loc:=LOC_REFERENCE;
              tg.GetLocal(exprasmlist,sizeof(aint),voidpointertype.def,
                 tvarsym(exceptsymtable.symindex.first).localloc.reference);
-             reference_reset_base(href2,tvarsym(exceptsymtable.symindex.first).localloc.reference.index,
-                tvarsym(exceptsymtable.symindex.first).localloc.reference.offset);
-             cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,href2);
+             cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,tvarsym(exceptsymtable.symindex.first).localloc.reference);
            end
          else
            begin
@@ -1179,6 +1189,8 @@ implementation
          get_exception_temps(exprasmlist,excepttemps);
          new_exception(exprasmlist,excepttemps,1,doobjectdestroyandreraise);
 
+         oldaktbreaklabel:=nil;
+         oldaktcontinuelabel:=nil;
          if assigned(right) then
            begin
               oldaktexitlabel:=current_procinfo.aktexitlabel;
@@ -1204,7 +1216,7 @@ implementation
          cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
          cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
          cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-         paraloc1:=paramanager.getintparaloc(pocall_default,1);
+         paramanager.getintparaloc(pocall_default,1,paraloc1);
          paramanager.allocparaloc(exprasmlist,paraloc1);
          cg.a_param_reg(exprasmlist, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1);
          paramanager.freeparaloc(exprasmlist,paraloc1);
@@ -1262,6 +1274,8 @@ implementation
          unget_exception_temps(exprasmlist,excepttemps);
          cg.a_label(exprasmlist,nextonlabel);
          flowcontrol:=oldflowcontrol+flowcontrol;
+         paraloc1.done;
+
          { next on node }
          if assigned(left) then
            secondpass(left);
@@ -1440,7 +1454,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.97  2004-06-20 08:55:29  florian
+  Revision 1.98  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.97.4.2  2004/09/12 18:30:48  peter
+    * uninitialized vars fixed
+
+  Revision 1.97.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.97  2004/06/20 08:55:29  florian
     * logs truncated
 
   Revision 1.96  2004/06/16 20:07:08  florian

compiler/ncginl.pas

@@ -57,7 +57,7 @@ implementation
       globtype,systems,
       cutils,verbose,globals,fmodule,
       symconst,symdef,defutil,symsym,
-      aasmbase,aasmtai,aasmcpu,
+      aasmbase,aasmtai,aasmcpu,parabase,
       cgbase,pass_1,pass_2,
       cpuinfo,cpubase,paramgr,procinfo,
       nbas,ncon,ncal,ncnv,nld,
@@ -183,15 +183,19 @@ implementation
        hp2 : tstringconstnode;
        otlabel,oflabel : tasmlabel;
        paraloc1,paraloc2,
-       paraloc3,paraloc4 : tparalocation;
+       paraloc3,paraloc4 : tcgpara;
      begin
        { the node should be removed in the firstpass }
        if not (cs_do_assertion in aktlocalswitches) then
           internalerror(7123458);
-       paraloc1:=paramanager.getintparaloc(pocall_default,1);
-       paraloc2:=paramanager.getintparaloc(pocall_default,2);
-       paraloc3:=paramanager.getintparaloc(pocall_default,3);
-       paraloc4:=paramanager.getintparaloc(pocall_default,4);
+       paraloc1.init;
+       paraloc2.init;
+       paraloc3.init;
+       paraloc4.init;
+       paramanager.getintparaloc(pocall_default,1,paraloc1);
+       paramanager.getintparaloc(pocall_default,2,paraloc2);
+       paramanager.getintparaloc(pocall_default,3,paraloc3);
+       paramanager.getintparaloc(pocall_default,4,paraloc4);
        otlabel:=truelabel;
        oflabel:=falselabel;
        objectlibrary.getlabel(truelabel);
@@ -229,6 +233,10 @@ implementation
        cg.a_label(exprasmlist,truelabel);
        truelabel:=otlabel;
        falselabel:=oflabel;
+       paraloc1.done;
+       paraloc2.done;
+       paraloc3.done;
+       paraloc4.done;
      end;
 
 
@@ -686,7 +694,13 @@ end.
 
 {
   $Log$
-  Revision 1.62  2004-08-16 21:00:15  peter
+  Revision 1.63  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.62.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.62  2004/08/16 21:00:15  peter
     * range checks fixed
 
   Revision 1.61  2004/07/12 17:58:19  peter

compiler/ncgld.pas

@@ -56,7 +56,7 @@ implementation
       aasmbase,aasmtai,aasmcpu,
       cgbase,pass_2,
       procinfo,
-      cpubase,
+      cpubase,parabase,
       tgobj,ncgutil,
       cgutils,cgobj,
       ncgbas;
@@ -80,7 +80,7 @@ implementation
         newsize : tcgsize;
         endrelocatelab,
         norelocatelab : tasmlabel;
-        paraloc1 : tparalocation;
+        paraloc1 : tcgpara;
       begin
          { we don't know the size of all arrays }
          newsize:=def_cgsize(resulttype.def);
@@ -164,7 +164,8 @@ implementation
                        objectlibrary.getlabel(norelocatelab);
                        objectlibrary.getlabel(endrelocatelab);
                        { make sure hregister can't allocate the register necessary for the parameter }
-                       paraloc1:=paramanager.getintparaloc(pocall_default,1);
+                       paraloc1.init;
+                       paramanager.getintparaloc(pocall_default,1,paraloc1);
                        hregister:=cg.getaddressregister(exprasmlist);
                        reference_reset_symbol(href,objectlibrary.newasmsymbol('FPC_THREADVAR_RELOCATE',AB_EXTERNAL,AT_DATA),0);
                        cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,hregister);
@@ -175,6 +176,7 @@ implementation
                        paramanager.allocparaloc(exprasmlist,paraloc1);
                        cg.a_param_ref(exprasmlist,OS_ADDR,href,paraloc1);
                        paramanager.freeparaloc(exprasmlist,paraloc1);
+                       paraloc1.done;
                        cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
                        cg.a_call_reg(exprasmlist,hregister);
                        cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
@@ -235,8 +237,7 @@ implementation
                                 begin
                                   if tvarsym(symtableentry).localloc.loc<>LOC_REFERENCE then
                                     internalerror(2003091816);
-                                  location.reference.base:=tvarsym(symtableentry).localloc.reference.index;
-                                  location.reference.offset:=tvarsym(symtableentry).localloc.reference.offset;
+                                  location.reference:=tvarsym(symtableentry).localloc.reference;
                                 end;
                               globalsymtable,
                               staticsymtable :
@@ -254,8 +255,7 @@ implementation
                                 begin
                                   if tvarsym(symtableentry).localloc.loc<>LOC_REFERENCE then
                                     internalerror(2003091817);
-                                  location.reference.base:=tvarsym(symtableentry).localloc.reference.index;
-                                  location.reference.offset:=tvarsym(symtableentry).localloc.reference.offset;
+                                  location.reference:=tvarsym(symtableentry).localloc.reference;
                                 end;
                               else
                                 internalerror(200305102);
@@ -394,6 +394,7 @@ implementation
          href : treference;
          old_allow_multi_pass2,
          releaseright : boolean;
+         len : aint;
          cgsize : tcgsize;
          r:Tregister;
 
@@ -408,14 +409,14 @@ implementation
         {
           in most cases we can process first the right node which contains
           the most complex code. Exceptions for this are:
-	    - result is in flags, loading left will then destroy the flags
-	    - result need reference count, when left points to a value used in
-	      right then decreasing the refcnt on left can possibly release
-	      the memory before right increased the refcnt, result is that an
-	      empty value is assigned
-	    - calln, call destroys most registers and is therefor 'complex'
-	
-	   But not when the result is in the flags, then
+            - result is in flags, loading left will then destroy the flags
+            - result need reference count, when left points to a value used in
+              right then decreasing the refcnt on left can possibly release
+              the memory before right increased the refcnt, result is that an
+              empty value is assigned
+            - calln, call destroys most registers and is therefor 'complex'
+
+           But not when the result is in the flags, then
           loading the left node afterwards can destroy the flags.
 
           when the right node returns as LOC_JUMP then we will generate
@@ -598,10 +599,16 @@ implementation
                     LOC_REFERENCE,
                     LOC_CREFERENCE :
                       begin
-                        cg.g_concatcopy(exprasmlist,right.location.reference,
-                                    left.location.reference,left.resulttype.def.size,true,false);
-                        { right.location is already released by concatcopy }
-                        releaseright:=false;
+{$warning HACK: unaligned test, maybe remove all unaligned locations (array of char) from the compiler}
+                        { Use unaligned copy when the offset is not aligned }
+                        len:=left.resulttype.def.size;
+                        if (right.location.reference.offset mod sizeof(aint)<>0) and
+                           (len>sizeof(aint)) then
+                          cg.g_concatcopy_unaligned(exprasmlist,right.location.reference,
+                              left.location.reference,len,false,false)
+                        else
+                          cg.g_concatcopy(exprasmlist,right.location.reference,
+                              left.location.reference,len,false,false);
                       end;
                     else
                       internalerror(200203284);
@@ -751,7 +758,7 @@ implementation
         dovariant : boolean;
         elesize : longint;
         tmpreg  : tregister;
-        paraloc : tparalocation;
+        paraloc : tcgparalocation;
       begin
         dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
         if dovariant then
@@ -961,9 +968,21 @@ begin
 end.
 {
   $Log$
-  Revision 1.123  2004-09-13 20:33:41  peter
+  Revision 1.124  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.123  2004/09/13 20:33:41  peter
     * pwidechar support in array of const
 
+  Revision 1.122.4.3  2004/09/12 18:31:50  peter
+    * use normal concatcopy when data < sizeof(aint)
+
+  Revision 1.122.4.2  2004/09/12 13:36:40  peter
+    * fixed alignment issues
+
+  Revision 1.122.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
   Revision 1.122  2004/08/15 13:30:18  florian
     * fixed alignment of variant records
     * more alignment problems fixed

compiler/ncgmat.pas

@@ -129,6 +129,7 @@ implementation
       globtype,systems,
       cutils,verbose,globals,
       symconst,aasmbase,aasmtai,aasmcpu,defutil,
+      parabase,
       pass_2,
       ncon,
       tgobj,ncgutil,cgobj,paramgr
@@ -266,7 +267,7 @@ implementation
          hdenom : tregister;
          power : longint;
          hl : tasmlabel;
-         paraloc1 : tparalocation;
+         paraloc1 : tcgpara;
       begin
          secondpass(left);
          if codegenerror then
@@ -332,11 +333,13 @@ implementation
                   }
                   objectlibrary.getlabel(hl);
                   cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_NE,0,hdenom,hl);
-                  paraloc1:=paramanager.getintparaloc(pocall_default,1);
+                  paraloc1.init;
+                  paramanager.getintparaloc(pocall_default,1,paraloc1);
                   paramanager.allocparaloc(exprasmlist,paraloc1);
                   cg.a_param_const(exprasmlist,OS_S32,200,paraloc1);
                   paramanager.freeparaloc(exprasmlist,paraloc1);
                   cg.a_call_name(exprasmlist,'FPC_HANDLERROR');
+                  paraloc1.done;
                   cg.a_label(exprasmlist,hl);
                   if nodetype = modn then
                     emit_mod_reg_reg(is_signed(left.resulttype.def),hdenom,hreg1)
@@ -480,7 +483,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.27  2004-06-20 08:55:29  florian
+  Revision 1.28  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.27.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.27  2004/06/20 08:55:29  florian
     * logs truncated
 
   Revision 1.26  2004/06/16 20:07:08  florian

compiler/ncgmem.pas

@@ -21,8 +21,6 @@
 
  ****************************************************************************
 }
-{ This unit generate assembler for memory related nodes.
-}
 unit ncgmem;
 
 {$i fpcdefs.inc}
@@ -80,22 +78,18 @@ interface
 implementation
 
     uses
-{$ifdef delphi}
-      sysutils,
-{$else}
-      strings,
-{$endif}
 {$ifdef GDB}
+      strings,
       gdb,
 {$endif GDB}
       systems,
       cutils,verbose,globals,
       symconst,symdef,symsym,defutil,paramgr,
       aasmbase,aasmtai,
-      procinfo,pass_2,
+      procinfo,pass_2,parabase,
       pass_1,nld,ncon,nadd,nutils,
       cgutils,cgobj,
-      tgobj,ncgutil,symbase
+      tgobj,ncgutil
       ;
 
 
@@ -194,15 +188,7 @@ implementation
             hsym:=tvarsym(currpi.procdef.parast.search('parentfp'));
             if not assigned(hsym) then
               internalerror(200309281);
-            case hsym.localloc.loc of
-              LOC_REFERENCE :
-                begin
-                  reference_reset_base(href,hsym.localloc.reference.index,hsym.localloc.reference.offset);
-                  cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,location.register);
-                end;
-              LOC_REGISTER :
-                cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,hsym.localloc.register,location.register);
-            end;
+            cg.a_load_loc_reg(exprasmlist,OS_ADDR,hsym.localloc,location.register);
             { walk parents }
             while (currpi.procdef.owner.symtablelevel>parentpd.parast.symtablelevel) do
               begin
@@ -259,7 +245,7 @@ implementation
 
     procedure tcgderefnode.pass_2;
       var
-        paraloc1 : tparalocation;
+        paraloc1 : tcgpara;
       begin
          secondpass(left);
          location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def));
@@ -292,10 +278,12 @@ implementation
             not(cs_compilesystem in aktmoduleswitches) and
             (not tpointerdef(left.resulttype.def).is_far) then
           begin
-            paraloc1:=paramanager.getintparaloc(pocall_default,1);
+            paraloc1.init;
+            paramanager.getintparaloc(pocall_default,1,paraloc1);
             paramanager.allocparaloc(exprasmlist,paraloc1);
             cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1);
             paramanager.freeparaloc(exprasmlist,paraloc1);
+            paraloc1.done;
             cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
             cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
             cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
@@ -309,11 +297,12 @@ implementation
 
     procedure tcgsubscriptnode.pass_2;
       var
-        paraloc1 : tparalocation;
+        paraloc1 : tcgpara;
       begin
          secondpass(left);
          if codegenerror then
            exit;
+         paraloc1.init;
          { classes and interfaces must be dereferenced implicit }
          if is_class_or_interface(left.resulttype.def) then
            begin
@@ -347,7 +336,7 @@ implementation
                 (cs_checkpointer in aktglobalswitches) and
                 not(cs_compilesystem in aktmoduleswitches) then
               begin
-                paraloc1:=paramanager.getintparaloc(pocall_default,1);
+                paramanager.getintparaloc(pocall_default,1,paraloc1);
                 paramanager.allocparaloc(exprasmlist,paraloc1);
                 cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1);
                 paramanager.freeparaloc(exprasmlist,paraloc1);
@@ -365,7 +354,7 @@ implementation
                 (cs_checkpointer in aktglobalswitches) and
                 not(cs_compilesystem in aktmoduleswitches) then
               begin
-                paraloc1:=paramanager.getintparaloc(pocall_default,1);
+                paramanager.getintparaloc(pocall_default,1,paraloc1);
                 paramanager.allocparaloc(exprasmlist,paraloc1);
                 cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1);
                 paramanager.freeparaloc(exprasmlist,paraloc1);
@@ -380,6 +369,7 @@ implementation
          inc(location.reference.offset,vs.fieldoffset);
          { also update the size of the location }
          location.size:=def_cgsize(resulttype.def);
+         paraloc1.done;
       end;
 
 
@@ -520,8 +510,10 @@ implementation
          poslabel,
          neglabel : tasmlabel;
          hreg : tregister;
-         paraloc1,paraloc2 : tparalocation;
+         paraloc1,paraloc2 : tcgpara;
        begin
+         paraloc1.init;
+         paraloc2.init;
          if is_open_array(left.resulttype.def) or
             is_array_of_const(left.resulttype.def) then
           begin
@@ -562,8 +554,8 @@ implementation
          else
           if is_dynamic_array(left.resulttype.def) then
             begin
-               paraloc1:=paramanager.getintparaloc(pocall_default,1);
-               paraloc2:=paramanager.getintparaloc(pocall_default,2);
+               paramanager.getintparaloc(pocall_default,1,paraloc1);
+               paramanager.getintparaloc(pocall_default,2,paraloc2);
                paramanager.allocparaloc(exprasmlist,paraloc2);
                cg.a_param_loc(exprasmlist,right.location,paraloc2);
                paramanager.allocparaloc(exprasmlist,paraloc1);
@@ -576,6 +568,8 @@ implementation
             end
          else
            cg.g_rangecheck(exprasmlist,right.location,right.resulttype.def,left.resulttype.def);
+         paraloc1.done;
+         paraloc2.done;
        end;
 
 
@@ -590,8 +584,10 @@ implementation
          newsize : tcgsize;
          mulsize: longint;
          isjump  : boolean;
-         paraloc1,paraloc2 : tparalocation;
+         paraloc1,paraloc2 : tcgpara;
       begin
+         paraloc1.init;
+         paraloc2.init;
          mulsize := get_mul_size;
 
          newsize:=def_cgsize(resulttype.def);
@@ -628,7 +624,7 @@ implementation
                 we can use the ansistring routine here }
               if (cs_check_range in aktlocalswitches) then
                 begin
-                   paraloc1:=paramanager.getintparaloc(pocall_default,1);
+                   paramanager.getintparaloc(pocall_default,1,paraloc1);
                    paramanager.allocparaloc(exprasmlist,paraloc1);
                    cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paraloc1);
                    paramanager.freeparaloc(exprasmlist,paraloc1);
@@ -712,8 +708,8 @@ implementation
                          st_ansistring:
                        {$endif}
                            begin
-                              paraloc1:=paramanager.getintparaloc(pocall_default,1);
-                              paraloc2:=paramanager.getintparaloc(pocall_default,2);
+                              paramanager.getintparaloc(pocall_default,1,paraloc1);
+                              paramanager.getintparaloc(pocall_default,2,paraloc2);
                               paramanager.allocparaloc(exprasmlist,paraloc2);
                               cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paraloc2);
                               href:=location.reference;
@@ -850,8 +846,8 @@ implementation
                          st_ansistring:
                        {$endif}
                            begin
-                              paraloc1:=paramanager.getintparaloc(pocall_default,1);
-                              paraloc2:=paramanager.getintparaloc(pocall_default,2);
+                              paramanager.getintparaloc(pocall_default,1,paraloc1);
+                              paramanager.getintparaloc(pocall_default,2,paraloc2);
                               paramanager.allocparaloc(exprasmlist,paraloc2);
                               cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paraloc2);
                               href:=location.reference;
@@ -883,6 +879,8 @@ implementation
            end;
 
         location.size:=newsize;
+        paraloc1.done;
+        paraloc2.done;
       end;
 
 
@@ -897,7 +895,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.95  2004-08-02 09:15:03  michael
+  Revision 1.96  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.95.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.95  2004/08/02 09:15:03  michael
   + Fixed range check for non-constant indexes in strings
 
   Revision 1.94  2004/07/12 17:58:19  peter

compiler/ncgutil.pas

@@ -29,7 +29,7 @@ interface
     uses
       node,cpuinfo,
       globtype,
-      cpubase,cgbase,
+      cpubase,cgbase,parabase,
       aasmbase,aasmtai,aasmcpu,
       symconst,symbase,symdef,symsym,symtype,symtable
 {$ifndef cpu64bit}
@@ -56,19 +56,14 @@ interface
     procedure gen_proc_entry_code(list:Taasmoutput);
     procedure gen_proc_exit_code(list:Taasmoutput);
     procedure gen_save_used_regs(list:TAAsmoutput);
-    procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tparalocation);
-    procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
-    procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
+    procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tcgpara);
+    procedure gen_initialize_code(list:TAAsmoutput);
+    procedure gen_finalize_code(list:TAAsmoutput);
     procedure gen_entry_code(list:TAAsmoutput);
     procedure gen_exit_code(list:TAAsmoutput);
     procedure gen_load_para_value(list:TAAsmoutput);
     procedure gen_load_return_value(list:TAAsmoutput);
 
-(*
-    procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
-    procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
-*)
-
    {#
       Allocate the buffers for exception management and setjmp environment.
       Return a pointer to these buffers, send them to the utility routine
@@ -106,7 +101,8 @@ interface
     procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
     procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
     procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
-    procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
+    procedure gen_alloc_inline_parast(list:TAAsmoutput;pd:tprocdef);
+    procedure gen_alloc_inline_funcret(list:TAAsmoutput;pd:tprocdef);
     procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
 
     { rtti and init/final }
@@ -298,11 +294,14 @@ implementation
 
     procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;exceptlabel:tasmlabel);
       var
-        paraloc1,paraloc2,paraloc3 : tparalocation;
+        paraloc1,paraloc2,paraloc3 : tcgpara;
       begin
-        paraloc1:=paramanager.getintparaloc(pocall_default,1);
-        paraloc2:=paramanager.getintparaloc(pocall_default,2);
-        paraloc3:=paramanager.getintparaloc(pocall_default,3);
+        paraloc1.init;
+        paraloc2.init;
+        paraloc3.init;
+        paramanager.getintparaloc(pocall_default,1,paraloc1);
+        paramanager.getintparaloc(pocall_default,2,paraloc2);
+        paramanager.getintparaloc(pocall_default,3,paraloc3);
         paramanager.allocparaloc(list,paraloc3);
         cg.a_paramaddr_ref(list,t.envbuf,paraloc3);
         paramanager.allocparaloc(list,paraloc2);
@@ -317,7 +316,7 @@ implementation
         cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
         cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
 
-        paraloc1:=paramanager.getintparaloc(pocall_default,1);
+        paramanager.getintparaloc(pocall_default,1,paraloc1);
         paramanager.allocparaloc(list,paraloc1);
         cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
         paramanager.freeparaloc(list,paraloc1);
@@ -327,6 +326,9 @@ implementation
 
         cg.g_exception_reason_save(list, t.reasonbuf);
         cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),exceptlabel);
+        paraloc1.done;
+        paraloc2.done;
+        paraloc3.done;
      end;
 
 
@@ -718,12 +720,12 @@ implementation
 
     procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
       var
-        href1,href2 : treference;
+        href1 : treference;
         list:TAAsmoutput;
         hsym : tvarsym;
         l    : longint;
         loadref : boolean;
-        localcopyloc : tparalocation;
+        localcopyloc : tlocation;
       begin
         list:=taasmoutput(arg);
         if (tsym(p).typ=varsym) and
@@ -738,8 +740,7 @@ implementation
                  loadref:=false;
                end;
              LOC_REFERENCE :
-               reference_reset_base(href1,tvarsym(p).localloc.reference.index,
-                   tvarsym(p).localloc.reference.offset);
+               href1:=tvarsym(p).localloc.reference;
              else
                internalerror(200309181);
            end;
@@ -760,8 +761,7 @@ implementation
                           so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
                         }
                         include(current_procinfo.flags,pi_do_call);
-                        reference_reset_base(href2,hsym.localloc.reference.index,hsym.localloc.reference.offset);
-                        cg.g_copyvaluepara_openarray(list,href1,href2,tarraydef(tvarsym(p).vartype.def).elesize)
+                        cg.g_copyvaluepara_openarray(list,href1,hsym.localloc.reference,tarraydef(tvarsym(p).vartype.def).elesize)
                       end
                     else
                       internalerror(200309182);
@@ -778,17 +778,16 @@ implementation
               localcopyloc.size:=int_cgsize(l);
               tg.GetLocal(list,l,tvarsym(p).vartype.def,localcopyloc.reference);
               { Copy data }
-              reference_reset_base(href2,localcopyloc.reference.index,localcopyloc.reference.offset);
               if is_shortstring(tvarsym(p).vartype.def) then
                 begin
                   { this code is only executed before the code for the body and the entry/exit code is generated
                     so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
                   }
                   include(current_procinfo.flags,pi_do_call);
-                  cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,loadref)
+                  cg.g_copyshortstring(list,href1,localcopyloc.reference,tstringdef(tvarsym(p).vartype.def).len,false,loadref)
                 end
               else
-                cg.g_concatcopy(list,href1,href2,tvarsym(p).vartype.def.size,true,loadref);
+                cg.g_concatcopy(list,href1,localcopyloc.reference,tvarsym(p).vartype.def.size,true,loadref);
               { update localloc of varsym }
               tg.Ungetlocal(list,tvarsym(p).localloc.reference);
               tvarsym(p).localloc:=localcopyloc;
@@ -833,8 +832,8 @@ implementation
         hp.free;
         exprasmlist:=oldexprasmlist;
       end;
-      
-        
+
+
     { generates the code for finalisation of local variables }
     procedure finalize_local_vars(p : tnamedindexitem;arg:pointer);
       begin
@@ -873,7 +872,7 @@ implementation
                      (pd.procsym=tprocsym(p)) and
                      (pd.localst.symtabletype<>staticsymtable) then
                     pd.localst.foreach_static(@finalize_local_typedconst,arg);
-                end;    
+                end;
             end;
         end;
       end;
@@ -910,7 +909,7 @@ implementation
                      (pd.procsym=tprocsym(p)) and
                      (pd.localst.symtabletype<>staticsymtable) then
                     pd.localst.foreach_static(@finalize_local_typedconst,arg);
-                end;    
+                end;
             end;
         end;
       end;
@@ -934,14 +933,13 @@ implementation
                begin
                  if tvarsym(p).localloc.loc<>LOC_REFERENCE then
                    internalerror(200309187);
-                 reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
-                 cg.g_incrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
+                 cg.g_incrrefcount(list,tvarsym(p).vartype.def,tvarsym(p).localloc.reference,is_open_array(tvarsym(p).vartype.def));
                end;
              vs_out :
                begin
                  case tvarsym(p).localloc.loc of
                    LOC_REFERENCE :
-                     reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
+                     href:=tvarsym(p).localloc.reference;
                    else
                      internalerror(2003091810);
                  end;
@@ -959,7 +957,6 @@ implementation
     { generates the code for decrementing the reference count of parameters }
     procedure final_paras(p : tnamedindexitem;arg:pointer);
       var
-        href : treference;
         list:TAAsmoutput;
       begin
         list:=taasmoutput(arg);
@@ -972,8 +969,7 @@ implementation
               include(current_procinfo.flags,pi_needs_implicit_finally);
               if tvarsym(p).localloc.loc<>LOC_REFERENCE then
                 internalerror(200309188);
-              reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
-              cg.g_decrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
+              cg.g_decrrefcount(list,tvarsym(p).vartype.def,tvarsym(p).localloc.reference,is_open_array(tvarsym(p).vartype.def));
             end;
          end
         else if (tsym(p).typ=varsym) and
@@ -984,10 +980,7 @@ implementation
             { cdecl functions don't have a high pointer so it is not possible to generate
               a local copy }
             if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
-              begin
-                reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
-                cg.g_releasevaluepara_openarray(list,href);
-              end;
+              cg.g_releasevaluepara_openarray(list,tvarsym(p).localloc.reference);
           end;
       end;
 
@@ -1034,12 +1027,15 @@ implementation
 
     procedure gen_load_return_value(list:TAAsmoutput);
       var
+{$ifndef cpu64bit}
+        href   : treference;
+{$endif cpu64bit}
         ressym : tvarsym;
-        resloc : tlocation;
+        resloc,
+        restmploc : tlocation;
         hreg   : tregister;
-        resultloc : tparalocation;
+        funcretloc : pcgparalocation;
       begin
-        resultloc:=current_procinfo.procdef.funcret_paraloc[calleeside];
         { Is the loading needed? }
         if is_void(current_procinfo.procdef.rettype.def) or
            (
@@ -1049,36 +1045,40 @@ implementation
            ) then
            exit;
 
+        funcretloc:=current_procinfo.procdef.funcret_paraloc[calleeside].location;
+        if not assigned(funcretloc) then
+          internalerror(200408202);
+
         { constructors return self }
         if (current_procinfo.procdef.proctypeoption=potype_constructor) then
           ressym:=tvarsym(current_procinfo.procdef.parast.search('self'))
         else
-          ressym := tvarsym(current_procinfo.procdef.funcretsym);
+          ressym:=tvarsym(current_procinfo.procdef.funcretsym);
         if (ressym.refs>0) then
           begin
             case ressym.localloc.loc of
               LOC_FPUREGISTER:
                 begin
-                  location_reset(resloc,LOC_CFPUREGISTER,resultloc.size);
-                  resloc.register:=ressym.localloc.register;
+                  location_reset(restmploc,LOC_CFPUREGISTER,funcretloc^.size);
+                  restmploc.register:=ressym.localloc.register;
                 end;
 
               LOC_REGISTER:
                 begin
-                  location_reset(resloc,LOC_CREGISTER,resultloc.size);
-                  resloc.register:=ressym.localloc.register;
+                  location_reset(restmploc,LOC_CREGISTER,funcretloc^.size);
+                  restmploc.register:=ressym.localloc.register;
                 end;
 
               LOC_MMREGISTER:
                 begin
-                  location_reset(resloc,LOC_CMMREGISTER,resultloc.size);
-                  resloc.register:=ressym.localloc.register;
+                  location_reset(restmploc,LOC_CMMREGISTER,funcretloc^.size);
+                  restmploc.register:=ressym.localloc.register;
                 end;
 
               LOC_REFERENCE:
                 begin
-                  location_reset(resloc,LOC_REFERENCE,resultloc.size);
-                  reference_reset_base(resloc.reference,ressym.localloc.reference.index,ressym.localloc.reference.offset);
+                  location_reset(restmploc,LOC_REFERENCE,funcretloc^.size);
+                  restmploc.reference:=ressym.localloc.reference;
                 end;
               else
                 internalerror(200309184);
@@ -1087,40 +1087,89 @@ implementation
             { Here, we return the function result. In most architectures, the value is
               passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
               function returns in a register and the caller receives it in an other one }
-            case resultloc.loc of
+            case funcretloc^.loc of
               LOC_REGISTER:
                 begin
 {$ifndef cpu64bit}
-                  if resloc.size in [OS_64,OS_S64] then
+                  if current_procinfo.procdef.funcret_paraloc[calleeside].size in [OS_64,OS_S64] then
                     begin
-                      cg.getexplicitregister(list,NR_FUNCTION_RETURN64_LOW_REG);
-                      cg.getexplicitregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
-                      cg.ungetregister(list,NR_FUNCTION_RETURN64_LOW_REG);
-                      cg.ungetregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
-                      // for the optimizer
-                      cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_LOW_REG);
-                      cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
-                      cg64.a_load64_loc_reg(list,resloc,joinreg64(NR_FUNCTION_RETURN64_LOW_REG,
-                                            NR_FUNCTION_RETURN64_HIGH_REG));
+                      current_procinfo.procdef.funcret_paraloc[calleeside].get_location(resloc);
+                      if resloc.loc<>LOC_REGISTER then
+                        internalerror(200409141);
+                      { Load low and high register separate to generate better register
+                        allocation info }
+                      if getsupreg(resloc.registerlow)<first_int_imreg then
+                        begin
+                          cg.getexplicitregister(list,resloc.registerlow);
+                          cg.ungetregister(list,resloc.registerlow);
+                          // for the optimizer
+                          cg.a_reg_alloc(list,resloc.registerlow);
+                        end;
+                      case restmploc.loc of
+                        LOC_REFERENCE :
+                          begin
+                            href:=restmploc.reference;
+                            if target_info.endian=ENDIAN_BIG then
+                              inc(href.offset,4);
+                            cg.a_load_ref_reg(list,OS_32,OS_32,href,resloc.registerlow);
+                          end;
+                        LOC_REGISTER :
+                          cg.a_load_reg_reg(list,OS_32,OS_32,restmploc.registerlow,resloc.registerlow);
+                        else
+                          internalerror(200409201);
+                      end;
+                      if getsupreg(resloc.registerhigh)<first_int_imreg then
+                        begin
+                          cg.getexplicitregister(list,resloc.registerhigh);
+                          cg.ungetregister(list,resloc.registerhigh);
+                          // for the optimizer
+                          cg.a_reg_alloc(list,resloc.registerhigh);
+                        end;
+                      case restmploc.loc of
+                        LOC_REFERENCE :
+                          begin
+                            href:=restmploc.reference;
+                            if target_info.endian=ENDIAN_LITTLE then
+                              inc(href.offset,4);
+                            cg.a_load_ref_reg(list,OS_32,OS_32,href,resloc.registerhigh);
+                          end;
+                        LOC_REGISTER :
+                          cg.a_load_reg_reg(list,OS_32,OS_32,restmploc.registerhigh,resloc.registerhigh);
+                        else
+                          internalerror(200409201);
+                      end;
                     end
                   else
 {$endif cpu64bit}
                     begin
-                      cg.getexplicitregister(list,resultloc.register);
-                      hreg:=cg.makeregsize(list,resultloc.register,resloc.size);
-                      cg.ungetregister(list,hreg);
-                      // for the optimizer
-                      cg.a_reg_alloc(list,resultloc.register);
-                      cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
+                      hreg:=cg.makeregsize(list,funcretloc^.register,restmploc.size);
+                      if getsupreg(funcretloc^.register)<first_int_imreg then
+                        begin
+                          cg.getexplicitregister(list,funcretloc^.register);
+                          cg.ungetregister(list,hreg);
+                          // for the optimizer
+                          cg.a_reg_alloc(list,funcretloc^.register);
+                        end;
+                      cg.a_load_loc_reg(list,restmploc.size,restmploc,hreg);
                     end;
                 end;
               LOC_FPUREGISTER:
                 begin
-                  cg.a_loadfpu_loc_reg(list,resloc,resultloc.register);
+                  if getsupreg(funcretloc^.register)<first_fpu_imreg then
+                    begin
+                      cg.getexplicitregister(list,funcretloc^.register);
+                      cg.ungetregister(list,funcretloc^.register);
+                    end;
+                  cg.a_loadfpu_loc_reg(list,restmploc,funcretloc^.register);
                 end;
               LOC_MMREGISTER:
                 begin
-                  cg.a_loadmm_loc_reg(list,resloc.size,resloc,resultloc.register,mms_movescalar);
+                  if getsupreg(funcretloc^.register)<first_mm_imreg then
+                    begin
+                      cg.getexplicitregister(list,funcretloc^.register);
+                      cg.ungetregister(list,funcretloc^.register);
+                    end;
+                  cg.a_loadmm_loc_reg(list,restmploc.size,restmploc,funcretloc^.register,mms_movescalar);
                 end;
               LOC_INVALID,
               LOC_REFERENCE:
@@ -1135,8 +1184,9 @@ implementation
     procedure gen_load_para_value(list:TAAsmoutput);
       var
         hp : tparaitem;
-        href : treference;
         gotregvarparas : boolean;
+        hiparaloc,
+        paraloc : pcgparalocation;
       begin
         { Store register parameters in reference or in register variable }
         if assigned(current_procinfo.procdef.parast) and
@@ -1149,6 +1199,10 @@ implementation
             gotregvarparas := false;
             while assigned(hp) do
               begin
+                paraloc:=hp.paraloc[calleeside].location;
+                if not assigned(paraloc) then
+                  internalerror(200408203);
+                hiparaloc:=paraloc^.next;
                 case tvarsym(hp.parasym).localloc.loc of
                   LOC_REGISTER,
                   LOC_MMREGISTER,
@@ -1162,35 +1216,26 @@ implementation
                     end;
                   LOC_REFERENCE :
                     begin
-                      if hp.paraloc[calleeside].loc<>LOC_REFERENCE then
+                      if paraloc^.loc<>LOC_REFERENCE then
                         begin
-                          if getregtype(hp.paraloc[calleeside].register)=R_INTREGISTER then
+                          if getregtype(paraloc^.register)=R_INTREGISTER then
                             begin
-                              if getsupreg(hp.paraloc[calleeside].register)<first_int_imreg then
+                              if getsupreg(paraloc^.register)<first_int_imreg then
                                 begin
 {$ifndef cpu64bit}
-                                  if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
-                                    begin
-                                      cg.getexplicitregister(list,hp.paraloc[calleeside].registerlow);
-                                      cg.getexplicitregister(list,hp.paraloc[calleeside].registerhigh);
-                                    end
-                                  else
+                                  if assigned(hiparaloc) then
+                                    cg.getexplicitregister(list,hiparaloc^.register);
 {$endif cpu64bit}
-                                    cg.getexplicitregister(list,hp.paraloc[calleeside].register);
+                                  cg.getexplicitregister(list,paraloc^.register);
                                 end;
                               { Release parameter register }
 {$ifndef cpu64bit}
-                              if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
-                                begin
-                                  cg.ungetregister(list,hp.paraloc[calleeside].registerlow);
-                                  cg.ungetregister(list,hp.paraloc[calleeside].registerhigh);
-                                end
-                              else
+                              if assigned(hiparaloc) then
+                                cg.ungetregister(list,hiparaloc^.register);
 {$endif cpu64bit}
-                                cg.ungetregister(list,hp.paraloc[calleeside].register);
+                              cg.ungetregister(list,paraloc^.register);
                             end;
-                          reference_reset_base(href,tvarsym(hp.parasym).localloc.reference.index,tvarsym(hp.parasym).localloc.reference.offset);
-                          cg.a_loadany_param_ref(list,hp.paraloc[calleeside],href,mms_movescalar);
+                          cg.a_loadany_param_ref(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.reference,mms_movescalar);
                         end;
                     end;
                   else
@@ -1219,7 +1264,7 @@ implementation
       end;
 
 
-    procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
+    procedure gen_initialize_code(list:TAAsmoutput);
       begin
         { initialize local data like ansistrings }
         case current_procinfo.procdef.proctypeoption of
@@ -1251,7 +1296,7 @@ implementation
       end;
 
 
-    procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
+    procedure gen_finalize_code(list:TAAsmoutput);
       begin
 {$ifdef OLDREGVARS}
         cleanup_regvars(list);
@@ -1288,9 +1333,12 @@ implementation
       var
         href : treference;
         paraloc1,
-        paraloc2 : tparalocation;
+        paraloc2 : tcgpara;
         hp   : tused_unit;
       begin
+        paraloc1.init;
+        paraloc2.init;
+
         { the actual profile code can clobber some registers,
           therefore if the context must be saved, do it before
           the actual call to the profile code
@@ -1316,8 +1364,8 @@ implementation
               (cs_profile in aktmoduleswitches) then
             begin
               reference_reset_symbol(href,objectlibrary.newasmsymbol('etext',AB_EXTERNAL,AT_DATA),0);
-              paraloc1:=paramanager.getintparaloc(pocall_default,1);
-              paraloc2:=paramanager.getintparaloc(pocall_default,2);
+              paramanager.getintparaloc(pocall_default,1,paraloc1);
+              paramanager.getintparaloc(pocall_default,2,paraloc2);
               paramanager.allocparaloc(list,paraloc2);
               cg.a_paramaddr_ref(list,href,paraloc2);
               reference_reset_symbol(href,objectlibrary.newasmsymbol('__image_base__',AB_EXTERNAL,AT_DATA),0);
@@ -1360,6 +1408,9 @@ implementation
 {$ifdef OLDREGVARS}
         load_regvars(list,nil);
 {$endif OLDREGVARS}
+
+        paraloc1.done;
+        paraloc2.done;
       end;
 
 
@@ -1504,9 +1555,11 @@ implementation
         lotemp,
         stackframe : longint;
         check      : boolean;
-        paraloc1   : tparalocation;
+        paraloc1   : tcgpara;
         href       : treference;
       begin
+        paraloc1.init;
+
         { generate call frame marker for dwarf call frame info }
         dwarfcfi.start_frame(list);
 
@@ -1517,8 +1570,8 @@ implementation
           begin
             { Allocate tempspace to store register parameter than
               is destroyed when calling stackchecking code }
-            paraloc1:=paramanager.getintparaloc(pocall_default,1);
-            if paraloc1.loc=LOC_REGISTER then
+            paramanager.getintparaloc(pocall_default,1,paraloc1);
+            if paraloc1.location^.loc=LOC_REGISTER then
               tg.GetTemp(list,sizeof(aint),tt_normal,href);
           end;
 
@@ -1550,20 +1603,22 @@ implementation
            begin
              { The tempspace to store original register is already
                allocated above before the stackframe size is calculated. }
-             if paraloc1.loc=LOC_REGISTER then
-               cg.a_load_reg_ref(list,OS_INT,OS_INT,paraloc1.register,href);
+             if paraloc1.location^.loc=LOC_REGISTER then
+               cg.a_load_reg_ref(list,OS_INT,OS_INT,paraloc1.location^.register,href);
              paramanager.allocparaloc(list,paraloc1);
              cg.a_param_const(list,OS_INT,stackframe,paraloc1);
              paramanager.freeparaloc(list,paraloc1);
              cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
              cg.a_call_name(list,'FPC_STACKCHECK');
              cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-             if paraloc1.loc=LOC_REGISTER then
+             if paraloc1.location^.loc=LOC_REGISTER then
                begin
-                 cg.a_load_ref_reg(list,OS_INT,OS_INT,href,paraloc1.register);
+                 cg.a_load_ref_reg(list,OS_INT,OS_INT,href,paraloc1.location^.register);
                  tg.UnGetTemp(list,href);
                end;
            end;
+
+        paraloc1.done;
       end;
 
 
@@ -1586,9 +1641,7 @@ implementation
         cg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
 
         { release return registers, needed for optimizer }
-        if current_procinfo.procdef.funcret_paraloc[calleeside].loc<>LOC_INVALID then
-          paramanager.freeparaloc(list,
-            current_procinfo.procdef.funcret_paraloc[calleeside]);
+        paramanager.freeparaloc(list,current_procinfo.procdef.funcret_paraloc[calleeside]);
 
         { end of frame marker for call frame info }
         dwarfcfi.end_frame(list);
@@ -1611,7 +1664,7 @@ implementation
       end;
 
 
-    procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tparalocation);
+    procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tcgpara);
       begin
         { Pure assembler routines need to save the registers themselves }
         if (po_assembler in current_procinfo.procdef.procoptions) then
@@ -1627,151 +1680,6 @@ implementation
       end;
 
 
-{****************************************************************************
-                                 Inlining
-****************************************************************************}
-
-(*
-    procedure load_inlined_return_value(list:TAAsmoutput);
-      var
-        ressym: tvarsym;
-        resloc: tlocation;
-        r,r2 : tregister;
-      begin
-        if not is_void(current_procinfo.procdef.rettype.def) then
-         begin
-           ressym := tvarsym(current_procinfo.procdef.funcretsym);
-           if ressym.reg.enum <> R_NO then
-             begin
-               if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
-                 location_reset(resloc,LOC_CREGISTER,OS_ADDR)
-               else
-                 if ressym.vartype.def.deftype = floatdef then
-                   location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procinfo.procdef.rettype.def))
-                 else
-                   location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
-               resloc.register := ressym.reg;
-             end
-           else
-             begin
-               location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
-               reference_reset_base(resloc.reference,current_procinfo.framepointer,tvarsym(current_procinfo.procdef.funcretsym).adjusted_address);
-             end;
-           { Here, we return the function result. In most architectures, the value is
-             passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
-             function returns in a register and the caller receives it in an other one }
-           case current_procinfo.procdef.rettype.def.deftype of
-             orddef,
-             enumdef :
-               begin
-{$ifndef cpu64bit}
-                 if resloc.size in [OS_64,OS_S64] then
-                  begin
-                    r:=cg.getregisterint(list,OS_INT);
-                    r2:=cg.getregisterint(list,OS_INT);
-                    cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
-                  end
-                 else
-{$endif cpu64bit}
-                  begin
-                    r:=cg.getregisterint(list,resloc.size);
-                    cg.a_load_loc_reg(list,resloc.size,resloc,r);
-                  end;
-               end;
-             floatdef :
-               begin
-{$ifdef cpufpemu}
-                  if cs_fp_emulation in aktmoduleswitches then
-                    r.enum := FUNCTION_RETURN_REG
-                 else
-{$endif cpufpemu}
-                  r.enum:=FPU_RESULT_REG;
-                 cg.a_loadfpu_loc_reg(list,resloc,r);
-               end;
-             else
-               begin
-                 if not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
-                  begin
-{$ifndef cpu64bit}
-                    { Win32 can return records in EAX:EDX }
-                    if resloc.size in [OS_64,OS_S64] then
-                     begin
-                       r:=cg.getregisterint(list,OS_INT);
-                       r2:=cg.getregisterint(list,OS_INT);
-                       cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
-                     end
-                    else
-{$endif cpu64bit}
-                     begin
-                       r:=cg.getregisterint(list,resloc.size);
-                       cg.a_load_loc_reg(list,resloc.size,resloc,r);
-                     end;
-                   end
-               end;
-           end;
-         end;
-      end;
-
-
-    procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
-      begin
-        { initialize return value }
-        initretvalue(list);
-
-        current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
-
-        { initialisizes temp. ansi/wide string data }
-        inittempvariables(list);
-
-        { initialize ansi/widesstring para's }
-        if assigned(current_procinfo.procdef.parast) then
-          current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
-
-        { generate copies of call by value parameters }
-        if not(po_assembler in current_procinfo.procdef.procoptions) then
-          current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
-
-        load_regvars(list,nil);
-      end;
-
-
-   procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
-      var
-        usesacc,
-        usesacchi,
-        usesfpu : boolean;
-      begin
-        if aktexitlabel.is_used then
-          cg.a_label(list,aktexitlabel);
-
-        cleanup_regvars(list);
-
-        { finalize temporary data }
-        finalizetempvariables(list);
-
-        current_procinfo.procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
-
-        { finalize paras data }
-        if assigned(current_procinfo.procdef.parast) then
-          current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
-
-        { handle return value, this is not done for assembler routines when
-          they didn't reference the result variable }
-        if not(po_assembler in current_procinfo.procdef.procoptions) or
-           (assigned(current_procinfo.procdef.funcretsym) and
-            (tvarsym(current_procinfo.procdef.funcretsym).refcount>1)) then
-          begin
-            if (current_procinfo.procdef.proctypeoption=potype_constructor) then
-             internalerror(200305263);
-//            load_inlined_return_value(list);
-             load_return_value(list,usesacc,usesacchi,usesfpu)
-          end;
-
-        cleanup_regvars(list);
-      end;
-*)
-
-
 {****************************************************************************
                                Const Data
 ****************************************************************************}
@@ -1853,7 +1761,7 @@ implementation
                     tg.GetLocal(list,getvaluesize,vartype.def,localloc.reference);
                     if cs_asm_source in aktglobalswitches then
                       list.concat(Tai_comment.Create(strpnew('Local '+realname+' located at '+
-                          std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
+                          std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
                   end;
               end;
             sym:=tsym(sym.indexnext);
@@ -1912,7 +1820,7 @@ implementation
                   begin
                     if not(po_assembler in current_procinfo.procdef.procoptions) then
                       begin
-                        case paraitem.paraloc[calleeside].loc of
+                        case paraitem.paraloc[calleeside].location^.loc of
                           LOC_MMREGISTER,
                           LOC_FPUREGISTER,
                           LOC_REGISTER:
@@ -1960,17 +1868,17 @@ implementation
                             end;
 {$endif powerpc}
                           else
-                            localloc:=paraitem.paraloc[calleeside];
+                            paraitem.paraloc[calleeside].get_location(localloc);
                         end;
                       end
                     else
-                      localloc:=paraitem.paraloc[calleeside];
+                      paraitem.paraloc[calleeside].get_location(localloc);
                     if cs_asm_source in aktglobalswitches then
                       case localloc.loc of
                         LOC_REFERENCE :
                           begin
                             list.concat(Tai_comment.Create(strpnew('Para '+realname+' located at '+
-                                std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
+                                std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
                           end;
                       end;
                   end;
@@ -1980,13 +1888,15 @@ implementation
       end;
 
 
-    procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
+    procedure gen_alloc_inline_parast(list:TAAsmoutput;pd:tprocdef);
       var
         sym : tsym;
+        calleeparaloc,
+        callerparaloc : pcgparalocation;
       begin
-        if (po_assembler in current_procinfo.procdef.procoptions) then
+        if (po_assembler in pd.procoptions) then
           exit;
-        sym:=tsym(st.symindex.first);
+        sym:=tsym(pd.parast.symindex.first);
         while assigned(sym) do
           begin
             if sym.typ=varsym then
@@ -1997,34 +1907,47 @@ implementation
                     localloc.loc:=LOC_REFERENCE;
                     localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pocall_inline));
                     tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
-                    case paraitem.paraloc[calleeside].loc of
-                      LOC_FPUREGISTER:
-                        begin
-                          paraitem.paraloc[calleeside].register := cg.getfpuregister(list,paraitem.paraloc[calleeside].size);
-                          paraitem.paraloc[callerside] := paraitem.paraloc[calleeside];
-                        end;
-                      LOC_REGISTER:
-                        begin
-                          paraitem.paraloc[calleeside].register := cg.getintregister(list,paraitem.paraloc[calleeside].size);
-                          paraitem.paraloc[callerside] := paraitem.paraloc[calleeside];
-                        end;
-                      LOC_MMREGISTER:
-                        begin
-                          paraitem.paraloc[calleeside].register := cg.getmmregister(list,paraitem.paraloc[calleeside].size);
-                          paraitem.paraloc[callerside] := paraitem.paraloc[calleeside];
-                        end;
-                      LOC_REFERENCE:
-                        begin
-                          paraitem.paraloc[calleeside] := localloc;
-                          paraitem.paraloc[callerside] := localloc;
+                    calleeparaloc:=paraitem.paraloc[calleeside].location;
+                    callerparaloc:=paraitem.paraloc[callerside].location;
+                    while assigned(calleeparaloc) do
+                      begin
+                        if not assigned(callerparaloc) then
+                          internalerror(200408281);
+                        if calleeparaloc^.loc<>callerparaloc^.loc then
+                          internalerror(200408282);
+                        case calleeparaloc^.loc of
+                          LOC_FPUREGISTER:
+                            begin
+                              calleeparaloc^.register:=cg.getfpuregister(list,calleeparaloc^.size);
+                              callerparaloc^.register:=calleeparaloc^.register;
+                            end;
+                          LOC_REGISTER:
+                            begin
+                              calleeparaloc^.register:=cg.getintregister(list,calleeparaloc^.size);
+                              callerparaloc^.register:=calleeparaloc^.register;
+                            end;
+                          LOC_MMREGISTER:
+                            begin
+                              calleeparaloc^.register:=cg.getmmregister(list,calleeparaloc^.size);
+                              callerparaloc^.register:=calleeparaloc^.register;
+                            end;
+                          LOC_REFERENCE:
+                            begin
+                              calleeparaloc^.reference.offset := localloc.reference.offset;
+                              calleeparaloc^.reference.index := localloc.reference.base;
+                              callerparaloc^.reference.offset := localloc.reference.offset;
+                              callerparaloc^.reference.index := localloc.reference.base;
+                            end;
                         end;
-                    end;
+                        calleeparaloc:=calleeparaloc^.next;
+                        callerparaloc:=callerparaloc^.next;
+                      end;
                     if cs_asm_source in aktglobalswitches then
                       begin
                         case localloc.loc of
                           LOC_REFERENCE :
                             list.concat(Tai_comment.Create(strpnew('Para '+realname+' allocated at '+
-                                std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
+                                std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
                         end;
                       end;
                   end;
@@ -2034,6 +1957,68 @@ implementation
       end;
 
 
+    procedure gen_alloc_inline_funcret(list:TAAsmoutput;pd:tprocdef);
+      var
+        sym : tsym;
+        calleeparaloc,
+        callerparaloc : pcgparalocation;
+      begin
+        if not assigned(pd.funcretsym) or
+           (po_assembler in pd.procoptions) then
+          exit;
+        { for localloc <> LOC_REFERENCE, we need regvar support inside inlined procedures }
+        with tvarsym(pd.funcretsym) do
+          begin
+            localloc.loc:=LOC_REFERENCE;
+            localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pocall_inline));
+            tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
+            calleeparaloc:=pd.funcret_paraloc[calleeside].location;
+            callerparaloc:=pd.funcret_paraloc[callerside].location;
+            while assigned(calleeparaloc) do
+              begin
+                if not assigned(callerparaloc) then
+                  internalerror(200408281);
+                if calleeparaloc^.loc<>callerparaloc^.loc then
+                   internalerror(200408282);
+                 case calleeparaloc^.loc of
+                   LOC_FPUREGISTER:
+                     begin
+                       calleeparaloc^.register:=cg.getfpuregister(list,calleeparaloc^.size);
+                       callerparaloc^.register:=calleeparaloc^.register;
+                     end;
+                   LOC_REGISTER:
+                     begin
+                       calleeparaloc^.register:=cg.getintregister(list,calleeparaloc^.size);
+                       callerparaloc^.register:=calleeparaloc^.register;
+                     end;
+                   LOC_MMREGISTER:
+                     begin
+                       calleeparaloc^.register:=cg.getmmregister(list,calleeparaloc^.size);
+                       callerparaloc^.register:=calleeparaloc^.register;
+                     end;
+                   LOC_REFERENCE:
+                     begin
+                       calleeparaloc^.reference.offset := localloc.reference.offset;
+                       calleeparaloc^.reference.index := localloc.reference.base;
+                       callerparaloc^.reference.offset := localloc.reference.offset;
+                       callerparaloc^.reference.index := localloc.reference.base;
+                     end;
+                 end;
+                 calleeparaloc:=calleeparaloc^.next;
+                 callerparaloc:=callerparaloc^.next;
+               end;
+             if cs_asm_source in aktglobalswitches then
+               begin
+                 case localloc.loc of
+                   LOC_REFERENCE :
+                     list.concat(Tai_comment.Create(strpnew('Funcret '+realname+' allocated at '+
+                         std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
+                 end;
+               end;
+           end;
+      end;
+
+
     procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
       var
         sym : tsym;
@@ -2053,7 +2038,7 @@ implementation
                         tg.UngetLocal(list,localloc.reference);
                       LOC_REGISTER :
                         begin
-                          if localloc.register<>paraitem.paraloc[calleeside].register then
+                          if localloc.register<>paraitem.paraloc[calleeside].location^.register then
                             begin
 {$ifndef cpu64bit}
                               if localloc.size in [OS_64,OS_S64] then
@@ -2148,12 +2133,27 @@ implementation
 end.
 {
   $Log$
-  Revision 1.215  2004-09-14 16:33:46  peter
+  Revision 1.216  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.215  2004/09/14 16:33:46  peter
     * release localsymtables when module is compiled
 
   Revision 1.214  2004/09/13 20:30:05  peter
     * finalize all (also procedure local) typedconst at unit finalization
 
+  Revision 1.213.4.3  2004/09/20 20:46:34  peter
+    * register allocation optimized for 64bit loading of parameters
+      and return values
+
+  Revision 1.213.4.2  2004/09/17 17:19:26  peter
+    * fixed 64 bit unaryminus for sparc
+    * fixed 64 bit inlining
+    * signness of not operation
+
+  Revision 1.213.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
   Revision 1.213  2004/08/23 11:00:06  michael
   + Patch from Peter to fix debuginfo in constructor.
 

compiler/nobj.pas

@@ -156,7 +156,7 @@ implementation
        gdb,
 {$endif GDB}
        aasmcpu,
-       cpubase,cgbase,
+       cpubase,cgbase,parabase,
        cgutils,cgobj
        ;
 
@@ -1346,7 +1346,7 @@ implementation
     var
       hsym : tsym;
       href : treference;
-      locpara : tparalocation;
+      paraloc : tcgparalocation;
     begin
       { calculate the parameter info for the procdef }
       if not procdef.has_paraloc_info then
@@ -1359,16 +1359,16 @@ implementation
              (hsym.typ=varsym) and
              assigned(tvarsym(hsym).paraitem)) then
         internalerror(200305251);
-      locpara:=tvarsym(hsym).paraitem.paraloc[callerside];
-      case locpara.loc of
+      paraloc:=tvarsym(hsym).paraitem.paraloc[callerside].location^;
+      case paraloc.loc of
         LOC_REGISTER:
-          cg.a_op_const_reg(exprasmlist,OP_SUB,locpara.size,ioffset,locpara.register);
+          cg.a_op_const_reg(exprasmlist,OP_SUB,paraloc.size,ioffset,paraloc.register);
         LOC_REFERENCE:
           begin
              { offset in the wrapper needs to be adjusted for the stored
                return address }
-             reference_reset_base(href,locpara.reference.index,locpara.reference.offset+sizeof(aint));
-             cg.a_op_const_ref(exprasmlist,OP_SUB,locpara.size,ioffset,href);
+             reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset+sizeof(aint));
+             cg.a_op_const_ref(exprasmlist,OP_SUB,paraloc.size,ioffset,href);
           end
         else
           internalerror(200309189);
@@ -1381,9 +1381,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.75  2004-09-13 20:31:07  peter
+  Revision 1.76  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.75  2004/09/13 20:31:07  peter
     * fixed and cleanup of overriding non-visible methods
 
+  Revision 1.74.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
   Revision 1.74  2004/07/09 22:17:32  peter
     * revert has_localst patch
     * replace aktstaticsymtable/aktglobalsymtable with current_module

compiler/options.pas

@@ -727,11 +727,16 @@ begin
                   exclude(initglobalswitches,cs_gdb_lineinfo);
                   exclude(initglobalswitches,cs_checkpointer);
                 end
-{$ifdef GDB}
                else
                 begin
+{$ifdef GDB}
                   include(initmoduleswitches,cs_debuginfo);
+{$else GDB}
+                  Message(option_no_debug_support);
+                  Message(option_no_debug_support_recompile_fpc);
+{$endif GDB}
                 end;
+{$ifdef GDB}
                if not RelocSectionSetExplicitly then
                  RelocSection:=false;
                j:=1;
@@ -792,9 +797,6 @@ begin
                    end;
                    inc(j);
                  end;
-{$else GDB}
-                 Message(option_no_debug_support);
-                 Message(option_no_debug_support_recompile_fpc);
 {$endif GDB}
              end;
 
@@ -2087,7 +2089,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.142  2004-09-16 16:31:53  peter
+  Revision 1.143  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.142  2004/09/16 16:31:53  peter
     * Use FExpand on paths passed to compiler
 
   Revision 1.141  2004/09/10 21:00:23  jonas
@@ -2097,6 +2102,9 @@ end.
   Revision 1.140  2004/09/08 11:23:31  michael
   + Check if outputdir exists,  Fix exitcode when displaying help pages
 
+  Revision 1.139.4.1  2004/09/19 20:53:33  peter
+    * fixed compile without gdb
+
   Revision 1.139  2004/08/27 21:59:26  peter
   browser disabled
   uf_local_symtable ppu flag when a localsymtable is stored

compiler/parabase.pas

@@ -0,0 +1,205 @@
+{
+    $Id$
+    Copyright (c) 2002 by Florian Klaempfl
+
+    Generic calling convention handling
+
+    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 parabase;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       cclasses,globtype,
+       cpubase,cgbase;
+
+    type
+       { tparamlocation describes where a parameter for a procedure is stored.
+         References are given from the caller's point of view. The usual
+         TLocation isn't used, because contains a lot of unnessary fields.
+       }
+       PCGParaLocation = ^TCGParaLocation;
+       TCGParaLocation = record
+         Next : PCGParaLocation;
+         Size : TCGSize; { size of this location }
+         Loc  : TCGLoc;
+         case TCGLoc of
+           LOC_REFERENCE : (reference : tparareference);
+           LOC_FPUREGISTER,
+           LOC_CFPUREGISTER,
+           LOC_MMREGISTER,
+           LOC_CMMREGISTER,
+           LOC_REGISTER,
+           LOC_CREGISTER : (register : tregister);
+       end;
+
+       TCGPara = object
+          Alignment : ShortInt;
+          Size      : TCGSize;  { Size of the parameter included in all locations }
+          Location  : PCGParalocation;
+          constructor init;
+          destructor  done;
+          procedure   reset;
+          procedure   check_simple_location;
+          function    add_location:pcgparalocation;
+          procedure   get_location(var newloc:tlocation);
+       end;
+
+       tvarargsinfo = (
+         va_uses_float_reg
+       );
+
+       tvarargspara = class(tlinkedlist)
+          varargsinfo : set of tvarargsinfo;
+{$ifdef x86_64}
+          { x86_64 requires %al to contain the no. SSE regs passed }
+          mmregsused  : longint;
+{$endif x86_64}
+       end;
+
+
+
+implementation
+
+    uses
+      systems,verbose;
+
+
+{****************************************************************************
+                                TCGPara
+****************************************************************************}
+
+    constructor tcgpara.init;
+      begin
+        alignment:=0;
+        size:=OS_NO;
+        location:=nil;
+      end;
+
+
+    destructor tcgpara.done;
+      begin
+        reset;
+      end;
+
+
+    procedure tcgpara.reset;
+      var
+        hlocation : pcgparalocation;
+      begin
+        while assigned(location) do
+          begin
+            hlocation:=location^.next;
+            dispose(location);
+            location:=hlocation;
+          end;
+        alignment:=0;
+        size:=OS_NO;
+      end;
+
+
+    function tcgpara.add_location:pcgparalocation;
+      var
+        prevlocation,
+        hlocation : pcgparalocation;
+      begin
+        prevlocation:=nil;
+        hlocation:=location;
+        while assigned(hlocation) do
+          begin
+            prevlocation:=hlocation;
+            hlocation:=hlocation^.next;
+          end;
+        new(hlocation);
+        Fillchar(hlocation^,sizeof(tcgparalocation),0);
+        if assigned(prevlocation) then
+          prevlocation^.next:=hlocation
+        else
+          location:=hlocation;
+        result:=hlocation;
+      end;
+
+
+    procedure tcgpara.check_simple_location;
+      begin
+        if not assigned(location) then
+          internalerror(200408161);
+        if assigned(location^.next) then
+          internalerror(200408162);
+      end;
+
+
+    procedure tcgpara.get_location(var newloc:tlocation);
+      begin
+        if not assigned(location) then
+          internalerror(200408205);
+        fillchar(newloc,sizeof(newloc),0);
+        newloc.loc:=location^.loc;
+        newloc.size:=size;
+        case location^.loc of
+          LOC_REGISTER :
+            begin
+{$ifndef cpu64bit}
+              if size in [OS_64,OS_S64] then
+                begin
+                  if not assigned(location^.next) then
+                    internalerror(200408206);
+                  if (location^.next^.loc<>LOC_REGISTER) then
+                    internalerror(200408207);
+                  if (target_info.endian = ENDIAN_BIG) then
+                    begin
+                      newloc.registerhigh:=location^.register;
+                      newloc.registerlow:=location^.next^.register;
+                    end
+                  else
+                    begin
+                      newloc.registerlow:=location^.register;
+                      newloc.registerhigh:=location^.next^.register;
+                    end;
+                end
+              else
+{$endif}
+                newloc.register:=location^.register;
+            end;
+          LOC_FPUREGISTER,
+          LOC_MMREGISTER :
+            newloc.register:=location^.register;
+          LOC_REFERENCE :
+            begin
+              newloc.reference.base:=location^.reference.index;
+              newloc.reference.offset:=location^.reference.offset;
+            end;
+        end;
+      end;
+
+end.
+
+{
+   $Log$
+   Revision 1.2  2004-09-21 17:25:12  peter
+     * paraloc branch merged
+
+   Revision 1.1.2.2  2004/09/14 19:09:37  jonas
+     * fixed typo in IE check
+
+   Revision 1.1.2.1  2004/09/02 15:47:58  peter
+     * missing file
+
+}
+

compiler/paramgr.pas

@@ -31,22 +31,11 @@ unit paramgr;
     uses
        cclasses,globtype,
        cpubase,cgbase,
+       parabase,
        aasmtai,
        symconst,symtype,symdef;
 
     type
-       tvarargsinfo = (
-         va_uses_float_reg
-       );
-
-       tvarargspara = class(tlinkedlist)
-          varargsinfo : set of tvarargsinfo;
-{$ifdef x86_64}
-          { x86_64 requires %al to contain the no. SSE regs passed }
-          mmregsused  : longint;
-{$endif x86_64}
-       end;
-
        {# This class defines some methods to take care of routine
           parameters. It should be overriden for each new processor
        }
@@ -87,21 +76,22 @@ unit paramgr;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;virtual;
           function get_volatile_registers_flags(calloption : tproccalloption):tcpuregisterset;virtual;
           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;virtual;
-          function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;virtual;abstract;
+
+          procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);virtual;abstract;
 
           {# allocate a parameter location created with create_paraloc_info
 
             @param(list Current assembler list)
             @param(loc Parameter location)
           }
-          procedure allocparaloc(list: taasmoutput; const loc: tparalocation); virtual;
+          procedure allocparaloc(list: taasmoutput; const cgpara: TCGPara); virtual;
 
-          {# free a parameter location allocated with allocparaloc
+          {# free a parameter location allocated with alloccgpara
 
             @param(list Current assembler list)
             @param(loc Parameter location)
           }
-          procedure freeparaloc(list: taasmoutput; const loc: tparalocation); virtual;
+          procedure freeparaloc(list: taasmoutput; const cgpara: TCGPara); virtual;
 
           { This is used to populate the location information on all parameters
             for the routine as seen in either the caller or the callee. It returns
@@ -121,11 +111,8 @@ unit paramgr;
           }
           function  create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;virtual;abstract;
 
-          { Return the location of the low and high part of a 64bit parameter }
-          procedure splitparaloc64(const locpara:tparalocation;var loclopara,lochipara:tparalocation);virtual;
-
-          procedure alloctempregs(list: taasmoutput;var locpara:tparalocation);virtual;
-          procedure alloctempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var locpara:tparalocation);virtual;
+          procedure createtempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var cgpara:TCGPara);virtual;
+          procedure duplicateparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var cgpara:TCGPara);
 
           function parseparaloc(paraitem : tparaitem;const s : string) : boolean;virtual;abstract;
        end;
@@ -138,8 +125,8 @@ unit paramgr;
 implementation
 
     uses
-       cpuinfo,systems,
-       cgutils,cgobj,tgobj,
+       systems,
+       cgobj,tgobj,
        defutil,verbose;
 
     { true if uses a parameter as return value }
@@ -301,201 +288,135 @@ implementation
       end;
 
 
-    procedure tparamanager.allocparaloc(list: taasmoutput; const loc: tparalocation);
+    procedure tparamanager.allocparaloc(list: taasmoutput; const cgpara: TCGPara);
+      var
+        paraloc : pcgparalocation;
       begin
-        case loc.loc of
-          LOC_REGISTER,
-          LOC_CREGISTER:
-            begin
-              if getsupreg(loc.register)<first_int_imreg then
-                cg.getexplicitregister(list,loc.register);
-            end;
-          LOC_FPUREGISTER,
-          LOC_CFPUREGISTER:
-            begin
-              if getsupreg(loc.register)<first_fpu_imreg then
-                cg.getexplicitregister(list,loc.register);
-            end;
-          LOC_MMREGISTER,
-          LOC_CMMREGISTER :
-            begin
-              if getsupreg(loc.register)<first_mm_imreg then
-                cg.getexplicitregister(list,loc.register);
-            end;
-          LOC_REFERENCE,
-          LOC_CREFERENCE :
-            { do nothing by default, most of the time it's the framepointer }
-          else
-            internalerror(200306091);
-        end;
-        case loc.lochigh of
-          LOC_INVALID :
-            ;
-          LOC_REGISTER,
-          LOC_CREGISTER,
-          LOC_FPUREGISTER,
-          LOC_CFPUREGISTER,
-          LOC_MMREGISTER,
-          LOC_CMMREGISTER :
-            begin
-              { NR_NO means we don't need to allocate the parameter.
-                This is used for inlining parameters which allocates
-                the parameters in gen_alloc_parast (PFV) }
-              if loc.registerhigh<>NR_NO then
-                cg.getexplicitregister(list,loc.registerhigh);
+        paraloc:=cgpara.location;
+        while assigned(paraloc) do
+          begin
+            case paraloc^.loc of
+              LOC_REGISTER,
+              LOC_CREGISTER:
+                begin
+                  if getsupreg(paraloc^.register)<first_int_imreg then
+                    cg.getexplicitregister(list,paraloc^.register);
+                end;
+              LOC_FPUREGISTER,
+              LOC_CFPUREGISTER:
+                begin
+                  if getsupreg(paraloc^.register)<first_fpu_imreg then
+                    cg.getexplicitregister(list,paraloc^.register);
+                end;
+              LOC_MMREGISTER,
+              LOC_CMMREGISTER :
+                begin
+                  if getsupreg(paraloc^.register)<first_mm_imreg then
+                    cg.getexplicitregister(list,paraloc^.register);
+                end;
             end;
-          else
-            internalerror(200306092);
-        end;
+            paraloc:=paraloc^.next;
+          end;
       end;
 
 
-    procedure tparamanager.freeparaloc(list: taasmoutput; const loc: tparalocation);
+    procedure tparamanager.freeparaloc(list: taasmoutput; const cgpara: TCGPara);
       var
+        paraloc : Pcgparalocation;
+{$ifdef cputargethasfixedstack}
         href : treference;
+{$endif cputargethasfixedstack}
       begin
-        case loc.loc of
-          LOC_REGISTER, LOC_CREGISTER:
-            begin
-{$ifndef cpu64bit}
-              if (loc.size in [OS_64,OS_S64,OS_F64]) then
+        paraloc:=cgpara.location;
+        while assigned(paraloc) do
+          begin
+            case paraloc^.loc of
+              LOC_REGISTER,
+              LOC_CREGISTER,
+              LOC_FPUREGISTER,
+              LOC_CFPUREGISTER,
+              LOC_MMREGISTER,
+              LOC_CMMREGISTER :
+                cg.ungetregister(list,paraloc^.register);
+              LOC_REFERENCE,
+              LOC_CREFERENCE :
                 begin
-                  cg.ungetregister(list,loc.registerhigh);
-                  cg.ungetregister(list,loc.registerlow);
-                end
-              else
-{$endif cpu64bit}
-                cg.ungetregister(list,loc.register);
-            end;
-          LOC_MMREGISTER, LOC_CMMREGISTER,
-          LOC_FPUREGISTER, LOC_CFPUREGISTER:
-            cg.ungetregister(list,loc.register);
-          LOC_REFERENCE,LOC_CREFERENCE:
-            begin
 {$ifdef cputargethasfixedstack}
-              reference_reset_base(href,loc.reference.index,loc.reference.offset);
-              tg.ungettemp(list,href);
+                  { don't use reference_reset_base, because that will depend on cgobj }
+                  fillchar(href,sizeof(href),0);
+                  href.base:=paraloc^.reference.index;
+                  href.offset:=paraloc^.reference.offset;
+                  tg.ungettemp(list,href);
 {$endif cputargethasfixedstack}
+                end;
             end;
-          else
-            internalerror(200306093);
-        end;
-        case loc.lochigh of
-          LOC_INVALID :
-            ;
-          LOC_REGISTER,
-          LOC_CREGISTER,
-          LOC_FPUREGISTER,
-          LOC_CFPUREGISTER,
-          LOC_MMREGISTER,
-          LOC_CMMREGISTER :
-            cg.ungetregister(list,loc.register);
-          else
-            internalerror(200306094);
-        end;
-      end;
-
-
-    procedure tparamanager.splitparaloc64(const locpara:tparalocation;var loclopara,lochipara:tparalocation);
-      begin
-        lochipara:=locpara;
-        loclopara:=locpara;
-        case locpara.size of
-          OS_S128 :
-            begin
-              lochipara.size:=OS_S64;
-              loclopara.size:=OS_64;
-            end;
-          OS_128 :
-            begin
-              lochipara.size:=OS_64;
-              loclopara.size:=OS_64;
-            end;
-          OS_S64 :
-            begin
-              lochipara.size:=OS_S32;
-              loclopara.size:=OS_32;
-            end;
-          OS_64 :
-            begin
-              lochipara.size:=OS_32;
-              loclopara.size:=OS_32;
-            end;
-          else
-            internalerror(200307023);
-        end;
-        loclopara.lochigh:=LOC_INVALID;
-        lochipara.lochigh:=LOC_INVALID;
-        case locpara.loc of
-           LOC_REGISTER,
-           LOC_CREGISTER,
-           LOC_FPUREGISTER,
-           LOC_CFPUREGISTER,
-           LOC_MMREGISTER,
-           LOC_CMMREGISTER :
-             begin
-               if locpara.lochigh=LOC_INVALID then
-                 internalerror(200402061);
-               loclopara.register:=locpara.registerlow;
-               lochipara.register:=locpara.registerhigh;
-             end;
-           LOC_REFERENCE:
-             begin
-               if target_info.endian=endian_big then
-                 inc(loclopara.reference.offset,tcgsize2size[loclopara.size])
-               else
-                 inc(lochipara.reference.offset,tcgsize2size[loclopara.size]);
-             end;
-           else
-             internalerror(200307024);
-        end;
+            paraloc:=paraloc^.next;
+          end;
       end;
 
 
-    procedure tparamanager.alloctempregs(list: taasmoutput;var locpara:tparalocation);
+    procedure tparamanager.createtempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var cgpara:TCGPara);
       var
-        cgsize : tcgsize;
+        href : treference;
+        len  : aint;
+        paraloc,
+        newparaloc : pcgparalocation;
       begin
-        if locpara.lochigh<>LOC_INVALID then
-          cgsize:=OS_INT
-        else
-          cgsize:=locpara.size;
-        case locpara.loc of
-          LOC_REGISTER:
-            locpara.register:=cg.getintregister(list,cgsize);
-          LOC_FPUREGISTER:
-            locpara.register:=cg.getfpuregister(list,cgsize);
-          LOC_MMREGISTER:
-            locpara.register:=cg.getmmregister(list,cgsize);
-          else
-            internalerror(200308123);
-        end;
-        case locpara.lochigh of
-          LOC_INVALID:
-            ;
-          LOC_REGISTER:
-            locpara.registerhigh:=cg.getintregister(list,cgsize);
-          LOC_FPUREGISTER:
-            locpara.registerhigh:=cg.getfpuregister(list,cgsize);
-          LOC_MMREGISTER:
-            locpara.registerhigh:=cg.getmmregister(list,cgsize);
-          else
-            internalerror(200308124);
-        end;
+        cgpara.reset;
+        cgpara.size:=paraitem.paraloc[callerside].size;
+        cgpara.alignment:=paraitem.paraloc[callerside].alignment;
+        paraloc:=paraitem.paraloc[callerside].location;
+        while assigned(paraloc) do
+          begin
+            if paraloc^.size=OS_NO then
+              len:=push_size(paraitem.paratyp,paraitem.paratype.def,calloption)
+            else
+              len:=tcgsize2size[paraloc^.size];
+            newparaloc:=cgpara.add_location;
+            newparaloc^.size:=paraloc^.size;
+{$warning maybe release this optimization for all targets?}
+{$ifdef sparc}
+            { Does it fit a register? }
+            if len<=sizeof(aint) then
+              newparaloc^.loc:=LOC_REGISTER
+            else
+{$endif sparc}
+              newparaloc^.loc:=paraloc^.loc;
+            case newparaloc^.loc of
+              LOC_REGISTER :
+                newparaloc^.register:=cg.getintregister(list,paraloc^.size);
+              LOC_FPUREGISTER :
+                newparaloc^.register:=cg.getfpuregister(list,paraloc^.size);
+              LOC_MMREGISTER :
+                newparaloc^.register:=cg.getmmregister(list,paraloc^.size);
+              LOC_REFERENCE :
+                begin
+                  tg.gettemp(list,len,tt_persistent,href);
+                  newparaloc^.reference.index:=href.base;
+                  newparaloc^.reference.offset:=href.offset;
+                end;
+            end;
+            paraloc:=paraloc^.next;
+          end;
       end;
 
 
-    procedure tparamanager.alloctempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var locpara:tparalocation);
+    procedure tparamanager.duplicateparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var cgpara:TCGPara);
       var
-        href : treference;
-        l    : aint;
+        paraloc,
+        newparaloc : pcgparalocation;
       begin
-        l:=push_size(paraitem.paratyp,paraitem.paratype.def,calloption);
-        tg.gettemp(list,l,tt_persistent,href);
-        locpara.loc:=LOC_REFERENCE;
-        locpara.lochigh:=LOC_INVALID;
-        locpara.reference.index:=href.base;
-        locpara.reference.offset:=href.offset;
+        cgpara.reset;
+        cgpara.size:=paraitem.paraloc[callerside].size;
+        cgpara.alignment:=paraitem.paraloc[callerside].alignment;
+        paraloc:=paraitem.paraloc[callerside].location;
+        while assigned(paraloc) do
+          begin
+            newparaloc:=cgpara.add_location;
+            move(paraloc^,newparaloc^,sizeof(newparaloc^));
+            newparaloc^.next:=nil;
+            paraloc:=paraloc^.next;
+          end;
       end;
 
 
@@ -515,7 +436,13 @@ end.
 
 {
    $Log$
-   Revision 1.77  2004-07-09 23:41:04  jonas
+   Revision 1.78  2004-09-21 17:25:12  peter
+     * paraloc branch merged
+
+   Revision 1.77.4.1  2004/08/31 20:43:06  peter
+     * paraloc patch
+
+   Revision 1.77  2004/07/09 23:41:04  jonas
      * support register parameters for inlined procedures + some inline
        cleanups
 

compiler/powerpc/cgcpu.pas

@@ -30,7 +30,8 @@ unit cgcpu;
        globtype,symtype,
        cgbase,cgobj,
        aasmbase,aasmcpu,aasmtai,
-       cpubase,cpuinfo,node,cg64f32,rgcpu;
+       cpubase,cpuinfo,node,cg64f32,rgcpu,
+       parabase;
 
     type
       tcgppc = class(tcg)
@@ -44,9 +45,9 @@ unit cgcpu;
         { left to right), this allows to move the parameter to    }
         { register, if the cpu supports register calling          }
         { conventions                                             }
-        procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;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;
+        procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;const paraloc : tcgpara);override;
+        procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const paraloc : tcgpara);override;
+        procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const paraloc : tcgpara);override;
 
 
         procedure a_call_name(list : taasmoutput;const s : string);override;
@@ -97,7 +98,7 @@ unit cgcpu;
         procedure g_save_standard_registers(list:Taasmoutput);override;
         procedure g_restore_standard_registers(list:Taasmoutput);override;
         procedure g_save_all_registers(list : taasmoutput);override;
-        procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);override;
+        procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tcgpara);override;
 
         procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
 
@@ -234,18 +235,19 @@ const
       end;
 
 
-    procedure tcgppc.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const locpara : tparalocation);
+    procedure tcgppc.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const paraloc : tcgpara);
       var
         ref: treference;
       begin
-        case locpara.loc of
+        paraloc.check_simple_location;
+        case paraloc.location^.loc of
           LOC_REGISTER,LOC_CREGISTER:
-            a_load_const_reg(list,size,a,locpara.register);
+            a_load_const_reg(list,size,a,paraloc.location^.register);
           LOC_REFERENCE:
             begin
                reference_reset(ref);
-               ref.base:=locpara.reference.index;
-               ref.offset:=locpara.reference.offset;
+               ref.base:=paraloc.location^.reference.index;
+               ref.offset:=paraloc.location^.reference.offset;
                a_load_const_ref(list,size,a,ref);
             end;
           else
@@ -254,21 +256,22 @@ const
       end;
 
 
-    procedure tcgppc.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);
+    procedure tcgppc.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const paraloc : tcgpara);
 
       var
         ref: treference;
         tmpreg: tregister;
 
       begin
-        case locpara.loc of
+        paraloc.check_simple_location;
+        case paraloc.location^.loc of
           LOC_REGISTER,LOC_CREGISTER:
-            a_load_ref_reg(list,size,size,r,locpara.register);
+            a_load_ref_reg(list,size,size,r,paraloc.location^.register);
           LOC_REFERENCE:
             begin
                reference_reset(ref);
-               ref.base:=locpara.reference.index;
-               ref.offset:=locpara.reference.offset;
+               ref.base:=paraloc.location^.reference.index;
+               ref.offset:=paraloc.location^.reference.offset;
                tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
                a_load_ref_reg(list,size,size,r,tmpreg);
                a_load_reg_ref(list,size,size,tmpreg,ref);
@@ -277,7 +280,7 @@ const
           LOC_FPUREGISTER,LOC_CFPUREGISTER:
             case size of
                OS_F32, OS_F64:
-                 a_loadfpu_ref_reg(list,size,r,locpara.register);
+                 a_loadfpu_ref_reg(list,size,r,paraloc.location^.register);
                else
                  internalerror(2002072801);
             end;
@@ -287,28 +290,29 @@ const
       end;
 
 
-    procedure tcgppc.a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
+    procedure tcgppc.a_paramaddr_ref(list : taasmoutput;const r : treference;const paraloc : tcgpara);
       var
         ref: treference;
         tmpreg: tregister;
 
       begin
-         case locpara.loc of
-            LOC_REGISTER,LOC_CREGISTER:
-              a_loadaddr_ref_reg(list,r,locpara.register);
-            LOC_REFERENCE:
-              begin
-                reference_reset(ref);
-                ref.base := locpara.reference.index;
-                ref.offset := locpara.reference.offset;
-                tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
-                a_loadaddr_ref_reg(list,r,tmpreg);
-                a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
-                rg[R_INTREGISTER].ungetregister(list,tmpreg);
-              end;
-            else
-              internalerror(2002080701);
-         end;
+        paraloc.check_simple_location;
+        case paraloc.location^.loc of
+           LOC_REGISTER,LOC_CREGISTER:
+             a_loadaddr_ref_reg(list,r,paraloc.location^.register);
+           LOC_REFERENCE:
+             begin
+               reference_reset(ref);
+               ref.base := paraloc.location^.reference.index;
+               ref.offset := paraloc.location^.reference.offset;
+               tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
+               a_loadaddr_ref_reg(list,r,tmpreg);
+               a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
+               rg[R_INTREGISTER].ungetregister(list,tmpreg);
+             end;
+           else
+             internalerror(2002080701);
+        end;
       end;
 
 
@@ -887,7 +891,7 @@ const
          {$warning FIX ME}
        end;
 
-     procedure tcgppc.g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);
+     procedure tcgppc.g_restore_all_registers(list : taasmoutput;const funcretparaloc:tcgpara);
        begin
          {$warning FIX ME}
        end;
@@ -1208,13 +1212,15 @@ const
                 hp:=tparaitem(current_procinfo.procdef.para.first);
                 while assigned(hp) do
                   begin
-                    if (hp.paraloc[calleeside].loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+                    if (hp.paraloc[calleeside].location^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
                       begin
+                        if assigned(hp.paraloc[callerside].location^.next) then
+                          internalerror(2004091210);
                         case tvarsym(hp.parasym).localloc.loc of
                           LOC_REFERENCE:
                             begin
-                              reference_reset_base(href,tvarsym(hp.parasym).localloc.reference.index,tvarsym(hp.parasym).localloc.reference.offset);
-                              reference_reset_base(href2,NR_R12,hp.paraloc[callerside].reference.offset);
+                              reference_reset_base(href,tvarsym(hp.parasym).localloc.reference.base,tvarsym(hp.parasym).localloc.reference.offset);
+                              reference_reset_base(href2,NR_R12,hp.paraloc[callerside].location^.reference.offset);
                               { we can't use functions here which allocate registers (FK)
                                cg.a_load_ref_ref(list,hp.paraloc[calleeside].size,hp.paraloc[calleeside].size,href2,href);
                               }
@@ -1243,12 +1249,12 @@ const
                             end;
                           LOC_CREGISTER:
                             begin
-                              reference_reset_base(href2,NR_R12,hp.paraloc[callerside].reference.offset);
+                              reference_reset_base(href2,NR_R12,hp.paraloc[callerside].location^.reference.offset);
                               cg.a_load_ref_reg(list,hp.paraloc[calleeside].size,hp.paraloc[calleeside].size,href2,tvarsym(hp.parasym).localloc.register);
                             end;
                           LOC_CFPUREGISTER:
                             begin
-                              reference_reset_base(href2,NR_R12,hp.paraloc[callerside].reference.offset);
+                              reference_reset_base(href2,NR_R12,hp.paraloc[callerside].location^.reference.offset);
                               cg.a_loadfpu_ref_reg(list,hp.paraloc[calleeside].size,href2,tvarsym(hp.parasym).localloc.register);
                             end;
                           else
@@ -2429,7 +2435,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.176  2004-07-17 14:48:20  jonas
+  Revision 1.177  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.176.4.2  2004/09/18 20:21:08  jonas
+    * fixed ppc, but still needs fix in tgobj
+
+  Revision 1.176.4.1  2004/09/10 11:10:08  florian
+    * first part of ppc fixes
+
+  Revision 1.176  2004/07/17 14:48:20  jonas
     * fixed op_const_reg_reg for (OP_ADD,0,reg1,reg2)
 
   Revision 1.175  2004/07/09 21:45:24  jonas
@@ -2463,5 +2478,4 @@ end.
 
   Revision 1.168  2004/03/06 21:37:45  florian
     * fixed ppc compilation
-
 }

compiler/powerpc/cpupara.pas

@@ -19,8 +19,6 @@
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  ****************************************************************************
 }
-{ PowerPC specific calling conventions are handled by this unit
-}
 unit cpupara;
 
 {$i fpcdefs.inc}
@@ -32,14 +30,16 @@ unit cpupara;
        cclasses,
        aasmtai,
        cpubase,cpuinfo,
-       symconst,symbase,symtype,symdef,paramgr,cgbase;
+       symconst,symbase,symtype,symdef,
+       paramgr,parabase,cgbase;
 
     type
        tppcparamanager = class(tparamanager)
           function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
-          function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
+
+          procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;override;
 
@@ -80,28 +80,35 @@ unit cpupara;
       end;
 
 
-    function tppcparamanager.getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;
-
+    procedure tppcparamanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);
+      var
+        paraloc : pcgparalocation;
       begin
-         fillchar(result,sizeof(tparalocation),0);
-         result.lochigh:=LOC_INVALID;
-         if nr<1 then
-           internalerror(2002070801)
-         else if nr<=8 then
-           begin
-              result.loc:=LOC_REGISTER;
-              result.register:=newreg(R_INTREGISTER,RS_R2+nr,R_SUBWHOLE);
-           end
-         else
-           begin
-              result.loc:=LOC_REFERENCE;
-              result.reference.index:=NR_STACK_POINTER_REG;
-              result.reference.offset:=(nr-8)*4;
-           end;
-         result.size := OS_INT;
+        cgpara.reset;
+        cgpara.size:=OS_INT;
+        cgpara.alignment:=get_para_align(calloption);
+        paraloc:=cgpara.add_location;
+        with paraloc^ do
+         begin
+           size:=OS_INT;
+           if (nr<=8) then
+             begin
+               if nr=0 then
+                 internalerror(200309271);
+               loc:=LOC_REGISTER;
+               register:=newreg(R_INTREGISTER,RS_R2+nr,R_SUBWHOLE);
+             end
+           else
+             begin
+               loc:=LOC_REFERENCE;
+               reference.index:=NR_STACK_POINTER_REG;
+               reference.offset:=sizeof(aint)*(nr-8);
+             end;
+          end;
       end;
 
 
+
     function getparaloc(p : tdef) : tcgloc;
 
       begin
@@ -110,48 +117,48 @@ unit cpupara;
          }
          case p.deftype of
             orddef:
-              getparaloc:=LOC_REGISTER;
+              result:=LOC_REGISTER;
             floatdef:
-              getparaloc:=LOC_FPUREGISTER;
+              result:=LOC_FPUREGISTER;
             enumdef:
-              getparaloc:=LOC_REGISTER;
+              result:=LOC_REGISTER;
             pointerdef:
-              getparaloc:=LOC_REGISTER;
+              result:=LOC_REGISTER;
             formaldef:
-              getparaloc:=LOC_REGISTER;
+              result:=LOC_REGISTER;
             classrefdef:
-              getparaloc:=LOC_REGISTER;
+              result:=LOC_REGISTER;
             recorddef:
-              getparaloc:=LOC_REFERENCE;
+              result:=LOC_REFERENCE;
             objectdef:
               if is_object(p) then
-                getparaloc:=LOC_REFERENCE
+                result:=LOC_REFERENCE
               else
-                getparaloc:=LOC_REGISTER;
+                result:=LOC_REGISTER;
             stringdef:
               if is_shortstring(p) or is_longstring(p) then
-                getparaloc:=LOC_REFERENCE
+                result:=LOC_REFERENCE
               else
-                getparaloc:=LOC_REGISTER;
+                result:=LOC_REGISTER;
             procvardef:
               if (po_methodpointer in tprocvardef(p).procoptions) then
-                getparaloc:=LOC_REFERENCE
+                result:=LOC_REFERENCE
               else
-                getparaloc:=LOC_REGISTER;
+                result:=LOC_REGISTER;
             filedef:
-              getparaloc:=LOC_REGISTER;
+              result:=LOC_REGISTER;
             arraydef:
-              getparaloc:=LOC_REFERENCE;
+              result:=LOC_REFERENCE;
             setdef:
               if is_smallset(p) then
-                getparaloc:=LOC_REGISTER
+                result:=LOC_REGISTER
               else
-                getparaloc:=LOC_REFERENCE;
+                result:=LOC_REFERENCE;
             variantdef:
-              getparaloc:=LOC_REFERENCE;
+              result:=LOC_REFERENCE;
             { avoid problems with errornous definitions }
             errordef:
-              getparaloc:=LOC_REGISTER;
+              result:=LOC_REGISTER;
             else
               internalerror(2002071001);
          end;
@@ -204,55 +211,74 @@ unit cpupara;
 
     procedure tppcparamanager.create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
       var
-        paraloc : tparalocation;
+        hiparaloc,
+        paraloc : pcgparalocation;
+        retcgsize  : tcgsize;
       begin
-        fillchar(paraloc,sizeof(tparalocation),0);
-        paraloc.size:=def_cgsize(p.rettype.def);
-        paraloc.Alignment:= std_param_align;
-        { Constructors return self }
+        { Constructors return self instead of a boolean }
         if (p.proctypeoption=potype_constructor) then
-          begin
-            paraloc.size:=OS_ADDR;
-            paraloc.loc:=LOC_REGISTER;
-            paraloc.register:=NR_FUNCTION_RESULT_REG;
-          end
+          retcgsize:=OS_ADDR
         else
-         { Return in FPU register? }
-         if p.rettype.def.deftype=floatdef then
+          retcgsize:=def_cgsize(p.rettype.def);
+        p.funcret_paraloc[side].reset;
+        p.funcret_paraloc[side].Alignment:=std_param_align;
+        p.funcret_paraloc[side].size:=retcgsize;
+        { void has no location }
+        if is_void(p.rettype.def) then
+          exit;
+        paraloc:=p.funcret_paraloc[side].add_location;
+        { Return in FPU register? }
+        if p.rettype.def.deftype=floatdef then
           begin
-            paraloc.loc:=LOC_FPUREGISTER;
-            paraloc.register:=NR_FPU_RESULT_REG;
+            paraloc^.loc:=LOC_FPUREGISTER;
+            paraloc^.register:=NR_FPU_RESULT_REG;
+            paraloc^.size:=retcgsize;
           end
         else
          { Return in register? }
          if not ret_in_param(p.rettype.def,p.proccalloption) then
           begin
-            paraloc.loc:=LOC_REGISTER;
 {$ifndef cpu64bit}
-            if paraloc.size in [OS_64,OS_S64] then
+            if retcgsize in [OS_64,OS_S64] then
              begin
-               paraloc.lochigh:=LOC_REGISTER;
-               paraloc.register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
-               paraloc.register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG
+               { low 32bits }
+               paraloc^.loc:=LOC_REGISTER;
+               paraloc^.size:=OS_32;
+               if side=callerside then
+                 paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
+               else
+                 paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
+               { high 32bits }
+               hiparaloc:=p.funcret_paraloc[side].add_location;
+               hiparaloc^.loc:=LOC_REGISTER;
+               hiparaloc^.size:=OS_32;
+               if side=callerside then
+                 hiparaloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
+               else
+                 hiparaloc^.register:=NR_FUNCTION_RETURN64_LOW_REG;
              end
             else
 {$endif cpu64bit}
              begin
-               paraloc.register:=NR_FUNCTION_RESULT_REG
+               paraloc^.loc:=LOC_REGISTER;
+               paraloc^.size:=retcgsize;
+               if side=callerside then
+                 paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(retcgsize))
+               else
+                 paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(retcgsize));
              end;
           end
         else
           begin
-            paraloc.loc:=LOC_REFERENCE;
+            paraloc^.loc:=LOC_REFERENCE;
+            paraloc^.size:=retcgsize;
           end;
-        p.funcret_paraloc[side]:=paraloc;
       end;
 
 
     function tppcparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
 
       var
-        paraloc : tparalocation;
         cur_stack_offset: aword;
         curintreg, curfloatreg, curmmreg: tsuperregister;
       begin
@@ -271,9 +297,10 @@ unit cpupara;
          stack_offset: aword;
          nextintreg,nextfloatreg,nextmmreg, maxfpureg : tsuperregister;
          paradef : tdef;
-         paraloc : tparalocation;
+         paraloc,paraloc2 : pcgparalocation;
          hp : tparaitem;
          loc : tcgloc;
+         paracgsize: tcgsize;
          is_64bit: boolean;
 
       procedure assignintreg;
@@ -281,17 +308,17 @@ unit cpupara;
         begin
            if nextintreg<=ord(NR_R10) then
              begin
-                paraloc.loc:=LOC_REGISTER;
-                paraloc.register:=newreg(R_INTREGISTER,nextintreg,R_SUBNONE);
+                paraloc^.loc:=LOC_REGISTER;
+                paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBNONE);
                 inc(nextintreg);
                 if target_info.abi=abi_powerpc_aix then
                   inc(stack_offset,4);
              end
            else
               begin
-                 paraloc.loc:=LOC_REFERENCE;
-                 paraloc.reference.index:=NR_STACK_POINTER_REG;
-                 paraloc.reference.offset:=stack_offset;
+                 paraloc^.loc:=LOC_REFERENCE;
+                 paraloc^.reference.index:=NR_STACK_POINTER_REG;
+                 paraloc^.reference.offset:=stack_offset;
                  inc(stack_offset,4);
              end;
         end;
@@ -313,64 +340,77 @@ unit cpupara;
          hp:=firstpara;
          while assigned(hp) do
            begin
+              hp.paraloc[side].reset;
               { currently only support C-style array of const }
               if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
                  is_array_of_const(hp.paratype.def) then
                 begin
+                  paraloc:=hp.paraloc[side].add_location;
                   { hack: the paraloc must be valid, but is not actually used }
-                  hp.paraloc[side].loc := LOC_REGISTER;
-                  hp.paraloc[side].lochigh := LOC_INVALID;
-                  hp.paraloc[side].register := NR_R0;
-                  hp.paraloc[side].size := OS_ADDR;
+                  paraloc^.loc := LOC_REGISTER;
+                  paraloc^.register := NR_R0;
+                  paraloc^.size := OS_ADDR;
                   break;
                 end;
 
               if (hp.paratyp in [vs_var,vs_out]) then
                 begin
-                  paradef := voidpointertype.def;
-                  loc := LOC_REGISTER;
+                  paradef:=voidpointertype.def;
+                  loc:=LOC_REGISTER;
+                  paracgsize := OS_ADDR;
                 end
               else
                 begin
                   paradef := hp.paratype.def;
                   loc:=getparaloc(paradef);
+                  paracgsize:=def_cgsize(paradef);
+                  { for things like formaldef }
+                  if paracgsize=OS_NO then
+                    paracgsize:=OS_ADDR;
                 end;
-              { make sure all alignment bytes are 0 as well }
-              fillchar(paraloc,sizeof(paraloc),0);
-              paraloc.alignment:= std_param_align;
-              paraloc.lochigh:=LOC_INVALID;
+              hp.paraloc[side].alignment:=std_param_align;
+              hp.paraloc[side].size:=paracgsize;
+              { First location }
+              paraloc:=hp.paraloc[side].add_location;
+              paraloc^.size:=paracgsize;
               case loc of
                  LOC_REGISTER:
                    begin
-                      paraloc.size := def_cgsize(paradef);
-                      { for things like formaldef }
-                      if paraloc.size = OS_NO then
-                        paraloc.size := OS_ADDR;
-                      is_64bit := paraloc.size in [OS_64,OS_S64];
+                      is_64bit:=paraloc^.size in [OS_64,OS_S64];
                       if nextintreg<=(RS_R10-ord(is_64bit))  then
                         begin
-                           paraloc.loc:=LOC_REGISTER;
+                           paraloc^.loc:=LOC_REGISTER;
+{$ifndef cpu64bit}
                            if is_64bit then
                              begin
                                if odd(nextintreg-RS_R3) and (target_info.abi=abi_powerpc_sysv) Then
                                  inc(nextintreg);
-                               paraloc.registerhigh:=newreg(R_INTREGISTER,nextintreg,R_SUBNONE);
-                               paraloc.lochigh:=LOC_REGISTER;
+                               paraloc^.size:=OS_32;
+                               paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBNONE);
+                               inc(nextintreg);
+                               paraloc2:=hp.paraloc[side].add_location;
+                               paraloc2^.loc:=LOC_REGISTER;
+                               paraloc2^.size:=OS_32;
+                               paraloc2^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBNONE);
+                               inc(nextintreg);
+                               if target_info.abi=abi_powerpc_aix then
+                                 inc(stack_offset,8);
+                             end
+                           else
+{$endif cpu64bit}
+                             begin
+                               paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBNONE);
                                inc(nextintreg);
                                if target_info.abi=abi_powerpc_aix then
-                                 inc(stack_offset,4);
-                             end;
-                           paraloc.registerlow:=newreg(R_INTREGISTER,nextintreg,R_SUBNONE);
-                           inc(nextintreg);
-                           if target_info.abi=abi_powerpc_aix then
-                             inc(stack_offset,4);
+                                 inc(stack_offset,sizeof(aword));
+                              end;
                         end
                       else
                          begin
                             nextintreg:=RS_R11;
-                            paraloc.loc:=LOC_REFERENCE;
-                            paraloc.reference.index:=NR_STACK_POINTER_REG;
-                            paraloc.reference.offset:=stack_offset;
+                            paraloc^.loc:=LOC_REFERENCE;
+                            paraloc^.reference.index:=NR_STACK_POINTER_REG;
+                            paraloc^.reference.offset:=stack_offset;
                             if not is_64bit then
                               inc(stack_offset,4)
                             else
@@ -379,22 +419,21 @@ unit cpupara;
                    end;
                  LOC_FPUREGISTER:
                    begin
-                      paraloc.size:=def_cgsize(paradef);
                       if nextfloatreg<=maxfpureg then
                         begin
-                           paraloc.loc:=LOC_FPUREGISTER;
-                           paraloc.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE);
+                           paraloc^.loc:=LOC_FPUREGISTER;
+                           paraloc^.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE);
                            inc(nextfloatreg);
                         end
                       else
                          begin
-                            paraloc.loc:=LOC_REFERENCE;
-                            paraloc.reference.index:=NR_STACK_POINTER_REG;
-                            paraloc.reference.offset:=stack_offset;
+                            paraloc^.loc:=LOC_REFERENCE;
+                            paraloc^.reference.index:=NR_STACK_POINTER_REG;
+                            paraloc^.reference.offset:=stack_offset;
                         end;
                       if target_info.abi=abi_powerpc_aix then
                         begin
-                          if paraloc.size = OS_F32 then
+                          if paraloc^.size = OS_F32 then
                             begin
                               inc(stack_offset,4);
                               if (nextintreg < RS_R11) then
@@ -412,36 +451,22 @@ unit cpupara;
                    end;
                  LOC_REFERENCE:
                    begin
-                      paraloc.size:=OS_ADDR;
+                      paraloc^.size:=OS_ADDR;
                       if push_addr_param(hp.paratyp,paradef,p.proccalloption) or
                         is_open_array(paradef) or
                         is_array_of_const(paradef) then
                         assignintreg
                       else
                         begin
-                           paraloc.loc:=LOC_REFERENCE;
-                           paraloc.reference.index:=NR_STACK_POINTER_REG;
-                           paraloc.reference.offset:=stack_offset;
+                           paraloc^.loc:=LOC_REFERENCE;
+                           paraloc^.reference.index:=NR_STACK_POINTER_REG;
+                           paraloc^.reference.offset:=stack_offset;
                            inc(stack_offset,hp.paratype.def.size);
                         end;
                    end;
                  else
                    internalerror(2002071002);
               end;
-{
-              this is filled in in ncgutil
-
-              if side = calleeside then
-                begin
-                  if (paraloc.loc = LOC_REFERENCE) then
-                    begin
-                      if (current_procinfo.procdef <> p) then
-                        internalerror(2003112201);
-                      inc(paraloc.reference.offset,current_procinfo.calc_stackframe_size);
-                    end;
-                end;
-}
-              hp.paraloc[side]:=paraloc;
               hp:=tparaitem(hp.next);
            end;
          curintreg:=nextintreg;
@@ -458,33 +483,32 @@ unit cpupara;
         parasize, l: longint;
         curintreg, firstfloatreg, curfloatreg, curmmreg: tsuperregister;
         hp: tparaitem;
-        paraloc: tparalocation;
+        paraloc: pcgparalocation;
       begin
         init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
         firstfloatreg:=curfloatreg;
 
-        result := create_paraloc_info_intern(p,callerside,tparaitem(p.para.first),curintreg,curfloatreg,curmmreg,cur_stack_offset);
+        result:=create_paraloc_info_intern(p,callerside,tparaitem(p.para.first),curintreg,curfloatreg,curmmreg,cur_stack_offset);
         if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
           { just continue loading the parameters in the registers }
-          result := create_paraloc_info_intern(p,callerside,tparaitem(varargspara.first),curintreg,curfloatreg,curmmreg,cur_stack_offset)
+          result:=create_paraloc_info_intern(p,callerside,tparaitem(varargspara.first),curintreg,curfloatreg,curmmreg,cur_stack_offset)
         else
           begin
-            hp := tparaitem(varargspara.first);
-            parasize := cur_stack_offset;
+            hp:=tparaitem(varargspara.first);
+            parasize:=cur_stack_offset;
             while assigned(hp) do
               begin
-                paraloc.size:=def_cgsize(hp.paratype.def);
-                paraloc.lochigh:=LOC_INVALID;
-                paraloc.loc:=LOC_REFERENCE;
-                paraloc.alignment:=4;
-                paraloc.reference.index:=NR_STACK_POINTER_REG;
+                hp.paraloc[callerside].alignment:=4;
+                paraloc:=hp.paraloc[callerside].add_location;
+                paraloc^.loc:=LOC_REFERENCE;
+                paraloc^.size:=def_cgsize(hp.paratype.def);
+                paraloc^.reference.index:=NR_STACK_POINTER_REG;
                 l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
-                paraloc.reference.offset:=parasize;
+                paraloc^.reference.offset:=parasize;
                 parasize:=parasize+l;
-                hp.paraloc[callerside]:=paraloc;
                 hp:=tparaitem(hp.next);
               end;
-            result := parasize;
+            result:=parasize;
           end;
         if curfloatreg<>firstfloatreg then
           include(varargspara.varargsinfo,va_uses_float_reg);
@@ -492,56 +516,60 @@ unit cpupara;
 
 
     function tppcparamanager.parseparaloc(p : tparaitem;const s : string) : boolean;
+      var
+        paraloc : pcgparalocation;
       begin
         result:=false;
         case target_info.system of
           system_powerpc_morphos:
             begin
-              p.paraloc[callerside].loc:=LOC_REFERENCE;
-              p.paraloc[callerside].lochigh:=LOC_INVALID;
-              p.paraloc[callerside].size:=def_cgsize(p.paratype.def);
               p.paraloc[callerside].alignment:=4;
-              p.paraloc[callerside].reference.index:=NR_R2;
+              paraloc:=p.paraloc[callerside].add_location;
+              paraloc^.loc:=LOC_REFERENCE;
+              paraloc^.size:=def_cgsize(p.paratype.def);
+              paraloc^.reference.index:=NR_R2;
               { pattern is always uppercase'd }
               if s='D0' then
-                p.paraloc[callerside].reference.offset:=0
+                paraloc^.reference.offset:=0
               else if s='D1' then
-                p.paraloc[callerside].reference.offset:=4
+                paraloc^.reference.offset:=4
               else if s='D2' then
-                p.paraloc[callerside].reference.offset:=8
+                paraloc^.reference.offset:=8
               else if s='D3' then
-                p.paraloc[callerside].reference.offset:=12
+                paraloc^.reference.offset:=12
               else if s='D4' then
-                p.paraloc[callerside].reference.offset:=16
+                paraloc^.reference.offset:=16
               else if s='D5' then
-                p.paraloc[callerside].reference.offset:=20
+                paraloc^.reference.offset:=20
               else if s='D6' then
-                p.paraloc[callerside].reference.offset:=24
+                paraloc^.reference.offset:=24
               else if s='D7' then
-                p.paraloc[callerside].reference.offset:=28
+                paraloc^.reference.offset:=28
               else if s='A0' then
-                p.paraloc[callerside].reference.offset:=32
+                paraloc^.reference.offset:=32
               else if s='A1' then
-                p.paraloc[callerside].reference.offset:=36
+                paraloc^.reference.offset:=36
               else if s='A2' then
-                p.paraloc[callerside].reference.offset:=40
+                paraloc^.reference.offset:=40
               else if s='A3' then
-                p.paraloc[callerside].reference.offset:=44
+                paraloc^.reference.offset:=44
               else if s='A4' then
-                p.paraloc[callerside].reference.offset:=48
+                paraloc^.reference.offset:=48
               else if s='A5' then
-                p.paraloc[callerside].reference.offset:=52
+                paraloc^.reference.offset:=52
               { 'A6' (offset 56) is used by mossyscall as libbase, so API
                 never passes parameters in it,
                 Indeed, but this allows to declare libbase either explicitly
                 or let the compiler insert it }
               else if s='A6' then
-                p.paraloc[callerside].reference.offset:=56
+                paraloc^.reference.offset:=56
               { 'A7' is the stack pointer on 68k, can't be overwritten
                 by API calls, so it has no offset }
               else
                 exit;
-              p.paraloc[calleeside]:=p.paraloc[callerside];
+
+              { copy to callee side }
+              p.paraloc[calleeside].add_location^:=paraloc^;
             end;
           else
             internalerror(200404182);
@@ -555,7 +583,19 @@ begin
 end.
 {
   $Log$
-  Revision 1.67  2004-07-19 19:15:50  florian
+  Revision 1.68  2004-09-21 17:25:13  peter
+    * paraloc branch merged
+
+  Revision 1.67.4.3  2004/09/18 20:21:08  jonas
+    * fixed ppc, but still needs fix in tgobj
+
+  Revision 1.67.4.2  2004/09/10 11:10:08  florian
+    * first part of ppc fixes
+
+  Revision 1.67.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.67  2004/07/19 19:15:50  florian
     * fixed funcret_paraloc writing in units
 
   Revision 1.66  2004/07/17 13:51:57  florian

compiler/powerpc/nppccal.pas

@@ -41,7 +41,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symbase,symsym,symtable,defutil,paramgr,
+      symconst,symbase,symsym,symtable,defutil,paramgr,parabase,
 {$ifdef GDB}
   {$ifdef delphi}
       sysutils,
@@ -67,9 +67,9 @@ implementation
               exprasmlist.concat(taicpu.op_const_const_const(A_CRXOR,6,6,6));
           end;
       end;
-        
+
     procedure tppccallnode.do_syscall;
-      var 
+      var
         tmpref: treference;
       begin
         case target_info.system of
@@ -77,22 +77,22 @@ implementation
             begin
               cg.getexplicitregister(exprasmlist,NR_R0);
               cg.getexplicitregister(exprasmlist,NR_R3);
-                                       
+
               { store call offset into R3 }
               exprasmlist.concat(taicpu.op_reg_const(A_LI,NR_R3,-tprocdef(procdefinition).extnumber));
-              
+
               { prepare LR, and call function }
-              reference_reset_base(tmpref,NR_R2,100); { 100 ($64) is EmulDirectCallOS offset } 
+              reference_reset_base(tmpref,NR_R2,100); { 100 ($64) is EmulDirectCallOS offset }
               exprasmlist.concat(taicpu.op_reg_ref(A_LWZ,NR_R0,tmpref));
               exprasmlist.concat(taicpu.op_reg(A_MTLR,NR_R0));
-              exprasmlist.concat(taicpu.op_none(A_BLRL));            
+              exprasmlist.concat(taicpu.op_none(A_BLRL));
 
               cg.ungetregister(exprasmlist,NR_R0);
               cg.ungetregister(exprasmlist,NR_R3);
             end;
           else
             internalerror(2004042901);
-        end;      
+        end;
       end;
 
 begin
@@ -100,7 +100,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.27  2004-06-20 08:55:32  florian
+  Revision 1.28  2004-09-21 17:25:13  peter
+    * paraloc branch merged
+
+  Revision 1.27.4.1  2004/09/18 20:21:08  jonas
+    * fixed ppc, but still needs fix in tgobj
+
+  Revision 1.27  2004/06/20 08:55:32  florian
     * logs truncated
 
   Revision 1.26  2004/04/29 22:18:37  karoly

compiler/ppu.pas

@@ -525,6 +525,8 @@ begin
   if entryidx<entry.size then
    skipdata(entry.size-entryidx);
   readdata(entry,sizeof(tppuentry));
+  if change_endian then
+   entry.size:=swaplong(entry.size);
   entrystart:=bufstart+bufidx;
   entryidx:=0;
   if not(entry.id in [mainentryid,subentryid]) then
@@ -1054,7 +1056,13 @@ end;
 end.
 {
   $Log$
-  Revision 1.56  2004-08-27 21:59:26  peter
+  Revision 1.57  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.56.4.1  2004/09/12 14:01:23  peter
+    * entry.size need endian update
+
+  Revision 1.56  2004/08/27 21:59:26  peter
   browser disabled
   uf_local_symtable ppu flag when a localsymtable is stored
 

compiler/pstatmnt.pas

@@ -1,5 +1,4 @@
 {
-    $Id$
     $Id$
     Copyright (c) 1998-2002 by Florian Klaempfl
 
@@ -1184,12 +1183,18 @@ implementation
 end.
 {
   $Log$
-  Revision 1.138  2004-09-21 16:00:50  peter
+  Revision 1.139  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.138  2004/09/21 16:00:50  peter
     * no difference for withnode when debuginfo is generated
 
   Revision 1.137  2004/09/13 20:28:27  peter
     * for loop variable assignment is not allowed anymore
 
+  Revision 1.136.4.1  2004/09/21 16:01:54  peter
+    * withnode debug disabled
+
   Revision 1.136  2004/06/20 08:55:30  florian
     * logs truncated
 

compiler/psub.pas

@@ -720,14 +720,14 @@ implementation
             aktlocalswitches:=entryswitches;
             gen_entry_code(templist);
             aktproccode.insertlistafter(entry_asmnode.currenttai,templist);
-            gen_initialize_code(templist,false);
+            gen_initialize_code(templist);
             aktproccode.insertlistafter(init_asmnode.currenttai,templist);
 
             { now generate finalize and exit code with the correct position
               and switches }
             aktfilepos:=exitpos;
             aktlocalswitches:=exitswitches;
-            gen_finalize_code(templist,false);
+            gen_finalize_code(templist);
             { the finalcode must be concated if there was no position available,
               using insertlistafter will result in an insert at the start
               when currentai=nil }
@@ -1393,13 +1393,21 @@ implementation
 end.
 {
   $Log$
-  Revision 1.205  2004-09-13 20:34:28  peter
+  Revision 1.206  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.205  2004/09/13 20:34:28  peter
     * keep localst in memory, it is also needed for finalizing
       typedconst
 
   Revision 1.204  2004/09/04 21:18:47  armin
   * target netwlibc added (libc is preferred for newer netware versions)
 
+  Revision 1.203.4.1  2004/09/17 17:19:26  peter
+    * fixed 64 bit unaryminus for sparc
+    * fixed 64 bit inlining
+    * signness of not operation
+
   Revision 1.203  2004/08/14 14:50:42  florian
     * fixed several sparc alignment issues
     + Jonas' inline node patch; non functional yet

compiler/rgobj.pas

@@ -608,12 +608,22 @@ unit rgobj;
     procedure trgobj.add_edges_used(u:Tsuperregister);
 
     var i:word;
+        v:tsuperregister;
 
     begin
       with live_registers do
         if length>0 then
           for i:=0 to length-1 do
-            add_edge(u,buf^[i]);
+            begin
+              v:=buf^[i];
+              add_edge(u,v);
+              { add also conflicts with all coalesced registers }
+              while ri_coalesced in reginfo[v].flags do
+                begin
+                  v:=reginfo[v].alias;
+                  add_edge(u,v);
+                end;
+            end;
     end;
 
 {$ifdef EXTDEBUG}
@@ -1255,7 +1265,7 @@ unit rgobj;
         i,j,k : word;
         n,a,c : Tsuperregister;
         colourednodes : Tsuperregisterset;
-		adj_colours:set of 0..255;
+                adj_colours:set of 0..255;
         found : boolean;
 
     begin
@@ -1705,8 +1715,13 @@ unit rgobj;
               supregset_include(regs_to_spill_set,t);
               {Clear all interferences of the spilled register.}
               clear_interferences(t);
-              {Get a temp for the spilled register}
-              tg.gettemp(templist,tcgsize2size[reg_cgsize(newreg(regtype,t,R_SUBWHOLE))],tt_noreuse,spill_temps^[t]);
+              {Get a temp for the spilled register, the size must at least equal a complete register,
+               take also care of the fact that subreg can be larger than a single register like doubles
+               that occupy 2 registers }
+              tg.gettemp(templist,
+                         max(tcgsize2size[reg_cgsize(newreg(regtype,t,R_SUBWHOLE))],
+                             tcgsize2size[reg_cgsize(newreg(regtype,t,reginfo[t].subreg))]),
+                         tt_noreuse,spill_temps^[t]);
             end;
         list.insertlistafter(headertai,templist);
         templist.free;
@@ -1986,7 +2001,16 @@ unit rgobj;
 end.
 {
   $Log$
-  Revision 1.134  2004-08-24 21:02:32  florian
+  Revision 1.135  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.134.4.2  2004/09/21 17:03:26  peter
+    * Include aliases of coalesce registers when adding conflicts
+
+  Revision 1.134.4.1  2004/09/12 13:36:40  peter
+    * fixed alignment issues
+
+  Revision 1.134  2004/08/24 21:02:32  florian
     * fixed longbool(<int64>) on sparc
 
   Revision 1.133  2004/07/09 21:38:30  daniel

compiler/sparc/cgcpu.pas

@@ -27,7 +27,7 @@ unit cgcpu;
 interface
 
     uses
-       globtype,
+       globtype,parabase,
        cgbase,cgobj,cg64f32,
        aasmbase,aasmtai,aasmcpu,
        cpubase,cpuinfo,
@@ -43,16 +43,17 @@ interface
         procedure done_register_allocators;override;
         function  getfpuregister(list:Taasmoutput;size:Tcgsize):Tregister;override;
         { sparc special, needed by cg64 }
+        procedure make_simple_ref(list:taasmoutput;var ref: treference);
         procedure handle_load_store(list:taasmoutput;isstore:boolean;op: tasmop;reg:tregister;ref: treference);
         procedure handle_reg_const_reg(list:taasmoutput;op:Tasmop;src:tregister;a:aint;dst:tregister);
         { parameter }
-        procedure a_param_const(list:TAasmOutput;size:tcgsize;a:aint;const LocPara:TParaLocation);override;
-        procedure a_param_ref(list:TAasmOutput;sz:tcgsize;const r:TReference;const LocPara:TParaLocation);override;
-        procedure a_paramaddr_ref(list:TAasmOutput;const r:TReference;const LocPara:TParaLocation);override;
-        procedure a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const locpara : tparalocation);override;
-        procedure a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const locpara : tparalocation);override;
-        procedure a_loadany_param_ref(list : taasmoutput;const locpara : tparalocation;const ref:treference;shuffle : pmmshuffle);override;
-        procedure a_loadany_param_reg(list : taasmoutput;const locpara : tparalocation;const reg:tregister;shuffle : pmmshuffle);override;
+        procedure a_param_const(list:TAasmOutput;size:tcgsize;a:aint;const paraloc:TCGPara);override;
+        procedure a_param_ref(list:TAasmOutput;sz:tcgsize;const r:TReference;const paraloc:TCGPara);override;
+        procedure a_paramaddr_ref(list:TAasmOutput;const r:TReference;const paraloc:TCGPara);override;
+        procedure a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const paraloc : TCGPara);override;
+        procedure a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const paraloc : TCGPara);override;
+//        procedure a_loadany_param_ref(list : taasmoutput;const paraloc : TCGPara;const ref:treference;shuffle : pmmshuffle);override;
+        procedure a_loadany_param_reg(list : taasmoutput;const paraloc : TCGPara;const reg:tregister;shuffle : pmmshuffle);override;
         procedure a_call_name(list:TAasmOutput;const s:string);override;
         procedure a_call_reg(list:TAasmOutput;Reg:TRegister);override;
         { General purpose instructions }
@@ -81,7 +82,7 @@ interface
         procedure g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef);override;
         procedure g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);override;
         procedure g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);override;
-        procedure g_restore_all_registers(list:TAasmOutput;const funcretparaloc:tparalocation);override;
+        procedure g_restore_all_registers(list:TAasmOutput;const funcretparaloc:TCGPara);override;
         procedure g_restore_standard_registers(list:taasmoutput);override;
         procedure g_save_all_registers(list : taasmoutput);override;
         procedure g_save_standard_registers(list : taasmoutput);override;
@@ -92,6 +93,9 @@ interface
       private
         procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
       public
+        procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
+        procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);override;
+        procedure a_param64_ref(list : taasmoutput;const r : treference;const paraloc : tcgpara);override;
         procedure a_op64_reg_reg(list:TAasmOutput;op:TOpCG;regsrc,regdst:TRegister64);override;
         procedure a_op64_const_reg(list:TAasmOutput;op:TOpCG;value:int64;regdst:TRegister64);override;
         procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : int64;regsrc,regdst : tregister64);override;
@@ -132,7 +136,7 @@ implementation
       end;
 
 
-    procedure tcgsparc.handle_load_store(list:taasmoutput;isstore:boolean;op: tasmop;reg:tregister;ref: treference);
+    procedure tcgsparc.make_simple_ref(list:taasmoutput;var ref: treference);
       var
         tmpreg : tregister;
         tmpref : treference;
@@ -191,12 +195,16 @@ implementation
                 ref.index:=NR_NO;
               end;
           end;
+      end;
+
+
+    procedure tcgsparc.handle_load_store(list:taasmoutput;isstore:boolean;op: tasmop;reg:tregister;ref: treference);
+      begin
+        make_simple_ref(list,ref);
         if isstore then
           list.concat(taicpu.op_reg_ref(op,reg,ref))
         else
           list.concat(taicpu.op_ref_reg(op,ref,reg));
-        if (tmpreg<>NR_NO) then
-          UnGetRegister(list,tmpreg);
       end;
 
 
@@ -254,20 +262,23 @@ implementation
       end;
 
 
-    procedure TCgSparc.a_param_const(list:TAasmOutput;size:tcgsize;a:aint;const LocPara:TParaLocation);
+    procedure TCgSparc.a_param_const(list:TAasmOutput;size:tcgsize;a:aint;const paraloc:TCGPara);
       var
         Ref:TReference;
       begin
-        case locpara.loc of
+        paraloc.check_simple_location;
+        case paraloc.location^.loc of
           LOC_REGISTER,LOC_CREGISTER:
-            a_load_const_reg(list,size,a,locpara.register);
+            a_load_const_reg(list,size,a,paraloc.location^.register);
           LOC_REFERENCE:
             begin
               { Code conventions need the parameters being allocated in %o6+92 }
-              with LocPara.Reference do
-                if(Index=NR_SP)and(Offset<Target_info.first_parm_offset) then
-                InternalError(2002081104);
-              reference_reset_base(ref,locpara.reference.index,locpara.reference.offset);
+              with paraloc.location^.Reference do
+                begin
+                  if (Index=NR_SP) and (Offset<Target_info.first_parm_offset) then
+                    InternalError(2002081104);
+                  reference_reset_base(ref,index,offset);
+                end;
               a_load_const_ref(list,size,a,ref);
             end;
           else
@@ -276,137 +287,170 @@ implementation
       end;
 
 
-    procedure TCgSparc.a_param_ref(list:TAasmOutput;sz:TCgSize;const r:TReference;const LocPara:TParaLocation);
+    procedure TCgSparc.a_param_ref(list:TAasmOutput;sz:TCgSize;const r:TReference;const paraloc:TCGPara);
       var
         ref: treference;
         tmpreg:TRegister;
       begin
-        with LocPara do
-          case loc of
-            LOC_REGISTER,LOC_CREGISTER :
-              a_load_ref_reg(list,sz,sz,r,Register);
-            LOC_REFERENCE:
-              begin
-                { Code conventions need the parameters being allocated in %o6+92 }
-                with LocPara.Reference do
-                  if(Index=NR_SP)and(Offset<Target_info.first_parm_offset) then
-                  InternalError(2002081104);
-                reference_reset_base(ref,locpara.reference.index,locpara.reference.offset);
-                tmpreg:=GetIntRegister(list,OS_INT);
-                a_load_ref_reg(list,sz,sz,r,tmpreg);
-                a_load_reg_ref(list,sz,sz,tmpreg,ref);
-                UnGetRegister(list,tmpreg);
-              end;
-            else
-              internalerror(2002081103);
+        paraloc.check_simple_location;
+        with paraloc.location^ do
+          begin
+            case loc of
+              LOC_REGISTER,LOC_CREGISTER :
+                a_load_ref_reg(list,sz,sz,r,Register);
+              LOC_REFERENCE:
+                begin
+                  { Code conventions need the parameters being allocated in %o6+92 }
+                  with Reference do
+                    begin
+                      if (Index=NR_SP) and (Offset<Target_info.first_parm_offset) then
+                        InternalError(2002081104);
+                      reference_reset_base(ref,index,offset);
+                    end;
+                  tmpreg:=GetIntRegister(list,OS_INT);
+                  a_load_ref_reg(list,sz,sz,r,tmpreg);
+                  a_load_reg_ref(list,sz,sz,tmpreg,ref);
+                  UnGetRegister(list,tmpreg);
+                end;
+              else
+                internalerror(2002081103);
+            end;
           end;
       end;
 
 
-    procedure TCgSparc.a_paramaddr_ref(list:TAasmOutput;const r:TReference;const LocPara:TParaLocation);
+    procedure TCgSparc.a_paramaddr_ref(list:TAasmOutput;const r:TReference;const paraloc:TCGPara);
       var
         Ref:TReference;
         TmpReg:TRegister;
       begin
-        case locpara.loc of
-          LOC_REGISTER,LOC_CREGISTER:
-            a_loadaddr_ref_reg(list,r,locpara.register);
-          LOC_REFERENCE:
-            begin
-              reference_reset(ref);
-              ref.base := locpara.reference.index;
-              ref.offset := locpara.reference.offset;
-              tmpreg:=GetAddressRegister(list);
-              a_loadaddr_ref_reg(list,r,tmpreg);
-              a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
-              UnGetRegister(list,tmpreg);
+        paraloc.check_simple_location;
+        with paraloc.location^ do
+          begin
+            case loc of
+              LOC_REGISTER,LOC_CREGISTER:
+                a_loadaddr_ref_reg(list,r,register);
+              LOC_REFERENCE:
+                begin
+                  reference_reset(ref);
+                  ref.base := reference.index;
+                  ref.offset := reference.offset;
+                  tmpreg:=GetAddressRegister(list);
+                  a_loadaddr_ref_reg(list,r,tmpreg);
+                  a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
+                  UnGetRegister(list,tmpreg);
+                end;
+              else
+                internalerror(2002080701);
             end;
-          else
-            internalerror(2002080701);
-        end;
+          end;
       end;
 
 
-    procedure tcgsparc.a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const locpara : tparalocation);
+    procedure tcgsparc.a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const paraloc : TCGPara);
+      var
+         href,href2 : treference;
+         hloc : pcgparalocation;
+      begin
+        href:=ref;
+        hloc:=paraloc.location;
+        while assigned(hloc) do
+          begin
+            case hloc^.loc of
+              LOC_REGISTER :
+                a_load_ref_reg(list,hloc^.size,hloc^.size,href,hloc^.register);
+              LOC_REFERENCE :
+                begin
+                  reference_reset_base(href2,hloc^.reference.index,hloc^.reference.offset);
+                  a_load_ref_ref(list,hloc^.size,hloc^.size,href,href2);
+                end;
+              else
+                internalerror(200408241);
+           end;
+           inc(href.offset,tcgsize2size[hloc^.size]);
+           hloc:=hloc^.next;
+         end;
+      end;
+
+
+    procedure tcgsparc.a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const paraloc : TCGPara);
       var
         href : treference;
       begin
         tg.GetTemp(list,TCGSize2Size[size],tt_normal,href);
         a_loadfpu_reg_ref(list,size,r,href);
-        a_paramfpu_ref(list,size,href,locpara);
+        a_paramfpu_ref(list,size,href,paraloc);
         tg.Ungettemp(list,href);
       end;
 
 
-    procedure tcgsparc.a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const locpara : tparalocation);
+      (*
+    procedure tcgsparc.a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const paraloc : TCGPara);
       var
-        templocpara : tparalocation;
+        tempparaloc : TCGPara;
       begin
         { floats are pushed in the int registers }
-        templocpara:=locpara;
-        case locpara.size of
+        tempparaloc:=paraloc;
+        case paraloc.size of
           OS_F32,OS_32 :
             begin
-              templocpara.size:=OS_32;
-              a_param_ref(list,OS_32,ref,templocpara);
+              tempparaloc.size:=OS_32;
+              a_param_ref(list,OS_32,ref,tempparaloc);
             end;
           OS_F64,OS_64 :
             begin
-              templocpara.size:=OS_64;
-              cg64.a_param64_ref(list,ref,templocpara);
+              tempparaloc.size:=OS_64;
+              cg64.a_param64_ref(list,ref,tempparaloc);
             end;
           else
             internalerror(200307021);
         end;
       end;
 
-
-    procedure tcgsparc.a_loadany_param_ref(list : taasmoutput;const locpara : tparalocation;const ref:treference;shuffle : pmmshuffle);
+    procedure tcgsparc.a_loadany_param_ref(list : taasmoutput;const paraloc : TCGPara;const ref:treference;shuffle : pmmshuffle);
       var
         href,
         tempref : treference;
-        templocpara : tparalocation;
+        tempparaloc : TCGPara;
       begin
         { Load floats like ints }
-        templocpara:=locpara;
-        case locpara.size of
+        tempparaloc:=paraloc;
+        case paraloc.size of
           OS_F32 :
-            templocpara.size:=OS_32;
+            tempparaloc.size:=OS_32;
           OS_F64 :
-            templocpara.size:=OS_64;
+            tempparaloc.size:=OS_64;
         end;
         { Word 0 is in register, word 1 is in reference }
-        if (templocpara.loc=LOC_REFERENCE) and (templocpara.low_in_reg) then
+        if (tempparaloc.loc=LOC_REFERENCE) and (tempparaloc.low_in_reg) then
           begin
             tempref:=ref;
-            cg.a_load_reg_ref(list,OS_INT,OS_INT,templocpara.register,tempref);
+            cg.a_load_reg_ref(list,OS_INT,OS_INT,tempparaloc.register,tempref);
             inc(tempref.offset,4);
-            reference_reset_base(href,templocpara.reference.index,templocpara.reference.offset);
+            reference_reset_base(href,tempparaloc.reference.index,tempparaloc.reference.offset);
             cg.a_load_ref_ref(list,OS_INT,OS_INT,href,tempref);
           end
         else
-          inherited a_loadany_param_ref(list,templocpara,ref,shuffle);
+          inherited a_loadany_param_ref(list,tempparaloc,ref,shuffle);
       end;
+*)
 
 
-    procedure tcgsparc.a_loadany_param_reg(list : taasmoutput;const locpara : tparalocation;const reg:tregister;shuffle : pmmshuffle);
+    procedure tcgsparc.a_loadany_param_reg(list : taasmoutput;const paraloc : TCGPara;const reg:tregister;shuffle : pmmshuffle);
       var
         href : treference;
       begin
-        { Word 0 is in register, word 1 is in reference, not
-          possible to load it in 1 register }
-        if (locpara.loc=LOC_REFERENCE) and (locpara.low_in_reg) then
-          internalerror(200307011);
+        paraloc.check_simple_location;
         { Float load use a temp reference }
-        if locpara.size in [OS_F32,OS_F64] then
+        if getregtype(reg)=R_FPUREGISTER then
           begin
-            tg.GetTemp(list,TCGSize2Size[locpara.size],tt_normal,href);
-            a_loadany_param_ref(list,locpara,href,shuffle);
-            a_loadfpu_ref_reg(list,locpara.size,href,reg);
+            tg.GetTemp(list,TCGSize2Size[paraloc.size],tt_normal,href);
+            a_loadany_param_ref(list,paraloc,href,shuffle);
+            a_loadfpu_ref_reg(list,paraloc.size,href,reg);
             tg.Ungettemp(list,href);
           end
         else
-          inherited a_loadany_param_reg(list,locpara,reg,shuffle);
+          inherited a_loadany_param_reg(list,paraloc,reg,shuffle);
       end;
 
 
@@ -458,9 +502,11 @@ implementation
 
     procedure TCgSparc.a_load_reg_ref(list:TAasmOutput;FromSize,ToSize:TCGSize;reg:tregister;const Ref:TReference);
       var
-        op:tasmop;
+        op : tasmop;
       begin
-        case ToSize of
+        if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then
+          fromsize := tosize;
+        case fromsize of
           { signed integer registers }
           OS_8,
           OS_S8:
@@ -480,10 +526,11 @@ implementation
 
     procedure TCgSparc.a_load_ref_reg(list:TAasmOutput;FromSize,ToSize:TCgSize;const ref:TReference;reg:tregister);
       var
-        op:tasmop;
+        op : tasmop;
       begin
-        case Fromsize of
-          { signed integer registers }
+        if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then
+          fromsize := tosize;
+        case fromsize of
           OS_S8:
             Op:=A_LDSB;{Load Signed Byte}
           OS_8:
@@ -506,6 +553,8 @@ implementation
 
 
     procedure TCgSparc.a_load_reg_reg(list:TAasmOutput;fromsize,tosize:tcgsize;reg1,reg2:tregister);
+      var
+        instr : taicpu;
       begin
         if (tcgsize2size[tosize]<tcgsize2size[fromsize]) or
            (
@@ -514,16 +563,32 @@ implementation
             not(fromsize in [OS_32,OS_S32])
            ) then
           begin
-{$warning TODO Sign extension}
             case tosize of
-              OS_8,OS_S8:
+              OS_8 :
                 a_op_const_reg_reg(list,OP_AND,tosize,$ff,reg1,reg2);
-              OS_16,OS_S16:
+              OS_16 :
                 a_op_const_reg_reg(list,OP_AND,tosize,$ffff,reg1,reg2);
-              OS_32,OS_S32:
+              OS_32,
+              OS_S32 :
                 begin
                   if reg1<>reg2 then
-                    list.Concat(taicpu.op_reg_reg(A_MOV,reg1,reg2));
+                    begin
+                      instr:=taicpu.op_reg_reg(A_MOV,reg1,reg2);
+                      list.Concat(instr);
+                      { Notify the register allocator that we have written a move instruction so
+                        it can try to eliminate it. }
+                      add_move_instruction(instr);
+                    end;
+                end;
+              OS_S8 :
+                begin
+                  list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,24,reg2));
+                  list.concat(taicpu.op_reg_const_reg(A_SRA,reg2,24,reg2));
+                end;
+              OS_S16 :
+                begin
+                  list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,16,reg2));
+                  list.concat(taicpu.op_reg_const_reg(A_SRA,reg2,16,reg2));
                 end;
               else
                 internalerror(2002090901);
@@ -533,7 +598,13 @@ implementation
           begin
             { same size, only a register mov required }
             if reg1<>reg2 then
-              list.Concat(taicpu.op_reg_reg(A_MOV,reg1,reg2));
+              begin
+                instr:=taicpu.op_reg_reg(A_MOV,reg1,reg2);
+                list.Concat(instr);
+                { Notify the register allocator that we have written a move instruction so
+                  it can try to eliminate it. }
+                add_move_instruction(instr);
+              end;
           end;
       end;
 
@@ -550,10 +621,7 @@ implementation
            (ref.offset<simm13lo) or
            (ref.offset>simm13hi) then
           begin
-            if (ref.base<>r) and (ref.index<>r) then
-              hreg:=r
-            else
-              hreg:=GetAddressRegister(list);
+            hreg:=GetAddressRegister(list);
             reference_reset(tmpref);
             tmpref.symbol := ref.symbol;
             tmpref.offset := ref.offset;
@@ -575,7 +643,7 @@ implementation
             else
               begin
                 if hreg<>r then
-                  list.Concat(taicpu.op_reg_reg(A_MOV,hreg,r));
+                  a_load_reg_reg(list,OS_ADDR,OS_ADDR,hreg,r);
               end;
             if hreg<>r then
               UnGetRegister(list,hreg);
@@ -588,14 +656,9 @@ implementation
                 begin
                   if ref.index<>NR_NO then
                     begin
-                      if (ref.base<>r) and (ref.index<>r) then
-                        hreg:=r
-                      else
-                        hreg:=GetAddressRegister(list);
+                      hreg:=GetAddressRegister(list);
                       list.concat(taicpu.op_reg_const_reg(A_ADD,ref.base,ref.offset,hreg));
                       list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,ref.index,r));
-                      if hreg<>r then
-                        UnGetRegister(list,hreg);
                     end
                   else
                     list.concat(taicpu.op_reg_const_reg(A_ADD,ref.base,ref.offset,r));
@@ -621,9 +684,17 @@ implementation
       const
          FpuMovInstr : Array[OS_F32..OS_F64] of TAsmOp =
            (A_FMOVS,A_FMOVD);
+      var
+        instr : taicpu;
       begin
         if reg1<>reg2 then
-          list.concat(taicpu.op_reg_reg(fpumovinstr[size],reg1,reg2));
+          begin
+            instr:=taicpu.op_reg_reg(fpumovinstr[size],reg1,reg2);
+            list.Concat(instr);
+            { Notify the register allocator that we have written a move instruction so
+              it can try to eliminate it. }
+            add_move_instruction(instr);
+          end;
       end;
 
 
@@ -677,11 +748,24 @@ implementation
 
 
     procedure TCgSparc.a_op_reg_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;src, dst:TRegister);
+      var
+        a : aint;
       begin
         Case Op of
-          OP_NEG,
-          OP_NOT:
+          OP_NEG :
             list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],src,dst));
+          OP_NOT :
+            begin
+              case size of
+                OS_8 :
+                  a:=aint($ffffff00);
+                OS_16 :
+                  a:=aint($ffff0000);
+                else
+                  a:=0;
+              end;
+              handle_reg_const_reg(list,A_XNOR,src,a,dst);
+            end;
           else
             list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],dst,src,dst));
         end;
@@ -838,7 +922,7 @@ implementation
       end;
 
 
-    procedure TCgSparc.g_restore_all_registers(list:TaasmOutput;const funcretparaloc:tparalocation);
+    procedure TCgSparc.g_restore_all_registers(list:TaasmOutput;const funcretparaloc:TCGPara);
       begin
         { The sparc port uses the sparc standard calling convetions so this function has no used }
       end;
@@ -999,6 +1083,46 @@ implementation
                                TCG64Sparc
 ****************************************************************************}
 
+
+    procedure tcg64sparc.a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);
+      var
+        tmpref: treference;
+      begin
+        { Override this function to prevent loading the reference twice }
+        tmpref:=ref;
+        tcgsparc(cg).make_simple_ref(list,tmpref);
+        cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref);
+        inc(tmpref.offset,4);
+        cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,tmpref);
+      end;
+
+
+    procedure tcg64sparc.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);
+      var
+        tmpref: treference;
+      begin
+        { Override this function to prevent loading the reference twice }
+        tmpref:=ref;
+        tcgsparc(cg).make_simple_ref(list,tmpref);
+        cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);
+        inc(tmpref.offset,4);
+        cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo);
+      end;
+
+
+    procedure tcg64sparc.a_param64_ref(list : taasmoutput;const r : treference;const paraloc : tcgpara);
+      var
+        hreg64 : tregister64;
+      begin
+        { Override this function to prevent loading the reference twice.
+          Use here some extra registers, but those are optimized away by the RA }
+        hreg64.reglo:=cg.GetIntRegister(list,OS_32);
+        hreg64.reghi:=cg.GetIntRegister(list,OS_32);
+        a_load64_ref_reg(list,r,hreg64);
+        a_param64_reg(list,hreg64,paraloc);
+      end;
+
+
     procedure TCg64Sparc.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
       begin
         case op of
@@ -1040,9 +1164,9 @@ implementation
         case op of
           OP_NEG :
             begin
-              list.concat(taicpu.op_reg_reg_reg(A_XNOR,NR_G0,regsrc.reghi,regdst.reghi));
+              { Use the simple code: y=0-z }
               list.concat(taicpu.op_reg_reg_reg(A_SUBcc,NR_G0,regsrc.reglo,regdst.reglo));
-              list.concat(taicpu.op_reg_const_reg(A_ADDX,regdst.reglo,-1,regdst.reglo));
+              list.concat(taicpu.op_reg_reg_reg(A_SUBX,NR_G0,regsrc.reghi,regdst.reghi));
               exit;
             end;
           OP_NOT :
@@ -1109,7 +1233,28 @@ begin
 end.
 {
   $Log$
-  Revision 1.86  2004-08-25 20:40:04  florian
+  Revision 1.87  2004-09-21 17:25:13  peter
+    * paraloc branch merged
+
+  Revision 1.86.4.5  2004/09/20 20:43:15  peter
+    * implement reg_ref/ref_reg for 64bit to prevent loading the
+      address symbol twice
+
+  Revision 1.86.4.4  2004/09/17 17:19:26  peter
+    * fixed 64 bit unaryminus for sparc
+    * fixed 64 bit inlining
+    * signness of not operation
+
+  Revision 1.86.4.3  2004/09/12 21:31:03  peter
+    * sign extension added
+
+  Revision 1.86.4.2  2004/09/12 13:36:40  peter
+    * fixed alignment issues
+
+  Revision 1.86.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.86  2004/08/25 20:40:04  florian
     * fixed absolute on sparc
 
   Revision 1.85  2004/08/24 21:02:32  florian

compiler/sparc/cpubase.pas

@@ -20,8 +20,6 @@
 
  ****************************************************************************
 }
-{ This Unit contains the base types for the PowerPC
-}
 unit cpubase;
 
 {$i fpcdefs.inc}
@@ -164,8 +162,6 @@ uses
 *****************************************************************************}
 
     type
-      TRefOptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup);
-
       { reference record }
       preference = ^treference;
       treference = record
@@ -174,91 +170,33 @@ uses
          { index register, R_NO if none }
          index       : tregister;
          { offset, 0 if none }
-         offset      : longint;
+         offset      : aint;
          { symbol this reference refers to, nil if none }
          symbol      : tasmsymbol;
          { symbol the symbol of this reference is relative to, nil if none }
-         relsymbol      : tasmsymbol;
+         relsymbol   : tasmsymbol;
          { reference type addr or symbol itself }
-         refaddr : trefaddr;
-         { used in conjunction with the previous field }
-         options     : trefoptions;
-         { alignment this reference is guaranteed to have }
-         alignment   : byte;
+         refaddr     : trefaddr;
       end;
 
       { reference record }
       pparareference = ^tparareference;
       tparareference = packed record
          index       : tregister;
-         offset      : longint;
+         offset      : aint;
       end;
 
 {*****************************************************************************
                                 Operand Sizes
 *****************************************************************************}
 
-{$ifdef dummy}
-{*****************************************************************************
-                             Argument Classification
-*****************************************************************************}
-type
-  TArgClass = (
-     { the following classes should be defined by all processor implemnations }
-     AC_NOCLASS,
-     AC_MEMORY,
-     AC_INTEGER,
-     AC_FPU,
-     { the following argument classes are i386 specific }
-     AC_FPUUP,
-     AC_SSE,
-     AC_SSEUP);
-{$endif dummy}
 
 {*****************************************************************************
                                Generic Location
 *****************************************************************************}
 
     type
-      { tparamlocation describes where a parameter for a procedure is stored.
-        References are given from the caller's point of view. The usual
-        TLocation isn't used, because contains a lot of unnessary fields.
-      }
-      tparalocation = record
-         Size : TCGSize;
-         { The location type where the parameter is passed, usually
-           LOC_REFERENCE,LOC_REGISTER or LOC_FPUREGISTER
-         }
-         Loc  : TCGLoc;
-         LocHigh : TCGLoc;
-         {Word alignment on stack 4 --> 32 bit}
-         Alignment:Byte;
-         case TCGLoc of
-            LOC_REFERENCE : (reference : tparareference; low_in_reg: boolean; lowreg : tregister);
-            LOC_FPUREGISTER, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER,
-              LOC_REGISTER,LOC_CREGISTER : (
-              case longint of
-                1 : (register,registerhigh : tregister);
-                { overlay a registerlow }
-                2 : (registerlow : tregister);
-                { overlay a 64 Bit register type }
-                3 : (reg64 : tregister64);
-                4 : (register64 : tregister64);
-            );
-      end;
-
-      treglocation = packed record
-        case longint of
-          1 : (register,registerhigh : tregister);
-          { overlay a registerlow }
-          2 : (registerlow : tregister);
-          { overlay a 64 Bit register type }
-          3 : (reg64 : tregister64);
-          4 : (register64 : tregister64);
-       end;
-
-
-      tlocation = record
+      TLocation = record
          size : TCGSize;
          loc : tcgloc;
          case tcgloc of
@@ -272,8 +210,9 @@ type
 {$endif FPC_BIG_ENDIAN}
                 2 : (value64 : int64);
               );
-            LOC_FPUREGISTER, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER,
-              LOC_REGISTER,LOC_CREGISTER : (
+            LOC_FPUREGISTER,LOC_CFPUREGISTER,
+            LOC_MMREGISTER,LOC_CMMREGISTER,
+            LOC_REGISTER,LOC_CREGISTER : (
                 case longint of
                   1 : (registerlow,registerhigh : tregister);
                   2 : (register : tregister);
@@ -570,7 +509,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.71  2004-08-24 21:02:33  florian
+  Revision 1.72  2004-09-21 17:25:13  peter
+    * paraloc branch merged
+
+  Revision 1.71.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.71  2004/08/24 21:02:33  florian
     * fixed longbool(<int64>) on sparc
 
   Revision 1.70  2004/08/15 13:30:18  florian

compiler/sparc/cpuinfo.pas

@@ -1,8 +1,8 @@
-{******************************************************************************
+{
     $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
+    Copyright (c) 1998-2002 by Florian Klaempfl
 
-    Basic Processor information
+    Basic Processor information for the SPARC
 
     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
@@ -18,13 +18,17 @@
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
- ****************************************************************************}
+ ****************************************************************************
+}
 unit cpuinfo;
-{$INCLUDE fpcdefs.inc}
+
+{$i fpcdefs.inc}
 
 interface
+
 uses
   globtype;
+
 type
   bestreal = double;
   ts32real = single;
@@ -51,7 +55,7 @@ const
 { size of the buffer used for setjump/longjmp
   the size of this buffer is deduced from the
   jmp_buf structure in setjumph.inc file }
-  JMP_BUF_SIZE = 12;
+  JMP_BUF_SIZE = 12+16;
 
   { calling conventions supported by the code generator }
   supported_calling_conventions : tproccalloptions = [
@@ -73,12 +77,19 @@ const
      'SOFT',
      'HARD'
    );
+
 implementation
 
 end.
 {
   $Log$
-  Revision 1.18  2004-06-20 08:55:32  florian
+  Revision 1.19  2004-09-21 17:25:13  peter
+    * paraloc branch merged
+
+  Revision 1.18.4.1  2004/09/12 12:04:41  peter
+    * sigset_t is now also in jmp_buf
+
+  Revision 1.18  2004/06/20 08:55:32  florian
     * logs truncated
 
   Revision 1.17  2004/06/16 20:07:10  florian

compiler/sparc/cpupara.pas

@@ -29,7 +29,7 @@ interface
       cclasses,
       aasmtai,
       cpubase,cpuinfo,
-      symconst,symbase,symtype,symdef,paramgr,cgbase;
+      symconst,symbase,symtype,symdef,paramgr,parabase,cgbase;
 
     type
       TSparcParaManager=class(TParaManager)
@@ -40,12 +40,9 @@ interface
         {Returns a structure giving the information on the storage of the parameter
         (which must be an integer parameter)
         @param(nr Parameter number of routine, starting from 1)}
-        function  getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
-        procedure allocparaloc(list: taasmoutput; const loc: tparalocation);override;
-        procedure freeparaloc(list: taasmoutput; const loc: tparalocation);override;
+        procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
-        function create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargspara):longint;override;
-        procedure splitparaloc64(const locpara:tparalocation;var loclopara,lochipara:tparalocation);override;
+        function  create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargspara):longint;override;
       private
         procedure create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
         procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; firstpara: tparaitem;
@@ -55,7 +52,7 @@ interface
 implementation
 
     uses
-      verbose,systems,
+      cutils,verbose,systems,
       defutil,cgobj;
 
     type
@@ -78,30 +75,34 @@ implementation
       end;
 
 
-    function TSparcParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint) : tparalocation;
+    procedure TSparcParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint;var cgpara : tcgpara);
+      var
+        paraloc : pcgparalocation;
       begin
         if nr<1 then
           InternalError(2002100806);
-        FillChar(GetIntParaLoc,SizeOf(TParaLocation),0);
-        result.lochigh:=LOC_INVALID;
-        Dec(nr);
-        with GetIntParaLoc do
-         begin
-           { The six first parameters are passed into registers }
-           if nr<6 then
-            begin
-              loc:=LOC_REGISTER;
-              register:=newreg(R_INTREGISTER,(RS_O0+nr),R_SUBWHOLE);
-            end
-           else
-           { The other parameters are passed on the stack }
-            begin
-              loc:=LOC_REFERENCE;
-              reference.index:=NR_STACK_POINTER_REG;
-              reference.offset:=92+(nr-6)*4;
-            end;
-           size:=OS_INT;
-         end;
+        cgpara.reset;
+        cgpara.size:=OS_INT;
+        cgpara.alignment:=std_param_align;
+        paraloc:=cgpara.add_location;
+        with paraloc^ do
+          begin
+            { The six first parameters are passed into registers }
+            dec(nr);
+            if nr<6 then
+              begin
+                loc:=LOC_REGISTER;
+                register:=newreg(R_INTREGISTER,(RS_O0+nr),R_SUBWHOLE);
+              end
+            else
+              begin
+                { The other parameters are passed on the stack }
+                loc:=LOC_REFERENCE;
+                reference.index:=NR_STACK_POINTER_REG;
+                reference.offset:=92+(nr-6)*4;
+              end;
+            size:=OS_INT;
+          end;
       end;
 
 
@@ -141,70 +142,78 @@ implementation
 
     procedure tsparcparamanager.create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
       var
-        paraloc : tparalocation;
+        paraloc : pcgparalocation;
+        retcgsize  : tcgsize;
       begin
-        fillchar(paraloc,sizeof(tparalocation),0);
-        paraloc.size:=def_cgsize(p.rettype.def);
-        paraloc.Alignment:= std_param_align;
-        { Constructors return self }
+        { Constructors return self instead of a boolean }
         if (p.proctypeoption=potype_constructor) then
-          begin
-            paraloc.size:=OS_ADDR;
-            paraloc.loc:=LOC_REGISTER;
-            if side=callerside then
-              paraloc.register:=NR_FUNCTION_RESULT_REG
-            else
-              paraloc.register:=NR_FUNCTION_RETURN_REG;
-          end
+          retcgsize:=OS_ADDR
         else
-         { Return in FPU register? }
-         if p.rettype.def.deftype=floatdef then
+          retcgsize:=def_cgsize(p.rettype.def);
+        p.funcret_paraloc[side].reset;
+        p.funcret_paraloc[side].Alignment:=std_param_align;
+        p.funcret_paraloc[side].size:=retcgsize;
+        { void has no location }
+        if is_void(p.rettype.def) then
+          exit;
+        paraloc:=p.funcret_paraloc[side].add_location;
+        { Return in FPU register? }
+        if p.rettype.def.deftype=floatdef then
           begin
-            paraloc.loc:=LOC_FPUREGISTER;
-            paraloc.register:=NR_FPU_RESULT_REG;
+            paraloc^.loc:=LOC_FPUREGISTER;
+            paraloc^.register:=NR_FPU_RESULT_REG;
+            paraloc^.size:=retcgsize;
           end
         else
          { Return in register? }
          if not ret_in_param(p.rettype.def,p.proccalloption) then
           begin
-            paraloc.loc:=LOC_REGISTER;
 {$ifndef cpu64bit}
-            if paraloc.size in [OS_64,OS_S64] then
+            if retcgsize in [OS_64,OS_S64] then
              begin
-               paraloc.lochigh:=LOC_REGISTER;
-               if side=callerside then
-                 paraloc.register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG
+               { high }
+               paraloc^.loc:=LOC_REGISTER;
+               paraloc^.size:=OS_32;
+               if (side=callerside)  or (p.proccalloption=pocall_inline)then
+                 paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
                else
-                 paraloc.register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
-               if side=callerside then
-                 paraloc.register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG
+                 paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
+               { low }
+               paraloc:=p.funcret_paraloc[side].add_location;
+               paraloc^.loc:=LOC_REGISTER;
+               paraloc^.size:=OS_32;
+               if (side=callerside) or (p.proccalloption=pocall_inline) then
+                 paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
                else
-                 paraloc.register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
+                 paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG;
              end
             else
 {$endif cpu64bit}
              begin
-               if side=callerside then
-                 paraloc.register:=NR_FUNCTION_RESULT_REG
+               paraloc^.loc:=LOC_REGISTER;
+               paraloc^.size:=retcgsize;
+               if (side=callerside)  or (p.proccalloption=pocall_inline)then
+                 paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(retcgsize))
                else
-                 paraloc.register:=NR_FUNCTION_RETURN_REG;
+                 paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(retcgsize));
              end;
           end
         else
           begin
-            paraloc.loc:=LOC_REFERENCE;
+            paraloc^.loc:=LOC_REFERENCE;
+            paraloc^.size:=retcgsize;
           end;
-        p.funcret_paraloc[side]:=paraloc;
       end;
 
 
     procedure tsparcparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;firstpara:tparaitem;
                                                            var intparareg,parasize:longint);
       var
-        paraloc : tparalocation;
-        hp : tparaitem;
-        is_64bit: boolean;
+        paraloc      : pcgparalocation;
+        hp           : tparaitem;
+        paracgsize   : tcgsize;
         hparasupregs : pparasupregs;
+        paralen      : longint;
       begin
         if side=callerside then
           hparasupregs:=@paraoutsupregs
@@ -213,52 +222,52 @@ implementation
         hp:=firstpara;
         while assigned(hp) do
           begin
-            fillchar(paraloc,sizeof(paraloc),0);
-            paraloc.Alignment:= std_param_align;
-            if push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption) or (hp.paratyp in [vs_var,vs_out]) then
-              paraloc.size:=OS_ADDR
+            if push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption) then
+              paracgsize:=OS_ADDR
             else
               begin
-                paraloc.size:=def_cgSize(hp.paratype.def);
-                if paraloc.size=OS_NO then
-                  paraloc.size:=OS_ADDR;
+                paracgsize:=def_cgSize(hp.paratype.def);
+                if paracgsize=OS_NO then
+                  paracgsize:=OS_ADDR;
               end;
-            is_64bit:=(paraloc.size in [OS_64,OS_S64,OS_F64]);
-            if (intparareg<=high(tparasupregs)-ord(is_64bit)) then
-              begin
-                paraloc.loc:=LOC_REGISTER;
-                { big endian }
-                if is_64bit then
-                  begin
-                    paraloc.registerhigh:=newreg(R_INTREGISTER,hparasupregs^[intparareg],R_SUBWHOLE);
-                    paraloc.lochigh:=LOC_REGISTER;
-                    inc(intparareg);
-                  end;
-                paraloc.registerlow:=newreg(R_INTREGISTER,hparasupregs^[intparareg],R_SUBWHOLE);
-                inc(intparareg);
-              end
-            else
+            { Floats are passed in int registers }
+            case paracgsize of
+              OS_F32 :
+                paracgsize:=OS_32;
+              OS_F64 :
+                paracgsize:=OS_64;
+            end;
+            hp.paraloc[side].reset;
+            hp.paraloc[side].size:=paracgsize;
+            hp.paraloc[side].Alignment:=std_param_align;
+            paralen:=tcgsize2size[paracgsize];
+            while (paralen>0) do
               begin
-                paraloc.loc:=LOC_REFERENCE;
-                { Low part need to be in O5 if still available }
+                paraloc:=hp.paraloc[side].add_location;
+                { We can allocate at maximum 32 bits per register }
+                if paracgsize in [OS_64,OS_S64] then
+                  paraloc^.size:=OS_32
+                else
+                  paraloc^.size:=paracgsize;
                 if (intparareg<=high(tparasupregs)) then
                   begin
-                    paraloc.low_in_reg:=true;
-                    paraloc.lowreg:=newreg(R_INTREGISTER,hparasupregs^[intparareg],R_SUBWHOLE);
+                    paraloc^.loc:=LOC_REGISTER;
+                    paraloc^.register:=newreg(R_INTREGISTER,hparasupregs^[intparareg],R_SUBWHOLE);
                     inc(intparareg);
-                  end;
-                if side=callerside then
-                  paraloc.reference.index:=NR_STACK_POINTER_REG
-                else
-                  paraloc.reference.index:=NR_FRAME_POINTER_REG;
-                paraloc.reference.offset:=target_info.first_parm_offset+parasize;
-                if is_64bit and
-                   (not paraloc.low_in_reg) then
-                  inc(parasize,8)
+                  end
                 else
-                  inc(parasize,4);
+                  begin
+                    paraloc^.loc:=LOC_REFERENCE;
+                    if side=callerside then
+                      paraloc^.reference.index:=NR_STACK_POINTER_REG
+                    else
+                      paraloc^.reference.index:=NR_FRAME_POINTER_REG;
+                    paraloc^.reference.offset:=target_info.first_parm_offset+parasize;
+                    { Parameters are aligned at 4 bytes }
+                    inc(parasize,align(tcgsize2size[paraloc^.size],sizeof(aint)));
+                  end;
+                dec(paralen,tcgsize2size[paraloc^.size]);
               end;
-            hp.paraloc[side]:=paraloc;
             hp:=TParaItem(hp.Next);
           end;
       end;
@@ -295,52 +304,29 @@ implementation
       end;
 
 
-    procedure tsparcparamanager.allocparaloc(list: taasmoutput; const loc: tparalocation);
-      begin
-        if (loc.loc=LOC_REFERENCE) and
-           (loc.low_in_reg) then
-          cg.GetExplicitRegister(list,loc.lowreg);
-        inherited allocparaloc(list,loc);
-      end;
-
-
-    procedure tsparcparamanager.freeparaloc(list: taasmoutput; const loc: tparalocation);
-      begin
-        if (loc.loc=LOC_REFERENCE) and
-           (loc.low_in_reg) then
-          cg.UnGetRegister(list,loc.lowreg);
-        inherited freeparaloc(list,loc);
-      end;
-
-    procedure tsparcparamanager.splitparaloc64(const locpara:tparalocation;var loclopara,lochipara:tparalocation);
-      begin
-        { Word 0 is in register, word 1 is in reference }
-        if (locpara.loc=LOC_REFERENCE) and locpara.low_in_reg then
-          begin
-            { high }
-            lochipara:=locpara;
-            if locpara.size=OS_S64 then
-              lochipara.size:=OS_S32
-            else
-              lochipara.size:=OS_32;
-            lochipara.low_in_reg:=false;
-            { low }
-            loclopara:=locpara;
-            loclopara.size:=OS_32;
-            loclopara.loc:=LOC_REGISTER;
-            loclopara.register:=locpara.lowreg;
-          end
-        else
-          inherited splitparaloc64(locpara,loclopara,lochipara);
-      end;
-
-
 begin
    ParaManager:=TSparcParaManager.create;
 end.
 {
   $Log$
-  Revision 1.40  2004-06-20 08:55:32  florian
+  Revision 1.41  2004-09-21 17:25:13  peter
+    * paraloc branch merged
+
+  Revision 1.40.4.4  2004/09/19 18:08:15  peter
+    * fixed order of 64 bit funcret registers
+
+  Revision 1.40.4.3  2004/09/17 17:19:26  peter
+    * fixed 64 bit unaryminus for sparc
+    * fixed 64 bit inlining
+    * signness of not operation
+
+  Revision 1.40.4.2  2004/09/12 13:36:40  peter
+    * fixed alignment issues
+
+  Revision 1.40.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.40  2004/06/20 08:55:32  florian
     * logs truncated
 
   Revision 1.39  2004/06/16 20:07:10  florian

compiler/sparc/itcpugas.pas

@@ -85,7 +85,7 @@ implementation
           R_SUBFD:
             setsubreg(r,R_SUBFS);
           R_SUBL,R_SUBW,R_SUBD,R_SUBQ:
-            setsubreg(r,R_SUBNONE);
+            setsubreg(r,R_SUBD);
         end;
         p:=findreg_by_number(r);
         if p<>0 then
@@ -97,7 +97,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2004-08-24 21:02:33  florian
+  Revision 1.5  2004-09-21 17:25:13  peter
+    * paraloc branch merged
+
+  Revision 1.4.4.1  2004/09/20 20:42:37  peter
+    * use R_SUBD for all int registers instead of R_SUBNONE
+
+  Revision 1.4  2004/08/24 21:02:33  florian
     * fixed longbool(<int64>) on sparc
 
   Revision 1.3  2004/06/20 08:55:32  florian

compiler/sparc/ncpuadd.pas

@@ -49,7 +49,7 @@ interface
       systems,
       cutils,verbose,
       paramgr,
-      aasmbase,aasmtai,aasmcpu,defutil,
+      aasmtai,aasmcpu,defutil,
       cgbase,cgcpu,
       cpupara,
       ncon,nset,nadd,
@@ -281,8 +281,70 @@ interface
 
     procedure tsparcaddnode.second_cmp64bit;
       var
-        unsigned : boolean;
-        l : tasmlabel;
+        unsigned   : boolean;
+
+      procedure firstjmp64bitcmp;
+        var
+           oldnodetype : tnodetype;
+        begin
+           { the jump the sequence is a little bit hairy }
+           case nodetype of
+              ltn,gtn:
+                begin
+                   cg.a_jmp_flags(exprasmlist,getresflags(unsigned),truelabel);
+                   { cheat a little bit for the negative test }
+                   toggleflag(nf_swaped);
+                   cg.a_jmp_flags(exprasmlist,getresflags(unsigned),falselabel);
+                   toggleflag(nf_swaped);
+                end;
+              lten,gten:
+                begin
+                   oldnodetype:=nodetype;
+                   if nodetype=lten then
+                     nodetype:=ltn
+                   else
+                     nodetype:=gtn;
+                   cg.a_jmp_flags(exprasmlist,getresflags(unsigned),truelabel);
+                   { cheat for the negative test }
+                   if nodetype=ltn then
+                     nodetype:=gtn
+                   else
+                     nodetype:=ltn;
+                   cg.a_jmp_flags(exprasmlist,getresflags(unsigned),falselabel);
+                   nodetype:=oldnodetype;
+                end;
+              equaln:
+                cg.a_jmp_flags(exprasmlist,F_NE,falselabel);
+              unequaln:
+                cg.a_jmp_flags(exprasmlist,F_NE,truelabel);
+           end;
+        end;
+
+      procedure secondjmp64bitcmp;
+
+        begin
+           { the jump the sequence is a little bit hairy }
+           case nodetype of
+              ltn,gtn,lten,gten:
+                begin
+                   { the comparisaion of the low dword have to be }
+                   {  always unsigned!                            }
+                   cg.a_jmp_flags(exprasmlist,getresflags(true),truelabel);
+                   cg.a_jmp_always(exprasmlist,falselabel);
+                end;
+              equaln:
+                begin
+                   cg.a_jmp_flags(exprasmlist,F_NE,falselabel);
+                   cg.a_jmp_always(exprasmlist,truelabel);
+                end;
+              unequaln:
+                begin
+                   cg.a_jmp_flags(exprasmlist,F_NE,truelabel);
+                   cg.a_jmp_always(exprasmlist,falselabel);
+                end;
+           end;
+        end;
+
       begin
         pass_left_right;
         force_reg_left_right(false,false);
@@ -290,49 +352,12 @@ interface
         unsigned:=not(is_signed(left.resulttype.def)) or
                   not(is_signed(right.resulttype.def));
 
-        location_reset(location,LOC_FLAGS,OS_NO);
-        location.resflags:=getresflags(unsigned);
+        location_reset(location,LOC_JUMP,OS_NO);
 
-        { operation requiring proper N, Z and C flags ? }
-        if unsigned or (nodetype in [equaln,unequaln]) then
-          begin
-            objectlibrary.getlabel(l);
-            exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi));
-            tcgsparc(cg).a_jmp_cond(exprasmlist,OC_NE,l);
-            exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo));
-            cg.a_label(exprasmlist,l);
-          end
-        { operation requiring proper N, V and C flags ? }
-        else if nodetype in [gten,ltn] then
-          begin
-            exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBCC,left.location.register64.reglo,right.location.register64.reglo,NR_G0));
-            exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBXCC,left.location.register64.reghi,right.location.register64.reghi,NR_G0));
-          end
-        else
-        { operation requiring proper N, Z and V flags ? }
-          begin
-            { this isn't possible so swap operands and use the "reverse" operation }
-            exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBCC,right.location.register64.reglo,left.location.register64.reglo,NR_G0));
-            exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBXCC,right.location.register64.reghi,left.location.register64.reghi,NR_G0));
-            if nf_swaped in flags then
-              begin
-                if location.resflags=F_L then
-                  location.resflags:=F_G
-                else if location.resflags=F_GE then
-                  location.resflags:=F_LE
-                else
-                  internalerror(200401221);
-              end
-            else
-              begin
-                if location.resflags=F_G then
-                  location.resflags:=F_L
-                else if location.resflags=F_LE then
-                  location.resflags:=F_GE
-                else
-                  internalerror(200401221);
-              end;
-          end;
+        exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi));
+        firstjmp64bitcmp;
+        exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo));
+        secondjmp64bitcmp;
 
         release_reg_left_right;
       end;
@@ -364,7 +389,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.25  2004-06-20 08:55:32  florian
+  Revision 1.26  2004-09-21 17:25:13  peter
+    * paraloc branch merged
+
+  Revision 1.25.4.1  2004/09/19 18:08:30  peter
+    * int64 compare fixed
+
+  Revision 1.25  2004/06/20 08:55:32  florian
     * logs truncated
 
   Revision 1.24  2004/06/16 20:07:10  florian

compiler/sparc/rspcon.inc

@@ -1,39 +1,39 @@
 { don't edit, this file is generated from spreg.dat }
 NR_NO = tregister($00000000);
-NR_G0 = tregister($01000000);
-NR_G1 = tregister($01000001);
-NR_G2 = tregister($01000002);
-NR_G3 = tregister($01000003);
-NR_G4 = tregister($01000004);
-NR_G5 = tregister($01000005);
-NR_G6 = tregister($01000006);
-NR_G7 = tregister($01000007);
-NR_O0 = tregister($01000008);
-NR_O1 = tregister($01000009);
-NR_O2 = tregister($0100000a);
-NR_O3 = tregister($0100000b);
-NR_O4 = tregister($0100000c);
-NR_O5 = tregister($0100000d);
-NR_O6 = tregister($0100000e);
-NR_O7 = tregister($0100000f);
-NR_L0 = tregister($01000010);
-NR_L1 = tregister($01000011);
-NR_L2 = tregister($01000012);
-NR_L3 = tregister($01000013);
-NR_L4 = tregister($01000014);
-NR_L5 = tregister($01000015);
-NR_L6 = tregister($01000016);
-NR_L7 = tregister($01000017);
-NR_I0 = tregister($01000018);
-NR_I1 = tregister($01000019);
-NR_I2 = tregister($0100001a);
-NR_I3 = tregister($0100001b);
-NR_I4 = tregister($0100001c);
-NR_I5 = tregister($0100001d);
-NR_I6 = tregister($0100001e);
-NR_I7 = tregister($0100001f);
-NR_FP = tregister($0100001e);
-NR_SP = tregister($0100000e);
+NR_G0 = tregister($01040000);
+NR_G1 = tregister($01040001);
+NR_G2 = tregister($01040002);
+NR_G3 = tregister($01040003);
+NR_G4 = tregister($01040004);
+NR_G5 = tregister($01040005);
+NR_G6 = tregister($01040006);
+NR_G7 = tregister($01040007);
+NR_O0 = tregister($01040008);
+NR_O1 = tregister($01040009);
+NR_O2 = tregister($0104000a);
+NR_O3 = tregister($0104000b);
+NR_O4 = tregister($0104000c);
+NR_O5 = tregister($0104000d);
+NR_O6 = tregister($0104000e);
+NR_O7 = tregister($0104000f);
+NR_L0 = tregister($01040010);
+NR_L1 = tregister($01040011);
+NR_L2 = tregister($01040012);
+NR_L3 = tregister($01040013);
+NR_L4 = tregister($01040014);
+NR_L5 = tregister($01040015);
+NR_L6 = tregister($01040016);
+NR_L7 = tregister($01040017);
+NR_I0 = tregister($01040018);
+NR_I1 = tregister($01040019);
+NR_I2 = tregister($0104001a);
+NR_I3 = tregister($0104001b);
+NR_I4 = tregister($0104001c);
+NR_I5 = tregister($0104001d);
+NR_I6 = tregister($0104001e);
+NR_I7 = tregister($0104001f);
+NR_FP = tregister($0104001e);
+NR_SP = tregister($0104000e);
 NR_F0 = tregister($02060000);
 NR_F1 = tregister($02060001);
 NR_F2 = tregister($02060002);

compiler/sparc/spreg.dat

@@ -8,41 +8,41 @@
 ;
 NO,$00,$00,$00,INVALID,-1,-1
 ; Integer registers
-G0,$01,$00,$00,%g0,1,1
-G1,$01,$00,$01,%g1,2,2
-G2,$01,$00,$02,%g2,3,3
-G3,$01,$00,$03,%g3,4,4
-G4,$01,$00,$04,%g4,5,5
-G5,$01,$00,$05,%g5,6,6
-G6,$01,$00,$06,%g6,7,7
-G7,$01,$00,$07,%g7,8,8
-O0,$01,$00,$08,%o0,9,9
-O1,$01,$00,$09,%o1,10,10
-O2,$01,$00,$0a,%o2,11,11
-O3,$01,$00,$0b,%o3,12,12
-O4,$01,$00,$0c,%o4,13,13
-O5,$01,$00,$0d,%o5,14,14
-O6,$01,$00,$0e,%o6,15,15
-O7,$01,$00,$0f,%o7,16,16
-L0,$01,$00,$10,%l0,17,17
-L1,$01,$00,$11,%l1,18,18
-L2,$01,$00,$12,%l2,19,19
-L3,$01,$00,$13,%l3,20,20
-L4,$01,$00,$14,%l4,21,21
-L5,$01,$00,$15,%l5,22,22
-L6,$01,$00,$16,%l6,23,23
-L7,$01,$00,$17,%l7,24,24
-I0,$01,$00,$18,%i0,25,25
-I1,$01,$00,$19,%i1,26,26
-I2,$01,$00,$1a,%i2,27,27
-I3,$01,$00,$1b,%i3,28,28
-I4,$01,$00,$1c,%i4,29,29
-I5,$01,$00,$1d,%i5,30,30
-I6,$01,$00,$1e,%i6,31,31
-I7,$01,$00,$1f,%i7,32,32
+G0,$01,$04,$00,%g0,1,1
+G1,$01,$04,$01,%g1,2,2
+G2,$01,$04,$02,%g2,3,3
+G3,$01,$04,$03,%g3,4,4
+G4,$01,$04,$04,%g4,5,5
+G5,$01,$04,$05,%g5,6,6
+G6,$01,$04,$06,%g6,7,7
+G7,$01,$04,$07,%g7,8,8
+O0,$01,$04,$08,%o0,9,9
+O1,$01,$04,$09,%o1,10,10
+O2,$01,$04,$0a,%o2,11,11
+O3,$01,$04,$0b,%o3,12,12
+O4,$01,$04,$0c,%o4,13,13
+O5,$01,$04,$0d,%o5,14,14
+O6,$01,$04,$0e,%o6,15,15
+O7,$01,$04,$0f,%o7,16,16
+L0,$01,$04,$10,%l0,17,17
+L1,$01,$04,$11,%l1,18,18
+L2,$01,$04,$12,%l2,19,19
+L3,$01,$04,$13,%l3,20,20
+L4,$01,$04,$14,%l4,21,21
+L5,$01,$04,$15,%l5,22,22
+L6,$01,$04,$16,%l6,23,23
+L7,$01,$04,$17,%l7,24,24
+I0,$01,$04,$18,%i0,25,25
+I1,$01,$04,$19,%i1,26,26
+I2,$01,$04,$1a,%i2,27,27
+I3,$01,$04,$1b,%i3,28,28
+I4,$01,$04,$1c,%i4,29,29
+I5,$01,$04,$1d,%i5,30,30
+I6,$01,$04,$1e,%i6,31,31
+I7,$01,$04,$1f,%i7,32,32
 ; Aliases for stackpointer (%o6) and framepointer (%i6)
-FP,$01,$00,$1e,%fp,31,31
-SP,$01,$00,$0e,%sp,15,15
+FP,$01,$04,$1e,%fp,31,31
+SP,$01,$04,$0e,%sp,15,15
 ; Float registers, single use
 F0,$02,$06,$00,%f0,32,32
 F1,$02,$06,$01,%f1,32,32
@@ -157,7 +157,13 @@ ASR31,$04,$00,$1f,%asr31,32,32
 
 ;
 ; $Log$
-; Revision 1.5  2004-06-16 20:07:11  florian
+; Revision 1.6  2004-09-21 17:25:13  peter
+;   * paraloc branch merged
+;
+; Revision 1.5.4.1  2004/09/20 20:42:38  peter
+;   * use R_SUBD for all int registers instead of R_SUBNONE
+;
+; Revision 1.5  2004/06/16 20:07:11  florian
 ;   * dwarf branch merged
 ;
 ; Revision 1.4.2.1  2004/05/11 19:34:57  peter

compiler/symdef.pas

@@ -39,7 +39,7 @@ interface
        { aasm }
        aasmbase,aasmtai,
        cpubase,cpuinfo,
-       cgbase
+       cgbase,parabase
 {$ifdef Delphi}
        ,dmisc
 {$endif}
@@ -113,11 +113,13 @@ interface
           defaultvalue : tsym; { tconstsym }
           defaultvaluederef : tderef;
           paratyp       : tvarspez; { required for procvar }
-          paraloc       : array[tcallercallee] of tparalocation;
+          paraloc       : array[tcallercallee] of TCGPara;
           is_hidden     : boolean; { is this a hidden (implicit) parameter }
 {$ifdef EXTDEBUG}
           eqval         : tequaltype;
 {$endif EXTDEBUG}
+          constructor create;
+          destructor destroy;override;
        end;
 
        tfiletyp = (ft_text,ft_typed,ft_untyped);
@@ -456,7 +458,7 @@ interface
 {$ifdef i386}
           fpu_used        : byte;    { how many stack fpu must be empty }
 {$endif i386}
-          funcret_paraloc : array[tcallercallee] of tparalocation;
+          funcret_paraloc : array[tcallercallee] of TCGPara;
           has_paraloc_info : boolean; { paraloc info is available }
           constructor create(level:byte);
           constructor ppuload(ppufile:tcompilerppufile);
@@ -921,6 +923,26 @@ implementation
       end;
 
 
+{****************************************************************************
+                           TParaItem
+****************************************************************************}
+
+    constructor tparaitem.create;
+      begin
+        inherited create;
+        paraloc[calleeside].init;
+        paraloc[callerside].init;
+      end;
+
+
+    destructor tparaitem.destroy;
+      begin
+        paraloc[calleeside].done;
+        paraloc[callerside].done;
+        inherited destroy;
+      end;
+
+
 {****************************************************************************
                      TDEF (base class for definitions)
 ****************************************************************************}
@@ -3277,6 +3299,8 @@ implementation
          savesize:=sizeof(aint);
          requiredargarea:=0;
          has_paraloc_info:=false;
+         funcret_paraloc[callerside].init;
+         funcret_paraloc[calleeside].init;
       end;
 
 
@@ -3302,6 +3326,8 @@ implementation
             memprocparast.stop;
 {$endif MEMDEBUG}
           end;
+         funcret_paraloc[callerside].done;
+         funcret_paraloc[calleeside].done;
          inherited destroy;
       end;
 
@@ -6158,10 +6184,16 @@ implementation
 end.
 {
   $Log$
-  Revision 1.254  2004-09-14 16:33:17  peter
+  Revision 1.255  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.254  2004/09/14 16:33:17  peter
     * restart sorting of enums when deref is called, this is needed when
       a unit is reloaded
 
+  Revision 1.253.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
   Revision 1.253  2004/08/27 21:59:26  peter
   browser disabled
   uf_local_symtable ppu flag when a localsymtable is stored

compiler/symsym.pas

@@ -37,7 +37,7 @@ interface
        cclasses,symnot,
        { aasm }
        aasmbase,
-       cpuinfo,cpubase,cgbase
+       cpuinfo,cpubase,cgbase,parabase
        ;
 
     type
@@ -150,8 +150,8 @@ interface
           varoptions    : tvaroptions;
           varspez       : tvarspez;  { sets the type of access }
           varstate      : tvarstate;
-          localloc      : tparalocation; { register/reference for local var }
-          fieldoffset   : longint; { offset in record/object }
+          localloc      : TLocation; { register/reference for local var }
+          fieldoffset   : longint;   { offset in record/object }
           paraitem      : tparaitem;
           notifications : Tlinkedlist;
           constructor create(const n : string;vsp:tvarspez;const tt : ttype);
@@ -2215,7 +2215,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.175  2004-08-15 12:06:03  jonas
+  Revision 1.176  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.175.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.175  2004/08/15 12:06:03  jonas
     * add cprefix to procedures which are autoamtically marked as external in
       macpas mode
 

compiler/systems/t_linux.pas

@@ -211,7 +211,7 @@ var
 begin
   with Info do
    begin
-     ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP --gc-sections -L. -o $EXE $RES';
+     ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES';
      DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES';
      DllCmd[2]:='strip --strip-unneeded $EXE';
 {$ifdef m68k}
@@ -572,7 +572,13 @@ end.
 
 {
   $Log$
-  Revision 1.20  2004-07-08 14:42:54  daniel
+  Revision 1.21  2004-09-21 17:25:13  peter
+    * paraloc branch merged
+
+  Revision 1.20.4.1  2004/09/20 15:24:42  peter
+    * remove gc-sections option until it really works
+
+  Revision 1.20  2004/07/08 14:42:54  daniel
     * Uclibc detection
 
   Revision 1.19  2004/06/20 08:55:32  florian

compiler/tgobj.pas

@@ -103,8 +103,8 @@ unit tgobj;
           procedure ungetiftemp(list: taasmoutput; const ref : treference);
 
           { Allocate space for a local }
-          procedure getlocal(list: taasmoutput; size : longint;def:tdef;var ref : tparareference);
-          procedure UnGetLocal(list: taasmoutput; const ref : tparareference);
+          procedure getlocal(list: taasmoutput; size : longint;def:tdef;var ref : treference);
+          procedure UnGetLocal(list: taasmoutput; const ref : treference);
        end;
 
      var
@@ -588,7 +588,7 @@ unit tgobj;
       end;
 
 
-    procedure ttgobj.getlocal(list: taasmoutput; size : longint;def:tdef;var ref : tparareference);
+    procedure ttgobj.getlocal(list: taasmoutput; size : longint;def:tdef;var ref : treference);
       var
         varalign : longint;
       begin
@@ -597,12 +597,12 @@ unit tgobj;
         { can't use reference_reset_base, because that will let tgobj depend
           on cgobj (PFV) }
         fillchar(ref,sizeof(ref),0);
-        ref.index:=current_procinfo.framepointer;
+        ref.base:=current_procinfo.framepointer;
         ref.offset:=alloctemp(list,size,varalign,tt_persistent,nil);
       end;
 
 
-    procedure ttgobj.UnGetLocal(list: taasmoutput; const ref : tparareference);
+    procedure ttgobj.UnGetLocal(list: taasmoutput; const ref : treference);
       begin
         FreeTemp(list,ref.offset,[tt_persistent]);
       end;
@@ -611,7 +611,10 @@ unit tgobj;
 end.
 {
   $Log$
-  Revision 1.47  2004-09-20 15:40:21  peter
+  Revision 1.48  2004-09-21 17:25:12  peter
+    * paraloc branch merged
+
+  Revision 1.47  2004/09/20 15:40:21  peter
     * make it compile with main branch
 
   Revision 1.46  2004/09/20 07:32:02  jonas

compiler/x86/nx86add.pas

@@ -20,9 +20,6 @@
 
  ****************************************************************************
 }
-{
-Common code generation for add nodes on the i386 and x86
-}
 unit nx86add;
 
 {$i fpcdefs.inc}
@@ -66,13 +63,12 @@ unit nx86add;
 
     uses
       globtype,globals,
-      verbose,
-      cutils,
+      verbose,cutils,
       cpuinfo,
       aasmbase,aasmtai,aasmcpu,
       symconst,symdef,
       cgobj,cgx86,cga,
-      paramgr,
+      paramgr,parabase,
       htypechk,
       pass_2,ncgutil,
       ncon,nset,
@@ -739,7 +735,7 @@ unit nx86add;
     procedure tx86addnode.second_addstring;
       var
         paraloc1,
-        paraloc2   : tparalocation;
+        paraloc2   : tcgpara;
         hregister1,
         hregister2 : tregister;
       begin
@@ -752,12 +748,14 @@ unit nx86add;
                 case nodetype of
                    ltn,lten,gtn,gten,equaln,unequaln :
                      begin
-                       paraloc1:=paramanager.getintparaloc(pocall_default,1);
-                       paraloc2:=paramanager.getintparaloc(pocall_default,2);
+                       paraloc1.init;
+                       paraloc2.init;
+                       paramanager.getintparaloc(pocall_default,1,paraloc1);
+                       paramanager.getintparaloc(pocall_default,2,paraloc2);
                        { process parameters }
                        secondpass(left);
                        location_release(exprasmlist,left.location);
-                       if paraloc2.loc=LOC_REGISTER then
+                       if paraloc2.location^.loc=LOC_REGISTER then
                          begin
                            hregister2:=cg.getaddressregister(exprasmlist);
                            cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,hregister2);
@@ -769,7 +767,7 @@ unit nx86add;
                          end;
                        secondpass(right);
                        location_release(exprasmlist,right.location);
-                       if paraloc1.loc=LOC_REGISTER then
+                       if paraloc1.location^.loc=LOC_REGISTER then
                          begin
                            hregister1:=cg.getaddressregister(exprasmlist);
                            cg.a_loadaddr_ref_reg(exprasmlist,right.location.reference,hregister1);
@@ -780,13 +778,13 @@ unit nx86add;
                            cg.a_paramaddr_ref(exprasmlist,right.location.reference,paraloc1);
                          end;
                        { push parameters }
-                       if paraloc1.loc=LOC_REGISTER then
+                       if paraloc1.location^.loc=LOC_REGISTER then
                          begin
                            cg.ungetregister(exprasmlist,hregister2);
                            paramanager.allocparaloc(exprasmlist,paraloc2);
                            cg.a_param_reg(exprasmlist,OS_ADDR,hregister2,paraloc2);
                          end;
-                       if paraloc2.loc=LOC_REGISTER then
+                       if paraloc2.location^.loc=LOC_REGISTER then
                          begin
                            cg.ungetregister(exprasmlist,hregister1);
                            paramanager.allocparaloc(exprasmlist,paraloc1);
@@ -799,6 +797,8 @@ unit nx86add;
                        cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
                        location_freetemp(exprasmlist,left.location);
                        location_freetemp(exprasmlist,right.location);
+                       paraloc1.done;
+                       paraloc2.done;
                      end;
                 end;
                 location_reset(location,LOC_FLAGS,OS_NO);
@@ -935,7 +935,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  2004-06-20 08:55:32  florian
+  Revision 1.12  2004-09-21 17:25:13  peter
+    * paraloc branch merged
+
+  Revision 1.11.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.11  2004/06/20 08:55:32  florian
     * logs truncated
 
   Revision 1.10  2004/06/16 20:07:11  florian

compiler/x86_64/cgcpu.pas

@@ -20,8 +20,6 @@
 
  ****************************************************************************
 }
-{ This unit implements the code generator for the x86-64.
-}
 unit cgcpu;
 
 {$i fpcdefs.inc}
@@ -31,14 +29,14 @@ unit cgcpu;
     uses
        cgbase,cgobj,cg64f64,cgx86,
        aasmbase,aasmtai,aasmcpu,
-       cpubase,cpuinfo,cpupara,
+       cpubase,cpuinfo,cpupara,parabase,
        node,symconst,rgx86,procinfo;
 
     type
       tcgx86_64 = class(tcgx86)
         procedure init_register_allocators;override;
         procedure g_save_all_registers(list : taasmoutput);override;
-        procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);override;
+        procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tcgpara);override;
         procedure g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);override;
       end;
 
@@ -72,7 +70,7 @@ unit cgcpu;
       end;
 
 
-    procedure tcgx86_64.g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);
+    procedure tcgx86_64.g_restore_all_registers(list : taasmoutput;const funcretparaloc:tcgpara);
       begin
         {$warning todo tcgx86_64.g_restore_all_registers}
       end;
@@ -111,7 +109,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.15  2004-07-09 23:30:13  jonas
+  Revision 1.16  2004-09-21 17:25:13  peter
+    * paraloc branch merged
+
+  Revision 1.15.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.15  2004/07/09 23:30:13  jonas
     *  changed first_sse_imreg to first_mm_imreg
 
   Revision 1.14  2004/06/20 08:55:32  florian

compiler/x86_64/cpupara.pas

@@ -20,8 +20,6 @@
 
  ****************************************************************************
 }
-{ Generates the argument location information for x86-64 target.
-}
 unit cpupara;
 
 {$i fpcdefs.inc}
@@ -33,7 +31,7 @@ unit cpupara;
       cpubase,cgbase,
       symconst,symbase,symtype,symdef,
       aasmtai,
-      paramgr;
+      parabase,paramgr;
 
     type
        tx86_64paramanager = class(tparamanager)
@@ -42,7 +40,7 @@ unit cpupara;
           procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;firstpara:tparaitem;
                                                var intparareg,mmparareg,parasize:longint);
        public
-          function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
+          procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
           function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
@@ -54,44 +52,38 @@ unit cpupara;
 
     uses
        cutils,verbose,
-       cpuinfo,systems,
-       defutil,
-       tgobj;
+       systems,
+       defutil;
 
     const
       paraintsupregs : array[0..5] of tsuperregister = (RS_RDI,RS_RSI,RS_RDX,RS_RCX,RS_R8,RS_R9);
       parammsupregs : array[0..7] of tsuperregister = (RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7);
 
-    procedure getvalueparaloc(p : tdef;var paraloc:tparalocation);
+    procedure getvalueparaloc(p : tdef;var loc1,loc2:tcgloc);
       begin
-        paraloc.size:=def_cgsize(p);
-        paraloc.loc:=LOC_INVALID;
-        paraloc.lochigh:=LOC_INVALID;
+        loc1:=LOC_INVALID;
+        loc2:=LOC_INVALID;
         case p.deftype of
            orddef:
              begin
-               paraloc.loc:=LOC_REGISTER;
+               loc1:=LOC_REGISTER;
                {$warning TODO 128bit also needs lochigh}
              end;
            floatdef:
              begin
                case tfloatdef(p).typ of
                   s80real:
-                    paraloc.loc:=LOC_REFERENCE;
+                    loc1:=LOC_REFERENCE;
                   s32real,
-                  s64real,
-                  s64currency :
-                    paraloc.loc:=LOC_MMREGISTER;
+                  s64real :
+                    loc1:=LOC_MMREGISTER;
+                  s64currency,
                   s64comp :
-                    begin
-                      paraloc.loc:=LOC_REGISTER;
-                      { Force Integer size }
-                      paraloc.size:=OS_64;
-                    end;
+                    loc1:=LOC_REGISTER;
                   s128real:
                     begin
-                      paraloc.loc:=LOC_MMREGISTER;
-                      paraloc.lochigh:=LOC_MMREGISTER;
+                      loc1:=LOC_MMREGISTER;
+                      loc2:=LOC_MMREGISTER;
                       {$warning TODO float 128bit needs SSEUP lochigh}
                     end;
                end;
@@ -101,47 +93,47 @@ unit cpupara;
                if p.size<=16 then
                  begin
                    {$warning TODO location depends on the fields}
-                   paraloc.loc:=LOC_REFERENCE;
+                   loc1:=LOC_REFERENCE;
                  end
                else
-                 paraloc.loc:=LOC_REFERENCE;
+                 loc1:=LOC_REFERENCE;
              end;
            objectdef:
              begin
                if is_object(p) then
-                 paraloc.loc:=LOC_REFERENCE
+                 loc1:=LOC_REFERENCE
                else
-                 paraloc.loc:=LOC_REGISTER;
+                 loc1:=LOC_REGISTER;
              end;
            arraydef:
-             paraloc.loc:=LOC_REFERENCE;
+             loc1:=LOC_REFERENCE;
            variantdef:
-             paraloc.loc:=LOC_REFERENCE;
+             loc1:=LOC_REFERENCE;
            stringdef:
              if is_shortstring(p) or is_longstring(p) then
-               paraloc.loc:=LOC_REFERENCE
+               loc1:=LOC_REFERENCE
              else
-               paraloc.loc:=LOC_REGISTER;
+               loc1:=LOC_REGISTER;
            setdef:
              if is_smallset(p) then
-               paraloc.loc:=LOC_REGISTER
+               loc1:=LOC_REGISTER
              else
-               paraloc.loc:=LOC_REFERENCE;
+               loc1:=LOC_REFERENCE;
            procvardef:
              begin
                { This is a record < 16 bytes }
                if (po_methodpointer in tprocvardef(p).procoptions) then
                  begin
-                   paraloc.loc:=LOC_REGISTER;
-                   paraloc.lochigh:=LOC_REGISTER;
+                   loc1:=LOC_REGISTER;
+                   loc2:=LOC_REGISTER;
                  end
                else
-                 paraloc.loc:=LOC_REGISTER;
+                 loc1:=LOC_REGISTER;
              end;
            else
              begin
                { default for pointers,enums,etc }
-               paraloc.loc:=LOC_REGISTER;
+               loc1:=LOC_REGISTER;
              end;
         end;
       end;
@@ -165,73 +157,88 @@ unit cpupara;
       end;
 
 
-    function tx86_64paramanager.getintparaloc(calloption : tproccalloption; nr : longint): tparalocation;
+    procedure tx86_64paramanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);
+      var
+        paraloc : pcgparalocation;
       begin
-         fillchar(result,sizeof(tparalocation),0);
-         result.size:=OS_INT;
-         if nr<1 then
-           internalerror(200304303)
-         else if nr<=high(paraintsupregs)+1 then
-           begin
-              result.loc:=LOC_REGISTER;
-              result.register:=newreg(R_INTREGISTER,paraintsupregs[nr-1],R_SUBWHOLE);
-           end
-         else
-           begin
-              result.loc:=LOC_REFERENCE;
-              result.reference.index:=NR_STACK_POINTER_REG;
-              result.reference.offset:=(nr-6)*8;
-           end;
+        cgpara.reset;
+        cgpara.size:=OS_INT;
+        cgpara.alignment:=get_para_align(calloption);
+        paraloc:=cgpara.add_location;
+        with paraloc^ do
+         begin
+           size:=OS_INT;
+           if nr<1 then
+             internalerror(200304303)
+           else if nr<=high(paraintsupregs)+1 then
+             begin
+                loc:=LOC_REGISTER;
+                register:=newreg(R_INTREGISTER,paraintsupregs[nr-1],R_SUBWHOLE);
+             end
+           else
+             begin
+                loc:=LOC_REFERENCE;
+                reference.index:=NR_STACK_POINTER_REG;
+                reference.offset:=(nr-6)*sizeof(aint);
+             end;
+          end;
       end;
 
 
     procedure tx86_64paramanager.create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
       var
-        paraloc : tparalocation;
+        paraloc : pcgparalocation;
+        retcgsize : tcgsize;
       begin
-        { Function return }
-        fillchar(paraloc,sizeof(tparalocation),0);
+        { Constructors return self instead of a boolean }
         if (p.proctypeoption=potype_constructor) then
-          paraloc.size:=OS_ADDR
+          retcgsize:=OS_ADDR
         else
-          paraloc.size:=def_cgsize(p.rettype.def);
-        if paraloc.size<>OS_NO then
+          retcgsize:=def_cgsize(p.rettype.def);
+        p.funcret_paraloc[side].reset;
+        p.funcret_paraloc[side].Alignment:=std_param_align;
+        p.funcret_paraloc[side].size:=retcgsize;
+        { void has no location }
+        if is_void(p.rettype.def) then
+          exit;
+        paraloc:=p.funcret_paraloc[side].add_location;
+        { Return in FPU register? }
+        if p.rettype.def.deftype=floatdef then
           begin
-            { Return in FPU register? }
-            if p.rettype.def.deftype=floatdef then
-              begin
-                case tfloatdef(p.rettype.def).typ of
-                  s32real,s64real:
-                    begin
-                      paraloc.loc:=LOC_MMREGISTER;
-                      paraloc.register:=NR_MM_RESULT_REG;
-                    end;
-                  s64currency,
-                  s64comp,
-                  s80real:
-                    begin
-                      paraloc.loc:=LOC_FPUREGISTER;
-                      paraloc.register:=NR_FPU_RESULT_REG;
-                    end;
-                  else
-                    internalerror(200405034);
+            case tfloatdef(p.rettype.def).typ of
+              s32real,s64real:
+                begin
+                  paraloc^.loc:=LOC_MMREGISTER;
+                  paraloc^.register:=NR_MM_RESULT_REG;
                 end;
-              end
-            else
-             { Return in register? }
-             if not ret_in_param(p.rettype.def,p.proccalloption) then
-              begin
-                paraloc.loc:=LOC_REGISTER;
-                paraloc.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(paraloc.size));
-              end
+              s64currency,
+              s64comp,
+              s80real:
+                begin
+                  paraloc^.loc:=LOC_FPUREGISTER;
+                  paraloc^.register:=NR_FPU_RESULT_REG;
+                end;
+              else
+                internalerror(200405034);
+            end;
+            paraloc^.size:=retcgsize;
+          end
+        else
+         { Return in register? }
+         if not ret_in_param(p.rettype.def,p.proccalloption) then
+          begin
+            paraloc^.loc:=LOC_REGISTER;
+            paraloc^.size:=retcgsize;
+            if side=callerside then
+              paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(retcgsize))
             else
-              begin
-                paraloc.loc:=LOC_REFERENCE;
-              end;
+              paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(retcgsize));
           end
         else
-          paraloc.loc:=LOC_INVALID;
-        p.funcret_paraloc[side]:=paraloc;
+          begin
+            paraloc^.loc:=LOC_REFERENCE;
+            paraloc^.size:=retcgsize;
+          end;
       end;
 
 
@@ -239,9 +246,12 @@ unit cpupara;
                                                             var intparareg,mmparareg,parasize:longint);
       var
         hp : tparaitem;
-        paraloc : tparalocation;
+        paraloc,
+        paraloc2 : pcgparalocation;
         subreg : tsubregister;
         pushaddr : boolean;
+        paracgsize : tcgsize;
+        loc1,loc2 : tcgloc;
         l,
         varalign,
         paraalign : longint;
@@ -254,84 +264,110 @@ unit cpupara;
             pushaddr:=push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption);
             if pushaddr then
               begin
-                paraloc.size:=OS_ADDR;
-                paraloc.loc:=LOC_REGISTER;
-                paraloc.lochigh:=LOC_INVALID;
+                loc1:=LOC_REGISTER;
+                loc2:=LOC_INVALID;
+                paracgsize:=OS_ADDR;
               end
             else
-              getvalueparaloc(hp.paratype.def,paraloc);
-            paraloc.alignment:=paraalign;
-            { Location low }
-            if (paraloc.loc=LOC_REGISTER) and
+              begin
+                getvalueparaloc(hp.paratype.def,loc1,loc2);
+                paracgsize:=def_cgsize(hp.paratype.def);
+                if paracgsize=OS_C64 then
+                  paracgsize:=OS_64;
+              end;
+            hp.paraloc[side].reset;
+            hp.paraloc[side].size:=paracgsize;
+            hp.paraloc[side].Alignment:=paraalign;
+            { First location }
+            paraloc:=hp.paraloc[side].add_location;
+            paraloc^.size:=paracgsize;
+            if (loc1=LOC_REGISTER) and
                (intparareg<=high(paraintsupregs)) then
               begin
-                if (paraloc.size=OS_NO) or (paraloc.lochigh<>LOC_INVALID) then
-                  subreg:=R_SUBWHOLE
+                if (paracgsize=OS_NO) or (loc2<>LOC_INVALID) then
+                  begin
+                    paraloc^.size:=OS_INT;
+                    subreg:=R_SUBWHOLE;
+                  end
                 else
-                  subreg:=cgsize2subreg(paraloc.size);
-                paraloc.register:=newreg(R_INTREGISTER,paraintsupregs[intparareg],subreg);
+                  begin
+                    paraloc^.size:=paracgsize;
+                    subreg:=cgsize2subreg(paracgsize);
+                  end;
+                paraloc^.loc:=LOC_REGISTER;
+                paraloc^.register:=newreg(R_INTREGISTER,paraintsupregs[intparareg],subreg);
                 inc(intparareg);
               end
-            else if (paraloc.loc=LOC_MMREGISTER) and
-               (mmparareg<=high(parammsupregs)) then
+            else if (loc1=LOC_MMREGISTER) and
+                    (mmparareg<=high(parammsupregs)) then
               begin
-                paraloc.register:=newreg(R_MMREGISTER,parammsupregs[mmparareg],R_SUBNONE);
+                paraloc^.loc:=LOC_MMREGISTER;
+                paraloc^.register:=newreg(R_MMREGISTER,parammsupregs[mmparareg],R_SUBNONE);
+                if paracgsize=OS_F128 then
+                  paraloc^.size:=OS_F64
+                else
+                  paraloc^.size:=paracgsize;
                 inc(mmparareg);
               end
             else
               begin
-                paraloc.loc:=LOC_REFERENCE;
-                paraloc.lochigh:=LOC_INVALID;
+                paraloc^.loc:=LOC_REFERENCE;
                 if side=callerside then
-                  paraloc.reference.index:=NR_STACK_POINTER_REG
+                  paraloc^.reference.index:=NR_STACK_POINTER_REG
                 else
-                  paraloc.reference.index:=NR_FRAME_POINTER_REG;
+                  paraloc^.reference.index:=NR_FRAME_POINTER_REG;
                 l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
                 varalign:=size_2_align(l);
-                paraloc.reference.offset:=parasize;
+                paraloc^.reference.offset:=parasize;
                 varalign:=used_align(varalign,paraalign,paraalign);
                 parasize:=align(parasize+l,varalign);
               end;
-            { Location High if required }
-            if (paraloc.lochigh<>LOC_INVALID) then
+            { Second location }
+            if (loc2<>LOC_INVALID) then
               begin
-                if (paraloc.lochigh=LOC_REGISTER) and
+                if (loc2=LOC_REGISTER) and
                    (intparareg<=high(paraintsupregs)) then
                   begin
-                    paraloc.registerhigh:=newreg(R_INTREGISTER,paraintsupregs[intparareg],R_SUBWHOLE);
+                    paraloc2:=hp.paraloc[side].add_location;
+                    paraloc2^.loc:=LOC_REGISTER;
+                    paraloc2^.register:=newreg(R_INTREGISTER,paraintsupregs[intparareg],R_SUBWHOLE);
+                    paraloc2^.size:=OS_INT;
                     inc(intparareg);
                   end
                 else
-                 if (paraloc.lochigh=LOC_MMREGISTER) and
+                 if (loc2=LOC_MMREGISTER) and
                     (mmparareg<=high(parammsupregs)) then
                   begin
-                    paraloc.registerhigh:=newreg(R_MMREGISTER,parammsupregs[mmparareg],R_SUBNONE);
+                    paraloc2:=hp.paraloc[side].add_location;
+                    paraloc2^.loc:=LOC_REGISTER;
+                    paraloc2^.register:=newreg(R_MMREGISTER,parammsupregs[mmparareg],R_SUBNONE);
+                    if paracgsize=OS_F128 then
+                      paraloc2^.size:=OS_F64
+                    else
+                      paraloc2^.size:=paracgsize;
                     inc(mmparareg);
                   end
                 else
                   begin
                     { Release when location low has already registers
                       assigned }
-                    if paraloc.loc=LOC_REGISTER then
+                    if paraloc^.loc=LOC_REGISTER then
                       dec(intparareg);
-                    if paraloc.loc=LOC_MMREGISTER then
+                    if paraloc^.loc=LOC_MMREGISTER then
                       dec(mmparareg);
                     { Overwrite with LOC_REFERENCE }
-                    paraloc.loc:=LOC_REFERENCE;
-                    paraloc.lochigh:=LOC_INVALID;
-                    fillchar(paraloc.reference,sizeof(paraloc.reference),0);
+                    paraloc^.loc:=LOC_REFERENCE;
                     if side=callerside then
-                      paraloc.reference.index:=NR_STACK_POINTER_REG
+                      paraloc^.reference.index:=NR_STACK_POINTER_REG
                     else
-                      paraloc.reference.index:=NR_FRAME_POINTER_REG;
+                      paraloc^.reference.index:=NR_FRAME_POINTER_REG;
                     l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
                     varalign:=size_2_align(l);
-                    paraloc.reference.offset:=parasize;
+                    paraloc^.reference.offset:=parasize;
                     varalign:=used_align(varalign,paraalign,paraalign);
                     parasize:=align(parasize+l,varalign);
                   end;
               end;
-            hp.paraloc[side]:=paraloc;
             hp:=tparaitem(hp.next);
           end;
         { Register parameters are assigned from left-to-right, but the
@@ -343,8 +379,9 @@ unit cpupara;
             hp:=tparaitem(p.para.first);
             while assigned(hp) do
               begin
-                if (hp.paraloc[side].loc=LOC_REFERENCE) then
-                  inc(hp.paraloc[side].reference.offset,target_info.first_parm_offset);
+                with hp.paraloc[side].location^ do
+                  if (loc=LOC_REFERENCE) then
+                    inc(reference.offset,target_info.first_parm_offset);
                 hp:=tparaitem(hp.next);
               end;
           end;
@@ -390,7 +427,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2004-06-20 08:55:32  florian
+  Revision 1.10  2004-09-21 17:25:13  peter
+    * paraloc branch merged
+
+  Revision 1.9.4.1  2004/08/31 20:43:06  peter
+    * paraloc patch
+
+  Revision 1.9  2004/06/20 08:55:32  florian
     * logs truncated
 
   Revision 1.8  2004/06/16 20:07:11  florian