From eb5814a868230cb455799a34b5b0142bb40e8b60 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sat, 20 Aug 2011 07:46:37 +0000 Subject: [PATCH] * implemented declaring and calling constructors for Java classes o handle them like for regular classes (return a class instance, although this is technically not true since they don't return anything; will be changed in the future) o because of the previous point, make sure that we handle the "function result" properly and don't pop too many values from the evaluation stack when calling one constructor from another o added "extra_pre_call_code" method used by njvmcal to insert the "new" opcode to create the new class instance before calling a constructor o when a constructor does not call any other constructor (inherited or otherwise), automatically insert a call to the inherited parameterless constructor as required by the jvm standard) TODO: check that *if* an inherited or other constructor is called from another constructor, that it does so as the first statement/ call git-svn-id: branches/jvmbackend@18328 - --- compiler/jvm/hlcgcpu.pas | 20 +++++++++++++++++--- compiler/jvm/njvmcal.pas | 37 +++++++++++++++++++++++++++++++++---- compiler/ncal.pas | 16 +++++++++++++++- compiler/ncgcal.pas | 8 ++++++++ compiler/pdecobj.pas | 4 +++- compiler/pdecsub.pas | 8 +++++--- compiler/pexpr.pas | 7 +++++-- compiler/procinfo.pas | 5 +++++ compiler/psub.pas | 20 ++++++++++++++++++++ 9 files changed, 111 insertions(+), 14 deletions(-) diff --git a/compiler/jvm/hlcgcpu.pas b/compiler/jvm/hlcgcpu.pas index 61e484fd73..92506ddfbe 100644 --- a/compiler/jvm/hlcgcpu.pas +++ b/compiler/jvm/hlcgcpu.pas @@ -81,6 +81,7 @@ uses procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override; procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override; + procedure gen_load_return_value(list:TAsmList);override; procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); override; { JVM-specific routines } @@ -788,11 +789,16 @@ implementation procedure thlcgjvm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean); var + retdef: tdef; opc: tasmop; begin - case current_procinfo.procdef.returndef.typ of + if current_procinfo.procdef.proctypeoption=potype_constructor then + retdef:=voidtype + else + retdef:=current_procinfo.procdef.returndef; + case retdef.typ of orddef: - case torddef(current_procinfo.procdef.returndef).ordtype of + case torddef(retdef).ordtype of uvoid: opc:=a_return; s64bit, @@ -803,7 +809,7 @@ implementation opc:=a_ireturn; end; floatdef: - case tfloatdef(current_procinfo.procdef.returndef).floattype of + case tfloatdef(retdef).floattype of s32real: opc:=a_freturn; s64real: @@ -817,6 +823,14 @@ implementation list.concat(taicpu.op_none(opc)); end; + procedure thlcgjvm.gen_load_return_value(list: TAsmList); + begin + { constructors don't return anything in the jvm } + if current_procinfo.procdef.proctypeoption=potype_constructor then + exit; + inherited gen_load_return_value(list); + end; + procedure thlcgjvm.record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); begin { add something to the al_procedures list as well, because if all al_* diff --git a/compiler/jvm/njvmcal.pas b/compiler/jvm/njvmcal.pas index 3ec17c7246..4156bfc4cd 100644 --- a/compiler/jvm/njvmcal.pas +++ b/compiler/jvm/njvmcal.pas @@ -35,6 +35,7 @@ interface tjvmcallnode = class(tcgcallnode) protected + 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; @@ -45,16 +46,37 @@ implementation uses verbose,globtype, - symtype,defutil,ncal, - cgbase,cgutils,tgobj, + symconst,symtype,defutil,ncal, + cgbase,cgutils,tgobj,procinfo, cpubase,aasmdata,aasmcpu, - hlcgobj,hlcgcpu; + hlcgobj,hlcgcpu, + jvmdef; {***************************************************************************** TJVMCALLNODE *****************************************************************************} + 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.typ<>procdef then + exit; + if tprocdef(procdefinition).proctypeoption<>potype_constructor then + exit; + if (methodpointer.resultdef.typ<>classrefdef) then + exit; + current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(tobjectdef(tprocdef(procdefinition).owner.defowner).jvm_full_typename))); + { 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(2); + end; + + procedure tjvmcallnode.set_result_location(realresdef: tstoreddef); begin location_reset_ref(location,LOC_REFERENCE,def_cgsize(realresdef),1); @@ -64,6 +86,9 @@ implementation procedure tjvmcallnode.do_release_unused_return_value; begin + if (tprocdef(procdefinition).proctypeoption=potype_constructor) and + (current_procinfo.procdef.proctypeoption=potype_constructor) then + exit; case resultdef.size of 0: ; @@ -92,7 +117,11 @@ implementation realresdef:=tstoreddef(resultdef) else realresdef:=tstoreddef(typedef); - totalremovesize:=pushedparasize-realresdef.size; + { a constructor doesn't actually return a value in the jvm } + if (tprocdef(procdefinition).proctypeoption=potype_constructor) then + totalremovesize:=pushedparasize + else + totalremovesize:=pushedparasize-realresdef.size; { remove parameters from internal evaluation stack counter (in case of e.g. no parameters and a result, it can also increase) } if totalremovesize>0 then diff --git a/compiler/ncal.pas b/compiler/ncal.pas index f70fc2cceb..e1a17906f9 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -1670,7 +1670,12 @@ implementation { push 0 as self when allocation is needed } if (methodpointer.resultdef.typ=classrefdef) or (cnf_new_call in callnodeflags) then - selftree:=cpointerconstnode.create(0,voidpointertype) + if not is_javaclass(tdef(procdefinition.owner.defowner)) then + selftree:=cpointerconstnode.create(0,voidpointertype) + else + { special handling for Java constructors, handled in + tjvmcallnode.extra_pre_call_code } + selftree:=cnothingnode.create else begin if methodpointer.nodetype=typen then @@ -3340,6 +3345,15 @@ implementation doinlinesimplify(tnode(callcleanupblock)); end; + { If a constructor calls another constructor of the same or of an + inherited class, some targets (jvm) have to generate different + entry code for the constructor. } + if (current_procinfo.procdef.proctypeoption=potype_constructor) and + (procdefinition.typ=procdef) and + (tprocdef(procdefinition).proctypeoption=potype_constructor) and + ([cnf_member_call,cnf_inherited] * callnodeflags <> []) then + current_procinfo.ConstructorCallingConstructor:=true; + { Continue with checking a normal call or generate the inlined code } if cnf_do_inline in callnodeflags then result:=pass1_inline diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index fa11523ef4..7f59d2f277 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -68,6 +68,7 @@ interface } procedure pop_parasize(pop_size:longint);virtual; procedure extra_interrupt_code;virtual; + procedure extra_pre_call_code;virtual; procedure extra_call_code;virtual; procedure extra_post_call_code;virtual; procedure do_syscall;virtual;abstract; @@ -285,6 +286,11 @@ implementation end; + procedure tcgcallnode.extra_pre_call_code; + begin + end; + + procedure tcgcallnode.extra_call_code; begin end; @@ -650,6 +656,8 @@ implementation not(procdefinition.has_paraloc_info in [callerside,callbothsides]) then internalerror(200305264); + extra_pre_call_code; + if assigned(callinitblock) then secondpass(tnode(callinitblock)); diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index f969ff2734..e0a2051aa8 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -102,7 +102,9 @@ implementation include(current_structdef.objectoptions,oo_has_constructor); { Set return type, class and record constructors return the created instance, object constructors return boolean } - if is_class(pd.struct) or is_record(pd.struct) then + if is_class(pd.struct) or + is_record(pd.struct) or + is_javaclass(pd.struct) then pd.returndef:=pd.struct else {$ifdef CPU64bitaddr} diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 63c660d5cf..14a808d699 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -1402,7 +1402,9 @@ implementation begin { Set return type, class constructors return the created instance, object constructors return boolean } - if is_class(pd.struct) or is_record(pd.struct) then + if is_class(pd.struct) or + is_record(pd.struct) or + is_javaclass(pd.struct) then pd.returndef:=pd.struct else {$ifdef CPU64bitaddr} @@ -2377,7 +2379,7 @@ const mutexclpo : [] ),( idtok:_OVERLOAD; - pd_flags : [pd_implemen,pd_interface,pd_body]; + pd_flags : [pd_implemen,pd_interface,pd_body,pd_javaclass,pd_intfjava]; handler : @pd_overload; pocall : pocall_none; pooption : [po_overload]; @@ -2386,7 +2388,7 @@ const mutexclpo : [] ),( idtok:_OVERRIDE; - pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_javaclass,pd_notrecord]; + pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_javaclass,pd_intfjava,pd_notrecord]; handler : @pd_override; pocall : pocall_none; pooption : [po_overridingmethod,po_virtualmethod]; diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 612c59900d..86054b9730 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -1257,7 +1257,9 @@ implementation else begin p1:=ctypenode.create(ttypesym(sym).typedef); - if (is_class(ttypesym(sym).typedef) or is_objcclass(ttypesym(sym).typedef)) and + if (is_class(ttypesym(sym).typedef) or + is_objcclass(ttypesym(sym).typedef) or + is_javaclass(ttypesym(sym).typedef)) and not(block_type in [bt_type,bt_const_type,bt_var_type]) then p1:=cloadvmtaddrnode.create(p1); end; @@ -1553,7 +1555,8 @@ implementation (for "TClassHelper.Something") } { class reference ? } if is_class(hdef) or - is_objcclass(hdef) then + is_objcclass(hdef) or + is_javaclass(hdef) then begin if getaddr and (token=_POINT) then begin diff --git a/compiler/procinfo.pas b/compiler/procinfo.pas index b23b34341b..3225ca1aa6 100644 --- a/compiler/procinfo.pas +++ b/compiler/procinfo.pas @@ -114,6 +114,11 @@ unit procinfo; { max. of space need for parameters } maxpushedparasize : aint; + { is this a constructor that calls another constructor on itself + (either inherited, or another constructor of the same class)? + Requires different entry code for some targets. } + ConstructorCallingConstructor: boolean; + constructor create(aparent:tprocinfo);virtual; destructor destroy;override; diff --git a/compiler/psub.pas b/compiler/psub.pas index 26bf91b98a..21f3c0f3e3 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -292,6 +292,7 @@ implementation var srsym : tsym; para : tcallparanode; + call : tcallnode; newstatement : tstatementnode; begin result:=internalstatements(newstatement); @@ -350,6 +351,25 @@ implementation voidpointertype), ccallnode.createintern('fpc_help_constructor',para))); end + else + if is_javaclass(current_structdef) then + begin + if (current_procinfo.procdef.proctypeoption=potype_constructor) and + not current_procinfo.ConstructorCallingConstructor then + begin + { call inherited constructor } + srsym:=search_struct_member(tobjectdef(current_structdef).childof,'CREATE'); + if assigned(srsym) and + (srsym.typ=procsym) then + begin + call:=ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[cnf_inherited]); + exclude(tcallnode(call).callnodeflags,cnf_return_value_used); + addstatement(newstatement,call); + end + else + internalerror(2011010312); + end; + end else if not is_record(current_structdef) then internalerror(200305103);