paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-17 13:58:16 +02:00
Code Issues Packages Projects Releases Wiki Activity
f1ae6fb6d4
fpc/compiler/arm/cpupara.pas
florian 8a9758c5e2 * logs truncated
2004-06-20 08:55:28 +00:00

462 lines
16 KiB
ObjectPascal
Raw Blame History

{
$Id$
Copyright (c) 2003 by Florian Klaempfl
ARM specific calling conventions
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
{ ARM specific calling conventions are handled by this unit
}
unit cpupara;
{$i fpcdefs.inc}
interface
uses
globtype,
aasmtai,
cpuinfo,cpubase,cgbase,
symconst,symbase,symtype,symdef,paramgr;
type
tarmparamanager = class(tparamanager)
function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
procedure alloctempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var locpara:tparalocation);override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;override;
private
procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; firstpara: tparaitem;
var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
end;
implementation
uses
verbose,systems,
rgobj,
defutil,symsym;
function tarmparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
begin
result:=VOLATILE_INTREGISTERS;
end;
function tarmparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
begin
result:=VOLATILE_FPUREGISTERS;
end;
function tarmparamanager.getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;
begin
fillchar(result,sizeof(tparalocation),0);
result.lochigh:=LOC_INVALID;
if nr<1 then
internalerror(2002070801)
else if nr<=4 then
begin
result.loc:=LOC_REGISTER;
result.register:=newreg(R_INTREGISTER,RS_R0+nr-1,R_SUBWHOLE);
end
else
begin
result.loc:=LOC_REFERENCE;
result.reference.index:=NR_STACK_POINTER_REG;
result.reference.offset:=(nr-5)*4;
end;
result.size := OS_INT;
end;
function getparaloc(calloption : tproccalloption; p : tdef) : tcgloc;
begin
{ Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
if push_addr_param for the def is true
}
case p.deftype of
orddef:
getparaloc:=LOC_REGISTER;
floatdef:
if calloption=pocall_softfloat then
getparaloc:=LOC_REGISTER
else
getparaloc:=LOC_FPUREGISTER;
enumdef:
getparaloc:=LOC_REGISTER;
pointerdef:
getparaloc:=LOC_REGISTER;
formaldef:
getparaloc:=LOC_REGISTER;
classrefdef:
getparaloc:=LOC_REGISTER;
recorddef:
getparaloc:=LOC_REFERENCE;
objectdef:
if is_object(p) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
stringdef:
if is_shortstring(p) or is_longstring(p) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
procvardef:
if (po_methodpointer in tprocvardef(p).procoptions) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
filedef:
getparaloc:=LOC_REGISTER;
arraydef:
getparaloc:=LOC_REFERENCE;
setdef:
if is_smallset(p) then
getparaloc:=LOC_REGISTER
else
getparaloc:=LOC_REFERENCE;
variantdef:
getparaloc:=LOC_REFERENCE;
{ avoid problems with errornous definitions }
errordef:
getparaloc:=LOC_REGISTER;
else
internalerror(2002071001);
end;
end;
function tarmparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
begin
if varspez in [vs_var,vs_out] then
begin
result:=true;
exit;
end;
case def.deftype of
recorddef:
result:=true;
arraydef:
result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
is_open_array(def) or
is_array_of_const(def) or
is_array_constructor(def);
setdef :
result:=(tsetdef(def).settype<>smallset);
stringdef :
result:=tstringdef(def).string_typ in [st_shortstring,st_longstring];
procvardef :
result:=po_methodpointer in tprocvardef(def).procoptions;
else
result:=inherited push_addr_param(varspez,def,calloption);
end;
end;
procedure tarmparamanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
begin
curintreg:=RS_R0;
curfloatreg:=RS_F0;
curmmreg:=RS_D0;
cur_stack_offset:=0;
end;
function tarmparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; firstpara: tparaitem;
var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
var
nextintreg,nextfloatreg,nextmmreg : tsuperregister;
paradef : tdef;
paraloc : tparalocation;
stack_offset : aword;
hp : tparaitem;
loc : tcgloc;
is_64bit: boolean;
procedure assignintreg;
begin
if nextintreg<=ord(NR_R3) then
begin
paraloc.loc:=LOC_REGISTER;
paraloc.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
inc(nextintreg);
end
else
begin
paraloc.loc:=LOC_REFERENCE;
paraloc.reference.index:=NR_STACK_POINTER_REG;
paraloc.reference.offset:=stack_offset;
inc(stack_offset,4);
end;
end;
begin
result:=0;
nextintreg:=curintreg;
nextfloatreg:=curfloatreg;
nextmmreg:=curmmreg;
stack_offset:=cur_stack_offset;
hp:=firstpara;
while assigned(hp) do
begin
if (hp.paratyp in [vs_var,vs_out]) then
begin
paradef:=voidpointertype.def;
loc:=LOC_REGISTER;
end
else
begin
paradef:=hp.paratype.def;
loc:=getparaloc(p.proccalloption,paradef);
end;
{ make sure all alignment bytes are 0 as well }
fillchar(paraloc,sizeof(paraloc),0);
paraloc.lochigh:=LOC_INVALID;
case loc of
LOC_REGISTER:
begin
paraloc.size := def_cgsize(paradef);
{ for things like formaldef }
if paraloc.size = OS_NO then
paraloc.size := OS_ADDR;
is_64bit := paraloc.size in [OS_64,OS_S64,OS_F64];
{ this is not abi compliant }
if nextintreg<=(RS_R3-ord(is_64bit)) then
begin
paraloc.loc:=LOC_REGISTER;
paraloc.registerlow:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
inc(nextintreg);
if is_64bit then
begin
paraloc.lochigh:=LOC_REGISTER;
paraloc.registerhigh:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
inc(nextintreg);
end;
end
else
begin
nextintreg:=RS_R4;
paraloc.loc:=LOC_REFERENCE;
paraloc.reference.index:=NR_STACK_POINTER_REG;
paraloc.reference.offset:=stack_offset;
if not is_64bit then
inc(stack_offset,4)
else
inc(stack_offset,8);
end;
end;
LOC_FPUREGISTER:
begin
paraloc.size:=def_cgsize(paradef);
if nextfloatreg<=RS_F3 then
begin
paraloc.loc:=LOC_FPUREGISTER;
paraloc.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE);
inc(nextfloatreg);
end
else
begin
paraloc.size:=def_cgsize(paradef);
nextintreg:=RS_F4;
paraloc.loc:=LOC_REFERENCE;
paraloc.reference.index:=NR_STACK_POINTER_REG;
paraloc.reference.offset:=stack_offset;
case paraloc.size of
OS_F32:
inc(stack_offset,4);
OS_F64:
inc(stack_offset,8);
OS_F80:
inc(stack_offset,10);
OS_F128:
inc(stack_offset,16);
else
internalerror(200403201);
end;
end;
end;
LOC_REFERENCE:
begin
paraloc.size:=OS_ADDR;
if push_addr_param(hp.paratyp,paradef,p.proccalloption) or
is_open_array(paradef) or
is_array_of_const(paradef) then
assignintreg
else
begin
paraloc.loc:=LOC_REFERENCE;
paraloc.reference.index:=NR_STACK_POINTER_REG;
paraloc.reference.offset:=stack_offset;
inc(stack_offset,hp.paratype.def.size);
end;
end;
else
internalerror(2002071002);
end;
if side=calleeside then
begin
if paraloc.loc=LOC_REFERENCE then
begin
paraloc.reference.index:=NR_FRAME_POINTER_REG;
inc(paraloc.reference.offset,4);
end;
end;
hp.paraloc[side]:=paraloc;
hp:=tparaitem(hp.next);
end;
curintreg:=nextintreg;
curfloatreg:=nextfloatreg;
curmmreg:=nextmmreg;
cur_stack_offset:=stack_offset;
result:=cur_stack_offset;
end;
function tarmparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
var
paraloc : tparalocation;
cur_stack_offset: aword;
curintreg, curfloatreg, curmmreg: tsuperregister;
begin
init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
result:=create_paraloc_info_intern(p,side,tparaitem(p.para.first),curintreg,curfloatreg,curmmreg,cur_stack_offset);
{ Function return }
fillchar(paraloc,sizeof(tparalocation),0);
paraloc.lochigh:=LOC_INVALID;
paraloc.size:=def_cgsize(p.rettype.def);
{ Return in FPU register? }
if p.rettype.def.deftype=floatdef then
begin
paraloc.loc:=LOC_FPUREGISTER;
paraloc.register:=NR_FPU_RESULT_REG;
end
else
{ Return in register? }
if not ret_in_param(p.rettype.def,p.proccalloption) then
begin
paraloc.loc:=LOC_REGISTER;
if paraloc.size in [OS_64,OS_S64] then
begin
paraloc.lochigh:=LOC_REGISTER;
paraloc.register:=NR_FUNCTION_RETURN64_LOW_REG;
paraloc.registerhigh:=NR_FUNCTION_RETURN64_HIGH_REG;
end
else
paraloc.register:=NR_FUNCTION_RETURN_REG;
end
else
begin
paraloc.loc:=LOC_REFERENCE;
end;
p.funcret_paraloc[side]:=paraloc;
end;
procedure tarmparamanager.alloctempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var locpara:tparalocation);
var
href : treference;
begin
if (paraitem.paratyp in [vs_var,vs_out]) then
locpara.loc:=LOC_REGISTER
else
begin
locpara.loc:=getparaloc(calloption,paraitem.paratype.def);
if (locpara.loc=LOC_REGISTER) and (def_cgsize(paraitem.paratype.def) in [OS_64,OS_S64,OS_F64]) then
locpara.lochigh:=LOC_REGISTER;
end;
if locpara.loc=LOC_REFERENCE then
inherited alloctempparaloc(list,calloption,paraitem,locpara)
else
alloctempregs(list,locpara);
end;
function tarmparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;
var
cur_stack_offset: aword;
parasize, l: longint;
curintreg, curfloatreg, curmmreg: tsuperregister;
hp: tparaitem;
paraloc: tparalocation;
begin
init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
result:=create_paraloc_info_intern(p,callerside,tparaitem(p.para.first),curintreg,curfloatreg,curmmreg,cur_stack_offset);
if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
{ just continue loading the parameters in the registers }
result:=create_paraloc_info_intern(p,callerside,tparaitem(varargspara.first),curintreg,curfloatreg,curmmreg,cur_stack_offset)
else
begin
hp:=tparaitem(varargspara.first);
parasize:=cur_stack_offset;
while assigned(hp) do
begin
paraloc.size:=def_cgsize(hp.paratype.def);
paraloc.lochigh:=LOC_INVALID;
paraloc.loc:=LOC_REFERENCE;
paraloc.alignment:=4;
paraloc.reference.index:=NR_STACK_POINTER_REG;
l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
paraloc.reference.offset:=parasize;
parasize:=parasize+l;
hp.paraloc[callerside]:=paraloc;
hp:=tparaitem(hp.next);
end;
result := parasize;
end;
end;
begin
paramanager:=tarmparamanager.create;
end.
{
$Log$
Revision 1.19 2004-06-20 08:55:31 florian
* logs truncated
Revision 1.18 2004/06/16 20:07:10 florian
* dwarf branch merged
Revision 1.17.2.1 2004/06/13 20:38:38 florian
* fixed floating point register spilling on sparc
Revision 1.17 2004/03/20 21:11:01 florian
+ float parameters can be on the stack now as well
Revision 1.16 2004/03/20 20:55:36 florian
+ implemented cdecl'd varargs on arm
+ -dCMEM supported by the compiler
* label/goto asmsymbol type with -dextdebug fixed
Revision 1.15 2004/03/07 00:16:59 florian
* compilation of arm rtl fixed
}
Reference in New Issue View Git Blame Copy Permalink