paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 05:00:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* don't treat variant records with one element as "records with one element"

Browse Source 
(the ABIs that prescribe special treatment for aggregates with one
     scalar element don't either, since a "union containing a single scalar"
     is not the same as a scalar)
  * fixed passing record with a single float field on PowerPC/AIX abi's
  * several changes to cgobj and ncgutil to correctly deal with transfering
    such records between integer and floating point registers

git-svn-id: trunk@15416 -
This commit is contained in:
Jonas Maebe 2010-06-13 09:57:58 +00:00
parent 037c783442
commit ea4bb9d752
6 changed files with 93 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8417,6 +8417,7 @@ tests/tbs/tb0569.pp svneol=native#text/pascal
tests/tbs/tb0570.pp svneol=native#text/plain
tests/tbs/tb0571.pas svneol=native#text/plain
tests/tbs/tb0572.pp svneol=native#text/plain
tests/tbs/tb0573.pp svneol=native#text/plain
tests/tbs/tb205.pp svneol=native#text/plain
tests/tbs/ub0060.pp svneol=native#text/plain
tests/tbs/ub0069.pp svneol=native#text/plain

7
compiler/cgobj.pas
View File

@ -900,6 +900,13 @@ implementation
end;
LOC_MMREGISTER,LOC_CMMREGISTER:
a_loadmm_intreg_reg(list,size,cgpara.location^.size,r,cgpara.location^.register,mms_movescalar);
LOC_FPUREGISTER,LOC_CFPUREGISTER:
begin
tg.GetTemp(list,TCGSize2Size[size],TCGSize2Size[size],tt_normal,ref);
a_load_reg_ref(list,size,size,r,ref);
a_loadfpu_ref_cgpara(list,cgpara.location^.size,ref,cgpara);
tg.Ungettemp(list,ref);
end
else
internalerror(2002071004);
end;

31
compiler/ncgutil.pas
View File

@ -789,8 +789,13 @@ implementation
href : treference;
size : longint;
{$endif i386}
locsize : tcgsize;
tmploc : tlocation;
begin
if not(l.size in [OS_32,OS_64,OS_128]) then
locsize:=l.size
else
locsize:=int_float_cgsize(tcgsize2size[l.size]);
{$ifdef i386}
case l.loc of
LOC_FPUREGISTER,
@ -808,11 +813,11 @@ implementation
end
else
reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
cg.a_loadfpu_reg_ref(list,l.size,l.size,l.register,href);
cg.a_loadfpu_reg_ref(list,locsize,locsize,l.register,href);
end;
LOC_FPUREGISTER:
begin
cg.a_loadfpu_reg_reg(list,l.size,cgpara.location^.size,l.register,cgpara.location^.register);
cg.a_loadfpu_reg_reg(list,locsize,cgpara.location^.size,l.register,cgpara.location^.register);
end;
{ can happen if a record with only 1 "single field" is
returned in a floating point register and then is directly
@ -821,7 +826,7 @@ implementation
begin
tmploc:=l;
location_force_mem(list,tmploc);
case l.size of
case locsize of
OS_F32:
tmploc.size:=OS_32;
OS_F64:
@ -853,7 +858,7 @@ implementation
end
else
reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,href,mms_movescalar);
cg.a_loadmm_reg_ref(list,locsize,locsize,l.register,href,mms_movescalar);
end;
LOC_FPUREGISTER:
begin
@ -875,7 +880,7 @@ implementation
size:=align(locintsize,cgpara.alignment);
if (not use_fixed_stack) and
(cgpara.location^.reference.index=NR_STACK_POINTER_REG) then
cg.a_load_ref_cgpara(list,l.size,l.reference,cgpara)
cg.a_load_ref_cgpara(list,locsize,l.reference,cgpara)
else
begin
reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
@ -884,7 +889,7 @@ implementation
end;
LOC_FPUREGISTER:
begin
cg.a_loadfpu_ref_cgpara(list,l.size,l.reference,cgpara);
cg.a_loadfpu_ref_cgpara(list,locsize,l.reference,cgpara);
end;
else
internalerror(2010053005);
@ -904,7 +909,7 @@ implementation
LOC_CMMREGISTER,
LOC_REGISTER,
LOC_CREGISTER :
cg.a_loadmm_reg_cgpara(list,l.size,l.register,cgpara,mms_movescalar);
cg.a_loadmm_reg_cgpara(list,locsize,l.register,cgpara,mms_movescalar);
LOC_FPUREGISTER,
LOC_CFPUREGISTER:
begin
@ -932,7 +937,7 @@ implementation
LOC_CREFERENCE,
LOC_FPUREGISTER,
LOC_CFPUREGISTER:
cg.a_loadfpu_reg_cgpara(list,l.size,l.register,cgpara);
cg.a_loadfpu_reg_cgpara(list,locsize,l.register,cgpara);
else
internalerror(2002042433);
end;
@ -941,7 +946,7 @@ implementation
case cgpara.location^.loc of
LOC_MMREGISTER,
LOC_CMMREGISTER:
cg.a_loadmm_ref_cgpara(list,l.size,l.reference,cgpara,mms_movescalar);
cg.a_loadmm_ref_cgpara(list,locsize,l.reference,cgpara,mms_movescalar);
{ Some targets pass floats in normal registers }
LOC_REGISTER,
LOC_CREGISTER,
@ -949,7 +954,7 @@ implementation
LOC_CREFERENCE,
LOC_FPUREGISTER,
LOC_CFPUREGISTER:
cg.a_loadfpu_ref_cgpara(list,l.size,l.reference,cgpara);
cg.a_loadfpu_ref_cgpara(list,locsize,l.reference,cgpara);
else
internalerror(2002042431);
end;
@ -961,7 +966,7 @@ implementation
value is still a const or in a register then write it
to a reference first. This situation can be triggered
by typecasting an int64 constant to a record of 8 bytes }
if l.size in [OS_64,OS_S64] then
if locsize = OS_F64 then
begin
tmploc:=l;
location_force_mem(list,tmploc);
@ -991,7 +996,9 @@ implementation
be handled by cpupara }
if (vardef.typ=floatdef) or
{ some ABIs return certain records in an fpu register }
(l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
(l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) or
(assigned(cgpara.location) and
(cgpara.Location^.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER])) then
begin
gen_loadfpu_loc_cgpara(list,l,cgpara,vardef.size);
exit;

17
compiler/powerpc/cpupara.pas
View File

@ -53,7 +53,7 @@ unit cpupara;
uses
verbose,systems,
defutil,
defutil,symtable,
procinfo,cpupi;
@ -357,6 +357,7 @@ unit cpupara;
hp : tparavarsym;
loc : tcgloc;
paracgsize: tcgsize;
sym: tfieldvarsym;
begin
{$ifdef extdebug}
@ -417,7 +418,6 @@ unit cpupara;
paralen := paradef.size
else
paralen := tcgsize2size[def_cgsize(paradef)];
loc := getparaloc(paradef);
if (target_info.abi = abi_powerpc_aix) and
(paradef.typ = recorddef) and
(hp.varspez in [vs_value,vs_const]) then
@ -425,14 +425,12 @@ unit cpupara;
{ if a record has only one field and that field is }
{ non-composite (not array or record), it must be }
{ passed according to the rules of that type. }
if (trecorddef(hp.vardef).symtable.SymList.count = 1) and
(not trecorddef(hp.vardef).isunion) and
((tabstractvarsym(trecorddef(hp.vardef).symtable.SymList[0]).vardef.typ = floatdef) or
((target_info.system = system_powerpc_darwin) and
(tabstractvarsym(trecorddef(hp.vardef).symtable.SymList[0]).vardef.typ in [orddef,enumdef]))) then
if tabstractrecordsymtable(tabstractrecorddef(paradef).symtable).has_single_field(sym) and
((sym.vardef.typ=floatdef) or
((target_info.system=system_powerpc_darwin) and
(sym.vardef.typ in [orddef,enumdef]))) then
begin
paradef :=
tabstractvarsym(trecorddef(hp.vardef).symtable.SymList[0]).vardef;
paradef:=sym.vardef;
paracgsize:=def_cgsize(paradef);
end
else
@ -452,6 +450,7 @@ unit cpupara;
end
end;
loc := getparaloc(paradef);
if varargsparas and
(target_info.abi = abi_powerpc_aix) and
(paradef.typ = floatdef) then

12
compiler/symtable.pas
View File

@ -1009,6 +1009,13 @@ implementation
i: longint;
begin
result:=false;
{ If a record contains a union, it does not contain a "single
non-composite field" in the context of certain ABIs requiring
special treatment for such records }
if (defowner.typ=recorddef) and
trecorddef(defowner).isunion then
exit;
{ a record/object can contain other things than fields }
for i:=0 to SymList.Count-1 do
begin
if tsym(symlist[i]).typ=fieldvarsym then
@ -1144,6 +1151,11 @@ implementation
end;
_datasize:=storesize;
fieldalignment:=storealign;
{ If a record contains a union, it does not contain a "single
non-composite field" in the context of certain ABIs requiring
special treatment for such records }
if defowner.typ=recorddef then
trecorddef(defowner).isunion:=true;
end;

46
tests/tbs/tb0573.pp Normal file
View File

@ -0,0 +1,46 @@
{$mode objfpc}
type
tr1 = record
s: single;
end;
tr2 = record
case byte of
1: (s: single);
end;
function f1(r1:tr1): tr1;
var
s: single;
begin
s:=r1.s;
result.s:=s;
end;
function f2(r2:tr2): tr2;
var
s: single;
begin
s:=r2.s;
result.s:=s;
end;
procedure test;
var
r1,r1a: tr1;
r2,r2a: tr2;
begin
r1.s:=1.0;
r2.s:=2.0;
r1a:=f1(r1);
r2a:=f2(r2);
if r1a.s<>1.0 then
halt(1);
if r2a.s<>2.0 then
halt(1);
end;
begin
test;
end.