From 82e01b4ad99d684f7377965b19d9d91afd51cc08 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Thu, 3 May 2007 15:05:44 +0000
Subject: [PATCH]   + support for refcounted records returned by functions in 2
 registers     (mantis #8685)

git-svn-id: trunk@7251 -
---
 .gitattributes         |  1 +
 compiler/ncgcal.pas    | 43 ++++++++++++++-----
 tests/webtbs/tw8685.pp | 95 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 128 insertions(+), 11 deletions(-)
 create mode 100644 tests/webtbs/tw8685.pp

diff --git a/.gitattributes b/.gitattributes
index 30ffb77875..0579fafcdd 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -8182,6 +8182,7 @@ tests/webtbs/tw8615.pp svneol=native#text/plain
 tests/webtbs/tw8633.pp svneol=native#text/plain
 tests/webtbs/tw8660.pp svneol=native#text/plain
 tests/webtbs/tw8664.pp svneol=native#text/plain
+tests/webtbs/tw8685.pp svneol=native#text/plain
 tests/webtbs/tw8757.pp svneol=native#text/plain
 tests/webtbs/tw8777f.pp svneol=native#text/plain
 tests/webtbs/tw8777g.pp svneol=native#text/plain
diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas
index 9c7faacb78..bb8d05d28c 100644
--- a/compiler/ncgcal.pas
+++ b/compiler/ncgcal.pas
@@ -530,24 +530,40 @@ implementation
               if procdefinition.funcretloc[callerside].loc<>LOC_REGISTER then
                 internalerror(200409261);
 
-              { the FUNCTION_RESULT_REG is already allocated }
-              if getsupreg(procdefinition.funcretloc[callerside].register)<first_int_imreg then
-                cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
-              if not assigned(funcretnode) then
+              retloc:=procdefinition.funcretloc[callerside];
+{$ifndef cpu64bit}
+              if cgsize in [OS_64,OS_S64] then
                 begin
+                  { the function result registers are already allocated }
+                  if getsupreg(retloc.register64.reglo)<first_int_imreg then
+                    cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reglo);
+                  retloc.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+                  cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,procdefinition.funcretloc[callerside].register64.reglo,retloc.register64.reglo);
+                  if getsupreg(retloc.register64.reghi)<first_int_imreg then
+                    cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reghi);
+                  retloc.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+                  cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,procdefinition.funcretloc[callerside].register64.reghi,retloc.register64.reghi);
+                end
+              else
+{$endif cpu64bit}
+                begin
+                  { the FUNCTION_RESULT_REG is already allocated }
+                  if getsupreg(retloc.register)<first_int_imreg then
+                    cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register);
+
                   { reg_ref could generate two instrcutions and allocate a register so we've to
                     save the result first before releasing it }
-                  hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
-                  cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,procdefinition.funcretloc[callerside].register,hregister);
+                  retloc.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
+                  cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,procdefinition.funcretloc[callerside].register,retloc.register);
+                end;
 
-                  location_reset(location,LOC_REFERENCE,OS_ADDR);
+              if not assigned(funcretnode) then
+                begin
+                  location_reset(location,LOC_REFERENCE,cgsize);
                   location.reference:=refcountedtemp;
-                  cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,hregister,location.reference);
                 end
               else
                 begin
-                  hregister := cg.getaddressregister(current_asmdata.CurrAsmList);
-                  cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,procdefinition.funcretloc[callerside].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)              }
@@ -556,8 +572,13 @@ implementation
                   location := tempnode.location;
                   tempnode.free;
                   cg.g_decrrefcount(current_asmdata.CurrAsmList,resultdef,location.reference);
-                  cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,hregister,location.reference);
                end;
+{$ifndef cpu64bit}
+              if cgsize in [OS_64,OS_S64] then
+                cg64.a_load64_reg_ref(current_asmdata.CurrAsmList,retloc.register64,location.reference)
+              else
+{$endif}
+                cg.a_load_reg_ref(current_asmdata.CurrAsmList,cgsize,cgsize,retloc.register,location.reference);
             end
         else
           { normal (ordinal,float,pointer) result value }
diff --git a/tests/webtbs/tw8685.pp b/tests/webtbs/tw8685.pp
new file mode 100644
index 0000000000..6dbd2eb84d
--- /dev/null
+++ b/tests/webtbs/tw8685.pp
@@ -0,0 +1,95 @@
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+program test;
+
+uses
+  SysUtils;
+  
+type
+  vecteurF = array of extended;
+  matriceF = array of vecteurF;
+  matriceE = record
+    err     :integer;
+    x       :matriceF;
+  end;
+
+var
+  A,B,C :matriceE;  
+
+function copyM(A:matriceE):matriceE;
+var
+  i,j,nl,nc :integer;
+  C   :matriceE;
+begin
+  nl:=succ(high(A.x));nc:=succ(high(A.x[0]));
+  setlength(C.x,nl,nc);
+  for i:=0 to pred(nl) do
+    begin
+      for j:=0 to pred(nc) do C.x[i,j]:=A.x[i,j];
+    end;
+  C.err:=A.err;
+  Result:=C;
+end;
+
+procedure copyM2(A:matriceE;var C:matriceE);
+var
+  i,j,nl,nc :integer;
+begin
+  nl:=succ(high(A.x));nc:=succ(high(A.x[0]));
+  setlength(C.x,nl,nc);
+  for i:=0 to pred(nl) do
+    begin
+      for j:=0 to pred(nc) do C.x[i,j]:=A.x[i,j];
+    end;
+  C.err:=A.err;
+end;
+
+procedure writeM(A:matriceE;str:string);
+var
+  i,j :integer;
+begin
+  for i:=0 to high(A.x) do
+    begin
+      for j:=0 to high(A.x[i]) do write(format(str,[A.x[i,j]]));
+      writeln;
+    end;
+end;
+
+procedure checkM(const A,B:matriceE);
+var
+  i,j :integer;
+begin
+  if (high(A.x) <> high(B.x)) then
+    halt(1);
+  for i:=0 to high(A.x) do
+    begin
+      if (high(A.x[i]) <> high(B.x[i])) then
+        halt(2);
+      for j:=0 to high(A.x[i]) do
+        if (A.x[i,j] <> B.x[i,j]) then
+          halt(3);
+    end;
+end;
+
+
+begin
+  setlength(A.x,3,3);
+  A.err:=0;
+  A.x[0,0]:=0.5;A.x[0,1]:=0.2;A.x[0,2]:=0.8;
+  A.x[1,0]:=0.2;A.x[1,1]:=0.2;A.x[1,2]:=0.9;
+  A.x[2,0]:=0.8;A.x[2,1]:=0.9;A.x[2,2]:=3.1;
+  writeln('matrix A,  number of lines : ',succ(high(A.x)));
+  writeM(A,'%6.3f');
+  writeln;
+  B:=copyM(A);
+  writeln('matrix B,  number of lines : ',succ(high(B.x)));
+  checkM(A,B);
+  writeln;
+  copyM2(A,C);
+  writeln('matrix C,  number of lines : ',succ(high(C.x)));
+  checkM(A,C);
+  writeln;
+  writeln('end');
+end.
+