paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-29 16:40:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ support for refcounted records returned by functions in 2 registers

Browse Source 
(mantis #8685)

git-svn-id: trunk@7251 -
This commit is contained in:
Jonas Maebe 2007-05-03 15:05:44 +00:00
parent de1af478c3
commit 82e01b4ad9
3 changed files with 128 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

43
compiler/ncgcal.pas
View File

@ -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 }

95
tests/webtbs/tw8685.pp Normal file
View File

@ -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.