mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 09:07:59 +02:00
+ 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 -
This commit is contained in:
Jonas Maebe
parent
5bf16214cd
commit
d6966e545b
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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]:=<result>" afterwards. Because Java strings are
|
||||
immutable, this is translated into "stringvar:=stringvar.setChar(3,
|
||||
<result>)". 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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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 }
|
||||
|
||||
@ -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));
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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+'[';
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user