* converted tcg.g_copyvaluepara_openarray() to thlcg

git-svn-id: trunk@21878 -

compiler/cgobj.pas

@@ -394,7 +394,6 @@ unit cgobj;
           procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); virtual;abstract;
           procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);virtual;
 
-          procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);virtual;
           procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);virtual;
 
           {# Emits instructions when compilation is done in profile
@@ -2107,69 +2106,6 @@ implementation
                             Entry/Exit Code Functions
 *****************************************************************************}
 
-    procedure tcg.g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);
-      var
-        sizereg,sourcereg,lenreg : tregister;
-        cgpara1,cgpara2,cgpara3 : TCGPara;
-      begin
-        { because some abis don't support dynamic stack allocation properly
-          open array value parameters are copied onto the heap
-        }
-
-        { calculate necessary memory }
-
-        { read/write operations on one register make the life of the register allocator hard }
-        if not(lenloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
-          begin
-            lenreg:=getintregister(list,OS_INT);
-            a_load_loc_reg(list,OS_INT,lenloc,lenreg);
-          end
-        else
-          lenreg:=lenloc.register;
-
-        sizereg:=getintregister(list,OS_INT);
-        a_op_const_reg_reg(list,OP_ADD,OS_INT,1,lenreg,sizereg);
-        a_op_const_reg(list,OP_IMUL,OS_INT,elesize,sizereg);
-        { load source }
-        sourcereg:=getaddressregister(list);
-        a_loadaddr_ref_reg(list,ref,sourcereg);
-
-        { do getmem call }
-        cgpara1.init;
-        paramanager.getintparaloc(pocall_default,1,ptruinttype,cgpara1);
-        a_load_reg_cgpara(list,OS_INT,sizereg,cgpara1);
-        paramanager.freecgpara(list,cgpara1);
-        allocallcpuregisters(list);
-        a_call_name(list,'FPC_GETMEM',false);
-        deallocallcpuregisters(list);
-        cgpara1.done;
-        { return the new address }
-        a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,destreg);
-
-        { do move call }
-        cgpara1.init;
-        cgpara2.init;
-        cgpara3.init;
-        paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
-        paramanager.getintparaloc(pocall_default,3,ptrsinttype,cgpara3);
-        { load size }
-        a_load_reg_cgpara(list,OS_SINT,sizereg,cgpara3);
-        { load destination }
-        a_load_reg_cgpara(list,OS_ADDR,destreg,cgpara2);
-        { load source }
-        a_load_reg_cgpara(list,OS_ADDR,sourcereg,cgpara1);
-        paramanager.freecgpara(list,cgpara3);
-        paramanager.freecgpara(list,cgpara2);
-        paramanager.freecgpara(list,cgpara1);
-        allocallcpuregisters(list);
-        a_call_name(list,'FPC_MOVE',false);
-        deallocallcpuregisters(list);
-        cgpara3.done;
-        cgpara2.done;
-        cgpara1.done;
-      end;
-
 
     procedure tcg.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
       var

compiler/hlcg2ll.pas

@@ -282,7 +282,6 @@ unit hlcg2ll;
           procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); override;
           procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation);override;
 
-          procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;arrdef: tarraydef;destreg:tregister);override;
           procedure g_releasevaluepara_openarray(list : TAsmList;arrdef: tarraydef;const l:tlocation);override;
 
           {# Emits instructions when compilation is done in profile
@@ -939,11 +938,6 @@ implementation
       cg.g_overflowCheck_loc(list,loc,def,ovloc);
     end;
 
-  procedure thlcg2ll.g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister);
-    begin
-      cg.g_copyvaluepara_openarray(list,ref,lenloc,arrdef.elesize,destreg);
-    end;
-
   procedure thlcg2ll.g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation);
     begin
       cg.g_releasevaluepara_openarray(list,l);

compiler/hlcgobj.pas

@@ -418,7 +418,7 @@ unit hlcgobj;
           procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); virtual; abstract;
           procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation);virtual; abstract;
 
-          procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;arrdef: tarraydef;destreg:tregister);virtual;abstract;
+          procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;arrdef: tarraydef;destreg:tregister);virtual;
           procedure g_releasevaluepara_openarray(list : TAsmList;arrdef: tarraydef;const l:tlocation);virtual;abstract;
 
           {# Emits instructions when compilation is done in profile
@@ -3247,6 +3247,71 @@ implementation
       a_label(list,neglabel);
     end;
 
+  procedure thlcgobj.g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister);
+    var
+      sizereg,sourcereg,lenreg : tregister;
+      cgpara1,cgpara2,cgpara3 : TCGPara;
+      ptrarrdef : tdef;
+      getmemres : tcgpara;
+      destloc : tlocation;
+    begin
+      { because some abis don't support dynamic stack allocation properly
+        open array value parameters are copied onto the heap
+      }
+
+      { calculate necessary memory }
+
+      { read/write operations on one register make the life of the register allocator hard }
+      if not(lenloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+        begin
+          lenreg:=getintregister(list,sinttype);
+          a_load_loc_reg(list,sinttype,sinttype,lenloc,lenreg);
+        end
+      else
+        lenreg:=lenloc.register;
+
+      sizereg:=getintregister(list,sinttype);
+      a_op_const_reg_reg(list,OP_ADD,sinttype,1,lenreg,sizereg);
+      a_op_const_reg(list,OP_IMUL,sinttype,arrdef.elesize,sizereg);
+      { load source }
+      ptrarrdef:=getpointerdef(arrdef);
+      sourcereg:=getaddressregister(list,ptrarrdef);
+      a_loadaddr_ref_reg(list,arrdef,ptrarrdef,ref,sourcereg);
+
+      { do getmem call }
+      cgpara1.init;
+      paramanager.getintparaloc(pocall_default,1,ptruinttype,cgpara1);
+      a_load_reg_cgpara(list,sinttype,sizereg,cgpara1);
+      paramanager.freecgpara(list,cgpara1);
+      getmemres:=g_call_system_proc(list,'fpc_getmem',ptrarrdef);
+      cgpara1.done;
+      { return the new address }
+      location_reset(destloc,LOC_REGISTER,OS_ADDR);
+      destloc.register:=destreg;
+      gen_load_cgpara_loc(list,ptrarrdef,getmemres,destloc,false);
+
+      { do move call }
+      cgpara1.init;
+      cgpara2.init;
+      cgpara3.init;
+      paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
+      paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
+      paramanager.getintparaloc(pocall_default,3,ptrsinttype,cgpara3);
+      { load size }
+      a_load_reg_cgpara(list,ptrsinttype,sizereg,cgpara3);
+      { load destination }
+      a_load_reg_cgpara(list,ptrarrdef,destreg,cgpara2);
+      { load source }
+      a_load_reg_cgpara(list,ptrarrdef,sourcereg,cgpara1);
+      paramanager.freecgpara(list,cgpara3);
+      paramanager.freecgpara(list,cgpara2);
+      paramanager.freecgpara(list,cgpara1);
+      g_call_system_proc(list,'MOVE',nil);
+      cgpara3.done;
+      cgpara2.done;
+      cgpara1.done;
+    end;
+
   procedure thlcgobj.g_profilecode(list: TAsmList);
     begin
     end;

compiler/ncgutil.pas

@@ -659,7 +659,7 @@ implementation
                       internalerror(200306061);
                     hreg:=cg.getaddressregister(list);
                     if not is_packed_array(tparavarsym(p).vardef) then
-                      cg.g_copyvaluepara_openarray(list,href,hsym.initialloc,tarraydef(tparavarsym(p).vardef).elesize,hreg)
+                      hlcg.g_copyvaluepara_openarray(list,href,hsym.initialloc,tarraydef(tparavarsym(p).vardef),hreg)
                     else
                       internalerror(2006080401);
 //                      cg.g_copyvaluepara_packedopenarray(list,href,hsym.intialloc,tarraydef(tparavarsym(p).vardef).elepackedbitsize,hreg);