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