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

* add a tdef to each parameter location and set it for all target

Browse Source 
backends (not yet used, will be used in high level code generator)

git-svn-id: trunk@24761 -
This commit is contained in:
Jonas Maebe 2013-06-02 10:24:02 +00:00
parent 53ba7fbb8b
commit 7566ddcc8f
13 changed files with 697 additions and 218 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
compiler/arm/cpupara.pas
View File

@ -81,20 +81,25 @@ unit cpupara;
procedure tarmparamanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
def : tdef;
psym : tparavarsym;
pdef : tdef;
begin
if nr<1 then
internalerror(2002070801);
def:=tparavarsym(pd.paras[nr-1]).vardef;
psym:=tparavarsym(pd.paras[nr-1]);
pdef:=psym.vardef;
if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
pdef:=getpointerdef(pdef);
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.size:=def_cgsize(pdef);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=std_param_align;
cgpara.def:=def;
cgpara.def:=pdef;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
size:=OS_INT;
def:=pdef;
size:=def_cgsize(pdef);
{ the four first parameters are passed into registers }
if nr<=4 then
begin
@ -362,6 +367,7 @@ unit cpupara;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_R0;
paraloc^.size:=OS_ADDR;
paraloc^.def:=voidpointertype;
break;
end;
@ -413,16 +419,28 @@ unit cpupara;
if (loc=LOC_REGISTER) and (paracgsize in [OS_F32,OS_F64,OS_F80]) then
case paracgsize of
OS_F32:
paraloc^.size:=OS_32;
begin
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end;
OS_F64:
paraloc^.size:=OS_32;
begin
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end;
else
internalerror(2005082901);
end
else if (paracgsize in [OS_NO,OS_64,OS_S64]) then
paraloc^.size := OS_32
begin
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else
paraloc^.size:=paracgsize;
begin
paraloc^.size:=paracgsize;
paraloc^.def:=get_paraloc_def(paradef,paracgsize,paralen,firstparaloc);
end;
case loc of
LOC_REGISTER:
begin
@ -449,6 +467,7 @@ unit cpupara;
{ LOC_REFERENCE always contains everything that's left }
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=int_cgsize(paralen);
paraloc^.def:=getarraydef(u8inttype,paralen);
if (side=callerside) then
paraloc^.reference.index:=NR_STACK_POINTER_REG;
paraloc^.reference.offset:=stack_offset;
@ -522,6 +541,7 @@ unit cpupara;
{ LOC_REFERENCE always contains everything that's left }
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=int_cgsize(paralen);
paraloc^.def:=getarraydef(u8inttype,paralen);
if (side=callerside) then
paraloc^.reference.index:=NR_STACK_POINTER_REG;
paraloc^.reference.offset:=stack_offset;
@ -534,6 +554,7 @@ unit cpupara;
if push_addr_param(hp.varspez,paradef,p.proccalloption) then
begin
paraloc^.size:=OS_ADDR;
paraloc^.def:=getpointerdef(paradef);
assignintreg
end
else
@ -545,6 +566,7 @@ unit cpupara;
stack_offset:=align(stack_offset,8);
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.reference.index:=NR_STACK_POINTER_REG;
paraloc^.reference.offset:=stack_offset;
@ -621,6 +643,7 @@ unit cpupara;
internalerror(2012032501);
end;
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else if (p.proccalloption in [pocall_softfloat]) or
(cs_fp_emulation in current_settings.moduleswitches) or
@ -636,6 +659,7 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
if target_info.endian = endian_big then
@ -643,6 +667,7 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end;
OS_32,
OS_F32:
@ -650,6 +675,7 @@ unit cpupara;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RETURN_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end;
else
internalerror(2005082603);
@ -660,6 +686,7 @@ unit cpupara;
paraloc^.loc:=LOC_FPUREGISTER;
paraloc^.register:=NR_FPU_RESULT_REG;
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end;
end
{ Return in register }
@ -673,6 +700,7 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
if target_info.endian = endian_big then
@ -680,15 +708,22 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RETURN_REG;
if (result.intsize<>3) then
paraloc^.size:=retcgsize
begin
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else
paraloc^.size:=OS_32;
begin
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end;
end;
end;
end;

54
compiler/avr/cpupara.pas
View File

@ -71,20 +71,25 @@ unit cpupara;
procedure tavrparamanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
def : tdef;
psym: tparavarsym;
pdef: tdef;
begin
if nr<1 then
internalerror(2002070801);
def:=tparavarsym(pd.paras[nr-1]).vardef;
psym:=tparavarsym(pd.paras[nr-1]);
pdef:=psym.vardef;
if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
pdef:=getpointerdef(pdef);
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.size:=def_cgsize(pdef);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=std_param_align;
cgpara.def:=def;
cgpara.def:=pdef;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
size:=OS_INT;
size:=def_cgsize(pdef);
def:=pdef;
{ the four first parameters are passed into registers }
if nr<=9 then
begin
@ -225,6 +230,7 @@ unit cpupara;
paracgsize : tcgsize;
paralen : longint;
i : integer;
firstparaloc: boolean;
procedure assignintreg;
begin
@ -272,6 +278,7 @@ unit cpupara;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_R25;
paraloc^.size:=OS_ADDR;
paraloc^.def:=voidpointertype;
break;
end;
@ -315,6 +322,7 @@ unit cpupara;
if paralen=0 then
internalerror(200410311);
{$endif EXTDEBUG}
firstparaloc:=true;
while paralen>0 do
begin
paraloc:=hp.paraloc[side].add_location;
@ -322,16 +330,28 @@ unit cpupara;
if (loc=LOC_REGISTER) and (paracgsize in [OS_F32,OS_F64,OS_F80]) then
case paracgsize of
OS_F32:
paraloc^.size:=OS_32;
begin
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end;
OS_F64:
paraloc^.size:=OS_32;
begin
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end;
else
internalerror(2005082901);
end
else if paracgsize<>OS_S8 then
paraloc^.size := OS_8
begin
paraloc^.size:=OS_8;
paraloc^.def:=u8inttype
end
else
paraloc^.size:=paracgsize;
begin
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
end;
case loc of
LOC_REGISTER:
begin
@ -346,6 +366,8 @@ unit cpupara;
{ LOC_REFERENCE covers always the overleft }
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=int_cgsize(paralen);
paraloc^.def:=get_paraloc_def(paradef,paracgsize,paralen,firstparaloc);
if (side=callerside) then
paraloc^.reference.index:=NR_STACK_POINTER_REG;
paraloc^.reference.offset:=stack_offset;
@ -357,9 +379,13 @@ unit cpupara;
begin
paraloc^.size:=OS_ADDR;
if push_addr_param(hp.varspez,paradef,p.proccalloption) then
assignintreg
begin
paraloc^.def:=getpointerdef(paradef);
assignintreg
end
else
begin
paraloc^.def:=hp.vardef;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.reference.index:=NR_STACK_POINTER_REG;
paraloc^.reference.offset:=stack_offset;
@ -378,6 +404,7 @@ unit cpupara;
end;
end;
dec(paralen,tcgsize2size[paraloc^.size]);
firstparaloc:=false;
end;
end;
curintreg:=nextintreg;
@ -424,10 +451,12 @@ unit cpupara;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end;
OS_32,
OS_F32:
@ -435,6 +464,7 @@ unit cpupara;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RETURN_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end;
else
internalerror(2005082603);
@ -445,6 +475,7 @@ unit cpupara;
paraloc^.loc:=LOC_FPUREGISTER;
paraloc^.register:=NR_FPU_RESULT_REG;
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end;
end
{ Return in register }
@ -455,16 +486,19 @@ unit cpupara;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RETURN_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end;
end;
end;

54
compiler/i386/cpupara.pas
View File

@ -277,18 +277,23 @@ unit cpupara;
procedure ti386paramanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
def : tdef;
psym: tparavarsym;
pdef: tdef;
begin
def:=tparavarsym(pd.paras[nr-1]).vardef;
psym:=tparavarsym(pd.paras[nr-1]);
pdef:=psym.vardef;
if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
pdef:=getpointerdef(pdef);
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.size:=def_cgsize(pdef);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=get_para_align(pd.proccalloption);
cgpara.def:=def;
cgpara.def:=pdef;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
size:=OS_INT;
size:=def_cgsize(pdef);
def:=pdef;
if pd.proccalloption=pocall_register then
begin
if (nr<=length(parasupregs)) then
@ -367,6 +372,7 @@ unit cpupara;
paraloc^.loc:=LOC_FPUREGISTER;
paraloc^.register:=NR_FPU_RESULT_REG;
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else
{ Return in register }
@ -381,6 +387,7 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
{ high 32bits }
paraloc:=result.add_location;
@ -390,10 +397,12 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else
begin
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
@ -413,8 +422,9 @@ unit cpupara;
paralen,
varalign : longint;
paraalign : shortint;
pushaddr : boolean;
paracgsize : tcgsize;
firstparaloc,
pushaddr : boolean;
begin
paraalign:=get_para_align(p.proccalloption);
{ we push Flags and CS as long
@ -476,6 +486,7 @@ unit cpupara;
paraloc:=hp.paraloc[side].add_location;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
@ -497,6 +508,7 @@ unit cpupara;
begin
if paralen=0 then
internalerror(200501163);
firstparaloc:=true;
while (paralen>0) do
begin
paraloc:=hp.paraloc[side].add_location;
@ -505,15 +517,22 @@ unit cpupara;
if (paracgsize in [OS_F64,OS_F32]) then
begin
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
l:=paralen;
end
else
begin
{ We can allocate at maximum 32 bits per location }
if paralen>sizeof(aint) then
l:=sizeof(aint)
begin
l:=sizeof(aint);
paraloc^.def:=uinttype;
end
else
l:=paralen;
begin
l:=paralen;
paraloc^.def:=get_paraloc_def(paradef,paracgsize,l,firstparaloc);
end;
paraloc^.size:=int_cgsize(l);
end;
if (side=callerside) or
@ -531,6 +550,7 @@ unit cpupara;
inc(paraloc^.reference.offset,4);
parasize:=align(parasize+l,varalign);
dec(paralen,l);
firstparaloc:=false;
end;
end;
if p.proccalloption in pushleftright_pocalls then
@ -552,9 +572,10 @@ unit cpupara;
l,
paralen,
varalign : longint;
pushaddr : boolean;
paraalign : shortint;
pass : byte;
firstparaloc,
pushaddr : boolean;
begin
if paras.count=0 then
exit;
@ -621,6 +642,7 @@ unit cpupara;
begin
paraloc:=hp.paraloc[side].add_location;
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=newreg(R_INTREGISTER,parasupregs[parareg],cgsize2subreg(R_INTREGISTER,paracgsize));
inc(parareg);
@ -636,6 +658,7 @@ unit cpupara;
paraloc:=hp.paraloc[side].add_location;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
@ -650,6 +673,7 @@ unit cpupara;
begin
if paralen=0 then
internalerror(200501163);
firstparaloc:=true;
while (paralen>0) do
begin
paraloc:=hp.paraloc[side].add_location;
@ -658,15 +682,22 @@ unit cpupara;
if (paracgsize in [OS_F64,OS_F32]) then
begin
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
l:=paralen;
end
else
begin
{ We can allocate at maximum 32 bits per location }
if paralen>sizeof(aint) then
l:=sizeof(aint)
begin
l:=sizeof(aint);
paraloc^.def:=uinttype;
end
else
l:=paralen;
begin
l:=paralen;
paraloc^.def:=get_paraloc_def(paradef,paracgsize,l,firstparaloc);
end;
paraloc^.size:=int_cgsize(l);
end;
if side=callerside then
@ -679,6 +710,7 @@ unit cpupara;
inc(paraloc^.reference.offset,target_info.first_parm_offset);
parasize:=align(parasize+l,varalign);
dec(paralen,l);
firstparaloc:=false;
end;
end;
end;

56
compiler/i8086/cpupara.pas
View File

@ -231,18 +231,23 @@ unit cpupara;
procedure ti8086paramanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
def : tdef;
psym: tparavarsym;
pdef : tdef;
begin
def:=tparavarsym(pd.paras[nr-1]).vardef;
psym:=tparavarsym(pd.paras[nr-1]);
pdef:=psym.vardef;
if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
pdef:=getpointerdef(pdef);
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.size:=def_cgsize(pdef);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=get_para_align(pd.proccalloption);
cgpara.def:=def;
cgpara.def:=pdef;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
size:=OS_INT;
size:=def_cgsize(pdef);
def:=pdef;
if pd.proccalloption=pocall_register then
begin
if (nr<=length(parasupregs)) then
@ -321,6 +326,7 @@ unit cpupara;
paraloc^.loc:=LOC_FPUREGISTER;
paraloc^.register:=NR_FPU_RESULT_REG;
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else
{ Return in register }
@ -335,6 +341,7 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG;
paraloc^.size:=OS_16;
paraloc^.def:=u16inttype;
{ bits 16..31 }
paraloc:=result.add_location;
@ -344,6 +351,7 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
paraloc^.size:=OS_16;
paraloc^.def:=u16inttype;
{ bits 32..47 }
paraloc:=result.add_location;
@ -353,6 +361,7 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RETURN64_HIGHER_REG;
paraloc^.size:=OS_16;
paraloc^.def:=u16inttype;
{ bits 48..63 }
paraloc:=result.add_location;
@ -362,6 +371,7 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RETURN64_HIGHEST_REG;
paraloc^.size:=OS_16;
paraloc^.def:=u16inttype;
end
else if retcgsize in [OS_32,OS_S32] then
begin
@ -371,6 +381,7 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RETURN32_LOW_REG;
paraloc^.size:=OS_16;
paraloc^.def:=u16inttype;
{ high 16bits }
paraloc:=result.add_location;
@ -380,10 +391,12 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RETURN32_HIGH_REG;
paraloc^.size:=OS_16;
paraloc^.def:=u16inttype;
end
else
begin
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
@ -403,8 +416,9 @@ unit cpupara;
paralen,
varalign : longint;
paraalign : shortint;
pushaddr : boolean;
paracgsize : tcgsize;
firstparaloc,
pushaddr : boolean;
begin
paraalign:=get_para_align(p.proccalloption);
{ we push Flags and CS as long
@ -466,6 +480,7 @@ unit cpupara;
paraloc:=hp.paraloc[side].add_location;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
@ -487,6 +502,7 @@ unit cpupara;
begin
if paralen=0 then
internalerror(200501163);
firstparaloc:=true;
while (paralen>0) do
begin
paraloc:=hp.paraloc[side].add_location;
@ -495,15 +511,22 @@ unit cpupara;
if (paracgsize in [OS_F64,OS_F32]) then
begin
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
l:=paralen;
end
else
begin
{ We can allocate at maximum 32 bits per location }
if paralen>sizeof(aint) then
l:=sizeof(aint)
begin
l:=sizeof(aint);
paraloc^.def:=uinttype;
end
else
l:=paralen;
begin
l:=paralen;
paraloc^.def:=get_paraloc_def(paradef,paracgsize,l,firstparaloc);
end;
paraloc^.size:=int_cgsize(l);
end;
if (side=callerside) or
@ -521,6 +544,7 @@ unit cpupara;
inc(paraloc^.reference.offset,4);
parasize:=align(parasize+l,varalign);
dec(paralen,l);
firstparaloc:=false;
end;
end;
if p.proccalloption in pushleftright_pocalls then
@ -545,6 +569,7 @@ unit cpupara;
pushaddr : boolean;
paraalign : shortint;
pass : byte;
firstparaloc : boolean;
begin
if paras.count=0 then
exit;
@ -611,6 +636,7 @@ unit cpupara;
begin
paraloc:=hp.paraloc[side].add_location;
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=newreg(R_INTREGISTER,parasupregs[parareg],cgsize2subreg(R_INTREGISTER,paracgsize));
inc(parareg);
@ -626,6 +652,7 @@ unit cpupara;
paraloc:=hp.paraloc[side].add_location;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
@ -640,6 +667,7 @@ unit cpupara;
begin
if paralen=0 then
internalerror(200501163);
firstparaloc:=true;
while (paralen>0) do
begin
paraloc:=hp.paraloc[side].add_location;
@ -648,15 +676,22 @@ unit cpupara;
if (paracgsize in [OS_F64,OS_F32]) then
begin
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
l:=paralen;
end
else
begin
{ We can allocate at maximum 32 bits per location }
if paralen>sizeof(aint) then
l:=sizeof(aint)
begin
l:=sizeof(aint);
paraloc^.def:=uinttype;
end
else
l:=paralen;
begin
l:=paralen;
paraloc^.def:=get_paraloc_def(paradef,paracgsize,l,firstparaloc);
end;
paraloc^.size:=int_cgsize(l);
end;
if side=callerside then
@ -669,6 +704,7 @@ unit cpupara;
inc(paraloc^.reference.offset,target_info.first_parm_offset);
parasize:=align(parasize+l,varalign);
dec(paralen,l);
firstparaloc:=false;
end;
end;
end;

15
compiler/jvm/cpupara.pas
View File

@ -147,6 +147,7 @@ implementation
result.size:=OS_NO;
result.intsize:=0;
paraloc^.size:=OS_NO;
paraloc^.def:=voidtype;
paraloc^.loc:=LOC_VOID;
exit;
end;
@ -156,6 +157,11 @@ implementation
retcgsize:=OS_INT;
result.intsize:=sizeof(pint);
end
else if jvmimplicitpointertype(result.def) then
begin
retcgsize:=OS_ADDR;
result.def:=getpointerdef(result.def);
end
else
begin
retcgsize:=def_cgsize(result.def);
@ -168,6 +174,8 @@ implementation
paraloc^.loc:=LOC_REFERENCE;
paraloc^.reference.index:=NR_EVAL_STACK_BASE;
paraloc^.reference.offset:=0;
paraloc^.size:=result.size;
paraloc^.def:=result.def;
end;
function TJVMParaManager.param_use_paraloc(const cgpara: tcgpara): boolean;
@ -226,6 +234,11 @@ implementation
paracgsize:=OS_ADDR;
paradef:=java_jlobject;
end
else if jvmimplicitpointertype(hp.vardef) then
begin
paracgsize:=OS_ADDR;
paradef:=getpointerdef(hp.vardef);
end
else
begin
paracgsize:=def_cgsize(hp.vardef);
@ -246,6 +259,8 @@ implementation
taking up two slots) }
paraloc^.loc:=LOC_REFERENCE;;
paraloc^.reference.offset:=paraofs;
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
case side of
callerside:
begin

25
compiler/m68k/cpupara.pas
View File

@ -68,16 +68,20 @@ unit cpupara;
procedure tm68kparamanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
def : tdef;
psym: tparavarsym;
pdef: tdef;
begin
if nr<1 then
internalerror(2002070801);
def:=tparavarsym(pd.paras[nr-1]).vardef;
psym:=tparavarsym(pd.paras[nr-1]);
pdef:=psym.vardef;
if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
pdef:=getpointerdef(pdef);
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.size:=def_cgsize(pdef);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=std_param_align;
cgpara.def:=def;
cgpara.def:=pdef;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
@ -87,7 +91,8 @@ unit cpupara;
loc:=LOC_REFERENCE;
reference.index:=NR_STACK_POINTER_REG;
reference.offset:=target_info.first_parm_offset+nr*4;
size:=OS_INT;
size:=def_cgsize(pdef);
def:=pdef;
end;
end;
@ -206,6 +211,7 @@ unit cpupara;
paraloc^.loc:=LOC_FPUREGISTER;
paraloc^.register:=NR_FPU_RESULT_REG;
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else
{ Return in register }
@ -215,6 +221,7 @@ unit cpupara;
{ low 32bits }
paraloc^.loc:=LOC_REGISTER;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
if side=callerside then
paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
else
@ -223,6 +230,7 @@ unit cpupara;
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
if side=calleeside then
paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
else
@ -232,6 +240,7 @@ unit cpupara;
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
@ -266,6 +275,7 @@ unit cpupara;
nextintreg,
nextfloatreg : tsuperregister;
stack_offset : longint;
firstparaloc : boolean;
begin
result:=0;
@ -301,6 +311,7 @@ unit cpupara;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_D0;
paraloc^.size:=OS_ADDR;
paraloc^.def:=voidpointertype;
break;
end;
@ -344,6 +355,7 @@ unit cpupara;
end
else
internalerror(200506052);
firstparaloc:=true;
{ can become < 0 for e.g. 3-byte records }
while (paralen > 0) do
begin
@ -384,6 +396,7 @@ unit cpupara;
{$endif DEBUG_CHARLIE}
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=int_cgsize(paralen);
paraloc^.def:=get_paraloc_def(paradef,paraloc^.size,paralen,firstparaloc);
if (side = callerside) then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
@ -392,6 +405,7 @@ unit cpupara;
inc(stack_offset,align(paralen,4));
paralen := 0;
end;
firstparaloc:=false;
end;
end;
result:=stack_offset;
@ -493,6 +507,7 @@ unit cpupara;
paraloc:=p.paraloc[callerside].add_location;
paraloc^.loc:=LOC_REGISTER;
paraloc^.size:=def_cgsize(p.vardef);
paraloc^.def:=p.vardef;
{ pattern is always uppercase'd }
if s='D0' then
paraloc^.register:=NR_D0

57
compiler/mips/cpupara.pas
View File

@ -126,16 +126,20 @@ implementation
procedure TMIPSParaManager.GetIntParaLoc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
def : tdef;
psym: tparavarsym;
pdef: tdef;
begin
if nr<1 then
InternalError(2002100806);
def:=tparavarsym(pd.paras[nr-1]).vardef;
psym:=tparavarsym(pd.paras[nr-1]);
pdef:=psym.vardef;
if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
pdef:=getpointerdef(pdef);
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.size:=def_cgsize(pdef);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=std_param_align;
cgpara.def:=def;
cgpara.def:=pdef;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
@ -154,7 +158,8 @@ implementation
reference.index:=NR_STACK_POINTER_REG;
reference.offset:=nr*mips_sizeof_register_param;
end;
size:=OS_INT;
size:=def_cgsize(pdef);
def:=pdef;
end;
end;
@ -225,6 +230,7 @@ implementation
if retcgsize=OS_F64 then
setsubreg(paraloc^.register,R_SUBFD);
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else
{ Return in register }
@ -239,6 +245,7 @@ implementation
else
paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
{ high }
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
@ -247,12 +254,14 @@ implementation
else
paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else
{$endif cpu64bitalu}
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
@ -269,11 +278,13 @@ implementation
hp : tparavarsym;
paracgsize : tcgsize;
paralen : longint;
paradef : tdef;
fpparareg : integer;
reg : tsuperregister;
alignment : longint;
tmp : longint;
locdef : tdef;
paradef : tdef;
fpparareg : integer;
reg : tsuperregister;
alignment : longint;
tmp : longint;
firstparaloc : boolean;
begin
fpparareg := 0;
for i:=0 to paras.count-1 do
@ -290,6 +301,7 @@ implementation
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_R0;
paraloc^.size:=OS_ADDR;
paraloc^.def:=voidpointertype;
break;
end;
@ -321,6 +333,7 @@ implementation
//writeln('para: ',hp.Name,' typ=',hp.vardef.typ,' paracgsize=',paracgsize,' align=',hp.vardef.alignment);
hp.paraloc[side].reset;
hp.paraloc[side].Alignment:=alignment;
locdef:=paradef;
if (paracgsize=OS_NO) or
{ Ordinals on caller side must be promoted to machine word }
((target_info.endian=endian_big) and // applies to little-endian too?
@ -329,9 +342,15 @@ implementation
(paralen<tcgsize2size[OS_INT]))then
begin
if is_signed(paradef) then
paracgsize:=OS_S32
begin
paracgsize:=OS_S32;
locdef:=s32inttype;
end
else
paracgsize:=OS_32;
begin
paracgsize:=OS_32;
locdef:=u32inttype;
end;
paralen:=align(paralen,4);
end
else
@ -363,6 +382,7 @@ implementation
if (not(paracgsize in [OS_F32, OS_F64])) or (fpparareg = 2) then
can_use_float := false;
firstparaloc:=true;
while paralen>0 do
begin
paraloc:=hp.paraloc[side].add_location;
@ -370,9 +390,15 @@ implementation
if (paracgsize in [OS_64,OS_S64]) or
((paracgsize in [OS_F32,OS_F64]) and
not(can_use_float)) then
paraloc^.size:=OS_32
begin
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else
paraloc^.size:=paracgsize;
begin
paraloc^.size:=paracgsize;
paraloc^.def:=locdef;
end;
{ ret in param? }
if (vo_is_funcret in hp.varoptions) and
@ -427,6 +453,7 @@ implementation
begin
paraloc^.shiftval := (sizeof(aint)-tcgsize2size[paraloc^.size])*(-8);
paraloc^.size := OS_INT;
paraloc^.def := osuinttype;
end;
inc(intparareg);
inc(intparasize,align(tcgsize2size[paraloc^.size],mips_sizeof_register_param));
@ -436,6 +463,7 @@ implementation
begin
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=int_cgsize(paralen);
paraloc^.def:=get_paraloc_def(locdef,paraloc^.size,paralen,firstparaloc);
if side=callerside then
begin
@ -463,6 +491,7 @@ implementation
paralen:=0;
end;
dec(paralen,tcgsize2size[paraloc^.size]);
firstparaloc:=false;
end;
end;
{ O32 ABI reqires at least 16 bytes }

1
compiler/parabase.pas
View File

@ -39,6 +39,7 @@ unit parabase;
TCGParaLocation = record
Next : PCGParaLocation;
Size : TCGSize; { size of this location }
Def : tdef;
Loc : TCGLoc;
case TCGLoc of
LOC_REFERENCE : (reference : TCGParaReference);

21
compiler/paramgr.pas
View File

@ -149,6 +149,11 @@ unit paramgr;
itself as well; parameter retinparam is only valid if function
returns true }
function handle_common_ret_in_param(def:tdef;pd:tabstractprocdef;out retinparam:boolean):boolean;
{ returns the def to use for a tparalocation part of a cgpara for paradef,
for which the tcgsize is locsize and the integer length is restlen.
fullsize is true if restlen equals the full paradef size }
function get_paraloc_def(paradef: tdef; paracgsize: tcgsize; restlen: aint; fullsize: boolean): tdef;
end;
@ -403,6 +408,7 @@ implementation
len:=tcgsize2size[paraloc^.size];
newparaloc:=cgpara.add_location;
newparaloc^.size:=paraloc^.size;
newparaloc^.def:=paraloc^.def;
newparaloc^.shiftval:=paraloc^.shiftval;
{ $warning maybe release this optimization for all targets? }
{ released for all CPUs:
@ -543,6 +549,7 @@ implementation
retloc.size:=OS_NO;
retcgsize:=OS_NO;
retloc.intsize:=0;
paraloc^.def:=retloc.def;
paraloc^.size:=OS_NO;
paraloc^.loc:=LOC_VOID;
exit;
@ -565,6 +572,7 @@ implementation
paraloc:=retloc.add_location;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=retcgsize;
paraloc^.def:=retloc.def;
exit;
end;
result:=false;
@ -602,6 +610,19 @@ implementation
end;
function tparamanager.get_paraloc_def(paradef: tdef; paracgsize: tcgsize; restlen: aint; fullsize: boolean): tdef;
begin
if fullsize then
result:=paradef
{ no support for 128 bit ints -> tcgsize2orddef can't handle
OS_(S)128 }
else if not(paracgsize in [OS_NO,OS_128,OS_S128]) then
result:=cgsize_orddef(paracgsize)
else
result:=getarraydef(u8inttype,restlen);
end;
procedure tparamanager.getintparaloc(pd: tabstractprocdef; nr : longint; var cgpara: tcgpara);
begin
if (nr<1) or (nr>pd.paras.count) then

77
compiler/powerpc/cpupara.pas
View File

@ -80,18 +80,23 @@ unit cpupara;
procedure tppcparamanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
def : tdef;
psym : tparavarsym;
pdef : tdef;
begin
def:=tparavarsym(pd.paras[nr-1]).vardef;
psym:=tparavarsym(pd.paras[nr-1]);
pdef:=psym.vardef;
if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
pdef:=getpointerdef(pdef);
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.size:=def_cgsize(pdef);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=get_para_align(pd.proccalloption);
cgpara.def:=def;
cgpara.def:=pdef;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
size:=OS_INT;
size:=def_cgsize(pdef);
def:=pdef;
if (nr<=8) then
begin
if nr=0 then
@ -262,6 +267,7 @@ unit cpupara;
paraloc^.loc:=LOC_FPUREGISTER;
paraloc^.register:=NR_FPU_RESULT_REG;
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else
{ Return in register }
@ -275,6 +281,7 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
{ high 32bits }
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
@ -283,6 +290,7 @@ unit cpupara;
else
paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else
begin
@ -292,6 +300,7 @@ unit cpupara;
else
paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end;
end;
end;
@ -318,6 +327,7 @@ unit cpupara;
stack_offset: longint;
paralen: aint;
nextintreg,nextfloatreg,nextmmreg, maxfpureg : tsuperregister;
locdef,
paradef : tdef;
paraloc : pcgparalocation;
i : integer;
@ -325,6 +335,7 @@ unit cpupara;
loc : tcgloc;
paracgsize: tcgsize;
sym: tfieldvarsym;
firstparaloc: boolean;
begin
{$ifdef extdebug}
@ -366,6 +377,7 @@ unit cpupara;
paraloc^.loc := LOC_REGISTER;
paraloc^.register := NR_R0;
paraloc^.size := OS_ADDR;
paraloc^.def:=voidpointertype;
break;
end;
@ -420,10 +432,16 @@ unit cpupara;
(paradef.typ = floatdef) then
begin
loc := LOC_REGISTER;
if paracgsize = OS_F64 then
paracgsize := OS_64
if paracgsize=OS_F64 then
begin
paracgsize:=OS_64;
paradef:=u64inttype;
end
else
paracgsize := OS_32;
begin
paracgsize:=OS_32;
paradef:=u32inttype;
end;
end;
hp.paraloc[side].alignment:=std_param_align;
@ -444,6 +462,8 @@ unit cpupara;
end
else
internalerror(2005011310);
locdef:=paradef;
firstparaloc:=true;
{ can become < 0 for e.g. 3-byte records }
while (paralen > 0) do
begin
@ -457,12 +477,21 @@ unit cpupara;
begin
paraloc^.loc := loc;
{ make sure we don't lose whether or not the type is signed }
if (paradef.typ <> orddef) then
paracgsize := int_cgsize(paralen);
if (paradef.typ<>orddef) then
begin
paracgsize:=int_cgsize(paralen);
locdef:=get_paraloc_def(paradef,paracgsize,paralen,firstparaloc);
end;
if (paracgsize in [OS_NO,OS_64,OS_S64,OS_128,OS_S128]) then
paraloc^.size := OS_INT
begin
paraloc^.size:=OS_INT;
paraloc^.def:=u32inttype;
end
else
paraloc^.size := paracgsize;
begin
paraloc^.size:=paracgsize;
paraloc^.def:=locdef;
end;
{ aix requires that record data stored in parameter
registers is left-aligned }
if (target_info.system in systems_aix) and
@ -471,6 +500,7 @@ unit cpupara;
begin
paraloc^.shiftval := (sizeof(aint)-tcgsize2size[paraloc^.size])*(-8);
paraloc^.size := OS_INT;
paraloc^.def := u32inttype;
end;
paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBNONE);
inc(nextintreg);
@ -483,6 +513,7 @@ unit cpupara;
begin
paraloc^.loc:=loc;
paraloc^.size := paracgsize;
paraloc^.def := paradef;
paraloc^.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE);
inc(nextfloatreg);
dec(paralen,tcgsize2size[paraloc^.size]);
@ -517,10 +548,24 @@ unit cpupara;
paraloc^.loc:=LOC_REFERENCE;
case loc of
LOC_FPUREGISTER:
paraloc^.size:=int_float_cgsize(paralen);
begin
paraloc^.size:=int_float_cgsize(paralen);
case paraloc^.size of
OS_F32: paraloc^.def:=s32floattype;
OS_F64: paraloc^.def:=s64floattype;
else
internalerror(2013060124);
end;
end;
LOC_REGISTER,
LOC_REFERENCE:
paraloc^.size:=int_cgsize(paralen);
begin
paraloc^.size:=int_cgsize(paralen);
if paraloc^.size<>OS_NO then
paraloc^.def:=cgsize_orddef(paraloc^.size)
else
paraloc^.def:=getarraydef(u8inttype,paralen);
end;
else
internalerror(2006011101);
end;
@ -553,6 +598,7 @@ unit cpupara;
end;
paralen := 0;
end;
firstparaloc:=false;
end;
end;
curintreg:=nextintreg;
@ -595,6 +641,7 @@ unit cpupara;
paraloc:=hp.paraloc[callerside].add_location;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=def_cgsize(hp.vardef);
paraloc^.def:=hp.vardef;
paraloc^.reference.index:=NR_STACK_POINTER_REG;
l:=push_size(hp.varspez,hp.vardef,p.proccalloption);
paraloc^.reference.offset:=parasize;
@ -623,6 +670,7 @@ unit cpupara;
paraloc:=p.paraloc[callerside].add_location;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=paracgsize;
paraloc^.def:=p.vardef;
paraloc^.reference.index:=newreg(R_INTREGISTER,RS_R2,R_SUBWHOLE);
{ pattern is always uppercase'd }
if s='D0' then
@ -667,6 +715,7 @@ unit cpupara;
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.size:=OS_ADDR;
paraloc^.def:=voidpointertype;
paraloc^.register:=NR_R12;
end
else

56
compiler/powerpc64/cpupara.pas
View File

@ -80,17 +80,22 @@ end;
procedure tppcparamanager.getintparaloc(pd : tabstractprocdef; nr: longint; var cgpara: tcgpara);
var
paraloc: pcgparalocation;
def: tdef;
psym: tparavarsym;
pdef: tdef;
begin
def:=tparavarsym(pd.paras[nr-1]).vardef;
psym:=tparavarsym(pd.paras[nr-1]);
pdef:=psym.vardef;
if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
pdef:=getpointerdef(pdef);
cgpara.reset;
cgpara.size := def_cgsize(def);
cgpara.size := def_cgsize(pdef);
cgpara.intsize := tcgsize2size[cgpara.size];
cgpara.alignment := get_para_align(pd.proccalloption);
cgpara.def:=def;
cgpara.def:=pdef;
paraloc := cgpara.add_location;
with paraloc^ do begin
size := OS_INT;
size := def_cgsize(pdef);
def := pdef;
if (nr <= 8) then begin
if (nr = 0) then
internalerror(200309271);
@ -219,6 +224,7 @@ begin
paraloc^.loc:=LOC_FPUREGISTER;
paraloc^.register:=NR_FPU_RESULT_REG;
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else
{ Return in register }
@ -229,6 +235,7 @@ begin
else
paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end;
end;
@ -255,6 +262,7 @@ var
stack_offset: longint;
paralen: aint;
nextintreg, nextfloatreg, nextmmreg : tsuperregister;
locdef,
paradef: tdef;
paraloc: pcgparalocation;
i: integer;
@ -263,6 +271,7 @@ var
paracgsize: tcgsize;
parashift : byte;
firstparaloc,
adjusttail: boolean;
begin
@ -295,6 +304,7 @@ begin
paraloc^.loc := LOC_REGISTER;
paraloc^.register := NR_R0;
paraloc^.size := OS_ADDR;
paraloc^.def := voidpointertype;
break;
end;
@ -359,6 +369,8 @@ begin
end else
internalerror(2005011310);
adjusttail:=paralen>8;
locdef:=paradef;
firstparaloc:=true;
{ can become < 0 for e.g. 3-byte records }
while (paralen > 0) do begin
paraloc := hp.paraloc[side].add_location;
@ -373,7 +385,10 @@ begin
{ make sure we don't lose whether or not the type is signed }
if (paracgsize <> OS_NO) and (paradef.typ <> orddef) then
paracgsize := int_cgsize(paralen);
begin
paracgsize := int_cgsize(paralen);
locdef:=get_paraloc_def(paradef,paracgsize,paralen,firstparaloc);
end;
{ aix requires that record data (including partial data) stored in
parameter registers is left-aligned. Other targets only do this if
@ -385,11 +400,18 @@ begin
begin
paraloc^.shiftval := (sizeof(aint)-paralen)*(-8);
paraloc^.size := OS_INT;
paraloc^.def := u64inttype;
end
else if (paracgsize in [OS_NO,OS_128,OS_S128]) then
paraloc^.size := OS_INT
begin
paraloc^.size := OS_INT;
paraloc^.def := osuinttype;
end
else
paraloc^.size := paracgsize;
begin
paraloc^.size := paracgsize;
paraloc^.def := locdef;
end;
paraloc^.register := newreg(R_INTREGISTER, nextintreg, R_SUBNONE);
inc(nextintreg);
@ -400,6 +422,7 @@ begin
(nextfloatreg <= RS_F13) then begin
paraloc^.loc := loc;
paraloc^.size := paracgsize;
paraloc^.def := locdef;
paraloc^.register := newreg(R_FPUREGISTER, nextfloatreg, R_SUBWHOLE);
{ the PPC64 ABI says that the GPR index is increased for every parameter, no matter
which type it is stored in }
@ -417,10 +440,21 @@ begin
paraloc^.loc := LOC_REFERENCE;
case loc of
LOC_FPUREGISTER:
paraloc^.size:=int_float_cgsize(paralen);
begin
paraloc^.size:=int_float_cgsize(paralen);
case paraloc^.size of
OS_F32: paraloc^.def:=s32floattype;
OS_F64: paraloc^.def:=s64floattype;
else
internalerror(2013060122);
end;
end;
LOC_REGISTER,
LOC_REFERENCE:
paraloc^.size:=int_cgsize(paralen);
begin
paraloc^.size:=int_cgsize(paralen);
paraloc^.def:=get_paraloc_def(paradef,paraloc^.size,paralen,firstparaloc);
end;
else
internalerror(2006011101);
end;
@ -440,6 +474,7 @@ begin
inc(stack_offset, align(paralen, 8));
paralen := 0;
end;
firstparaloc:=false;
end;
end;
@ -480,6 +515,7 @@ begin
paraloc := hp.paraloc[callerside].add_location;
paraloc^.loc := LOC_REFERENCE;
paraloc^.size := def_cgsize(hp.vardef);
paraloc^.def := hp.vardef;
paraloc^.reference.index := NR_STACK_POINTER_REG;
l := push_size(hp.varspez, hp.vardef, p.proccalloption);
paraloc^.reference.offset := parasize;

30
compiler/sparc/cpupara.pas
View File

@ -77,16 +77,20 @@ implementation
procedure TSparcParaManager.GetIntParaLoc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
def : tdef;
psym: tparavarsym;
pdef: tdef;
begin
if nr<1 then
InternalError(2002100806);
def:=tparavarsym(pd.paras[nr-1]).vardef;
psym:=tparavarsym(pd.paras[nr-1]);
pdef:=psym.vardef;
if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
pdef:=getpointerdef(pdef);
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.size:=def_cgsize(pdef);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=std_param_align;
cgpara.def:=def;
cgpara.def:=pdef;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
@ -104,7 +108,8 @@ implementation
reference.index:=NR_STACK_POINTER_REG;
reference.offset:=92+(nr-6)*4;
end;
size:=OS_INT;
size:=def_cgsize(pdef);
def:=pdef;
end;
end;
@ -158,6 +163,7 @@ implementation
if retcgsize=OS_F64 then
setsubreg(paraloc^.register,R_SUBFD);
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else
{ Return in register }
@ -172,6 +178,7 @@ implementation
else
paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
{ low }
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
@ -180,12 +187,14 @@ implementation
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
@ -224,6 +233,7 @@ implementation
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_G0;
paraloc^.size:=OS_ADDR;
paraloc^.def:=voidpointertype;
break;
end;
@ -257,9 +267,15 @@ implementation
{ 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
paraloc^.size:=OS_32
begin
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
end
else
paraloc^.size:=paracgsize;
begin
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
end;
{ ret in param? }
if vo_is_funcret in hp.varoptions then
begin

412
compiler/x86_64/cpupara.pas
View File

@ -99,7 +99,7 @@ unit cpupara;
MAX_PARA_CLASSES = 4;
type
tx64paraclass = (
tx64paraclasstype = (
X86_64_NO_CLASS,
X86_64_INTEGER_CLASS,X86_64_INTEGERSI_CLASS,
X86_64_SSE_CLASS,X86_64_SSESF_CLASS,X86_64_SSEDF_CLASS,X86_64_SSEUP_CLASS,
@ -107,6 +107,12 @@ unit cpupara;
X86_64_COMPLEX_X87_CLASS,
X86_64_MEMORY_CLASS
);
tx64paraclass = record
def: tdef;
typ: tx64paraclasstype;
end;
tx64paraclasses = array[0..MAX_PARA_CLASSES-1] of tx64paraclass;
{ Win64-specific helper }
@ -120,82 +126,168 @@ unit cpupara;
of this code is to classify each 8bytes of incoming argument by the register
class and assign registers accordingly. *)
function classify_representative_def(def1, def2: tdef): tdef;
var
def1size, def2size: asizeint;
begin
if not assigned(def1) then
result:=def2
else if not assigned(def2) then
result:=def1
else
begin
def1size:=def1.size;
def2size:=def2.size;
if def1size>def2size then
result:=def1
else if def2size>def1size then
result:=def2
else if def1.alignment>def2.alignment then
result:=def1
else
result:=def2;
end;
end;
(* Classify the argument of type TYPE and mode MODE.
CLASSES will be filled by the register class used to pass each word
of the operand. The number of words is returned. In case the parameter
should be passed in memory, 0 is returned. As a special case for zero
sized containers, classes[0] will be NO_CLASS and 1 is returned.
real_size contains either def.size, or a value derived from
def.bitpackedsize and the field offset denoting the number of bytes
spanned by a bitpacked field
See the x86-64 PS ABI for details.
*)
procedure classify_single_integer_class(def: tdef; size,real_size: aint; var cl: tx64paraclass; byte_offset: aint);
begin
if (byte_offset=0) and
(real_size in [1,2,4,8]) and
(not assigned(cl.def) or
(def.alignment>=cl.def.alignment)) then
cl.def:=def;
if size<=4 then
begin
cl.typ:=X86_64_INTEGERSI_CLASS;
if not assigned(cl.def) or
(cl.def.size<size) then
begin
case size of
1: cl.def:=u8inttype;
2: cl.def:=u16inttype;
3,4: cl.def:=u32inttype;
end;
end;
end
else
begin
cl.typ:=X86_64_INTEGER_CLASS;
if not assigned(cl.def) or
(cl.def.size<size) then
cl.def:=u64inttype;
end;
end;
function classify_as_integer_argument(def: tdef; real_size: aint; var classes: tx64paraclasses; byte_offset: aint): longint;
var
size: aint;
begin
size:=byte_offset+real_size;
classify_single_integer_class(def,size,real_size,classes[0],byte_offset);
if size<=8 then
result:=1
else
begin
classify_single_integer_class(def,size-8,real_size,classes[1],byte_offset-8);
if size>16 then
internalerror(2010021401);
result:=2;
end
end;
(* Return the union class of CLASS1 and CLASS2.
See the x86-64 PS ABI for details. *)
function merge_classes(class1, class2: tx64paraclass): tx64paraclass;
begin
(* Rule #1: If both classes are equal, this is the resulting class. *)
if (class1=class2) then
exit(class1);
if (class1.typ=class2.typ) then
begin
result.typ:=class1.typ;
result.def:=classify_representative_def(class1.def,class2.def);
exit;
end;
(* Rule #2: If one of the classes is NO_CLASS, the resulting class is
the other class. *)
if (class1=X86_64_NO_CLASS) then
if (class1.typ=X86_64_NO_CLASS) then
exit(class2);
if (class2=X86_64_NO_CLASS) then
if (class2.typ=X86_64_NO_CLASS) then
exit(class1);
(* Rule #3: If one of the classes is MEMORY, the result is MEMORY. *)
if (class1=X86_64_MEMORY_CLASS) or
(class2=X86_64_MEMORY_CLASS) then
exit(X86_64_MEMORY_CLASS);
if (class1.typ=X86_64_MEMORY_CLASS) then
exit(class1)
else if (class2.typ=X86_64_MEMORY_CLASS) then
exit(class2);
(* Rule #4: If one of the classes is INTEGER, the result is INTEGER. *)
{ 32 bit }
if ((class1=X86_64_INTEGERSI_CLASS) and
(class2=X86_64_SSESF_CLASS)) or
((class2=X86_64_INTEGERSI_CLASS) and
(class1=X86_64_SSESF_CLASS)) then
exit(X86_64_INTEGERSI_CLASS);
if ((class1.typ=X86_64_INTEGERSI_CLASS) and
(class2.typ=X86_64_SSESF_CLASS)) then
exit(class1)
else if ((class2.typ=X86_64_INTEGERSI_CLASS) and
(class1.typ=X86_64_SSESF_CLASS)) then
exit(class2);
{ 64 bit }
if (class1 in [X86_64_INTEGER_CLASS,X86_64_INTEGERSI_CLASS]) or
(class2 in [X86_64_INTEGER_CLASS,X86_64_INTEGERSI_CLASS]) then
exit(X86_64_INTEGER_CLASS);
if (class1.typ in [X86_64_INTEGER_CLASS,X86_64_INTEGERSI_CLASS]) then
begin
result:=class1;
if result.def.size<8 then
begin
result.typ:=X86_64_INTEGER_CLASS;
result.def:=s64inttype;
end;
exit
end
else if (class2.typ in [X86_64_INTEGER_CLASS,X86_64_INTEGERSI_CLASS]) then
begin
result:=class2;
if result.def.size<8 then
begin
result.typ:=X86_64_INTEGER_CLASS;
result.def:=s64inttype;
end;
exit
end;
(* Rule #5: If one of the classes is X87, X87UP, or COMPLEX_X87 class,
MEMORY is used. *)
if (class1 in [X86_64_X87_CLASS,X86_64_X87UP_CLASS,X86_64_COMPLEX_X87_CLASS]) or
(class2 in [X86_64_X87_CLASS,X86_64_X87UP_CLASS,X86_64_COMPLEX_X87_CLASS]) then
exit(X86_64_MEMORY_CLASS);
if (class1.typ in [X86_64_X87_CLASS,X86_64_X87UP_CLASS,X86_64_COMPLEX_X87_CLASS]) then
begin
result:=class1;
result.typ:=X86_64_MEMORY_CLASS;
exit;
end
else if (class2.typ in [X86_64_X87_CLASS,X86_64_X87UP_CLASS,X86_64_COMPLEX_X87_CLASS]) then
begin
result:=class2;
result.typ:=X86_64_MEMORY_CLASS;
exit;
end;
(* Rule #6: Otherwise class SSE is used. *)
result:=X86_64_SSE_CLASS;
end;
(* Classify the argument of type TYPE and mode MODE.
CLASSES will be filled by the register class used to pass each word
of the operand. The number of words is returned. In case the parameter
should be passed in memory, 0 is returned. As a special case for zero
sized containers, classes[0] will be NO_CLASS and 1 is returned.
real_size contains either def.size, or a value derived from
def.bitpackedsize and the field offset denoting the number of bytes
spanned by a bitpacked field
See the x86-64 PS ABI for details.
*)
function classify_as_integer_argument(real_size: aint; var classes: tx64paraclasses; byte_offset: aint): longint;
var
size: aint;
begin
size:=byte_offset+real_size;
if size<=4 then
classes[0]:=X86_64_INTEGERSI_CLASS
if class1.def.size>class2.def.size then
result:=class1
else
classes[0]:=X86_64_INTEGER_CLASS;
if size<=8 then
result:=1
else
begin
if size<=12 then
classes[1]:=X86_64_INTEGERSI_CLASS
else if (size<=16) then
classes[1]:=X86_64_INTEGER_CLASS
else
internalerror(2010021401);
result:=2;
end
result:=class2;
result.typ:=X86_64_SSE_CLASS;
result.def:=getarraydef(s32floattype,2)
end;
@ -211,7 +303,8 @@ unit cpupara;
begin
if aggregate_in_registers_win64(varspez,def.size) then
begin
classes[0]:=X86_64_INTEGER_CLASS;
classes[0].typ:=X86_64_INTEGER_CLASS;
classes[0].def:=def;
result:=1;
end
else
@ -231,14 +324,18 @@ unit cpupara;
signal memory class, so handle it as special case. *)
if (words=0) then
begin
classes[0]:=X86_64_NO_CLASS;
classes[0].typ:=X86_64_NO_CLASS;
classes[0].def:=def;
exit(1);
end;
{ we'll be merging the classes elements with the subclasses
elements, so initialise them first }
for i:=low(classes) to high(classes) do
classes[i]:=X86_64_NO_CLASS;
begin
classes[i].typ:=X86_64_NO_CLASS;
classes[i].def:=nil;
end;
result:=words;
end;
@ -249,6 +346,7 @@ unit cpupara;
i,
pos: longint;
begin
fillchar(subclasses,sizeof(subclasses),0);
result:=classify_argument(def,varspez,real_size,subclasses,new_byte_offset mod 8);
if (result=0) then
exit;
@ -274,38 +372,41 @@ unit cpupara;
X86_64_SSE_CLASS or any other ones aren't
X86_64_SSEUP_CLASS, everything should be passed in
memory. *)
if (classes[0]<>X86_64_SSE_CLASS) then
if (classes[0].typ<>X86_64_SSE_CLASS) then
exit(0);
for i:=1 to words-1 do
if (classes[i]<>X86_64_SSEUP_CLASS) then
if (classes[i].typ<>X86_64_SSEUP_CLASS) then
exit(0);
end;
(* Final merger cleanup. *)
(* The first one must never be X86_64_SSEUP_CLASS or
X86_64_X87UP_CLASS. *)
if (classes[0]=X86_64_SSEUP_CLASS) or
(classes[0]=X86_64_X87UP_CLASS) then
if (classes[0].typ=X86_64_SSEUP_CLASS) or
(classes[0].typ=X86_64_X87UP_CLASS) then
internalerror(2010021402);
for i:=0 to words-1 do
begin
(* If one class is MEMORY, everything should be passed in
memory. *)
if (classes[i]=X86_64_MEMORY_CLASS) then
if (classes[i].typ=X86_64_MEMORY_CLASS) then
exit(0);
(* The X86_64_SSEUP_CLASS should be always preceded by
X86_64_SSE_CLASS or X86_64_SSEUP_CLASS. *)
if (classes[i]=X86_64_SSEUP_CLASS) and
(classes[i-1]<>X86_64_SSE_CLASS) and
(classes[i-1]<>X86_64_SSEUP_CLASS) then
classes[i]:=X86_64_SSE_CLASS;
if (classes[i].typ=X86_64_SSEUP_CLASS) and
(classes[i-1].typ<>X86_64_SSE_CLASS) and
(classes[i-1].typ<>X86_64_SSEUP_CLASS) then
begin
classes[i].typ:=X86_64_SSE_CLASS;
classes[i].def:=getarraydef(s32floattype,2);
end;
(* If X86_64_X87UP_CLASS isn't preceded by X86_64_X87_CLASS,
everything should be passed in memory. *)
if (classes[i]=X86_64_X87UP_CLASS) and
(classes[i-1]<>X86_64_X87_CLASS) then
if (classes[i].typ=X86_64_X87UP_CLASS) and
(classes[i-1].typ<>X86_64_X87_CLASS) then
exit(0);
end;
@ -317,20 +418,32 @@ unit cpupara;
such locations always up to 64 bits, although this loads/stores
some superfluous data }
{ 1) the first part is 32 bit while there is still a second part }
if (classes[1]<>X86_64_NO_CLASS) then
case classes[0] of
if (classes[1].typ<>X86_64_NO_CLASS) then
case classes[0].typ of
X86_64_INTEGERSI_CLASS:
classes[0]:=X86_64_INTEGER_CLASS;
begin
classes[0].typ:=X86_64_INTEGER_CLASS;
classes[0].def:=s64inttype;
end;
X86_64_SSESF_CLASS:
classes[0]:=X86_64_SSE_CLASS;
begin
classes[0].typ:=X86_64_SSE_CLASS;
classes[0].def:=getarraydef(s32floattype,2);
end;
end;
{ 2) the second part is 32 bit, but the total size is > 12 bytes }
if (def.size>12) then
case classes[1] of
case classes[1].typ of
X86_64_INTEGERSI_CLASS:
classes[1]:=X86_64_INTEGER_CLASS;
begin
classes[1].typ:=X86_64_INTEGER_CLASS;
classes[1].def:=s64inttype;
end;
X86_64_SSESF_CLASS:
classes[1]:=X86_64_SSE_CLASS;
begin
classes[1].typ:=X86_64_SSE_CLASS;
classes[1].def:=getarraydef(s32floattype,2);
end;
end;
result:=words;
@ -466,44 +579,51 @@ unit cpupara;
enumdef,
pointerdef,
classrefdef:
result:=classify_as_integer_argument(real_size,classes,byte_offset);
result:=classify_as_integer_argument(def,real_size,classes,byte_offset);
formaldef:
result:=classify_as_integer_argument(voidpointertype.size,classes,byte_offset);
result:=classify_as_integer_argument(voidpointertype,voidpointertype.size,classes,byte_offset);
floatdef:
begin
classes[0].def:=def;
case tfloatdef(def).floattype of
s32real:
begin
if byte_offset=0 then
classes[0]:=X86_64_SSESF_CLASS
classes[0].typ:=X86_64_SSESF_CLASS
else
{ if we have e.g. a record with two successive "single"
fields, we need a 64 bit rather than a 32 bit load }
classes[0]:=X86_64_SSE_CLASS;
begin
{ if we have e.g. a record with two successive "single"
fields, we need a 64 bit rather than a 32 bit load }
classes[0].typ:=X86_64_SSE_CLASS;
classes[0].def:=getarraydef(s32floattype,2);
end;
result:=1;
end;
s64real:
begin
classes[0]:=X86_64_SSEDF_CLASS;
classes[0].typ:=X86_64_SSEDF_CLASS;
result:=1;
end;
s80real,
sc80real:
begin
classes[0]:=X86_64_X87_CLASS;
classes[1]:=X86_64_X87UP_CLASS;
classes[0].typ:=X86_64_X87_CLASS;
classes[1].typ:=X86_64_X87UP_CLASS;
classes[1].def:=def;
result:=2;
end;
s64comp,
s64currency:
begin
classes[0]:=X86_64_INTEGER_CLASS;
classes[0].typ:=X86_64_INTEGER_CLASS;
result:=1;
end;
s128real:
begin
classes[0]:=X86_64_SSE_CLASS;
classes[1]:=X86_64_SSEUP_CLASS;
classes[0].typ:=X86_64_SSE_CLASS;
classes[0].def:=getarraydef(s32floattype,2);
classes[1].typ:=X86_64_SSEUP_CLASS;
classes[1].def:=getarraydef(s32floattype,2);
result:=2;
end;
else
@ -519,12 +639,12 @@ unit cpupara;
result:=0
else
{ all kinds of pointer types: class, objcclass, interface, ... }
result:=classify_as_integer_argument(voidpointertype.size,classes,byte_offset);
result:=classify_as_integer_argument(def,voidpointertype.size,classes,byte_offset);
end;
setdef:
begin
if is_smallset(def) then
result:=classify_as_integer_argument(def.size,classes,byte_offset)
result:=classify_as_integer_argument(def,def.size,classes,byte_offset)
else
result:=0;
end;
@ -533,13 +653,13 @@ unit cpupara;
if (tstringdef(def).stringtype in [st_shortstring,st_longstring]) then
result:=0
else
result:=classify_as_integer_argument(def.size,classes,byte_offset);
result:=classify_as_integer_argument(def,def.size,classes,byte_offset);
end;
arraydef:
begin
{ a dynamic array is treated like a pointer }
if is_dynamic_array(def) then
result:=classify_as_integer_argument(voidpointertype.size,classes,byte_offset)
result:=classify_as_integer_argument(def,voidpointertype.size,classes,byte_offset)
{ other special arrays are passed on the stack }
else if is_open_array(def) or
is_array_of_const(def) then
@ -561,7 +681,7 @@ unit cpupara;
end
else
{ pointer }
result:=classify_as_integer_argument(def.size,classes,byte_offset);
result:=classify_as_integer_argument(def,def.size,classes,byte_offset);
end;
variantdef:
begin
@ -585,7 +705,10 @@ unit cpupara;
{ init the classes array, because even if classify_argument inits only
one element we copy both to loc1/loc2 in case "1" is returned }
for i:=low(classes) to high(classes) do
classes[i]:=X86_64_NO_CLASS;
begin
classes[i].typ:=X86_64_NO_CLASS;
classes[i].def:=nil;
end;
{ def.size internalerrors for open arrays and dynamic arrays, since
their size cannot be determined at compile-time.
classify_argument does not look at the realsize argument for arrays
@ -598,16 +721,17 @@ unit cpupara;
case numclasses of
0:
begin
loc1:=X86_64_MEMORY_CLASS;
loc2:=X86_64_NO_CLASS;
loc1.typ:=X86_64_MEMORY_CLASS;
loc1.def:=def;
loc2.typ:=X86_64_NO_CLASS;
end;
1,2:
begin
{ If the class is X87, X87UP or COMPLEX_X87, it is passed in memory }
if classes[0] in [X86_64_X87_CLASS,X86_64_X87UP_CLASS,X86_64_COMPLEX_X87_CLASS] then
classes[0]:=X86_64_MEMORY_CLASS;
if classes[1] in [X86_64_X87_CLASS,X86_64_X87UP_CLASS,X86_64_COMPLEX_X87_CLASS] then
classes[1]:=X86_64_MEMORY_CLASS;
if classes[0].typ in [X86_64_X87_CLASS,X86_64_X87UP_CLASS,X86_64_COMPLEX_X87_CLASS] then
classes[0].typ:=X86_64_MEMORY_CLASS;
if classes[1].typ in [X86_64_X87_CLASS,X86_64_X87UP_CLASS,X86_64_COMPLEX_X87_CLASS] then
classes[1].typ:=X86_64_MEMORY_CLASS;
loc1:=classes[0];
loc2:=classes[1];
end
@ -625,6 +749,7 @@ unit cpupara;
begin
if handle_common_ret_in_param(def,pd,result) then
exit;
fillchar(classes,sizeof(classes),0);
case def.typ of
{ for records it depends on their contents and size }
recorddef,
@ -667,6 +792,7 @@ unit cpupara;
classes: tx64paraclasses;
numclasses: longint;
begin
fillchar(classes,sizeof(classes),0);
result:=false;
{ var,out,constref always require address }
if varspez in [vs_var,vs_out,vs_constref] then
@ -766,18 +892,23 @@ unit cpupara;
procedure tx86_64paramanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
def : tdef;
psym : tparavarsym;
pdef : tdef;
begin
def:=tparavarsym(pd.paras[nr-1]).vardef;
psym:=tparavarsym(pd.paras[nr-1]);
pdef:=psym.vardef;
if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
pdef:=getpointerdef(pdef);
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.size:=def_cgsize(pdef);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=get_para_align(pd.proccalloption);
cgpara.def:=def;
cgpara.def:=pdef;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
size:=OS_INT;
size:=def_cgsize(pdef);
paraloc^.def:=pdef;
if target_info.system=system_x86_64_win64 then
begin
if nr<1 then
@ -785,7 +916,7 @@ unit cpupara;
else if nr<=high(paraintsupregs_winx64)+1 then
begin
loc:=LOC_REGISTER;
register:=newreg(R_INTREGISTER,paraintsupregs_winx64[nr-1],R_SUBWHOLE);
register:=newreg(R_INTREGISTER,paraintsupregs_winx64[nr-1],cgsize2subreg(R_INTREGISTER,size));
end
else
begin
@ -801,7 +932,7 @@ unit cpupara;
else if nr<=high(paraintsupregs)+1 then
begin
loc:=LOC_REGISTER;
register:=newreg(R_INTREGISTER,paraintsupregs[nr-1],R_SUBWHOLE);
register:=newreg(R_INTREGISTER,paraintsupregs[nr-1],cgsize2subreg(R_INTREGISTER,size));
end
else
begin
@ -847,6 +978,7 @@ unit cpupara;
if result.def.typ=floatdef then
begin
paraloc:=result.add_location;
paraloc^.def:=result.def;
case tfloatdef(result.def).floattype of
s32real:
begin
@ -878,6 +1010,7 @@ unit cpupara;
else
{ Return in register }
begin
fillchar(classes,sizeof(classes),0);
numclasses:=classify_argument(result.def,vs_value,result.def.size,classes,0);
{ this would mean a memory return }
if (numclasses=0) then
@ -890,18 +1023,30 @@ unit cpupara;
for i:=0 to numclasses-1 do
begin
paraloc:=result.add_location;
case classes[i] of
paraloc^.def:=classes[i].def;
case classes[i].typ of
X86_64_INTEGERSI_CLASS,
X86_64_INTEGER_CLASS:
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=intretregs[intretregidx];
if classes[i]=X86_64_INTEGER_CLASS then
paraloc^.size:=OS_64
if classes[i].typ=X86_64_INTEGER_CLASS then
begin
paraloc^.size:=OS_64;
if paraloc^.def.size<>8 then
paraloc^.def:=u64inttype;
end
else if result.intsize in [1,2,4] then
paraloc^.size:=retcgsize
begin
paraloc^.size:=retcgsize;
paraloc^.def:=result.def;
end
else
paraloc^.size:=OS_32;
begin
paraloc^.size:=OS_32;
if paraloc^.def.size<>4 then
paraloc^.def:=u32inttype;
end;
setsubreg(paraloc^.register,cgsize2subreg(R_INTREGISTER,paraloc^.size));
inc(intretregidx);
end;
@ -912,7 +1057,7 @@ unit cpupara;
begin
paraloc^.loc:=LOC_MMREGISTER;
paraloc^.register:=mmretregs[mmretregidx];
case classes[i] of
case classes[i].typ of
X86_64_SSESF_CLASS:
begin
setsubreg(paraloc^.register,R_SUBMMS);
@ -938,6 +1083,7 @@ unit cpupara;
(numclasses<>1) then
internalerror(2010060302);
paraloc^.loc:=LOC_VOID;
paraloc^.def:=voidtype;
end;
else
internalerror(2010021504);
@ -974,11 +1120,12 @@ unit cpupara;
pushaddr:=push_addr_param(hp.varspez,paradef,p.proccalloption);
if pushaddr then
begin
loc[1]:=X86_64_INTEGER_CLASS;
loc[2]:=X86_64_NO_CLASS;
loc[1].typ:=X86_64_INTEGER_CLASS;
loc[2].typ:=X86_64_NO_CLASS;
paracgsize:=OS_ADDR;
paralen:=sizeof(pint);
paradef:=getpointerdef(paradef);
loc[1].def:=paradef;
end
else
begin
@ -993,6 +1140,7 @@ unit cpupara;
paracgsize:=OS_S32;
paralen:=4;
paradef:=s32inttype;
loc[1].def:=paradef;
end;
end;
@ -1001,19 +1149,20 @@ unit cpupara;
(target_info.system = system_x86_64_win64) and
(paradef.typ = floatdef) then
begin
loc[2]:=X86_64_NO_CLASS;
loc[2].typ:=X86_64_NO_CLASS;
if paracgsize=OS_F64 then
begin
loc[1]:=X86_64_INTEGER_CLASS;
loc[1].typ:=X86_64_INTEGER_CLASS;
paracgsize:=OS_64;
paradef:=u64inttype;
end
else
begin
loc[1]:=X86_64_INTEGERSI_CLASS;
loc[1].typ:=X86_64_INTEGERSI_CLASS;
paracgsize:=OS_32;
paradef:=u32inttype;
end;
loc[1].def:=paradef;
end;
hp.paraloc[side].reset;
@ -1027,7 +1176,7 @@ unit cpupara;
needintloc:=0;
needmmloc:=0;
for locidx:=low(loc) to high(loc) do
case loc[locidx] of
case loc[locidx].typ of
X86_64_INTEGER_CLASS,
X86_64_INTEGERSI_CLASS:
inc(needintloc);
@ -1048,9 +1197,10 @@ unit cpupara;
{ If there are no registers available for any
eightbyte of an argument, the whole argument is
passed on the stack. }
loc[low(loc)]:=X86_64_MEMORY_CLASS;
loc[low(loc)].typ:=X86_64_MEMORY_CLASS;
loc[low(loc)].def:=paradef;
for locidx:=succ(low(loc)) to high(loc) do
loc[locidx]:=X86_64_NO_CLASS;
loc[locidx].typ:=X86_64_NO_CLASS;
end;
locidx:=1;
@ -1059,31 +1209,38 @@ unit cpupara;
if locidx>2 then
internalerror(200501283);
{ Allocate }
case loc[locidx] of
case loc[locidx].typ of
X86_64_INTEGER_CLASS,
X86_64_INTEGERSI_CLASS:
begin
paraloc:=hp.paraloc[side].add_location;
paraloc^.loc:=LOC_REGISTER;
if (paracgsize=OS_NO) or (loc[2]<>X86_64_NO_CLASS) then
paraloc^.def:=loc[locidx].def;
if (paracgsize=OS_NO) or (loc[2].typ<>X86_64_NO_CLASS) then
begin
if loc[locidx]=X86_64_INTEGER_CLASS then
if loc[locidx].typ=X86_64_INTEGER_CLASS then
begin
paraloc^.size:=OS_INT;
paraloc^.def:=u64inttype;
subreg:=R_SUBWHOLE;
end
else
begin
paraloc^.size:=OS_32;
paraloc^.def:=u32inttype;
subreg:=R_SUBD;
end;
end
else
begin
paraloc^.size:=paracgsize;
paraloc^.def:=paradef;
{ s64comp is pushed in an int register }
if paraloc^.size=OS_C64 then
paraloc^.size:=OS_64;
begin
paraloc^.size:=OS_64;
paraloc^.def:=u64inttype;
end;
subreg:=cgsize2subreg(R_INTREGISTER,paraloc^.size);
end;
@ -1107,8 +1264,9 @@ unit cpupara;
begin
paraloc:=hp.paraloc[side].add_location;
paraloc^.loc:=LOC_MMREGISTER;
paraloc^.def:=loc[locidx].def;
case loc[locidx] of
case loc[locidx].typ of
X86_64_SSESF_CLASS:
begin
subreg:=R_SUBMMS;
@ -1143,6 +1301,7 @@ unit cpupara;
begin
paraloc:=hp.paraloc[side].add_location;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.def:=loc[locidx].def;
{Hack alert!!! We should modify int_cgsize to handle OS_128,
however, since int_cgsize is called in many places in the
compiler where only a few can already handle OS_128, fixing it
@ -1171,7 +1330,7 @@ unit cpupara;
internalerror(2010053113);
end;
if (locidx<2) and
(loc[locidx+1]<>X86_64_NO_CLASS) then
(loc[locidx+1].typ<>X86_64_NO_CLASS) then
inc(locidx);
end;
end
@ -1179,6 +1338,7 @@ unit cpupara;
begin
paraloc:=hp.paraloc[side].add_location;
paraloc^.loc:=LOC_VOID;
paraloc^.def:=paradef;
end;
end;
{ Register parameters are assigned from left-to-right, but the