|
|
@@ -1,5 +1,5 @@
|
|
|
{
|
|
|
- Copyright (c) 2019 by Dmitry Boyarintsev based on JVM by Jonas Maebe
|
|
|
+ Copyright (c) 2019 by Dmitry Boyarintsev
|
|
|
|
|
|
WebAssembly-specific code for call nodes
|
|
|
|
|
|
@@ -31,597 +31,33 @@ interface
|
|
|
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;
|
|
|
+ { twasmcallparanode }
|
|
|
|
|
|
- procedure handlemanagedbyrefpara(orgparadef: tdef); override;
|
|
|
+ twasmcallparanode = class(tcgcallparanode)
|
|
|
end;
|
|
|
|
|
|
- { tjvmcallnode }
|
|
|
+ { twasmcallnode }
|
|
|
|
|
|
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:=ptruinttype
|
|
|
- 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,ptruinttype);
|
|
|
- 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;
|
|
|
+ globtype, aasmdata, defutil, cgutils, tgobj;
|
|
|
|
|
|
+ { twasmcallnode }
|
|
|
|
|
|
procedure twasmcallnode.set_result_location(realresdef: tstoreddef);
|
|
|
begin
|
|
|
+ // default implementation is placing the return value on LOC_REGISTER.
|
|
|
+ // WebAssembly always returns the value on stack.
|
|
|
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);
|
|
|
+ tg.gethltemp(current_asmdata.CurrAsmList,realresdef,retloc.intsize,tt_normal,location.reference);
|
|
|
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;
|
nickysn