mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 05:58:02 +02:00
615 lines
25 KiB
ObjectPascal
615 lines
25 KiB
ObjectPascal
{
|
|
Copyright (c) 2011 by Jonas Maebe
|
|
|
|
JVM-specific code 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 njvmcal;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
cgbase,
|
|
symtype,symdef,
|
|
node,ncal,ncgcal;
|
|
|
|
type
|
|
tjvmcallparanode = class(tcgcallparanode)
|
|
protected
|
|
procedure push_formal_para; override;
|
|
procedure push_copyout_para; override;
|
|
|
|
procedure handlemanagedbyrefpara(orgparadef: tdef); override;
|
|
end;
|
|
|
|
{ tjvmcallnode }
|
|
|
|
tjvmcallnode = class(tcgcallnode)
|
|
protected
|
|
procedure wrapcomplexinlinepara(para: tcallparanode); override;
|
|
procedure extra_pre_call_code; override;
|
|
procedure set_result_location(realresdef: tstoreddef); override;
|
|
procedure do_release_unused_return_value;override;
|
|
procedure extra_post_call_code; override;
|
|
function dispatch_procvar: tnode;
|
|
procedure remove_hidden_paras;
|
|
procedure gen_vmt_entry_load; override;
|
|
public
|
|
function pass_typecheck: tnode; override;
|
|
function pass_1: tnode; override;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
verbose,globals,globtype,constexp,cutils,compinnr,
|
|
symconst,symtable,symsym,symcpu,defutil,
|
|
cgutils,tgobj,procinfo,htypechk,
|
|
cpubase,aasmbase,aasmdata,aasmcpu,
|
|
hlcgobj,hlcgcpu,
|
|
pass_1,nutils,nadd,nbas,ncnv,ncon,nflw,ninl,nld,nmem,
|
|
jvmdef;
|
|
|
|
{*****************************************************************************
|
|
TJVMCALLPARANODE
|
|
*****************************************************************************}
|
|
|
|
procedure tjvmcallparanode.push_formal_para;
|
|
begin
|
|
{ primitive values are boxed, so in all cases this is a pointer to
|
|
something and since it cannot be changed (or is not supposed to be
|
|
changed anyway), we don't have to create a temporary array to hold a
|
|
pointer to this value and can just pass the pointer to this value
|
|
directly.
|
|
|
|
In case the value can be changed (formal var/out), then we have
|
|
already created a temporary array of one element that holds the boxed
|
|
(or in case of a non-primitive type: original) value. The reason is
|
|
that copying it back out may be a complex operation which we don't
|
|
want to handle at the code generator level.
|
|
|
|
-> always push a value parameter (which is either an array of one
|
|
element, or an object) }
|
|
push_value_para
|
|
end;
|
|
|
|
|
|
procedure tjvmcallparanode.push_copyout_para;
|
|
begin
|
|
{ everything is wrapped and replaced by handlemanagedbyrefpara() in
|
|
pass_1 }
|
|
push_value_para;
|
|
end;
|
|
|
|
|
|
procedure getparabasenodes(p: tnode; out basenode: tnode; out parent: tunarynode);
|
|
begin
|
|
parent:=nil;
|
|
while assigned(p) do
|
|
begin
|
|
case p.nodetype of
|
|
inlinen:
|
|
begin
|
|
if tinlinenode(p).inlinenumber=in_box_x then
|
|
begin
|
|
parent:=tunarynode(p);
|
|
p:=parent.left;
|
|
end
|
|
else
|
|
break;
|
|
end;
|
|
subscriptn,
|
|
vecn:
|
|
begin
|
|
break;
|
|
end;
|
|
typeconvn:
|
|
begin
|
|
parent:=tunarynode(p);
|
|
{ skip typeconversions that don't change the node type }
|
|
p:=actualtargetnode(@p)^;
|
|
end;
|
|
derefn:
|
|
begin
|
|
parent:=tunarynode(p);
|
|
p:=tunarynode(p).left;
|
|
end
|
|
else
|
|
break;
|
|
end;
|
|
end;
|
|
basenode:=p;
|
|
end;
|
|
|
|
|
|
function replacewithtemp(var orgnode:tnode): ttempcreatenode;
|
|
begin
|
|
if valid_for_var(orgnode,false) then
|
|
result:=ctempcreatenode.create_reference(
|
|
orgnode.resultdef,orgnode.resultdef.size,
|
|
tt_persistent,true,orgnode,true)
|
|
else
|
|
result:=ctempcreatenode.create_value(
|
|
orgnode.resultdef,orgnode.resultdef.size,
|
|
tt_persistent,true,orgnode);
|
|
{ this node is reused while constructing the temp }
|
|
orgnode:=ctemprefnode.create(result);
|
|
typecheckpass(orgnode);
|
|
end;
|
|
|
|
|
|
procedure tjvmcallparanode.handlemanagedbyrefpara(orgparadef: tdef);
|
|
var
|
|
arrdef: tarraydef;
|
|
arreledef: tdef;
|
|
initstat,
|
|
copybackstat,
|
|
finistat: tstatementnode;
|
|
finiblock: tblocknode;
|
|
realpara, tempn, unwrappedele0, unwrappedele1: tnode;
|
|
realparaparent: tunarynode;
|
|
realparatemp, arraytemp: ttempcreatenode;
|
|
leftcopy: tnode;
|
|
implicitptrpara,
|
|
verifyout: boolean;
|
|
begin
|
|
{ the original version doesn't do anything for garbage collected
|
|
platforms, but who knows in the future }
|
|
inherited;
|
|
{ implicit pointer types are already pointers -> no need to stuff them
|
|
in an array to pass them by reference (except in case of a formal
|
|
parameter, in which case everything is passed in an array since the
|
|
callee can't know what was passed in) }
|
|
if jvmimplicitpointertype(orgparadef) and
|
|
(parasym.vardef.typ<>formaldef) then
|
|
exit;
|
|
|
|
fparainit:=internalstatements(initstat);
|
|
fparacopyback:=internalstatements(copybackstat);
|
|
finiblock:=internalstatements(finistat);
|
|
getparabasenodes(left,realpara,realparaparent);
|
|
{ make sure we can get a copy of left safely, so we can use it both
|
|
to load the original parameter value and to assign the result again
|
|
afterwards (if required) }
|
|
|
|
{ special case for access to string character, because those are
|
|
translated into function calls that differ depending on which side of
|
|
an assignment they are on }
|
|
if (realpara.nodetype=vecn) and
|
|
(tvecnode(realpara).left.resultdef.typ=stringdef) then
|
|
begin
|
|
if node_complexity(tvecnode(realpara).left)>1 then
|
|
begin
|
|
realparatemp:=replacewithtemp(tvecnode(realpara).left);
|
|
addstatement(initstat,realparatemp);
|
|
addstatement(finistat,ctempdeletenode.create(realparatemp));
|
|
end;
|
|
if node_complexity(tvecnode(realpara).right)>1 then
|
|
begin
|
|
realparatemp:=replacewithtemp(tvecnode(realpara).right);
|
|
addstatement(initstat,realparatemp);
|
|
addstatement(finistat,ctempdeletenode.create(realparatemp));
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ general case: if it's possible that there's a function call
|
|
involved, use a temp to prevent double evaluations }
|
|
if assigned(realparaparent) then
|
|
begin
|
|
realparatemp:=replacewithtemp(realparaparent.left);
|
|
addstatement(initstat,realparatemp);
|
|
addstatement(finistat,ctempdeletenode.create(realparatemp));
|
|
end;
|
|
end;
|
|
{ create a copy of the original left (with temps already substituted),
|
|
so we can use it if required to handle copying the return value back }
|
|
leftcopy:=left.getcopy;
|
|
implicitptrpara:=jvmimplicitpointertype(orgparadef);
|
|
{ create the array temp that that will serve as the parameter }
|
|
if parasym.vardef.typ=formaldef then
|
|
arreledef:=java_jlobject
|
|
else if implicitptrpara then
|
|
arreledef:=cpointerdef.getreusable(orgparadef)
|
|
else
|
|
arreledef:=parasym.vardef;
|
|
arrdef:=carraydef.getreusable(arreledef,1+ord(cs_check_var_copyout in current_settings.localswitches));
|
|
{ the -1 means "use the array's element count to determine the number
|
|
of elements" in the JVM temp generator }
|
|
arraytemp:=ctempcreatenode.create(arrdef,-1,tt_persistent,true);
|
|
addstatement(initstat,arraytemp);
|
|
addstatement(finistat,ctempdeletenode.create(arraytemp));
|
|
|
|
{ we can also check out-parameters if we are certain that they'll be
|
|
valid according to the JVM. That's basically everything except for
|
|
local variables (fields, arrays etc are all initialized on creation) }
|
|
verifyout:=
|
|
(cs_check_var_copyout in current_settings.localswitches) and
|
|
((actualtargetnode(@left)^.nodetype<>loadn) or
|
|
(tloadnode(actualtargetnode(@left)^).symtableentry.typ<>localvarsym));
|
|
|
|
{ in case of a non-out parameter, pass in the original value (also
|
|
always in case of implicitpointer type, since that pointer points to
|
|
the data that will be changed by the callee) }
|
|
if (parasym.varspez<>vs_out) or
|
|
verifyout or
|
|
((parasym.vardef.typ<>formaldef) and
|
|
implicitptrpara) then
|
|
begin
|
|
if implicitptrpara then
|
|
begin
|
|
{ pass pointer to the struct }
|
|
left:=caddrnode.create_internal(left);
|
|
include(taddrnode(left).addrnodeflags,anf_typedaddr);
|
|
typecheckpass(left);
|
|
end;
|
|
{ wrap the primitive type in an object container
|
|
if required }
|
|
if parasym.vardef.typ=formaldef then
|
|
begin
|
|
if (left.resultdef.typ in [orddef,floatdef]) then
|
|
begin
|
|
left:=cinlinenode.create(in_box_x,false,ccallparanode.create(left,nil));
|
|
typecheckpass(left);
|
|
end;
|
|
left:=ctypeconvnode.create_explicit(left,java_jlobject);
|
|
end;
|
|
{ put the parameter value in the array }
|
|
addstatement(initstat,cassignmentnode.create(
|
|
cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0)),
|
|
left));
|
|
{ and the copy for checking }
|
|
if (cs_check_var_copyout in current_settings.localswitches) then
|
|
addstatement(initstat,cassignmentnode.create(
|
|
cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(1)),
|
|
cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0))));
|
|
end
|
|
else
|
|
left.free;
|
|
{ replace the parameter with the temp array }
|
|
left:=ctemprefnode.create(arraytemp);
|
|
{ generate the code to copy back the changed value into the original
|
|
parameter in case of var/out.
|
|
|
|
In case of a formaldef, changes to the parameter in the callee change
|
|
the pointer inside the array -> we have to copy back the changes in
|
|
all cases.
|
|
|
|
In case of a regular parameter, we only have to copy things back in
|
|
case it's not an implicit pointer type. The reason is that for
|
|
implicit pointer types, any changes will have been directly applied
|
|
to the original parameter via the implicit pointer that we passed in }
|
|
if (parasym.varspez in [vs_var,vs_out]) and
|
|
((parasym.vardef.typ=formaldef) or
|
|
not implicitptrpara) then
|
|
begin
|
|
{ add the extraction of the parameter and assign it back to the
|
|
original location }
|
|
tempn:=ctemprefnode.create(arraytemp);
|
|
tempn:=cvecnode.create(tempn,genintconstnode(0));
|
|
{ unbox if necessary }
|
|
if parasym.vardef.typ=formaldef then
|
|
begin
|
|
if orgparadef.typ in [orddef,floatdef] then
|
|
tempn:=cinlinenode.create(in_unbox_x_y,false,ccallparanode.create(
|
|
ctypenode.create(orgparadef),ccallparanode.create(tempn,nil)))
|
|
else if implicitptrpara then
|
|
tempn:=ctypeconvnode.create_explicit(tempn,cpointerdef.getreusable(orgparadef))
|
|
end;
|
|
if implicitptrpara then
|
|
tempn:=cderefnode.create(tempn)
|
|
else
|
|
begin
|
|
{ add check to determine whether the location passed as
|
|
var-parameter hasn't been modified directly to a different
|
|
value than the returned var-parameter in the mean time }
|
|
if ((parasym.varspez=vs_var) or
|
|
verifyout) and
|
|
(cs_check_var_copyout in current_settings.localswitches) then
|
|
begin
|
|
unwrappedele0:=cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0));
|
|
unwrappedele1:=cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(1));
|
|
if (parasym.vardef.typ=formaldef) and
|
|
(orgparadef.typ in [orddef,floatdef]) then
|
|
begin
|
|
unwrappedele0:=cinlinenode.create(in_unbox_x_y,false,ccallparanode.create(
|
|
ctypenode.create(orgparadef),ccallparanode.create(unwrappedele0,nil)));
|
|
unwrappedele1:=cinlinenode.create(in_unbox_x_y,false,ccallparanode.create(
|
|
ctypenode.create(orgparadef),ccallparanode.create(unwrappedele1,nil)))
|
|
end;
|
|
addstatement(copybackstat,cifnode.create(
|
|
caddnode.create(andn,
|
|
caddnode.create(unequaln,leftcopy.getcopy,ctypeconvnode.create_explicit(unwrappedele0,orgparadef)),
|
|
caddnode.create(unequaln,leftcopy.getcopy,ctypeconvnode.create_explicit(unwrappedele1,orgparadef))),
|
|
ccallnode.createintern('fpc_var_copyout_mismatch',
|
|
ccallparanode.create(genintconstnode(fileinfo.column),
|
|
ccallparanode.create(genintconstnode(fileinfo.line),nil))
|
|
),nil
|
|
));
|
|
end;
|
|
end;
|
|
addstatement(copybackstat,cassignmentnode.create(leftcopy,
|
|
ctypeconvnode.create_explicit(tempn,orgparadef)));
|
|
end
|
|
else
|
|
leftcopy.free;
|
|
addstatement(copybackstat,finiblock);
|
|
firstpass(fparainit);
|
|
firstpass(left);
|
|
firstpass(fparacopyback);
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TJVMCALLNODE
|
|
*****************************************************************************}
|
|
|
|
procedure tjvmcallnode.wrapcomplexinlinepara(para: tcallparanode);
|
|
var
|
|
tempnode: ttempcreatenode;
|
|
begin
|
|
{ don't use caddrnodes for the JVM target, because we can't take the
|
|
address of every kind of type (e.g., of ansistrings). A temp-reference
|
|
node does work for any kind of memory reference (and the expectloc
|
|
is LOC_(C)REFERENCE when this routine is called), but is not (yet)
|
|
supported for other targets }
|
|
tempnode:=ctempcreatenode.create_reference(para.parasym.vardef,para.parasym.vardef.size,
|
|
tt_persistent,tparavarsym(para.parasym).is_regvar(false),para.left,false);
|
|
addstatement(inlineinitstatement,tempnode);
|
|
addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode));
|
|
para.left:=ctemprefnode.create(tempnode);
|
|
{ inherit addr_taken flag }
|
|
if (tabstractvarsym(para.parasym).addr_taken) then
|
|
tempnode.includetempflag(ti_addr_taken);
|
|
end;
|
|
|
|
|
|
procedure tjvmcallnode.extra_pre_call_code;
|
|
begin
|
|
{ when calling a constructor, first create a new instance, except
|
|
when calling it from another constructor (because then this has
|
|
already been done before calling the current constructor) }
|
|
if procdefinition.proctypeoption<>potype_constructor then
|
|
exit;
|
|
if not(methodpointer.resultdef.typ in [classrefdef,recorddef]) then
|
|
exit;
|
|
{ in case of an inherited constructor call in a class, the methodpointer
|
|
is an objectdef rather than a classrefdef. That's not true in case
|
|
of records though, so we need an extra check }
|
|
if (current_procinfo.procdef.proctypeoption=potype_constructor) and
|
|
(cnf_inherited in callnodeflags) then
|
|
exit;
|
|
current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(tabstractrecorddef(procdefinition.owner.defowner).jvm_full_typename(true),AT_METADATA)));
|
|
{ the constructor doesn't return anything, so put a duplicate of the
|
|
self pointer on the evaluation stack for use as function result
|
|
after the constructor has run }
|
|
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dup));
|
|
thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,2);
|
|
end;
|
|
|
|
|
|
procedure tjvmcallnode.set_result_location(realresdef: tstoreddef);
|
|
begin
|
|
location_reset_ref(location,LOC_REFERENCE,def_cgsize(realresdef),1,[]);
|
|
{ in case of jvmimplicitpointertype(), the function will have allocated
|
|
it already and we don't have to allocate it again here }
|
|
if not jvmimplicitpointertype(realresdef) then
|
|
tg.gethltemp(current_asmdata.CurrAsmList,realresdef,realresdef.size,tt_normal,location.reference)
|
|
else
|
|
tg.gethltemp(current_asmdata.CurrAsmList,java_jlobject,java_jlobject.size,tt_normal,location.reference);
|
|
end;
|
|
|
|
|
|
procedure tjvmcallnode.do_release_unused_return_value;
|
|
begin
|
|
if (tabstractprocdef(procdefinition).proctypeoption=potype_constructor) and
|
|
(current_procinfo.procdef.proctypeoption=potype_constructor) then
|
|
exit;
|
|
if is_void(resultdef) then
|
|
exit;
|
|
if (location.loc=LOC_REFERENCE) then
|
|
tg.ungetiftemp(current_asmdata.CurrAsmList,location.reference);
|
|
if assigned(funcretnode) then
|
|
exit;
|
|
if jvmimplicitpointertype(resultdef) or
|
|
(resultdef.size in [1..4]) then
|
|
begin
|
|
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_pop));
|
|
thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
|
|
end
|
|
else if resultdef.size=8 then
|
|
begin
|
|
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_pop2));
|
|
thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,2);
|
|
end
|
|
else
|
|
internalerror(2011010305);
|
|
end;
|
|
|
|
|
|
procedure tjvmcallnode.extra_post_call_code;
|
|
var
|
|
realresdef: tdef;
|
|
begin
|
|
thlcgjvm(hlcg).g_adjust_stack_after_call(current_asmdata.CurrAsmList,procdefinition,pushedparasize,typedef);
|
|
{ a constructor doesn't actually return a value in the jvm }
|
|
if (tabstractprocdef(procdefinition).proctypeoption<>potype_constructor) then
|
|
begin
|
|
if cnf_return_value_used in callnodeflags then
|
|
begin
|
|
if not assigned(typedef) then
|
|
realresdef:=tstoreddef(resultdef)
|
|
else
|
|
realresdef:=tstoreddef(typedef);
|
|
thlcgjvm(hlcg).maybe_resize_stack_para_val(current_asmdata.CurrAsmList,realresdef,false);
|
|
end;
|
|
end;
|
|
|
|
{ if this was an inherited constructor call, initialise all fields that
|
|
are wrapped types following it }
|
|
if (tabstractprocdef(procdefinition).proctypeoption=potype_constructor) and
|
|
(cnf_inherited in callnodeflags) then
|
|
thlcgjvm(hlcg).gen_initialize_fields_code(current_asmdata.CurrAsmList);
|
|
end;
|
|
|
|
|
|
procedure tjvmcallnode.remove_hidden_paras;
|
|
var
|
|
prevpara, para, nextpara: tcallparanode;
|
|
begin
|
|
prevpara:=nil;
|
|
para:=tcallparanode(left);
|
|
while assigned(para) do
|
|
begin
|
|
nextpara:=tcallparanode(para.right);
|
|
if vo_is_hidden_para in para.parasym.varoptions then
|
|
begin
|
|
if assigned(prevpara) then
|
|
prevpara.right:=nextpara
|
|
else
|
|
left:=nextpara;
|
|
para.right:=nil;
|
|
para.free;
|
|
end
|
|
else
|
|
prevpara:=para;
|
|
para:=nextpara;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tjvmcallnode.gen_vmt_entry_load;
|
|
begin
|
|
{ nothing to do }
|
|
end;
|
|
|
|
|
|
function tjvmcallnode.pass_typecheck: tnode;
|
|
begin
|
|
result:=inherited pass_typecheck;
|
|
if assigned(result) or
|
|
codegenerror then
|
|
exit;
|
|
{ unfortunately, we cannot handle a call to a virtual constructor for
|
|
the current instance from inside another constructor. The reason is
|
|
that these must be called via reflection, but before an instance has
|
|
been fully initialized (which can only be done by calling either an
|
|
inherited constructor or another constructor of this class) you can't
|
|
perform reflection.
|
|
|
|
Replacing virtual constructors with plain virtual methods that are
|
|
called after the instance has been initialized causes problems if they
|
|
in turn call plain constructors from inside the JDK (you cannot call
|
|
constructors anymore once the instance has been constructed). It also
|
|
causes problems regarding which other constructor to call then instead
|
|
before to initialize the instance (we could add dummy constructors for
|
|
that purpose to Pascal classes, but that scheme breaks when a class
|
|
inherits from a JDK class other than JLObject).
|
|
}
|
|
if (current_procinfo.procdef.proctypeoption=potype_constructor) and
|
|
not(cnf_inherited in callnodeflags) and
|
|
(procdefinition.proctypeoption=potype_constructor) and
|
|
(po_virtualmethod in procdefinition.procoptions) and
|
|
(cnf_member_call in callnodeflags) then
|
|
CGMessage(parser_e_jvm_invalid_virtual_constructor_call);
|
|
end;
|
|
|
|
|
|
function tjvmcallnode.dispatch_procvar: tnode;
|
|
var
|
|
pdclass: tobjectdef;
|
|
begin
|
|
pdclass:=tcpuprocvardef(right.resultdef).classdef;
|
|
{ convert procvar type into corresponding class }
|
|
if not tprocvardef(right.resultdef).is_addressonly then
|
|
begin
|
|
right:=caddrnode.create_internal(right);
|
|
include(taddrnode(right).addrnodeflags,anf_typedaddr);
|
|
end;
|
|
right:=ctypeconvnode.create_explicit(right,pdclass);
|
|
include(right.flags,nf_load_procvar);
|
|
typecheckpass(right);
|
|
|
|
{ call the invoke method with these parameters. It will take care of the
|
|
wrapping and typeconversions; first filter out the automatically added
|
|
hidden parameters though }
|
|
remove_hidden_paras;
|
|
result:=ccallnode.createinternmethod(right,'INVOKE',left);
|
|
{ reused }
|
|
left:=nil;
|
|
right:=nil;
|
|
end;
|
|
|
|
|
|
function tjvmcallnode.pass_1: tnode;
|
|
var
|
|
sym: tsym;
|
|
wrappername: shortstring;
|
|
begin
|
|
{ transform procvar calls }
|
|
if assigned(right) then
|
|
result:=dispatch_procvar
|
|
else
|
|
begin
|
|
{ replace virtual class method and constructor calls in case they may
|
|
be indirect; make sure we don't replace the callthrough to the
|
|
original constructor with another call to the wrapper }
|
|
if (procdefinition.typ=procdef) and
|
|
not(current_procinfo.procdef.synthetickind in [tsk_callthrough,tsk_callthrough_nonabstract]) and
|
|
not(cnf_inherited in callnodeflags) and
|
|
((procdefinition.proctypeoption=potype_constructor) or
|
|
(po_classmethod in procdefinition.procoptions)) and
|
|
(po_virtualmethod in procdefinition.procoptions) and
|
|
(methodpointer.nodetype<>loadvmtaddrn) then
|
|
begin
|
|
wrappername:=symtableprocentry.name+'__FPCVIRTUALCLASSMETHOD__';
|
|
sym:=
|
|
search_struct_member(tobjectdef(procdefinition.owner.defowner),
|
|
wrappername);
|
|
if not assigned(sym) or
|
|
(sym.typ<>procsym) then
|
|
internalerror(2011072801);
|
|
{ do not simply replace the procsym/procdef in case we could
|
|
in theory do that, because the parameter nodes have already
|
|
been bound to the current procdef's parasyms }
|
|
remove_hidden_paras;
|
|
result:=ccallnode.create(left,tprocsym(sym),symtableproc,methodpointer,callnodeflags,nil);
|
|
result.flags:=flags;
|
|
left:=nil;
|
|
methodpointer:=nil;
|
|
exit;
|
|
end;
|
|
result:=inherited pass_1;
|
|
if assigned(result) then
|
|
exit;
|
|
{ set foverrideprocnamedef so that even virtual method calls will be
|
|
name-based (instead of based on VMT entry numbers) }
|
|
if procdefinition.typ=procdef then
|
|
foverrideprocnamedef:=tprocdef(procdefinition)
|
|
end;
|
|
end;
|
|
|
|
|
|
begin
|
|
ccallnode:=tjvmcallnode;
|
|
ccallparanode:=tjvmcallparanode;
|
|
end.
|