From d6966e545bfe9ab85a84c238751d934b74059a94 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sat, 20 Aug 2011 08:23:33 +0000 Subject: [PATCH] + support for formal var/out parameters on the JVM target: o primitive types are first boxed o the parameter is passed inside an array of one class instance o changing the parameter inside the routine (by assigning a value to it like in Delphi.NET and different from regular Pascal code) will replace this class instance (again boxing the value if required) o on return, the class instance is extracted, unboxed if required, and assigned back to the original location o formal const parameters are handled without the extra array indirection, since they cannot be changed TODO: while writing tjvmcallparanode.handleformalcopyoutpara() I forgot that calling getcopy on ttemprefnodes whose ttempcreatenode hasn't been copied yet works fine, so that code is more complex than needed. Still have to fix. git-svn-id: branches/jvmbackend@18675 - --- compiler/compinnr.inc | 1 + compiler/jvm/cpupara.pas | 7 +- compiler/jvm/njvmcal.pas | 251 ++++++++++++++++++++++++++++++++++++--- compiler/jvm/njvmcnv.pas | 35 +++++- compiler/jvm/njvminl.pas | 51 ++++---- compiler/jvm/njvmld.pas | 33 ++++- compiler/jvmdef.pas | 123 +++++++++++++++++++ compiler/ncal.pas | 73 ++++++++++-- compiler/ncgcal.pas | 22 ++++ compiler/ncgld.pas | 3 + compiler/ninl.pas | 28 ++++- compiler/symdef.pas | 3 +- rtl/inc/innr.inc | 2 + 13 files changed, 574 insertions(+), 58 deletions(-) diff --git a/compiler/compinnr.inc b/compiler/compinnr.inc index 4b5352ab94..6bed628f9a 100644 --- a/compiler/compinnr.inc +++ b/compiler/compinnr.inc @@ -84,6 +84,7 @@ const in_bsf_x = 74; in_bsr_x = 75; in_box_x = 76; { managed platforms: wrap in class instance } + in_unbox_x_y = 77; { manage platforms: extract from class instance } { Internal constant functions } in_const_sqr = 100; diff --git a/compiler/jvm/cpupara.pas b/compiler/jvm/cpupara.pas index 1e6cacf4ba..93d38634e8 100644 --- a/compiler/jvm/cpupara.pas +++ b/compiler/jvm/cpupara.pas @@ -83,7 +83,10 @@ implementation { true if a parameter is too large to copy and only the address is pushed } function TJVMParaManager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; begin - result:=jvmimplicitpointertype(def); + result:= + jvmimplicitpointertype(def) or + ((def.typ=formaldef) and + not(varspez in [vs_var,vs_out])); end; @@ -92,7 +95,7 @@ implementation { in principle also for vs_constref, but since we can't have real references, that won't make a difference } result:= - (varspez in [vs_var,vs_out]) and + (varspez in [vs_var,vs_out,vs_constref]) and not jvmimplicitpointertype(def); end; diff --git a/compiler/jvm/njvmcal.pas b/compiler/jvm/njvmcal.pas index 879a0e424c..0143982f80 100644 --- a/compiler/jvm/njvmcal.pas +++ b/compiler/jvm/njvmcal.pas @@ -31,13 +31,14 @@ interface ncgcal; type - tjvmcallparanode = class(tcgcallparanode) protected outcopybasereg: tregister; procedure push_formal_para; override; procedure push_copyout_para; override; + procedure handleformalcopyoutpara(orgparadef: tdef); override; + procedure load_arrayref_para(useparadef: tdef); end; @@ -55,12 +56,12 @@ interface implementation uses - verbose,globtype, + verbose,globtype,constexp, symconst,defutil,ncal, cgutils,tgobj,procinfo, cpubase,aasmdata,aasmcpu, hlcgobj,hlcgcpu, - node, + pass_1,node,nutils,nbas,ncnv,ncon,ninl,nld,nmem, jvmdef; {***************************************************************************** @@ -95,14 +96,22 @@ implementation procedure tjvmcallparanode.push_formal_para; - var - primitivetype: boolean; begin - { create an array with one element of JLObject } - thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,1,R_INTREGISTER); - { left is either an object-derived type, or has been boxed into one } - current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_anewarray,current_asmdata.RefAsmSymbol(jvmarrtype(java_jlobject,primitivetype)))); - load_arrayref_para(java_jlobject); + { 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; @@ -125,6 +134,220 @@ implementation 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:=p.actualtargetnode; + end; + derefn: + begin + parent:=tunarynode(p); + p:=tunarynode(p).left; + end + else + break; + end; + end; + basenode:=p; + end; + + + function replacewithtemps(var orgnode, copiednode: tnode): ttempcreatenode; + begin + result:=ctempcreatenode.create_value( + orgnode.resultdef,orgnode.resultdef.size, + tt_persistent,true,orgnode); + { this right is reused while constructing the temp } + orgnode:=ctemprefnode.create(result); + typecheckpass(orgnode); + { this right is not reused } + copiednode.free; + copiednode:=ctemprefnode.create(result); + typecheckpass(copiednode); + end; + + + procedure tjvmcallparanode.handleformalcopyoutpara(orgparadef: tdef); + var + paravaltemp, + arraytemp, + indextemp: ttempcreatenode; + arrdef: tarraydef; + initstat, + finistat: tstatementnode; + leftcopy: tnode; + realpara, copyrealpara, tempn, assignmenttempn: tnode; + realparaparent,copyrealparaparent: tunarynode; + derefbasedef: tdef; + deref: boolean; + begin + fparainit:=internalstatements(initstat); + { In general, we now create a temp array of one element, assign left + (or its address in case of a jvmimplicitpointertype) to it, replace + the parameter with this array, and add code to paracopyback that + extracts the value from the array again and assigns it to the original + variable. + + Complications + a) in case the parameter involves calling a function, it must not + be called twice, so take the address of the location (since this + is a var/out parameter, taking the address is conceptually + always possible) + b) in case this is an element of a string, we can't take the address + in JVM code, so we then have to take the address of the string + (which conceptually may not be possible since it can be a + property or so) and store the index value into a temp, and + reconstruct the vecn in te paracopyback code from this data + (it's similar for normal var/out parameters) + } + + { we'll replace a bunch of stuff in the parameter with temprefnodes, + but we can't take a getcopy for the assignment afterwards of this + result since a getcopy will always assume that we are copying the + init/deletenodes too and that the temprefnodes have to point to the + new temps -> get a copy of the parameter in advance, and then replace + the nodes in the copy with temps just like in the original para } + leftcopy:=left.getcopy; + { get the real parameter source in case of type conversions. This is + the same logic as for set_unique(). The parent is where we have to + replace realpara with the temp that replaces it. } + getparabasenodes(left,realpara,realparaparent); + getparabasenodes(leftcopy,copyrealpara,copyrealparaparent); + { assign either the parameter's address (in case it's an implicit + pointer type) or the parameter itself (in case it's a primitive or + actual pointer/object type) to the temp } + deref:=false; + if jvmimplicitpointertype(realpara.resultdef) then + begin + derefbasedef:=realpara.resultdef; + realpara:=caddrnode.create_internal(realpara); + include(realpara.flags,nf_typedaddr); + typecheckpass(realpara); + { we'll have to reference the parameter again in the expression } + deref:=true; + end; + paravaltemp:=nil; + { make sure we don't replace simple loadnodes with a temp, because + in case of passing e.g. stringvar[3] to a formal var/out parameter, + we add "stringvar[3]:=" afterwards. Because Java strings are + immutable, this is translated into "stringvar:=stringvar.setChar(3, + )". So if we replace stringvar with a temp, this will change + the temp rather than stringvar. } + indextemp:=nil; + if (realpara.nodetype=vecn) then + begin + if node_complexity(tvecnode(realpara).left)>1 then + begin + paravaltemp:=replacewithtemps(tvecnode(realpara).left, + tvecnode(copyrealpara).left); + addstatement(initstat,paravaltemp); + end; + { in case of an array index, also replace the index with a temp if + necessary/useful } + if (node_complexity(tvecnode(realpara).right)>1) then + begin + indextemp:=replacewithtemps(tvecnode(realpara).right, + tvecnode(copyrealpara).right); + addstatement(initstat,indextemp); + end; + end + else + begin + paravaltemp:=ctempcreatenode.create_value( + realpara.resultdef,java_jlobject.size,tt_persistent,true,realpara); + addstatement(initstat,paravaltemp); + { replace the parameter in the parameter expression with this temp } + tempn:=ctemprefnode.create(paravaltemp); + assignmenttempn:=ctemprefnode.create(paravaltemp); + { will be spliced in the middle of a tree that has already been + typecheckpassed } + typecheckpass(tempn); + typecheckpass(assignmenttempn); + if assigned(realparaparent) then + begin + { left has been reused in paravaltemp (it's realpara itself) -> + don't free } + realparaparent.left:=tempn; + { the left's copy is not reused } + copyrealparaparent.left.free; + copyrealparaparent.left:=assignmenttempn; + end + else + begin + { left has been reused in paravaltemp (it's realpara itself) -> + don't free } + left:=tempn; + { leftcopy can remain the same } + assignmenttempn.free; + end; + end; + { create the array temp that and assign the parameter value (typecasted + to java_jlobject) } + arrdef:=tarraydef.create(0,1,s32inttype); + arrdef.elementdef:=java_jlobject; + arraytemp:=ctempcreatenode.create(arrdef,java_jlobject.size, + tt_persistent,true); + addstatement(initstat,arraytemp); + { wrap the primitive type in an object container + if required } + if (left.resultdef.typ in [orddef,floatdef]) then + begin + left:=cinlinenode.create(in_box_x,false,ccallparanode.create(left,nil)); + typecheckpass(left); + end; + addstatement(initstat,cassignmentnode.create( + cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0)), + ctypeconvnode.create_explicit(left,java_jlobject))); + { replace the parameter with the array } + left:=ctemprefnode.create(arraytemp); + { add the extraction of the parameter and assign it back to the + original location } + fparacopyback:=internalstatements(finistat); + tempn:=cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0)); + { unbox if necessary } + if orgparadef.typ in [orddef,floatdef] then + tempn:=cinlinenode.create(in_unbox_x_y,false,ccallparanode.create( + ctypenode.create(orgparadef),ccallparanode.create(tempn,nil))); + if (deref) then + begin + inserttypeconv_explicit(tempn,getpointerdef(derefbasedef)); + tempn:=cderefnode.create(tempn); + end; + addstatement(finistat,cassignmentnode.create(leftcopy, + ctypeconvnode.create_explicit(tempn,orgparadef))); + if assigned(indextemp) then + addstatement(finistat,ctempdeletenode.create(indextemp)); + addstatement(finistat,ctempdeletenode.create(arraytemp)); + if assigned(paravaltemp) then + addstatement(finistat,ctempdeletenode.create(paravaltemp)); + typecheckpass(fparainit); + typecheckpass(left); + typecheckpass(fparacopyback); + end; + + {***************************************************************************** TJVMCALLNODE *****************************************************************************} @@ -246,12 +469,8 @@ implementation end else begin -{$ifndef nounsupported} - { to do: extract value from boxed parameter or load - value back } -{$else} - internalerror(2011051901); -{$endif} + { extracting values from foramldef parameters is done + by the generic code } end; end; end; diff --git a/compiler/jvm/njvmcnv.pas b/compiler/jvm/njvmcnv.pas index d37dd080be..a282437626 100644 --- a/compiler/jvm/njvmcnv.pas +++ b/compiler/jvm/njvmcnv.pas @@ -93,7 +93,7 @@ implementation symconst,symdef,symsym,symtable,aasmbase,aasmdata, defutil,defcmp,jvmdef, cgbase,cgutils,pass_1,pass_2, - nbas,ncon,ncal,nld,nmem,procinfo, + nbas,ncon,ncal,ninl,nld,nmem,procinfo, nutils, cpubase,aasmcpu, tgobj,hlcgobj,hlcgcpu; @@ -912,7 +912,35 @@ implementation side } if (left.resultdef.typ=formaldef) and not assignment_side then - exit; + begin + if resultdef.typ in [orddef,floatdef] then + begin + if not check_only then + begin + resnode:=cinlinenode.create(in_unbox_x_y,false, + ccallparanode.create(ctypenode.create(resultdef), + ccallparanode.create(left,nil))); + left:=nil; + end; + result:=true; + exit; + end + else if jvmimplicitpointertype(resultdef) then + begin + { typecast formaldef to pointer to the type, then deref, so that + a proper checkcast is inserted } + if not check_only then + begin + resnode:=ctypeconvnode.create_explicit(left,getpointerdef(resultdef)); + resnode:=cderefnode.create(resnode); + left:=nil; + end; + result:=true; + exit; + end; + result:=false; + exit; + end; { don't allow conversions between different classes of primitive types, except for a few special cases } @@ -1195,7 +1223,8 @@ implementation if (checkdef.typ=pointerdef) and jvmimplicitpointertype(tpointerdef(checkdef).pointeddef) then checkdef:=tpointerdef(checkdef).pointeddef; - if checkdef=voidpointertype then + if (checkdef=voidpointertype) or + (checkdef.typ=formaldef) then checkdef:=java_jlobject else if checkdef.typ=enumdef then checkdef:=tenumdef(checkdef).classdef diff --git a/compiler/jvm/njvminl.pas b/compiler/jvm/njvminl.pas index c9386333c4..591fbd0f72 100644 --- a/compiler/jvm/njvminl.pas +++ b/compiler/jvm/njvminl.pas @@ -38,8 +38,8 @@ interface function first_copy: tnode; override; - function handle_box: tnode; override; function first_box: tnode; override; + function first_unbox: tnode; override; function first_setlength_array: tnode; function first_setlength_string: tnode; @@ -76,7 +76,6 @@ interface *) procedure second_new; override; procedure second_setlength; override; - procedure second_box; override; protected procedure load_fpu_location; end; @@ -238,20 +237,38 @@ implementation end; - function tjvminlinenode.handle_box: tnode; + function tjvminlinenode.first_box: tnode; + var + boxdef, + boxparadef: tdef; begin - Result:=inherited; - resultdef:=java_jlobject; + { get class wrapper type } + jvmgetboxtype(left.resultdef,boxdef,boxparadef); + { created wrapped instance } + inserttypeconv_explicit(tcallparanode(left).left,boxparadef); + result:=ccallnode.createinternmethod( + cloadvmtaddrnode.create(ctypenode.create(tobjectdef(boxdef))),'CREATE',left); + { reused } + left:=nil; end; - function tjvminlinenode.first_box: tnode; + function tjvminlinenode.first_unbox: tnode; + var + val: tnode; + boxdef, + boxparadef: tdef; begin - result:=nil; - expectloc:=LOC_REGISTER; -{$ifdef nounsupported} - internalerror(2011042603); -{$endif} + jvmgetboxtype(resultdef,boxdef,boxparadef); + val:=tcallparanode(tcallparanode(left).right).left; + tcallparanode(tcallparanode(left).right).left:=nil; + { typecast to the boxing type } + val:=ctypeconvnode.create_explicit(val,boxdef); + { call the unboxing method } + val:=ccallnode.createinternmethod(val,jvmgetunboxmethod(resultdef),nil); + { add type conversion for shortint -> byte etc } + inserttypeconv_explicit(val,resultdef); + result:=val; end; @@ -796,18 +813,6 @@ implementation thlcgjvm(hlcg).a_load_reg_loc(current_asmdata.CurrAsmList,target.resultdef,target.resultdef,tmpreg,target.location); end; - procedure tjvminlinenode.second_box; - begin -{$ifndef nounsupported} - secondpass(tcallparanode(left).left); - location_reset(location,LOC_REGISTER,OS_ADDR); - location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject); - hlcg.a_load_const_reg(current_asmdata.CurrAsmList,java_jlobject,0,location.register); -{$else} - internalerror(2011042606); -{$endif} - end; - begin cinlinenode:=tjvminlinenode; diff --git a/compiler/jvm/njvmld.pas b/compiler/jvm/njvmld.pas index 36a58df7ad..06654bc2b7 100644 --- a/compiler/jvm/njvmld.pas +++ b/compiler/jvm/njvmld.pas @@ -55,15 +55,19 @@ implementation uses verbose, aasmdata, - nbas,nld,ncal,nmem,ncnv, + nbas,nld,ncal,ninl,nmem,ncnv, symconst,symsym,symdef,symtable,defutil,jvmdef, paramgr, + pass_1, cgbase,hlcgobj; { tjvmassignmentnode } function tjvmassignmentnode.pass_1: tnode; var + block: tblocknode; + tempn: ttempcreatenode; + stat: tstatementnode; target: tnode; psym: tsym; begin @@ -115,6 +119,30 @@ function tjvmassignmentnode.pass_1: tnode; tvecnode(target).right:=nil; exit; end + else if target.resultdef.typ=formaldef then + begin + if right.resultdef.typ in [orddef,floatdef] then + right:=cinlinenode.create(in_box_x,false,right) + else if jvmimplicitpointertype(right.resultdef) then + begin + { we have to assign the address of a deep copy of the type to the + object in the formalpara -> create a temp, assign the value to + the temp, then assign the address in the temp to the para } + block:=internalstatements(stat); + tempn:=ctempcreatenode.create_value(right.resultdef,right.resultdef.size, + tt_persistent,false,right); + addstatement(stat,tempn); + right:=caddrnode.create(ctemprefnode.create(tempn)); + inserttypeconv_explicit(right,java_jlobject); + addstatement(stat,ctempdeletenode.create_normal_temp(tempn)); + addstatement(stat,ctypeconvnode.create_explicit( + caddrnode.create(ctemprefnode.create(tempn)),java_jlobject)); + right:=block; + end; + typecheckpass(right); + result:=inherited; + exit; + end else result:=inherited; end; @@ -134,7 +162,8 @@ function tjvmloadnode.is_addr_param_load: boolean; begin result:= (inherited and - not jvmimplicitpointertype(tparavarsym(symtableentry).vardef)) or + not jvmimplicitpointertype(tparavarsym(symtableentry).vardef) and + (tparavarsym(symtableentry).vardef.typ<>formaldef)) or is_copyout_addr_param_load; end; diff --git a/compiler/jvmdef.pas b/compiler/jvmdef.pas index 82f4f0892f..b34f6caa76 100644 --- a/compiler/jvmdef.pas +++ b/compiler/jvmdef.pas @@ -74,6 +74,11 @@ interface function jvmmangledbasename(sym: tsym; withsignature: boolean): TSymStr; function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr; + { sometimes primitive types have to be boxed/unboxed via class types. This + routine returns the appropriate box type for the passed primitive type } + procedure jvmgetboxtype(def: tdef; out objdef, paradef: tdef); + function jvmgetunboxmethod(def: tdef): string; + implementation uses @@ -503,6 +508,124 @@ implementation end; + procedure jvmgetboxtype(def: tdef; out objdef, paradef: tdef); + begin + case def.typ of + orddef: + begin + case torddef(def).ordtype of + pasbool8: + begin + objdef:=tobjectdef(search_system_type('JLBOOLEAN').typedef); + paradef:=pasbool8type; + end; + { wrap all integer types into a JLLONG, so that we don't get + errors after returning a byte assigned to a long etc } + s8bit, + u8bit, + uchar, + bool8bit, + s16bit, + u16bit, + bool16bit, + pasbool16, + s32bit, + u32bit, + bool32bit, + pasbool32, + s64bit, + u64bit, + scurrency, + bool64bit, + pasbool64: + begin + objdef:=tobjectdef(search_system_type('JLLONG').typedef); + paradef:=s64inttype; + end; + uwidechar: + begin + objdef:=tobjectdef(search_system_type('JLCHARACTER').typedef); + paradef:=cwidechartype; + end; + else + internalerror(2011052101); + end; + end; + floatdef: + begin + case tfloatdef(def).floattype of + s32real: + begin + objdef:=tobjectdef(search_system_type('JLFLOAT').typedef); + paradef:=s32floattype; + end; + s64real: + begin + objdef:=tobjectdef(search_system_type('JLDOUBLE').typedef); + paradef:=s64floattype; + end; + else + internalerror(2011052102); + end; + end; + else + internalerror(2011052103); + end; + end; + + + function jvmgetunboxmethod(def: tdef): string; + begin + case def.typ of + orddef: + begin + case torddef(def).ordtype of + pasbool8: + result:='BOOLEANVALUE'; + s8bit, + u8bit, + uchar, + bool8bit: + result:='BYTEVALUE'; + s16bit, + u16bit, + bool16bit, + pasbool16: + result:='SHORTVALUE'; + s32bit, + u32bit, + bool32bit, + pasbool32: + result:='INTVALUE'; + s64bit, + u64bit, + scurrency, + bool64bit, + pasbool64: + result:='LONGVALUE'; + uwidechar: + result:='CHARVALUE'; + else + internalerror(2011071702); + end; + end; + floatdef: + begin + case tfloatdef(def).floattype of + s32real: + result:='FLOATVALUE'; + s64real: + result:='DOUBLEVALUE'; + else + internalerror(2011071703); + end; + end; + else + internalerror(2011071704); + end; + end; + + function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr; var container: tsymtable; diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 388f39887a..8d710df57e 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -178,6 +178,13 @@ interface private fcontains_stack_tainting_call_cached, ffollowed_by_stack_tainting_call_cached : boolean; + protected + { in case of copy-out parameters: initialization code, and the code to + copy back the parameter value after the call (including any required + finalization code } + fparainit, + fparacopyback: tnode; + procedure handleformalcopyoutpara(orgparadef: tdef);virtual;abstract; public callparaflags : tcallparaflags; parasym : tparavarsym; @@ -187,6 +194,8 @@ interface destructor destroy;override; constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl; override; + procedure derefimpl; override; function dogetcopy : tnode;override; procedure insertintolist(l : tnodelist);override; function pass_typecheck : tnode;override; @@ -221,6 +230,7 @@ interface parameter whose evaluation involves a stack tainting parameter (result is only valid after order_parameters has been called) } property followed_by_stack_tainting_call_cached: boolean read ffollowed_by_stack_tainting_call_cached; + property paracopyback: tnode read fparacopyback; end; tcallparanodeclass = class of tcallparanode; @@ -573,6 +583,8 @@ implementation begin inherited ppuload(t,ppufile); ppufile.getsmallset(callparaflags); + fparainit:=ppuloadnode(ppufile); + fparacopyback:=ppuloadnode(ppufile); end; @@ -580,6 +592,28 @@ implementation begin inherited ppuwrite(ppufile); ppufile.putsmallset(callparaflags); + ppuwritenode(ppufile,fparainit); + ppuwritenode(ppufile,fparacopyback); + end; + + + procedure tcallparanode.buildderefimpl; + begin + inherited buildderefimpl; + if assigned(fparainit) then + fparainit.buildderefimpl; + if assigned(fparacopyback) then + fparacopyback.buildderefimpl; + end; + + + procedure tcallparanode.derefimpl; + begin + inherited derefimpl; + if assigned(fparainit) then + fparainit.derefimpl; + if assigned(fparacopyback) then + fparacopyback.derefimpl; end; @@ -587,11 +621,19 @@ implementation var n : tcallparanode; - + initcopy: tnode; begin + initcopy:=nil; + { must be done before calling inherited getcopy, because can create + tempcreatenodes for values used in left } + if assigned(fparainit) then + initcopy:=fparainit.getcopy; n:=tcallparanode(inherited dogetcopy); n.callparaflags:=callparaflags; n.parasym:=parasym; + n.fparainit:=initcopy; + if assigned(fparacopyback) then + n.fparacopyback:=fparacopyback.getcopy; result:=n; end; @@ -625,9 +667,13 @@ implementation tcallparanode(right).get_paratype; old_array_constructor:=allow_array_constructor; allow_array_constructor:=true; + if assigned(fparainit) then + typecheckpass(fparainit); typecheckpass(left); if assigned(third) then typecheckpass(third); + if assigned(fparacopyback) then + typecheckpass(fparacopyback); allow_array_constructor:=old_array_constructor; if codegenerror then resultdef:=generrordef @@ -642,7 +688,11 @@ implementation tcallparanode(right).firstcallparan; if not assigned(left.resultdef) then get_paratype; + if assigned(fparainit) then + firstpass(fparainit); firstpass(left); + if assigned(fparacopyback) then + firstpass(fparacopyback); if assigned(third) then firstpass(third); expectloc:=left.expectloc; @@ -871,21 +921,22 @@ implementation begin if not valid_for_formal_var(left,true) then CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list) - else if (target_info.system in systems_managed_vm) and - (left.resultdef.typ in [orddef,floatdef]) then + else if (target_info.system in systems_managed_vm) then begin - left:=cinlinenode.create(in_box_x,false,ccallparanode.create(left,nil)); - typecheckpass(left); -{$ifdef nounsupported} - { TODO: unbox afterwards } - internalerror(2011042608); -{$endif} + olddef:=left.resultdef; + handleformalcopyoutpara(left.resultdef); end; end; vs_const : begin if not valid_for_formal_const(left,true) then - CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list); + CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list) + else if (target_info.system in systems_managed_vm) and + (left.resultdef.typ in [orddef,floatdef]) then + begin + left:=cinlinenode.create(in_box_x,false,ccallparanode.create(left,nil)); + typecheckpass(left); + end; end; end; end @@ -1006,6 +1057,8 @@ implementation begin docompare := inherited docompare(p) and + fparainit.isequal(tcallparanode(p).fparainit) and + fparacopyback.isequal(tcallparanode(p).fparacopyback) and (callparaflags = tcallparanode(p).callparaflags) ; end; diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index 496167d387..f9d6d9e907 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -52,6 +52,7 @@ interface procedure handle_return_value; procedure release_unused_return_value; + procedure copy_back_paras; procedure release_para_temps; procedure pushparas; procedure freeparas; @@ -181,6 +182,8 @@ implementation oflabel:=current_procinfo.CurrFalseLabel; current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + if assigned(fparainit) then + secondpass(fparainit); secondpass(left); maybechangeloadnodereg(current_asmdata.CurrAsmList,left,true); @@ -471,6 +474,22 @@ implementation end; + procedure tcgcallnode.copy_back_paras; + var + hp, + hp2 : tnode; + ppn : tcallparanode; + begin + ppn:=tcallparanode(left); + while assigned(ppn) do + begin + if assigned(ppn.paracopyback) then + secondpass(ppn.paracopyback); + ppn:=tcallparanode(ppn.right); + end; + end; + + procedure tcgcallnode.release_para_temps; var hp, @@ -966,6 +985,9 @@ implementation if assigned(callcleanupblock) then secondpass(tnode(callcleanupblock)); + { copy back copy-out parameters if any } + copy_back_paras; + { release temps and finalize unused return values, must be after the callcleanupblock because that converts temps from persistent to normal } diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas index 2177a1b8bc..52b81505b8 100644 --- a/compiler/ncgld.pas +++ b/compiler/ncgld.pas @@ -809,6 +809,9 @@ implementation { TODO: HACK: unaligned test, maybe remove all unaligned locations (array of char) from the compiler} { Use unaligned copy when the offset is not aligned } len:=left.resultdef.size; + { can be 0 in case of formaldef on JVM target } + if len=0 then + len:=sizeof(pint); { data smaller than an aint has less alignment requirements } alignmentrequirement:=min(len,sizeof(aint)); diff --git a/compiler/ninl.pas b/compiler/ninl.pas index 1211ffddbf..24133234d4 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -74,8 +74,8 @@ interface function first_new: tnode; virtual; function first_length: tnode; virtual; function first_box: tnode; virtual; abstract; + function first_unbox: tnode; virtual; abstract; - function handle_box: tnode; virtual; private function handle_str: tnode; function handle_reset_rewrite_typed: tnode; @@ -85,6 +85,8 @@ interface function handle_val: tnode; function handle_setlength: tnode; function handle_copy: tnode; + function handle_box: tnode; + function handle_unbox: tnode; end; tinlinenodeclass = class of tinlinenode; @@ -2903,6 +2905,10 @@ implementation begin result:=handle_box; end; + in_unbox_x_y: + begin + result:=handle_unbox; + end; else internalerror(8); end; @@ -3303,6 +3309,8 @@ implementation result:=first_new; in_box_x: result:=first_box; + in_unbox_x_y: + result:=first_unbox; else internalerror(89); end; @@ -3597,9 +3605,27 @@ implementation function tinlinenode.handle_box: tnode; begin result:=nil; + if not assigned(left) or + assigned(tcallparanode(left).right) then + CGMessage1(parser_e_wrong_parameter_size,'FpcInternalBox'); resultdef:=class_tobject; end; + + function tinlinenode.handle_unbox: tnode; + begin + result:=nil; + if not assigned(left) or + not assigned(tcallparanode(left).right) or + assigned(tcallparanode(tcallparanode(left).right).right) then + CGMessage1(parser_e_wrong_parameter_size,'FpcInternalUnBox'); + if tcallparanode(left).left.nodetype<>typen then + internalerror(2011071701); + ttypenode(tcallparanode(left).left).allowed:=true; + resultdef:=tcallparanode(left).left.resultdef; + end; + + function tinlinenode.first_pack_unpack: tnode; var loopstatement : tstatementnode; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 859da89234..6bea360276 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -4661,7 +4661,8 @@ implementation does achieve regular call-by-reference semantics though; formaldefs always have to be passed like that because their contents can be replaced } - if (vs.vardef.typ=formaldef) or + if ((vs.vardef.typ=formaldef) and + (vs.varspez<>vs_const)) or ((vs.varspez in [vs_var,vs_out,vs_constref]) and not jvmimplicitpointertype(vs.vardef)) then tmpresult:=tmpresult+'['; diff --git a/rtl/inc/innr.inc b/rtl/inc/innr.inc index da5c95e14e..f9307fa87e 100644 --- a/rtl/inc/innr.inc +++ b/rtl/inc/innr.inc @@ -84,6 +84,8 @@ const fpc_in_sar_x = 73; fpc_in_bsf_x = 74; fpc_in_bsr_x = 75; + in_box_x = 76; { managed platforms: wrap in class instance } + in_unbox_x_y = 77; { manage platforms: extract from class instance } { Internal constant functions } fpc_in_const_sqr = 100;