paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-16 12:02:33 +02:00
Code Issues Packages Projects Releases Wiki Activity
df01446f42
fpc/compiler/avr/cpupara.pas
Jonas Maebe 57bd6d2685 + merged nestedprocvars branch 
+ support for nested procedural variables:
    o activate using {$modeswitch nestedprocvars} (compatible with all
      regular syntax modes, enabled by default for MacPas mode)
    o activating this mode switch changes the way the frame pointer is
      passed to nested routines into the same way that Delphi uses (always
      passed via the stack, and if necessary removed from the stack by
      the caller) -- Todo: possibly also allow using this parameter
      passing convention without enabling nested procvars, maybe even
      by default in Delphi mode, see mantis #9432
    o both global and nested routines can be passed to/assigned to a
      nested procvar (and called via them). Note that converting global
      *procvars* to nested procvars is intentionally not supported, so
      that this functionality can also be implemented via compile-time
      generated trampolines if necessary (e.g. for LLVM or CIL backends
      as long as they don't support the aforementioned parameter passing
      convention)
    o a nested procvar can both be declared using a Mac/ISO Pascal style
      "inline" type declaration as a parameter type, or as a stand-alone
      type (in the latter case, add "is nested" at the end in analogy to
      "of object" for method pointers -- note that using variables of
      such a type is dangerous, because if you call them once the enclosing
      stack frame no longer exists on the stack, the results are
      undefined; this is however allowed for Metaware Pascal compatibility)

git-svn-id: trunk@15694 -
2010-08-02 22:20:36 +00:00

529 lines
19 KiB
ObjectPascal
Raw Blame History

{
Copyright (c) 2008 by Florian Klaempfl
AVR specific calling conventions, it follows the GCC AVR 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,globals,
aasmtai,aasmdata,
cpuinfo,cpubase,cgbase,cgutils,
symconst,symbase,symtype,symdef,parabase,paramgr;
type
tavrparamanager = 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 ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override;
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);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; def: tdef): tcgpara;override;
private
procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
end;
implementation
uses
verbose,systems,
rgobj,
defutil,symsym;
function tavrparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
begin
result:=VOLATILE_INTREGISTERS;
end;
function tavrparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
begin
result:=VOLATILE_FPUREGISTERS;
end;
procedure tavrparamanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);
var
paraloc : pcgparalocation;
begin
if nr<1 then
internalerror(2002070801);
cgpara.reset;
cgpara.size:=OS_INT;
cgpara.intsize:=tcgsize2size[OS_INT];
cgpara.alignment:=std_param_align;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
size:=OS_INT;
{ the four first parameters are passed into registers }
if nr<=4 then
begin
loc:=LOC_REGISTER;
register:=newreg(R_INTREGISTER,RS_R0+nr-1,R_SUBWHOLE);
end
else
begin
{ the other parameters are passed on the stack }
loc:=LOC_REFERENCE;
reference.index:=NR_STACK_POINTER_REG;
reference.offset:=(nr-5)*4;
end;
end;
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.typ of
orddef:
getparaloc:=LOC_REGISTER;
floatdef:
if (calloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) 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_REGISTER;
objectdef:
getparaloc:=LOC_REGISTER;
stringdef:
if is_shortstring(p) or is_longstring(p) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
procvardef:
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_REGISTER;
{ avoid problems with errornous definitions }
errordef:
getparaloc:=LOC_REGISTER;
else
internalerror(2002071001);
end;
end;
function tavrparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
begin
result:=false;
if varspez in [vs_var,vs_out] then
begin
result:=true;
exit;
end;
case def.typ of
objectdef:
result:=is_object(def) and ((varspez=vs_const) or (def.size=0));
recorddef:
result:=(varspez=vs_const) or (def.size=0);
variantdef,
formaldef:
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:=not is_smallset(def);
stringdef :
result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
end;
end;
function tavrparamanager.ret_in_param(def : tdef;calloption : tproccalloption) : boolean;
begin
case def.typ of
recorddef:
{ this is how gcc 4.0.4 on linux seems to do it, it doesn't look like being
ARM ABI standard compliant
}
result:=not((trecorddef(def).symtable.SymList.count=1) and
not(ret_in_param(tabstractvarsym(trecorddef(def).symtable.SymList[0]).vardef,calloption)));
{
objectdef
arraydef:
result:=not(def.size in [1,2,4]);
}
else
result:=inherited ret_in_param(def,calloption);
end;
end;
procedure tavrparamanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
begin
curintreg:=RS_R0;
curfloatreg:=RS_INVALID;
curmmreg:=RS_INVALID;
cur_stack_offset:=0;
end;
function tavrparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
var
nextintreg,nextfloatreg,nextmmreg : tsuperregister;
paradef : tdef;
paraloc : pcgparalocation;
stack_offset : aword;
hp : tparavarsym;
loc : tcgloc;
paracgsize : tcgsize;
paralen : longint;
i : integer;
procedure assignintreg;
begin
{ In case of po_delphi_nested_cc, the parent frame pointer
is always passed on the stack. }
if (nextintreg<=RS_R3) 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,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;
for i:=0 to paras.count-1 do
begin
hp:=tparavarsym(paras[i]);
paradef:=hp.vardef;
hp.paraloc[side].reset;
{ currently only support C-style array of const,
there should be no location assigned to the vararg array itself }
if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) 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_R0;
paraloc^.size:=OS_ADDR;
break;
end;
if (hp.varspez in [vs_var,vs_out]) or
push_addr_param(hp.varspez,paradef,p.proccalloption) or
is_open_array(paradef) or
is_array_of_const(paradef) then
begin
paradef:=voidpointertype;
loc:=LOC_REGISTER;
paracgsize := OS_ADDR;
paralen := tcgsize2size[OS_ADDR];
end
else
begin
if not is_special_array(paradef) then
paralen := paradef.size
else
paralen := tcgsize2size[def_cgsize(paradef)];
loc := getparaloc(p.proccalloption,paradef);
if (paradef.typ in [objectdef,arraydef,recorddef]) and
not is_special_array(paradef) and
(hp.varspez in [vs_value,vs_const]) then
paracgsize := int_cgsize(paralen)
else
begin
paracgsize:=def_cgsize(paradef);
{ for things like formaldef }
if (paracgsize=OS_NO) then
begin
paracgsize:=OS_ADDR;
paralen := tcgsize2size[OS_ADDR];
end;
end
end;
hp.paraloc[side].size:=paracgsize;
hp.paraloc[side].Alignment:=std_param_align;
hp.paraloc[side].intsize:=paralen;
{$ifdef EXTDEBUG}
if paralen=0 then
internalerror(200410311);
{$endif EXTDEBUG}
while paralen>0 do
begin
paraloc:=hp.paraloc[side].add_location;
if (loc=LOC_REGISTER) and (paracgsize in [OS_F32,OS_F64,OS_F80]) then
case paracgsize of
OS_F32:
paraloc^.size:=OS_32;
OS_F64:
paraloc^.size:=OS_32;
else
internalerror(2005082901);
end
else if (paracgsize in [OS_NO,OS_64,OS_S64]) then
paraloc^.size := OS_32
else
paraloc^.size:=paracgsize;
case loc of
LOC_REGISTER:
begin
{ this is not abi compliant
why? (FK) }
if nextintreg<=RS_R3 then
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
inc(nextintreg);
end
else
begin
{ LOC_REFERENCE covers always the overleft }
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=int_cgsize(paralen);
if (side=callerside) then
paraloc^.reference.index:=NR_STACK_POINTER_REG;
paraloc^.reference.offset:=stack_offset;
inc(stack_offset,align(paralen,4));
paralen:=0;
end;
end;
LOC_REFERENCE:
begin
paraloc^.size:=OS_ADDR;
if push_addr_param(hp.varspez,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.vardef.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;
dec(paralen,tcgsize2size[paraloc^.size]);
end;
end;
curintreg:=nextintreg;
curfloatreg:=nextfloatreg;
curmmreg:=nextmmreg;
cur_stack_offset:=stack_offset;
result:=cur_stack_offset;
end;
function tavrparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
var
cur_stack_offset: aword;
curintreg, curfloatreg, curmmreg: tsuperregister;
retcgsize : tcgsize;
begin
init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
create_funcretloc_info(p,side);
end;
procedure tavrparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
begin
p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
end;
function tavrparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;
var
retcgsize : tcgsize;
paraloc : pcgparalocation;
begin
result.init;
result.alignment:=get_para_align(p.proccalloption);
{ void has no location }
if is_void(def) then
begin
paraloc:=result.add_location;
result.size:=OS_NO;
result.intsize:=0;
paraloc^.size:=OS_NO;
paraloc^.loc:=LOC_VOID;
exit;
end;
{ Constructors return self instead of a boolean }
if (p.proctypeoption=potype_constructor) then
begin
retcgsize:=OS_ADDR;
result.intsize:=sizeof(pint);
end
else
begin
retcgsize:=def_cgsize(def);
result.intsize:=def.size;
end;
result.size:=retcgsize;
{ Return is passed as var parameter }
if ret_in_param(def,p.proccalloption) then
begin
paraloc:=result.add_location;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=retcgsize;
exit;
end;
paraloc:=result.add_location;
{ Return in FPU register? }
if def.typ=floatdef then
begin
if (p.proccalloption in [pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then
begin
case retcgsize of
OS_64,
OS_F64:
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
paraloc^.size:=OS_32;
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
paraloc^.size:=OS_32;
end;
OS_32,
OS_F32:
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RETURN_REG;
paraloc^.size:=OS_32;
end;
else
internalerror(2005082603);
end;
end
else
begin
paraloc^.loc:=LOC_FPUREGISTER;
paraloc^.register:=NR_FPU_RESULT_REG;
paraloc^.size:=retcgsize;
end;
end
{ Return in register }
else
begin
if retcgsize in [OS_64,OS_S64] then
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
paraloc^.size:=OS_32;
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
paraloc^.size:=OS_32;
end
else
begin
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=NR_FUNCTION_RETURN_REG;
paraloc^.size:=OS_32;
end;
end;
end;
function tavrparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
var
cur_stack_offset: aword;
curintreg, curfloatreg, curmmreg: tsuperregister;
begin
init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
result:=create_paraloc_info_intern(p,callerside,p.paras,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,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset)
else
internalerror(200410231);
end;
begin
paramanager:=tavrparamanager.create;
end.
Reference in New Issue View Git Blame Copy Permalink