paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 03:39:40 +01:00
Code Issues Packages Projects Releases Wiki Activity

* split create_paraloc_info_intern for sparc32 and sparc64

Browse Source 
* fixed several sparc64 calling convention issues

git-svn-id: trunk@36947 -
This commit is contained in:
florian 2017-08-20 15:21:51 +00:00
parent 50fab14389
commit 9c3f5db022
3 changed files with 548 additions and 254 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

207
compiler/sparc/cpupara.pas
View File

@ -33,6 +33,10 @@ interface
type
tcpuparamanager=class(TSparcParaManager)
procedure create_paraloc_info_intern(p : tabstractprocdef; side : tcallercallee; paras : tparalist;
var curintreg: LongInt; curfloatreg: tsuperregister; var cur_stack_offset: aword);override;
function push_addr_param(varspez : tvarspez; def : tdef; calloption : tproccalloption) : boolean;override;
function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
end;
implementation
@ -42,6 +46,209 @@ implementation
defutil,
cgobj;
{ true if a parameter is too large to copy and only the address is pushed }
function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
begin
result:=false;
{ var,out,constref always require address }
if varspez in [vs_var,vs_out,vs_constref] then
begin
result:=true;
exit;
end;
case def.typ of
arraydef:
result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
is_open_array(def) or
is_array_of_const(def) or
is_array_constructor(def);
recorddef,
variantdef,
formaldef :
result:=true;
objectdef :
result:=is_object(def);
stringdef :
result:=(tstringdef(def).stringtype in [st_shortstring,st_longstring]);
procvardef :
result:=not tprocvardef(def).is_addressonly;
setdef :
result:=not is_smallset(def);
end;
end;
procedure tcpuparamanager.create_paraloc_info_intern(p : tabstractprocdef; side : tcallercallee; paras : tparalist;
var curintreg : LongInt; curfloatreg : tsuperregister;
var cur_stack_offset : aword);
var
paraloc : pcgparalocation;
i : integer;
hp : tparavarsym;
paradef : tdef;
paracgsize : tcgsize;
hparasupregs : pparasupregs;
paralen : longint;
begin
if side=callerside then
hparasupregs:=@paraoutsupregs
else
hparasupregs:=@parainsupregs;
for i:=0 to paras.count-1 do
begin
hp:=tparavarsym(paras[i]);
paradef:=hp.vardef;
{ currently only support C-style array of const,
there should be no location assigned to the vararg array itself }
if (p.proccalloption in cstylearrayofconst) and
is_array_of_const(paradef) then
begin
paraloc:=hp.paraloc[side].add_location;
{ hack: the paraloc must be valid, but is not actually used }
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_G0;
paraloc^.size:=OS_ADDR;
paraloc^.def:=voidpointertype;
break;
end;
if push_addr_param(hp.varspez,paradef,p.proccalloption) then
begin
paracgsize:=OS_ADDR;
paradef:=cpointerdef.getreusable_no_free(paradef);
end
else
begin
paracgsize:=def_cgsize(paradef);
{ for formaldef }
if paracgsize=OS_NO then
begin
paracgsize:=OS_ADDR;
paradef:=voidpointertype;
end;
end;
hp.paraloc[side].reset;
hp.paraloc[side].size:=paracgsize;
hp.paraloc[side].def:=paradef;
if (side = callerside) then
hp.paraloc[side].Alignment:=std_param_align
else
hp.paraloc[side].Alignment:=paradef.alignment;
paralen:=tcgsize2size[paracgsize];
hp.paraloc[side].intsize:=paralen;
while paralen>0 do
begin
paraloc:=hp.paraloc[side].add_location;
{ Floats are passed in int registers,
We can allocate at maximum 32 bits per register }
if paracgsize in [OS_64,OS_S64,OS_F32,OS_F64] then
begin
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else
begin
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
end;
{ ret in param? }
if vo_is_funcret in hp.varoptions then
begin
paraloc^.loc:=LOC_REFERENCE;
paraloc^.reference.offset:=64;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
paraloc^.reference.index:=NR_FRAME_POINTER_REG;
end
{ In case of po_delphi_nested_cc, the parent frame pointer
is always passed on the stack. }
else if (curintreg<=high(tparasupregs)) and
(not(vo_is_parentfp in hp.varoptions) or
not(po_delphi_nested_cc in p.procoptions)) then
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=newreg(R_INTREGISTER,hparasupregs^[curintreg],R_SUBWHOLE);
inc(curintreg);
end
else
begin
paraloc^.loc:=LOC_REFERENCE;
paraloc^.reference.offset:=target_info.first_parm_offset+cur_stack_offset;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
paraloc^.reference.index:=NR_FRAME_POINTER_REG;
if (target_info.endian=endian_big) and
(paralen<tcgsize2size[OS_INT]) and
(paradef.typ<>recorddef) then
inc(paraloc^.reference.offset,4-paralen);
{ Parameters are aligned at 4 bytes }
inc(cur_stack_offset,align(tcgsize2size[paraloc^.size],sizeof(pint)));
end;
dec(paralen,tcgsize2size[paraloc^.size]);
end;
end;
end;
function tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
var
paraloc : pcgparalocation;
retcgsize : tcgsize;
begin
if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
exit;
paraloc:=result.add_location;
{ Return in FPU register? }
if result.def.typ=floatdef then
begin
paraloc^.loc:=LOC_FPUREGISTER;
paraloc^.register:=NR_FPU_RESULT_REG;
if retcgsize=OS_F64 then
setsubreg(paraloc^.register,R_SUBFD);
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else
{ Return in register }
begin
if retcgsize in [OS_64,OS_S64] then
begin
paraloc^.loc:=LOC_REGISTER;
{ high }
if side=callerside then
paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
else
paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
{ low }
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
if side=callerside then
paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
else
paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
if (side=callerside) then
paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
else
paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
end;
end;
end;
begin
ParaManager:=tcpuparamanager.create;
end.

317
compiler/sparc64/cpupara.pas
View File

@ -33,6 +33,15 @@ interface
type
tcpuparamanager=class(TSparcParaManager)
procedure create_paraloc_info_intern(p : tabstractprocdef; side : tcallercallee; paras : tparalist; var curintreg : LongInt;
curfloatreg : tsuperregister; var cur_stack_offset : aword);override;
function push_addr_param(varspez : tvarspez; def : tdef; calloption : tproccalloption) : boolean;override;
function ret_in_param(def : tdef; pd : tabstractprocdef) : boolean;override;
function get_funcretloc(p : tabstractprocdef; side : tcallercallee; forcetempdef : tdef) : tcgpara;override;
private
function push_addr_param_intern(varspez : tvarspez; def : tdef; calloption : tproccalloption; recsizelimit : aword) : boolean;
procedure create_paraloc1_info_intern(p : tabstractprocdef; side : tcallercallee; paradef : tdef; var loc : TCGPara; varspez : tvarspez; varoptions : tvaroptions; recsizelimit : aword;
var curintreg : LongInt; var curfloatreg : tsuperregister; var cur_stack_offset : aword);
end;
implementation
@ -42,6 +51,314 @@ implementation
defutil,
cgobj;
{ true if a parameter is too large to copy and only the address is pushed }
function tcpuparamanager.push_addr_param_intern(varspez:tvarspez;def : tdef;calloption : tproccalloption;recsizelimit : aword) : boolean;
begin
result:=false;
{ var,out,constref always require address }
if varspez in [vs_var,vs_out,vs_constref] then
begin
result:=true;
exit;
end;
case def.typ of
arraydef:
result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
is_open_array(def) or
is_array_of_const(def) or
is_array_constructor(def);
recorddef:
result:=def.size>recsizelimit;
variantdef:
result:=false;
formaldef :
result:=true;
objectdef :
result:=(is_object(def) and (def.size>recsizelimit));
stringdef :
result:=(tstringdef(def).stringtype in [st_shortstring,st_longstring]);
procvardef :
result:=false;
setdef :
result:=not is_smallset(def);
end;
end;
{ true if a parameter is too large to copy and only the address is pushed }
function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
begin
result:=push_addr_param_intern(varspez,def,calloption,16);
end;
function tcpuparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
begin
if handle_common_ret_in_param(def,pd,result) then
exit;
case def.typ of
{ it is a matter of interpretation, if objects should be returned in registers according to the abi as the
abi talks only about structures and unions
at least for the compiler, it is a problem, if an object is returned in registers
consider
tobject1 = object
function f : tobject1;
...
contructor init;
end;
the constructor changes the size of tobject1, so its return location might change from register to memory, this
is something the compiler could not handle currently, so we do not return objects in registers yet
objectdef:
begin
result:=is_object(def) and (def.size>32);
exit;
end;}
recorddef:
begin
result:=def.size>32;
exit;
end;
end;
result:=inherited ret_in_param(def,pd);
end;
procedure tcpuparamanager.create_paraloc1_info_intern(
p : tabstractprocdef; side: tcallercallee;paradef:tdef;var loc : TCGPara;varspez : tvarspez;varoptions : tvaroptions;recsizelimit : aword;
var curintreg: LongInt; var curfloatreg: tsuperregister; var cur_stack_offset : aword);
procedure nextloc(currsize : TCgSize);
begin
if curintreg>high(tparasupregs) then
begin
if (currsize<low(tcgsize2size)) or (currsize>high(tcgsize2size)) then
internalerror(2017080101);
{ Parameters are aligned at 8 bytes }
inc(cur_stack_offset,align(tcgsize2size[currsize],sizeof(pint)));
end;
inc(curintreg);
if currsize=OS_F128 then
inc(curfloatreg,4)
else
inc(curfloatreg,2);
end;
var
paraloc : pcgparalocation;
paracgsize : tcgsize;
hparasupregs : pparasupregs;
paralen : longint;
begin
if side=callerside then
hparasupregs:=@paraoutsupregs
else
hparasupregs:=@parainsupregs;
{ currently only support C-style array of const,
there should be no location assigned to the vararg array itself }
if (p.proccalloption in cstylearrayofconst) and
is_array_of_const(paradef) then
begin
paraloc:=loc.add_location;
{ hack: the paraloc must be valid, but is not actually used }
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_G0;
paraloc^.size:=OS_ADDR;
paraloc^.def:=voidpointertype;
exit;
end;
if push_addr_param_intern(varspez,paradef,p.proccalloption,recsizelimit) then
begin
paracgsize:=OS_ADDR;
paradef:=cpointerdef.getreusable_no_free(paradef);
end
else
begin
paracgsize:=def_cgsize(paradef);
if paradef.typ=formaldef then
begin
paracgsize:=OS_ADDR;
paradef:=voidpointertype;
end;
end;
loc.reset;
loc.size:=paracgsize;
loc.def:=paradef;
if side=callerside then
loc.Alignment:=std_param_align
else
loc.Alignment:=paradef.alignment;
{ sparc64 returns records up to a size of 32 in register, we cannot encode this
in paracgsize, so paracgsize is OS_NO in this case }
if paracgsize=OS_NO then
paralen:=paradef.size
else
paralen:=tcgsize2size[paracgsize];
loc.intsize:=paralen;
while paralen>0 do
begin
paraloc:=loc.add_location;
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
{ ret in param? }
if vo_is_funcret in varoptions then
begin
paraloc^.loc:=LOC_REFERENCE;
paraloc^.reference.offset:=128;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
paraloc^.reference.index:=NR_FRAME_POINTER_REG;
inc(paraloc^.reference.offset,STACK_BIAS);
end
{ In case of po_delphi_nested_cc, the parent frame pointer
is always passed on the stack. }
else if (curintreg<=high(tparasupregs)) and
(not(vo_is_parentfp in varoptions) or
not(po_delphi_nested_cc in p.procoptions)) then
begin
if paraloc^.size in [OS_F32,OS_F64,OS_F128] then
begin
paraloc^.loc:=LOC_FPUREGISTER;
case paraloc^.size of
OS_F32:
{ singles are put into the uneven register }
paraloc^.register:=newreg(R_FPUREGISTER,curfloatreg+1,R_SUBFS);
OS_F64:
paraloc^.register:=newreg(R_FPUREGISTER,curfloatreg,R_SUBFD);
OS_F128:
paraloc^.register:=newreg(R_FPUREGISTER,curfloatreg,R_SUBFQ);
else
Internalerror(2017072301);
end;
end
else
begin
if paracgsize in [OS_NO,OS_128,OS_S128] then
begin
if paralen>4 then
begin
paraloc^.size:=OS_INT;
paraloc^.def:=u64inttype;
end
else
begin
{ for 3-byte records }
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end;
end;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=newreg(R_INTREGISTER,hparasupregs^[curintreg],R_SUBWHOLE);
{ left align }
if (target_info.endian=endian_big) and
not(paraloc^.size in [OS_64,OS_S64]) and
(paradef.typ in [setdef,recorddef,arraydef,objectdef]) then
begin
paraloc^.shiftval:=-(8-tcgsize2size[paraloc^.size])*8;
paraloc^.Size:=OS_64;
end;
end;
nextloc(paraloc^.Size);
end
else
begin
paraloc^.loc:=LOC_REFERENCE;
paraloc^.reference.offset:=target_info.first_parm_offset+cur_stack_offset;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
paraloc^.reference.index:=NR_FRAME_POINTER_REG;
inc(paraloc^.reference.offset,STACK_BIAS);
if (target_info.endian=endian_big) and
(paralen<tcgsize2size[OS_INT]) and
(paradef.typ<>recorddef) then
inc(paraloc^.reference.offset,4-paralen);
{ Parameters are aligned to 8 byte boundaries }
inc(cur_stack_offset,align(paralen,8));
{ a stack location covers always the remainder of a parameter }
exit;
end;
dec(paralen,tcgsize2size[paraloc^.size]);
end;
end;
procedure tcpuparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
var curintreg: LongInt; curfloatreg: tsuperregister; var cur_stack_offset : aword);
var
i : integer;
begin
for i:=0 to paras.count-1 do
create_paraloc1_info_intern(p,side,tparavarsym(paras[i]).vardef,tparavarsym(paras[i]).paraloc[side],tparavarsym(paras[i]).varspez,
tparavarsym(paras[i]).varoptions,16,curintreg,curfloatreg,cur_stack_offset);
end;
function tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
var
paraloc : pcgparalocation;
retcgsize : tcgsize;
curintreg : LongInt;
curfloatreg : tsuperregister;
cur_stack_offset : aword;
begin
if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
exit;
if ret_in_param(result.def,p) then
Internalerror(2017080601);
if is_record(result.def) or is_object(result.def) then
begin
curintreg:=0;
curfloatreg:=RS_F0;
cur_stack_offset:=0;
create_paraloc1_info_intern(p,side,result.def,result,vs_value,
[],32,curintreg,curfloatreg,cur_stack_offset);
{ sparc64 calling conventions are difficult, so better check if everything is ok }
if result.location^.loc=LOC_INVALID then
Internalerror(2017080501);
end
else
begin
paraloc:=result.add_location;
{ Return in FPU register? }
if result.def.typ=floatdef then
begin
paraloc^.loc:=LOC_FPUREGISTER;
paraloc^.register:=NR_FPU_RESULT_REG;
if retcgsize=OS_F64 then
setsubreg(paraloc^.register,R_SUBFD);
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else
{ Return in register }
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
if (side=callerside) then
paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
else
paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
end;
end;
end;
begin
ParaManager:=tcpuparamanager.create;
end.

278
compiler/sparcgen/sppara.pas
View File

@ -32,24 +32,14 @@ interface
type
tsparcparamanager=class(TParaManager)
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
function get_volatile_registers_int(calloption : tproccalloption):TCpuRegisterSet;override;
function get_volatile_registers_fpu(calloption : tproccalloption):TCpuRegisterSet;override;
function create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override;
function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
private
procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
var intparareg,parasize:longint);
var curintreg: longint; curfloatreg: tsuperregister; var cur_stack_offset: aword);virtual;abstract;
end;
implementation
uses
cutils,verbose,systems,
defutil,
cgobj;
type
tparasupregs = array[0..5] of tsuperregister;
pparasupregs = ^tparasupregs;
@ -57,6 +47,12 @@ implementation
paraoutsupregs : tparasupregs = (RS_O0,RS_O1,RS_O2,RS_O3,RS_O4,RS_O5);
parainsupregs : tparasupregs = (RS_I0,RS_I1,RS_I2,RS_I3,RS_I4,RS_I5);
implementation
uses
cutils,verbose,systems,
defutil,
cgobj;
function tsparcparamanager.get_volatile_registers_int(calloption : tproccalloption):TCpuRegisterSet;
begin
@ -70,263 +66,37 @@ implementation
end;
{ true if a parameter is too large to copy and only the address is pushed }
function tsparcparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
begin
result:=false;
{ var,out,constref always require address }
if varspez in [vs_var,vs_out,vs_constref] then
begin
result:=true;
exit;
end;
case def.typ of
arraydef:
result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
is_open_array(def) or
is_array_of_const(def) or
is_array_constructor(def);
recorddef,
variantdef,
formaldef :
result:=true;
objectdef :
result:=is_object(def);
stringdef :
result:=(tstringdef(def).stringtype in [st_shortstring,st_longstring]);
procvardef :
result:=not tprocvardef(def).is_addressonly;
setdef :
result:=not is_smallset(def);
end;
end;
function tsparcparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
var
paraloc : pcgparalocation;
retcgsize : tcgsize;
begin
if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
exit;
paraloc:=result.add_location;
{ Return in FPU register? }
if result.def.typ=floatdef then
begin
paraloc^.loc:=LOC_FPUREGISTER;
paraloc^.register:=NR_FPU_RESULT_REG;
if retcgsize=OS_F64 then
setsubreg(paraloc^.register,R_SUBFD);
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else
{ Return in register }
begin
{$ifndef cpu64bitaddr}
if retcgsize in [OS_64,OS_S64] then
begin
paraloc^.loc:=LOC_REGISTER;
{ high }
if side=callerside then
paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
else
paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
{ low }
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
if side=callerside then
paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
else
paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else
{$endif not cpu64bitaddr}
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
if (side=callerside) then
paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
else
paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
end;
end;
end;
procedure tsparcparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
var intparareg,parasize:longint);
var
paraloc : pcgparalocation;
i : integer;
hp : tparavarsym;
paradef : tdef;
paracgsize : tcgsize;
hparasupregs : pparasupregs;
paralen : longint;
begin
if side=callerside then
hparasupregs:=@paraoutsupregs
else
hparasupregs:=@parainsupregs;
for i:=0 to paras.count-1 do
begin
hp:=tparavarsym(paras[i]);
paradef:=hp.vardef;
{ currently only support C-style array of const,
there should be no location assigned to the vararg array itself }
if (p.proccalloption in cstylearrayofconst) and
is_array_of_const(paradef) then
begin
paraloc:=hp.paraloc[side].add_location;
{ hack: the paraloc must be valid, but is not actually used }
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_G0;
paraloc^.size:=OS_ADDR;
paraloc^.def:=voidpointertype;
break;
end;
if push_addr_param(hp.varspez,paradef,p.proccalloption) then
begin
paracgsize:=OS_ADDR;
paradef:=cpointerdef.getreusable_no_free(paradef);
end
else
begin
paracgsize:=def_cgsize(paradef);
{ for formaldef }
if paracgsize=OS_NO then
begin
paracgsize:=OS_ADDR;
paradef:=voidpointertype;
end;
end;
hp.paraloc[side].reset;
hp.paraloc[side].size:=paracgsize;
hp.paraloc[side].def:=paradef;
if (side = callerside) then
hp.paraloc[side].Alignment:=std_param_align
else
hp.paraloc[side].Alignment:=paradef.alignment;
paralen:=tcgsize2size[paracgsize];
hp.paraloc[side].intsize:=paralen;
while paralen>0 do
begin
paraloc:=hp.paraloc[side].add_location;
{$ifdef SPARC64}
{ Floats are passed in int registers }
if paracgsize=OS_F32 then
begin
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else if paracgsize=OS_F64 then
begin
paraloc^.size:=OS_64;
paraloc^.def:=u64inttype;
end
else
{$else SPARC64}
{ Floats are passed in int registers,
We can allocate at maximum 32 bits per register }
if paracgsize in [OS_64,OS_S64,OS_F32,OS_F64] then
begin
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else
{$endif SPARC64}
begin
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
end;
{ ret in param? }
if vo_is_funcret in hp.varoptions then
begin
paraloc^.loc:=LOC_REFERENCE;
{$ifdef SPARC64}
paraloc^.reference.offset:=128;
{$else SPARC64}
paraloc^.reference.offset:=64;
{$endif SPARC64}
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
paraloc^.reference.index:=NR_FRAME_POINTER_REG;
{$ifdef SPARC64}
inc(paraloc^.reference.offset,STACK_BIAS);
{$endif SPARC64}
end
{ In case of po_delphi_nested_cc, the parent frame pointer
is always passed on the stack. }
else if (intparareg<=high(tparasupregs)) and
(not(vo_is_parentfp in hp.varoptions) or
not(po_delphi_nested_cc in p.procoptions)) then
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=newreg(R_INTREGISTER,hparasupregs^[intparareg],R_SUBWHOLE);
inc(intparareg);
end
else
begin
paraloc^.loc:=LOC_REFERENCE;
paraloc^.reference.offset:=target_info.first_parm_offset+parasize;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
paraloc^.reference.index:=NR_FRAME_POINTER_REG;
{$ifdef SPARC64}
inc(paraloc^.reference.offset,STACK_BIAS);
{$endif SPARC64}
if (target_info.endian=endian_big) and
(paralen<tcgsize2size[OS_INT]) and
(paradef.typ<>recorddef) then
inc(paraloc^.reference.offset,4-paralen);
{ Parameters are aligned at 4 bytes }
inc(parasize,align(tcgsize2size[paraloc^.size],sizeof(pint)));
end;
dec(paralen,tcgsize2size[paraloc^.size]);
end;
end;
end;
function tsparcparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
var
intparareg,
parasize : longint;
curintreg : LongInt;
curfloatreg : TSuperRegister;
cur_stack_offset : aword;
begin
intparareg:=0;
parasize:=0;
curintreg:=0;
curfloatreg:=RS_F0;
cur_stack_offset:=0;
{ calculate the registers for the normal parameters }
create_paraloc_info_intern(p,callerside,p.paras,intparareg,parasize);
create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,cur_stack_offset);
{ append the varargs }
create_paraloc_info_intern(p,callerside,varargspara,intparareg,parasize);
result:=parasize;
create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,cur_stack_offset);
result:=cur_stack_offset;
end;
function tsparcparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
var
intparareg,
parasize : longint;
curintreg : LongInt;
curfloatreg : TSuperRegister;
cur_stack_offset : aword;
begin
intparareg:=0;
parasize:=0;
create_paraloc_info_intern(p,side,p.paras,intparareg,parasize);
curintreg:=0;
curfloatreg:=RS_F0;
cur_stack_offset:=0;
create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,cur_stack_offset);
{ Create Function result paraloc }
create_funcretloc_info(p,side);
{ We need to return the size allocated on the stack }
result:=parasize;
result:=cur_stack_offset;
end;