From 92526c41a9ea39714e23ab4ba1d9694963ddce7a Mon Sep 17 00:00:00 2001
From: nickysn <nickysn@gmail.com>
Date: Wed, 29 Jul 2020 17:07:58 +0000
Subject: [PATCH] [PATCH 25/83] adding nwasmcal (copied over from njvmcal) in
order to properly handle function results
From 7652ef7e443b90453d6e4559e5c1641add53daf2 Mon Sep 17 00:00:00 2001
From: Dmitry Boyarintsev <skalogryz.lists@gmail.com>
Date: Wed, 11 Sep 2019 22:57:08 -0400
git-svn-id: branches/wasm@45902 -
---
.gitattributes | 1 +
compiler/wasm/cpunode.pas | 2 +-
compiler/wasm/nwasmcal.pas | 628 +++++++++++++++++++++++++++++++++++++
3 files changed, 630 insertions(+), 1 deletion(-)
create mode 100644 compiler/wasm/nwasmcal.pas
diff --git a/.gitattributes b/.gitattributes
index 3e632e8c95..261b7d48a5 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -932,6 +932,7 @@ compiler/wasm/cputarg.pas svneol=native#text/plain
compiler/wasm/hlcgcpu.pas svneol=native#text/plain
compiler/wasm/itcpuwasm.pas svneol=native#text/plain
compiler/wasm/nwasmadd.pas svneol=native#text/plain
+compiler/wasm/nwasmcal.pas svneol=native#text/plain
compiler/wasm/nwasmflw.pas svneol=native#text/plain
compiler/wasm/rgcpu.pas svneol=native#text/plain
compiler/wasm/rwasmcon.inc svneol=native#text/plain
diff --git a/compiler/wasm/cpunode.pas b/compiler/wasm/cpunode.pas
index dd910f4720..ba96366fb5 100644
--- a/compiler/wasm/cpunode.pas
+++ b/compiler/wasm/cpunode.pas
@@ -33,7 +33,7 @@ implementation
ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,
ncgadd, ncgcal,ncgmat,ncginl,
- nwasmadd, nwasmflw,
+ nwasmadd, nwasmcal, nwasmflw,
(* todo: WASM
njvmadd,njvmcal,njvmmat,njvmcnv,njvmcon,njvminl,njvmmem,njvmflw,njvmld,
njvmset,njvmvmt
diff --git a/compiler/wasm/nwasmcal.pas b/compiler/wasm/nwasmcal.pas
new file mode 100644
index 0000000000..94e646ac54
--- /dev/null
+++ b/compiler/wasm/nwasmcal.pas
@@ -0,0 +1,628 @@
+{
+ Copyright (c) 2011 by Dmitry Boyarintsev
+
+ WebAssembly-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 nwasmcal;
+
+{$i fpcdefs.inc}
+
+interface
+
+ uses
+ cgbase,
+ symtype,symdef,
+ node,ncal,ncgcal;
+
+ type
+ twasmcallparanode = class(tcgcallparanode)
+ protected
+ function push_zero_sized_value_para: boolean; override;
+
+ procedure push_formal_para; override;
+ procedure push_copyout_para; override;
+
+ procedure handlemanagedbyrefpara(orgparadef: tdef); override;
+ end;
+
+ { tjvmcallnode }
+
+ twasmcallnode = 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;
+
+{*****************************************************************************
+ TJVMCALLPARANODE
+*****************************************************************************}
+
+ function twasmcallparanode.push_zero_sized_value_para: boolean;
+ begin
+ { part of the signature -> need to be pushed }
+ result:=true;
+ end;
+
+
+ procedure twasmcallparanode.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 twasmcallparanode.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 twasmcallparanode.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;
+
+ //todo:
+ //implicitptrpara:=jvmimplicitpointertype(orgparadef);
+ implicitptrpara := false;
+
+ { create the array temp that that will serve as the paramter }
+ 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;
+
+
+{*****************************************************************************
+ TWASMCALLNODE
+*****************************************************************************}
+
+ procedure twasmcallnode.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 twasmcallnode.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;
+
+ 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 twasmcallnode.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 twasmcallnode.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_drop));
+ thlcgwasm(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 twasmcallnode.extra_post_call_code;
+ var
+ realresdef: tdef;
+ begin
+ thlcgwasm(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);
+ thlcgwasm(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
+ thlcgwasm(hlcg).gen_initialize_fields_code(current_asmdata.CurrAsmList);
+ end;
+
+
+ procedure twasmcallnode.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 twasmcallnode.gen_vmt_entry_load;
+ begin
+ { nothing to do }
+ end;
+
+
+ function twasmcallnode.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 twasmcallnode.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 twasmcallnode.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 fforcedprocname so that even virtual method calls will be
+ name-based (instead of based on VMT entry numbers) }
+ if procdefinition.typ=procdef then
+ fforcedprocname:=tprocdef(procdefinition).mangledname
+ end;
+ end;
+
+
+begin
+ ccallnode:=twasmcallnode;
+ ccallparanode:=twasmcallparanode;
+end.