mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-28 06:23:48 +02:00
57bd6d2685
+ 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 -
943 lines
40 KiB
ObjectPascal
943 lines
40 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2002 by Florian Klaempfl
|
|
|
|
Generate assembler for call nodes
|
|
|
|
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.
|
|
|
|
****************************************************************************
|
|
}
|
|
unit ncgcal;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
cpubase,
|
|
globtype,
|
|
parabase,cgutils,
|
|
symdef,node,ncal;
|
|
|
|
type
|
|
tcgcallparanode = class(tcallparanode)
|
|
private
|
|
tempcgpara : tcgpara;
|
|
procedure push_addr_para;
|
|
procedure push_value_para;
|
|
public
|
|
constructor create(expr,next : tnode);override;
|
|
destructor destroy;override;
|
|
procedure secondcallparan;override;
|
|
end;
|
|
|
|
tcgcallnode = class(tcallnode)
|
|
private
|
|
|
|
procedure handle_return_value;
|
|
procedure release_unused_return_value;
|
|
procedure release_para_temps;
|
|
procedure pushparas;
|
|
procedure freeparas;
|
|
protected
|
|
retloc: tcgpara;
|
|
|
|
framepointer_paraloc : tcgpara;
|
|
{# This routine is used to push the current frame pointer
|
|
on the stack. This is used in nested routines where the
|
|
value of the frame pointer is always pushed as an extra
|
|
parameter.
|
|
|
|
The default handling is the standard handling used on
|
|
most stack based machines, where the frame pointer is
|
|
the first invisible parameter.
|
|
}
|
|
procedure pop_parasize(pop_size:longint);virtual;
|
|
procedure extra_interrupt_code;virtual;
|
|
procedure extra_call_code;virtual;
|
|
procedure extra_post_call_code;virtual;
|
|
procedure do_syscall;virtual;abstract;
|
|
|
|
{ The function result is returned in a tcgpara. This tcgpara has to
|
|
be translated into a tlocation so the rest of the code generator
|
|
can work with it. This routine decides what the most appropriate
|
|
tlocation is and sets self.location based on that. }
|
|
procedure set_result_location(realresdef: tstoreddef);virtual;
|
|
public
|
|
procedure pass_generate_code;override;
|
|
destructor destroy;override;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
systems,
|
|
cutils,verbose,globals,
|
|
cpuinfo,
|
|
symconst,symtable,defutil,paramgr,
|
|
cgbase,pass_2,
|
|
aasmbase,aasmtai,aasmdata,
|
|
nbas,nmem,nld,ncnv,nutils,
|
|
{$ifdef x86}
|
|
cga,cgx86,aasmcpu,
|
|
{$endif x86}
|
|
ncgutil,
|
|
cgobj,tgobj,
|
|
procinfo,
|
|
wpobase;
|
|
|
|
|
|
{*****************************************************************************
|
|
TCGCALLPARANODE
|
|
*****************************************************************************}
|
|
|
|
constructor tcgcallparanode.create(expr,next : tnode);
|
|
begin
|
|
inherited create(expr,next);
|
|
tempcgpara.init;
|
|
end;
|
|
|
|
|
|
destructor tcgcallparanode.destroy;
|
|
begin
|
|
tempcgpara.done;
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
procedure tcgcallparanode.push_addr_para;
|
|
begin
|
|
if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
|
|
internalerror(200304235);
|
|
cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,left.location.reference,tempcgpara);
|
|
end;
|
|
|
|
|
|
procedure tcgcallparanode.push_value_para;
|
|
begin
|
|
{ we've nothing to push when the size of the parameter is 0 }
|
|
if left.resultdef.size=0 then
|
|
exit;
|
|
|
|
{ Move flags and jump in register to make it less complex }
|
|
if left.location.loc in [LOC_FLAGS,LOC_JUMP,LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF] then
|
|
location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),false);
|
|
|
|
{ load the parameter's tlocation into its cgpara }
|
|
gen_load_loc_cgpara(current_asmdata.CurrAsmList,left.resultdef,left.location,tempcgpara)
|
|
end;
|
|
|
|
|
|
procedure tcgcallparanode.secondcallparan;
|
|
var
|
|
href : treference;
|
|
otlabel,
|
|
oflabel : tasmlabel;
|
|
begin
|
|
if not(assigned(parasym)) then
|
|
internalerror(200304242);
|
|
|
|
{ Skip nothingn nodes which are used after disabling
|
|
a parameter }
|
|
if (left.nodetype<>nothingn) then
|
|
begin
|
|
otlabel:=current_procinfo.CurrTrueLabel;
|
|
oflabel:=current_procinfo.CurrFalseLabel;
|
|
current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
|
|
current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
|
|
secondpass(left);
|
|
|
|
maybechangeloadnodereg(current_asmdata.CurrAsmList,left,true);
|
|
|
|
{ release memory for refcnt out parameters }
|
|
if (parasym.varspez=vs_out) and
|
|
is_managed_type(left.resultdef) then
|
|
begin
|
|
location_get_data_ref(current_asmdata.CurrAsmList,left.location,href,false,sizeof(pint));
|
|
cg.g_decrrefcount(current_asmdata.CurrAsmList,left.resultdef,href);
|
|
end;
|
|
|
|
paramanager.createtempparaloc(current_asmdata.CurrAsmList,aktcallnode.procdefinition.proccalloption,parasym,tempcgpara);
|
|
|
|
{ handle varargs first, because parasym is not valid }
|
|
if (cpf_varargs_para in callparaflags) then
|
|
begin
|
|
if paramanager.push_addr_param(vs_value,left.resultdef,
|
|
aktcallnode.procdefinition.proccalloption) then
|
|
push_addr_para
|
|
else
|
|
push_value_para;
|
|
end
|
|
{ hidden parameters }
|
|
else if (vo_is_hidden_para in parasym.varoptions) then
|
|
begin
|
|
{ don't push a node that already generated a pointer type
|
|
by address for implicit hidden parameters }
|
|
if (vo_is_funcret in parasym.varoptions) or
|
|
{ pass "this" in C++ classes explicitly as pointer
|
|
because push_addr_param might not be true for them }
|
|
(is_cppclass(parasym.vardef) and (vo_is_self in parasym.varoptions)) or
|
|
(not(left.resultdef.typ in [pointerdef,classrefdef]) and
|
|
paramanager.push_addr_param(parasym.varspez,parasym.vardef,
|
|
aktcallnode.procdefinition.proccalloption)) then
|
|
push_addr_para
|
|
else
|
|
push_value_para;
|
|
end
|
|
{ formal def }
|
|
else if (parasym.vardef.typ=formaldef) then
|
|
begin
|
|
{ allow passing of a constant to a const formaldef }
|
|
if (parasym.varspez=vs_const) and
|
|
(left.location.loc in [LOC_CONSTANT,LOC_REGISTER]) then
|
|
location_force_mem(current_asmdata.CurrAsmList,left.location);
|
|
push_addr_para;
|
|
end
|
|
{ Normal parameter }
|
|
else
|
|
begin
|
|
{ don't push a node that already generated a pointer type
|
|
by address for implicit hidden parameters }
|
|
if (not(
|
|
(vo_is_hidden_para in parasym.varoptions) and
|
|
(left.resultdef.typ in [pointerdef,classrefdef])
|
|
) and
|
|
paramanager.push_addr_param(parasym.varspez,parasym.vardef,
|
|
aktcallnode.procdefinition.proccalloption)) and
|
|
{ dyn. arrays passed to an array of const must be passed by value, see tests/webtbs/tw4219.pp }
|
|
not(
|
|
is_array_of_const(parasym.vardef) and
|
|
is_dynamic_array(left.resultdef)
|
|
) then
|
|
begin
|
|
{ Passing a var parameter to a var parameter, we can
|
|
just push the address transparently }
|
|
if (left.nodetype=loadn) and
|
|
(tloadnode(left).is_addr_param_load) then
|
|
begin
|
|
if (left.location.reference.index<>NR_NO) or
|
|
(left.location.reference.offset<>0) then
|
|
internalerror(200410107);
|
|
cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_ADDR,left.location.reference.base,tempcgpara)
|
|
end
|
|
else
|
|
begin
|
|
{ Force to be in memory }
|
|
if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
|
|
location_force_mem(current_asmdata.CurrAsmList,left.location);
|
|
push_addr_para;
|
|
end;
|
|
end
|
|
else
|
|
push_value_para;
|
|
end;
|
|
current_procinfo.CurrTrueLabel:=otlabel;
|
|
current_procinfo.CurrFalseLabel:=oflabel;
|
|
|
|
{ update return location in callnode when this is the function
|
|
result }
|
|
if assigned(parasym) and
|
|
(vo_is_funcret in parasym.varoptions) then
|
|
location_copy(aktcallnode.location,left.location);
|
|
end;
|
|
|
|
{ next parameter }
|
|
if assigned(right) then
|
|
tcallparanode(right).secondcallparan;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TCGCALLNODE
|
|
*****************************************************************************}
|
|
|
|
procedure tcgcallnode.extra_interrupt_code;
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.extra_call_code;
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.extra_post_call_code;
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.set_result_location(realresdef: tstoreddef);
|
|
begin
|
|
if realresdef.is_intregable or
|
|
realresdef.is_fpuregable or
|
|
{ avoid temporarily storing pointer-sized entities that can't be
|
|
regvars, such as reference-counted pointers, to memory --
|
|
no exception can occur right now (except in case of existing
|
|
memory corruption), and we'd store them to a regular temp
|
|
anyway and that is not safer than keeping them in a register }
|
|
((realresdef.size=sizeof(aint)) and
|
|
(retloc.location^.loc=LOC_REGISTER) and
|
|
not assigned(retloc.location^.next)) then
|
|
location_allocate_register(current_asmdata.CurrAsmList,location,realresdef,false)
|
|
else
|
|
begin
|
|
location_reset_ref(location,LOC_REFERENCE,def_cgsize(realresdef),0);
|
|
tg.GetTemp(current_asmdata.CurrAsmList,retloc.intsize,retloc.Alignment,tt_normal,location.reference);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.pop_parasize(pop_size:longint);
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.handle_return_value;
|
|
var
|
|
realresdef: tstoreddef;
|
|
begin
|
|
{ Check that the return location is set when the result is passed in
|
|
a parameter }
|
|
if (procdefinition.proctypeoption<>potype_constructor) and
|
|
paramanager.ret_in_param(resultdef,procdefinition.proccalloption) then
|
|
begin
|
|
{ self.location is set near the end of secondcallparan so it
|
|
refers to the implicit result parameter }
|
|
if location.loc<>LOC_REFERENCE then
|
|
internalerror(200304241);
|
|
exit;
|
|
end;
|
|
|
|
if not assigned(typedef) then
|
|
realresdef:=tstoreddef(resultdef)
|
|
else
|
|
realresdef:=tstoreddef(typedef);
|
|
|
|
{$ifdef x86}
|
|
if (retloc.location^.loc=LOC_FPUREGISTER) then
|
|
begin
|
|
tcgx86(cg).inc_fpu_stack;
|
|
location_reset(location,LOC_FPUREGISTER,retloc.location^.size);
|
|
location.register:=retloc.location^.register;
|
|
end
|
|
else
|
|
{$endif x86}
|
|
begin
|
|
{ get a tlocation that can hold the return value that's currently in
|
|
the the return value's tcgpara }
|
|
set_result_location(realresdef);
|
|
|
|
{ Do not move the physical register to a virtual one in case
|
|
the return value is not used, because if the virtual one is
|
|
then mapped to the same register as the physical one, we will
|
|
end up with two deallocs of this register (one inserted here,
|
|
one inserted by the register allocator), which unbalances the
|
|
register allocation information. The return register(s) will
|
|
be freed by location_free() in release_unused_return_value
|
|
(mantis #13536). }
|
|
if (cnf_return_value_used in callnodeflags) or
|
|
assigned(funcretnode) then
|
|
begin
|
|
gen_load_cgpara_loc(current_asmdata.CurrAsmList,realresdef,retloc,location,false);
|
|
{$ifdef arm}
|
|
if (resultdef.typ=floatdef) and
|
|
(location.loc=LOC_REGISTER) and
|
|
(current_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) then
|
|
begin
|
|
location_force_mem(current_asmdata.CurrAsmList,location);
|
|
end;
|
|
{$endif arm}
|
|
end;
|
|
end;
|
|
|
|
{ copy value to the final location if this was already provided to the
|
|
callnode. This must be done after the call node, because the location can
|
|
also be used as parameter and may not be finalized yet }
|
|
if assigned(funcretnode) then
|
|
begin
|
|
funcretnode.pass_generate_code;
|
|
{ Decrease refcount for refcounted types, this can be skipped when
|
|
we have used a temp, because then it is already done from tempcreatenode.
|
|
Also no finalize is needed, because there is no risk of exceptions from the
|
|
function since this is code is only executed after the function call has returned }
|
|
if is_managed_type(funcretnode.resultdef) and
|
|
(funcretnode.nodetype<>temprefn) then
|
|
cg.g_decrrefcount(current_asmdata.CurrAsmList,funcretnode.resultdef,funcretnode.location.reference);
|
|
|
|
case location.loc of
|
|
LOC_REGISTER :
|
|
{$ifndef cpu64bitalu}
|
|
if location.size in [OS_64,OS_S64] then
|
|
cg64.a_load64_reg_loc(current_asmdata.CurrAsmList,location.register64,funcretnode.location)
|
|
else
|
|
{$endif}
|
|
cg.a_load_reg_loc(current_asmdata.CurrAsmList,location.size,location.register,funcretnode.location);
|
|
LOC_REFERENCE:
|
|
begin
|
|
case funcretnode.location.loc of
|
|
LOC_REGISTER:
|
|
cg.a_load_ref_reg(current_asmdata.CurrAsmList,location.size,location.size,location.reference,funcretnode.location.register);
|
|
LOC_REFERENCE:
|
|
cg.g_concatcopy(current_asmdata.CurrAsmList,location.reference,funcretnode.location.reference,resultdef.size);
|
|
else
|
|
internalerror(200802121);
|
|
end;
|
|
end;
|
|
else
|
|
internalerror(200709085);
|
|
end;
|
|
location := funcretnode.location;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.release_unused_return_value;
|
|
begin
|
|
{ When the result is not used we need to finalize the result and
|
|
can release the temp. This need to be after the callcleanupblock
|
|
tree is generated, because that converts the temp from persistent to normal }
|
|
if not(cnf_return_value_used in callnodeflags) then
|
|
begin
|
|
case location.loc of
|
|
LOC_REFERENCE :
|
|
begin
|
|
if is_managed_type(resultdef) then
|
|
cg.g_finalize(current_asmdata.CurrAsmList,resultdef,location.reference);
|
|
tg.ungetiftemp(current_asmdata.CurrAsmList,location.reference);
|
|
end;
|
|
{$ifdef x86}
|
|
LOC_FPUREGISTER :
|
|
begin
|
|
{ release FPU stack }
|
|
emit_reg(A_FSTP,S_NO,NR_FPU_RESULT_REG);
|
|
tcgx86(cg).dec_fpu_stack;
|
|
end;
|
|
{$endif x86}
|
|
end;
|
|
if (retloc.intsize<>0) then
|
|
paramanager.freecgpara(current_asmdata.CurrAsmList,retloc);
|
|
location_reset(location,LOC_VOID,OS_NO);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.release_para_temps;
|
|
var
|
|
hp,
|
|
hp2 : tnode;
|
|
ppn : tcallparanode;
|
|
begin
|
|
{ Release temps from parameters }
|
|
ppn:=tcallparanode(left);
|
|
while assigned(ppn) do
|
|
begin
|
|
if assigned(ppn.left) then
|
|
begin
|
|
{ don't release the funcret temp }
|
|
if not(assigned(ppn.parasym)) or
|
|
not(vo_is_funcret in ppn.parasym.varoptions) then
|
|
location_freetemp(current_asmdata.CurrAsmList,ppn.left.location);
|
|
{ process also all nodes of an array of const }
|
|
hp:=ppn.left;
|
|
while (hp.nodetype=typeconvn) do
|
|
hp:=ttypeconvnode(hp).left;
|
|
if (hp.nodetype=arrayconstructorn) and
|
|
assigned(tarrayconstructornode(hp).left) then
|
|
begin
|
|
while assigned(hp) do
|
|
begin
|
|
hp2:=tarrayconstructornode(hp).left;
|
|
{ ignore typeconvs and addrn inserted by arrayconstructn for
|
|
passing a shortstring }
|
|
if (hp2.nodetype=typeconvn) and
|
|
(tunarynode(hp2).left.nodetype=addrn) then
|
|
hp2:=tunarynode(tunarynode(hp2).left).left;
|
|
location_freetemp(current_asmdata.CurrAsmList,hp2.location);
|
|
hp:=tarrayconstructornode(hp).right;
|
|
end;
|
|
end;
|
|
end;
|
|
ppn:=tcallparanode(ppn.right);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.pushparas;
|
|
var
|
|
ppn : tcgcallparanode;
|
|
callerparaloc,
|
|
tmpparaloc : pcgparalocation;
|
|
sizeleft: aint;
|
|
htempref,
|
|
href : treference;
|
|
calleralignment,
|
|
tmpalignment: longint;
|
|
begin
|
|
{ copy all resources to the allocated registers }
|
|
ppn:=tcgcallparanode(left);
|
|
while assigned(ppn) do
|
|
begin
|
|
if (ppn.left.nodetype<>nothingn) then
|
|
begin
|
|
{ better check for the real location of the parameter here, when stack passed parameters
|
|
are saved temporary in registers, checking for the tmpparaloc.loc is wrong
|
|
}
|
|
paramanager.freecgpara(current_asmdata.CurrAsmList,ppn.tempcgpara);
|
|
tmpparaloc:=ppn.tempcgpara.location;
|
|
sizeleft:=ppn.tempcgpara.intsize;
|
|
calleralignment:=ppn.parasym.paraloc[callerside].alignment;
|
|
tmpalignment:=ppn.tempcgpara.alignment;
|
|
if (tmpalignment=0) or
|
|
(calleralignment=0) then
|
|
internalerror(2009020701);
|
|
callerparaloc:=ppn.parasym.paraloc[callerside].location;
|
|
while assigned(callerparaloc) do
|
|
begin
|
|
{ Every paraloc must have a matching tmpparaloc }
|
|
if not assigned(tmpparaloc) then
|
|
internalerror(200408224);
|
|
if callerparaloc^.size<>tmpparaloc^.size then
|
|
internalerror(200408225);
|
|
case callerparaloc^.loc of
|
|
LOC_REGISTER:
|
|
begin
|
|
if tmpparaloc^.loc<>LOC_REGISTER then
|
|
internalerror(200408221);
|
|
if getsupreg(callerparaloc^.register)<first_int_imreg then
|
|
cg.getcpuregister(current_asmdata.CurrAsmList,callerparaloc^.register);
|
|
cg.a_load_reg_reg(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,
|
|
tmpparaloc^.register,callerparaloc^.register);
|
|
end;
|
|
LOC_FPUREGISTER:
|
|
begin
|
|
if tmpparaloc^.loc<>LOC_FPUREGISTER then
|
|
internalerror(200408222);
|
|
if getsupreg(callerparaloc^.register)<first_fpu_imreg then
|
|
cg.getcpuregister(current_asmdata.CurrAsmList,callerparaloc^.register);
|
|
cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,tmpparaloc^.size,ppn.tempcgpara.size,tmpparaloc^.register,callerparaloc^.register);
|
|
end;
|
|
LOC_MMREGISTER:
|
|
begin
|
|
if tmpparaloc^.loc<>LOC_MMREGISTER then
|
|
internalerror(200408223);
|
|
if getsupreg(callerparaloc^.register)<first_mm_imreg then
|
|
cg.getcpuregister(current_asmdata.CurrAsmList,callerparaloc^.register);
|
|
cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,
|
|
tmpparaloc^.register,callerparaloc^.register,mms_movescalar);
|
|
end;
|
|
LOC_REFERENCE:
|
|
begin
|
|
if use_fixed_stack then
|
|
begin
|
|
{ Can't have a data copied to the stack, every location
|
|
must contain a valid size field }
|
|
|
|
if (tmpparaloc^.size=OS_NO) and
|
|
((tmpparaloc^.loc<>LOC_REFERENCE) or
|
|
assigned(tmpparaloc^.next)) then
|
|
internalerror(200501281);
|
|
reference_reset_base(href,callerparaloc^.reference.index,callerparaloc^.reference.offset,calleralignment);
|
|
{ copy parameters in case they were moved to a temp. location because we've a fixed stack }
|
|
case tmpparaloc^.loc of
|
|
LOC_REFERENCE:
|
|
begin
|
|
reference_reset_base(htempref,tmpparaloc^.reference.index,tmpparaloc^.reference.offset,tmpalignment);
|
|
{ use concatcopy, because it can also be a float which fails when
|
|
load_ref_ref is used }
|
|
if (ppn.tempcgpara.size <> OS_NO) then
|
|
cg.g_concatcopy(current_asmdata.CurrAsmList,htempref,href,tcgsize2size[tmpparaloc^.size])
|
|
else
|
|
cg.g_concatcopy(current_asmdata.CurrAsmList,htempref,href,sizeleft)
|
|
end;
|
|
LOC_REGISTER:
|
|
cg.a_load_reg_ref(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href);
|
|
LOC_FPUREGISTER:
|
|
cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href);
|
|
LOC_MMREGISTER:
|
|
cg.a_loadmm_reg_ref(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href,mms_movescalar);
|
|
else
|
|
internalerror(200402081);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
dec(sizeleft,tcgsize2size[tmpparaloc^.size]);
|
|
callerparaloc:=callerparaloc^.next;
|
|
tmpparaloc:=tmpparaloc^.next;
|
|
end;
|
|
end;
|
|
ppn:=tcgcallparanode(ppn.right);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tcgcallnode.freeparas;
|
|
var
|
|
ppn : tcgcallparanode;
|
|
begin
|
|
{ free the resources allocated for the parameters }
|
|
ppn:=tcgcallparanode(left);
|
|
while assigned(ppn) do
|
|
begin
|
|
if (ppn.left.nodetype<>nothingn) then
|
|
begin
|
|
if (ppn.parasym.paraloc[callerside].location^.loc <> LOC_REFERENCE) then
|
|
paramanager.freecgpara(current_asmdata.CurrAsmList,ppn.parasym.paraloc[callerside]);
|
|
end;
|
|
ppn:=tcgcallparanode(ppn.right);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure tcgcallnode.pass_generate_code;
|
|
var
|
|
name_to_call: shortstring;
|
|
regs_to_save_int,
|
|
regs_to_save_fpu,
|
|
regs_to_save_mm : Tcpuregisterset;
|
|
href : treference;
|
|
pop_size : longint;
|
|
vmtoffset : aint;
|
|
pvreg,
|
|
vmtreg : tregister;
|
|
oldaktcallnode : tcallnode;
|
|
retlocitem: pcgparalocation;
|
|
{$ifdef vtentry}
|
|
sym : tasmsymbol;
|
|
{$endif vtentry}
|
|
{$ifdef x86_64}
|
|
cgpara : tcgpara;
|
|
{$endif x86_64}
|
|
begin
|
|
if not assigned(procdefinition) or
|
|
not procdefinition.has_paraloc_info then
|
|
internalerror(200305264);
|
|
|
|
if assigned(callinitblock) then
|
|
secondpass(tnode(callinitblock));
|
|
|
|
regs_to_save_int:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
|
|
regs_to_save_fpu:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption);
|
|
regs_to_save_mm:=paramanager.get_volatile_registers_mm(procdefinition.proccalloption);
|
|
|
|
{ Include Function result registers }
|
|
if (not is_void(resultdef)) then
|
|
begin
|
|
{ The forced returntype may have a different size than the one
|
|
declared for the procdef }
|
|
if not assigned(typedef) then
|
|
retloc:=procdefinition.funcretloc[callerside]
|
|
else
|
|
retloc:=paramanager.get_funcretloc(procdefinition,callerside,typedef);
|
|
retlocitem:=retloc.location;
|
|
while assigned(retlocitem) do
|
|
begin
|
|
case retlocitem^.loc of
|
|
LOC_REGISTER:
|
|
include(regs_to_save_int,getsupreg(retlocitem^.register));
|
|
LOC_FPUREGISTER:
|
|
include(regs_to_save_fpu,getsupreg(retlocitem^.register));
|
|
LOC_MMREGISTER:
|
|
include(regs_to_save_mm,getsupreg(retlocitem^.register));
|
|
LOC_REFERENCE,
|
|
LOC_VOID:
|
|
;
|
|
else
|
|
internalerror(2004110213);
|
|
end;
|
|
retlocitem:=retlocitem^.next;
|
|
end;
|
|
end;
|
|
|
|
{ Process parameters, register parameters will be loaded
|
|
in imaginary registers. The actual load to the correct
|
|
register is done just before the call }
|
|
oldaktcallnode:=aktcallnode;
|
|
aktcallnode:=self;
|
|
if assigned(left) then
|
|
tcallparanode(left).secondcallparan;
|
|
aktcallnode:=oldaktcallnode;
|
|
|
|
{ procedure variable or normal function call ? }
|
|
if (right=nil) then
|
|
begin
|
|
{ register call for WPO (must be done before wpo test below,
|
|
otherwise optimised called methods are no longer registered)
|
|
}
|
|
if (po_virtualmethod in procdefinition.procoptions) and
|
|
assigned(methodpointer) and
|
|
(methodpointer.nodetype<>typen) and
|
|
(not assigned(current_procinfo) or
|
|
wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then
|
|
tprocdef(procdefinition)._class.register_vmt_call(tprocdef(procdefinition).extnumber);
|
|
{$ifdef vtentry}
|
|
if not is_interface(tprocdef(procdefinition)._class) then
|
|
begin
|
|
inc(current_asmdata.NextVTEntryNr);
|
|
current_asmdata.CurrAsmList.Concat(tai_symbol.CreateName('VTREF'+tostr(current_asmdata.NextVTEntryNr)+'_'+tprocdef(procdefinition)._class.vmt_mangledname+'$$'+tostr(vmtoffset div sizeof(pint)),AT_FUNCTION,0));
|
|
end;
|
|
{$endif vtentry}
|
|
|
|
name_to_call:='';
|
|
if assigned(fobjcforcedprocname) then
|
|
name_to_call:=fobjcforcedprocname^;
|
|
{ When methodpointer is typen we don't need (and can't) load
|
|
a pointer. We can directly call the correct procdef (PFV) }
|
|
if (name_to_call='') and
|
|
(po_virtualmethod in procdefinition.procoptions) and
|
|
assigned(methodpointer) and
|
|
(methodpointer.nodetype<>typen) and
|
|
not wpoinfomanager.can_be_devirtualized(methodpointer.resultdef,procdefinition,name_to_call) then
|
|
begin
|
|
{ virtual methods require an index }
|
|
if tprocdef(procdefinition).extnumber=$ffff then
|
|
internalerror(200304021);
|
|
|
|
secondpass(methodpointer);
|
|
|
|
{ Load VMT from self }
|
|
if methodpointer.resultdef.typ=objectdef then
|
|
gen_load_vmt_register(current_asmdata.CurrAsmList,tobjectdef(methodpointer.resultdef),methodpointer.location,vmtreg)
|
|
else
|
|
begin
|
|
{ Load VMT value in register }
|
|
location_force_reg(current_asmdata.CurrAsmList,methodpointer.location,OS_ADDR,false);
|
|
vmtreg:=methodpointer.location.register;
|
|
end;
|
|
|
|
{ test validity of VMT }
|
|
if not(is_interface(tprocdef(procdefinition)._class)) and
|
|
not(is_cppclass(tprocdef(procdefinition)._class)) then
|
|
cg.g_maybe_testvmt(current_asmdata.CurrAsmList,vmtreg,tprocdef(procdefinition)._class);
|
|
|
|
{ Call through VMT, generate a VTREF symbol to notify the linker }
|
|
vmtoffset:=tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber);
|
|
{ register call for WPO }
|
|
if (not assigned(current_procinfo) or
|
|
wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then
|
|
tprocdef(procdefinition)._class.register_vmt_call(tprocdef(procdefinition).extnumber);
|
|
{$ifndef x86}
|
|
pvreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
|
|
{$endif not x86}
|
|
reference_reset_base(href,vmtreg,vmtoffset,sizeof(pint));
|
|
{$ifndef x86}
|
|
cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,pvreg);
|
|
{$endif not x86}
|
|
|
|
{ Load parameters that are in temporary registers in the
|
|
correct parameter register }
|
|
if assigned(left) then
|
|
begin
|
|
pushparas;
|
|
{ free the resources allocated for the parameters }
|
|
freeparas;
|
|
end;
|
|
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
|
|
if cg.uses_registers(R_FPUREGISTER) then
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
|
|
if cg.uses_registers(R_MMREGISTER) then
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm);
|
|
|
|
{ call method }
|
|
extra_call_code;
|
|
{$ifdef x86}
|
|
cg.a_call_ref(current_asmdata.CurrAsmList,href);
|
|
{$else x86}
|
|
cg.a_call_reg(current_asmdata.CurrAsmList,pvreg);
|
|
{$endif x86}
|
|
extra_post_call_code;
|
|
end
|
|
else
|
|
begin
|
|
{ Load parameters that are in temporary registers in the
|
|
correct parameter register }
|
|
if assigned(left) then
|
|
begin
|
|
pushparas;
|
|
{ free the resources allocated for the parameters }
|
|
freeparas;
|
|
end;
|
|
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
|
|
if cg.uses_registers(R_FPUREGISTER) then
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
|
|
if cg.uses_registers(R_MMREGISTER) then
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm);
|
|
|
|
if procdefinition.proccalloption=pocall_syscall then
|
|
do_syscall
|
|
else
|
|
begin
|
|
{ Calling interrupt from the same code requires some
|
|
extra code }
|
|
if (po_interrupt in procdefinition.procoptions) then
|
|
extra_interrupt_code;
|
|
extra_call_code;
|
|
if (name_to_call='') then
|
|
cg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition).mangledname,po_weakexternal in procdefinition.procoptions)
|
|
else
|
|
cg.a_call_name(current_asmdata.CurrAsmList,name_to_call,po_weakexternal in procdefinition.procoptions);
|
|
extra_post_call_code;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
{ now procedure variable case }
|
|
begin
|
|
secondpass(right);
|
|
|
|
pvreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
|
|
{ Only load OS_ADDR from the reference }
|
|
if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
|
|
cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,right.location.reference,pvreg)
|
|
else
|
|
cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_ADDR,right.location,pvreg);
|
|
location_freetemp(current_asmdata.CurrAsmList,right.location);
|
|
|
|
{ Load parameters that are in temporary registers in the
|
|
correct parameter register }
|
|
if assigned(left) then
|
|
begin
|
|
pushparas;
|
|
{ free the resources allocated for the parameters }
|
|
freeparas;
|
|
end;
|
|
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
|
|
if cg.uses_registers(R_FPUREGISTER) then
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
|
|
if cg.uses_registers(R_MMREGISTER) then
|
|
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm);
|
|
|
|
{ Calling interrupt from the same code requires some
|
|
extra code }
|
|
if (po_interrupt in procdefinition.procoptions) then
|
|
extra_interrupt_code;
|
|
extra_call_code;
|
|
cg.a_call_reg(current_asmdata.CurrAsmList,pvreg);
|
|
extra_post_call_code;
|
|
end;
|
|
|
|
{ Need to remove the parameters from the stack? }
|
|
if (procdefinition.proccalloption in clearstack_pocalls) then
|
|
begin
|
|
pop_size:=pushedparasize;
|
|
{ for Cdecl functions we don't need to pop the funcret when it
|
|
was pushed by para }
|
|
if paramanager.ret_in_param(procdefinition.returndef,procdefinition.proccalloption) then
|
|
dec(pop_size,sizeof(pint));
|
|
{ Remove parameters/alignment from the stack }
|
|
pop_parasize(pop_size);
|
|
end
|
|
{ frame pointer parameter is popped by the caller when it's passed the
|
|
Delphi way }
|
|
else if (po_delphi_nested_cc in procdefinition.procoptions) and
|
|
not use_fixed_stack then
|
|
pop_parasize(sizeof(pint));
|
|
{ Release registers, but not the registers that contain the
|
|
function result }
|
|
if (not is_void(resultdef)) then
|
|
begin
|
|
retlocitem:=retloc.location;
|
|
while assigned(retlocitem) do
|
|
begin
|
|
case retlocitem^.loc of
|
|
LOC_REGISTER:
|
|
exclude(regs_to_save_int,getsupreg(retlocitem^.register));
|
|
LOC_FPUREGISTER:
|
|
exclude(regs_to_save_fpu,getsupreg(retlocitem^.register));
|
|
LOC_MMREGISTER:
|
|
exclude(regs_to_save_mm,getsupreg(retlocitem^.register));
|
|
LOC_REFERENCE,
|
|
LOC_VOID:
|
|
;
|
|
else
|
|
internalerror(2004110214);
|
|
end;
|
|
retlocitem:=retlocitem^.next;
|
|
end;
|
|
end;
|
|
|
|
{$if defined(x86) or defined(arm)}
|
|
if (procdefinition.proccalloption=pocall_safecall) and
|
|
(target_info.system in systems_all_windows) then
|
|
begin
|
|
{$ifdef x86_64}
|
|
cgpara.init;
|
|
paramanager.getintparaloc(pocall_default,1,cgpara);
|
|
cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_ADDR,NR_RAX,cgpara);
|
|
cgpara.done;
|
|
{$endif x86_64}
|
|
cg.allocallcpuregisters(current_asmdata.CurrAsmList);
|
|
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_SAFECALLCHECK',false);
|
|
cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
|
|
end;
|
|
{$endif}
|
|
|
|
if cg.uses_registers(R_MMREGISTER) then
|
|
cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm);
|
|
if cg.uses_registers(R_FPUREGISTER) then
|
|
cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
|
|
cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
|
|
|
|
{ handle function results }
|
|
if (not is_void(resultdef)) then
|
|
handle_return_value
|
|
else
|
|
location_reset(location,LOC_VOID,OS_NO);
|
|
|
|
{ convert persistent temps for parameters and function result to normal temps }
|
|
if assigned(callcleanupblock) then
|
|
secondpass(tnode(callcleanupblock));
|
|
|
|
{ release temps and finalize unused return values, must be
|
|
after the callcleanupblock because that converts temps
|
|
from persistent to normal }
|
|
release_unused_return_value;
|
|
|
|
{ release temps of paras }
|
|
release_para_temps;
|
|
|
|
{ perhaps i/o check ? }
|
|
if (cs_check_io in current_settings.localswitches) and
|
|
(po_iocheck in procdefinition.procoptions) and
|
|
not(po_iocheck in current_procinfo.procdef.procoptions) and
|
|
{ no IO check for methods and procedure variables }
|
|
(right=nil) and
|
|
not(po_virtualmethod in procdefinition.procoptions) then
|
|
begin
|
|
cg.allocallcpuregisters(current_asmdata.CurrAsmList);
|
|
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_IOCHECK',false);
|
|
cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
|
|
end;
|
|
end;
|
|
|
|
|
|
destructor tcgcallnode.destroy;
|
|
begin
|
|
if assigned(typedef) then
|
|
retloc.done;
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
begin
|
|
ccallparanode:=tcgcallparanode;
|
|
ccallnode:=tcgcallnode;
|
|
end.
|