mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-04 16:23:43 +02:00
37aa2d8443
o sets of enums are handled as JUEnumSet instances, others as JUBitSet
derivatives (both smallsets and varsets, to make interoperability with
Java easier)
o special handling of set constants: these have to be constructed at run
time. In case of constants in the code, create an internal constsym to
represent them. These and regular constsyms are then aliased by an
another internal staticvarsym that is used to initialise them in the
unit initialisation code.
o until they are constructed at run time, set constants are encoded as
constant Java strings (with the characters containing the set bits)
o hlcgobj conversion of tcginnode.pass_generate_code() for the genjumps
part (that's the only part of the generic code that's used by the JVM
target)
o as far as explicit typecasting support is concerned, currently the
following ones are supported (both from/to setdefs): ordinal types,
enums, any other set types (whose size is the same on native targets)
o enum setdefs also emit signatures
o overloading routines for different ordinal set types, or for different
enum set types, is not supported on the JVM target
git-svn-id: branches/jvmbackend@18662 -
573 lines
21 KiB
ObjectPascal
573 lines
21 KiB
ObjectPascal
{
|
||
Copyright (c) 2000-2011 by Florian Klaempfl and Jonas Maebe
|
||
|
||
Code generation for add nodes on the JVM
|
||
|
||
This program is free software; you can redistribute it and/or modify
|
||
it under the terms of the GNU General Public License as published by
|
||
the Free Software Foundation; either version 2 of the License, or
|
||
(at your option) any later version.
|
||
|
||
This program is distributed in the hope that it will be useful,
|
||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
GNU General Public License for more details.
|
||
|
||
You should have received a copy of the GNU General Public License
|
||
along with this program; if not, write to the Free Software
|
||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||
|
||
****************************************************************************
|
||
}
|
||
unit njvmadd;
|
||
|
||
{$i fpcdefs.inc}
|
||
|
||
interface
|
||
|
||
uses
|
||
cgbase,
|
||
node,ncgadd,cpubase;
|
||
|
||
type
|
||
|
||
{ tjvmaddnode }
|
||
|
||
tjvmaddnode = class(tcgaddnode)
|
||
function pass_1: tnode;override;
|
||
protected
|
||
function first_addstring: tnode; override;
|
||
function jvm_first_addset: tnode;
|
||
|
||
function cmpnode2signedtopcmp: TOpCmp;
|
||
|
||
procedure second_generic_compare;
|
||
|
||
procedure pass_left_right;override;
|
||
procedure second_addfloat;override;
|
||
procedure second_cmpfloat;override;
|
||
procedure second_cmpboolean;override;
|
||
procedure second_cmp64bit;override;
|
||
procedure second_add64bit; override;
|
||
procedure second_cmpordinal;override;
|
||
end;
|
||
|
||
implementation
|
||
|
||
uses
|
||
systems,
|
||
cutils,verbose,constexp,globtype,
|
||
symconst,symtable,symdef,
|
||
paramgr,procinfo,pass_1,
|
||
aasmtai,aasmdata,aasmcpu,defutil,
|
||
hlcgobj,hlcgcpu,cgutils,
|
||
cpupara,
|
||
nbas,ncon,nset,nadd,ncal,ncnv,nld,nmat,nmem,
|
||
njvmcon,
|
||
cgobj;
|
||
|
||
{*****************************************************************************
|
||
tjvmaddnode
|
||
*****************************************************************************}
|
||
|
||
function tjvmaddnode.pass_1: tnode;
|
||
begin
|
||
{ special handling for enums: they're classes in the JVM -> get their
|
||
ordinal value to compare them (do before calling inherited pass_1,
|
||
because pass_1 will convert enum constants from ordinals into class
|
||
instances) }
|
||
if (left.resultdef.typ=enumdef) and
|
||
(right.resultdef.typ=enumdef) then
|
||
begin
|
||
{ enums can only be compared at this stage (add/sub is only allowed
|
||
in constant expressions) }
|
||
if not is_boolean(resultdef) then
|
||
internalerror(2011062603);
|
||
inserttypeconv_explicit(left,s32inttype);
|
||
inserttypeconv_explicit(right,s32inttype);
|
||
end;
|
||
{ special handling for sets: all sets are JUBitSet/JUEnumSet on the JVM
|
||
target to ease interoperability with Java code }
|
||
if left.resultdef.typ=setdef then
|
||
begin
|
||
result:=jvm_first_addset;
|
||
exit;
|
||
end;
|
||
result:=inherited pass_1;
|
||
if expectloc=LOC_FLAGS then
|
||
expectloc:=LOC_JUMP;
|
||
end;
|
||
|
||
|
||
function tjvmaddnode.first_addstring: tnode;
|
||
var
|
||
cmpfuncname: string;
|
||
begin
|
||
{ when we get here, we are sure that both the left and the right }
|
||
{ node are both strings of the same stringtype (JM) }
|
||
case nodetype of
|
||
addn:
|
||
begin
|
||
if is_shortstring(resultdef) then
|
||
begin
|
||
result:=inherited;
|
||
exit;
|
||
end;
|
||
{ unicode/ansistring operations use functions rather than
|
||
procedures for efficiency reasons (were also implemented before
|
||
var-parameters were supported; may go to procedures for
|
||
maintenance reasons though }
|
||
if (left.nodetype=stringconstn) and (tstringconstnode(left).len=0) then
|
||
begin
|
||
result:=right;
|
||
left.free;
|
||
left:=nil;
|
||
right:=nil;
|
||
exit;
|
||
end;
|
||
if (right.nodetype=stringconstn) and (tstringconstnode(right).len=0) then
|
||
begin
|
||
result:=left;
|
||
left:=nil;
|
||
right.free;
|
||
right:=nil;
|
||
exit;
|
||
end;
|
||
|
||
{ create the call to the concat routine both strings as arguments }
|
||
result:=ccallnode.createintern('fpc_'+
|
||
tstringdef(resultdef).stringtypname+'_concat',
|
||
ccallparanode.create(right,
|
||
ccallparanode.create(left,nil)));
|
||
{ we reused the arguments }
|
||
left := nil;
|
||
right := nil;
|
||
end;
|
||
ltn,lten,gtn,gten,equaln,unequaln :
|
||
begin
|
||
{ call compare routine }
|
||
cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare';
|
||
{ for equality checks use optimized version }
|
||
if nodetype in [equaln,unequaln] then
|
||
cmpfuncname := cmpfuncname + '_equal';
|
||
|
||
result := ccallnode.createintern(cmpfuncname,
|
||
ccallparanode.create(right,ccallparanode.create(left,nil)));
|
||
{ and compare its result with 0 according to the original operator }
|
||
result := caddnode.create(nodetype,result,
|
||
cordconstnode.create(0,s32inttype,false));
|
||
left := nil;
|
||
right := nil;
|
||
end;
|
||
else
|
||
internalerror(2011031401);
|
||
end;
|
||
end;
|
||
|
||
|
||
function tjvmaddnode.jvm_first_addset: tnode;
|
||
|
||
procedure call_set_helper_paras(const n : string; isenum: boolean; paras: tcallparanode);
|
||
var
|
||
block: tblocknode;
|
||
stat: tstatementnode;
|
||
temp: ttempcreatenode;
|
||
begin
|
||
result:=ccallnode.createinternmethod(left,'CLONE',nil);
|
||
if isenum then
|
||
inserttypeconv_explicit(result,java_juenumset)
|
||
else
|
||
inserttypeconv_explicit(result,java_jubitset);
|
||
if isenum then
|
||
begin
|
||
{ all enum instance methods return a boolean, while we are
|
||
interested in the resulting set }
|
||
block:=internalstatements(stat);
|
||
temp:=ctempcreatenode.create(java_juenumset,4,tt_persistent,true);
|
||
addstatement(stat,temp);
|
||
addstatement(stat,cassignmentnode.create(
|
||
ctemprefnode.create(temp),result));
|
||
addstatement(stat,ccallnode.createinternmethod(
|
||
ctemprefnode.create(temp),n,paras));
|
||
addstatement(stat,ctempdeletenode.create_normal_temp(temp));
|
||
addstatement(stat,ctemprefnode.create(temp));
|
||
result:=block;
|
||
end
|
||
else
|
||
result:=ccallnode.createinternmethod(result,n,paras);
|
||
end;
|
||
|
||
procedure call_set_helper(const n: string; isenum: boolean);
|
||
begin
|
||
call_set_helper_paras(n,isenum,ccallparanode.create(right,nil));
|
||
end;
|
||
|
||
var
|
||
procname: string;
|
||
tmpn: tnode;
|
||
paras: tcallparanode;
|
||
isenum: boolean;
|
||
begin
|
||
isenum:=
|
||
(assigned(tsetdef(left.resultdef).elementdef) and
|
||
(tsetdef(left.resultdef).elementdef.typ=enumdef)) or
|
||
((right.nodetype=setelementn) and
|
||
(tsetelementnode(right).left.resultdef.typ=enumdef)) or
|
||
((right.resultdef.typ=setdef) and
|
||
assigned(tsetdef(right.resultdef).elementdef) and
|
||
(tsetdef(right.resultdef).elementdef.typ=enumdef));
|
||
{ don't destroy optimization opportunity }
|
||
if not((nodetype=addn) and
|
||
(right.nodetype=setelementn) and
|
||
is_emptyset(left)) then
|
||
begin
|
||
left:=caddrnode.create_internal(left);
|
||
include(left.flags,nf_typedaddr);
|
||
if isenum then
|
||
begin
|
||
inserttypeconv_explicit(left,java_juenumset);
|
||
if right.resultdef.typ=setdef then
|
||
begin
|
||
right:=caddrnode.create_internal(right);
|
||
include(right.flags,nf_typedaddr);
|
||
inserttypeconv_explicit(right,java_juenumset);
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
inserttypeconv_explicit(left,java_jubitset);
|
||
if right.resultdef.typ=setdef then
|
||
begin
|
||
right:=caddrnode.create_internal(right);
|
||
include(right.flags,nf_typedaddr);
|
||
inserttypeconv_explicit(right,java_jubitset);
|
||
end;
|
||
end;
|
||
end
|
||
else
|
||
tjvmsetconstnode(left).setconsttype:=sct_notransform;
|
||
firstpass(left);
|
||
firstpass(right);
|
||
case nodetype of
|
||
equaln,unequaln,lten,gten:
|
||
begin
|
||
case nodetype of
|
||
equaln,unequaln:
|
||
procname:='EQUALS';
|
||
lten,gten:
|
||
begin
|
||
{ (left <= right) = (right >= left) }
|
||
if nodetype=lten then
|
||
begin
|
||
tmpn:=left;
|
||
left:=right;
|
||
right:=tmpn;
|
||
end;
|
||
procname:='CONTAINSALL'
|
||
end;
|
||
end;
|
||
result:=ccallnode.createinternmethod(left,procname,ccallparanode.create(right,nil));
|
||
{ for an unequaln, we have to negate the result of equals }
|
||
if nodetype=unequaln then
|
||
result:=cnotnode.create(result);
|
||
end;
|
||
addn:
|
||
begin
|
||
{ optimize first loading of a set }
|
||
if (right.nodetype=setelementn) and
|
||
is_emptyset(left) then
|
||
begin
|
||
paras:=nil;
|
||
procname:='OF';
|
||
if isenum then
|
||
begin
|
||
inserttypeconv_explicit(tsetelementnode(right).left,tenumdef(tsetelementnode(right).left.resultdef).getbasedef.classdef);
|
||
result:=cloadvmtaddrnode.create(ctypenode.create(java_juenumset));
|
||
end
|
||
else
|
||
begin
|
||
{ for boolean, char, etc }
|
||
inserttypeconv_explicit(tsetelementnode(right).left,s32inttype);
|
||
result:=cloadvmtaddrnode.create(ctypenode.create(java_jubitset));
|
||
end;
|
||
paras:=ccallparanode.create(tsetelementnode(right).left,nil);
|
||
tsetelementnode(right).left:=nil;
|
||
if assigned(tsetelementnode(right).right) then
|
||
begin
|
||
procname:='RANGE';
|
||
if isenum then
|
||
begin
|
||
inserttypeconv_explicit(tsetelementnode(right).right,tenumdef(tsetelementnode(right).right.resultdef).getbasedef.classdef);
|
||
end
|
||
else
|
||
begin
|
||
inserttypeconv_explicit(tsetelementnode(right).right,s32inttype);
|
||
end;
|
||
paras:=ccallparanode.create(tsetelementnode(right).right,paras);
|
||
tsetelementnode(right).right:=nil;
|
||
end;
|
||
right.free;
|
||
result:=ccallnode.createinternmethod(result,procname,paras)
|
||
end
|
||
else
|
||
begin
|
||
if right.nodetype=setelementn then
|
||
begin
|
||
paras:=nil;
|
||
{ get a copy of left to add to }
|
||
procname:='ADD';
|
||
if isenum then
|
||
begin
|
||
inserttypeconv_explicit(tsetelementnode(right).left,tenumdef(tsetelementnode(right).left.resultdef).getbasedef.classdef);
|
||
end
|
||
else
|
||
begin
|
||
{ for boolean, char, etc }
|
||
inserttypeconv_explicit(tsetelementnode(right).left,s32inttype);
|
||
end;
|
||
paras:=ccallparanode.create(tsetelementnode(right).left,paras);
|
||
tsetelementnode(right).left:=nil;
|
||
if assigned(tsetelementnode(right).right) then
|
||
begin
|
||
procname:='ADDALL';
|
||
{ create a set containing the range via the class
|
||
factory method, then add all of its elements }
|
||
if isenum then
|
||
begin
|
||
inserttypeconv_explicit(tsetelementnode(right).right,tenumdef(tsetelementnode(right).right.resultdef).getbasedef.classdef);
|
||
tmpn:=cloadvmtaddrnode.create(ctypenode.create(java_juenumset));
|
||
end
|
||
else
|
||
begin
|
||
inserttypeconv_explicit(tsetelementnode(right).right,s32inttype);
|
||
tmpn:=cloadvmtaddrnode.create(ctypenode.create(java_jubitset));
|
||
end;
|
||
paras:=ccallparanode.create(ccallnode.createinternmethod(tmpn,'RANGE',ccallparanode.create(tsetelementnode(right).right,paras)),nil);
|
||
tsetelementnode(right).right:=nil;
|
||
end;
|
||
call_set_helper_paras(procname,isenum,paras);
|
||
end
|
||
else
|
||
call_set_helper('ADDALL',isenum)
|
||
end
|
||
end;
|
||
subn:
|
||
call_set_helper('REMOVEALL',isenum);
|
||
symdifn:
|
||
if isenum then
|
||
begin
|
||
{ "s1 xor s2" is the same as "(s1 + s2) - (s1 * s2)"
|
||
-> call helper to prevent double evaluations }
|
||
result:=ccallnode.createintern('fpc_enumset_symdif',
|
||
ccallparanode.create(right,ccallparanode.create(left,nil)));
|
||
left:=nil;
|
||
right:=nil;
|
||
end
|
||
else
|
||
call_set_helper('SYMDIF',isenum);
|
||
muln:
|
||
call_set_helper('RETAINALL',isenum)
|
||
else
|
||
internalerror(2011062807);
|
||
end;
|
||
{ convert helper result back to original set type for further expression
|
||
evaluation }
|
||
if not is_boolean(resultdef) then
|
||
begin
|
||
inserttypeconv_explicit(result,getpointerdef(resultdef));
|
||
result:=cderefnode.create(result);
|
||
end;
|
||
{ left and right are reused as parameters }
|
||
left:=nil;
|
||
right:=nil;
|
||
end;
|
||
|
||
|
||
function tjvmaddnode.cmpnode2signedtopcmp: TOpCmp;
|
||
begin
|
||
case nodetype of
|
||
gtn: result:=OC_GT;
|
||
gten: result:=OC_GTE;
|
||
ltn: result:=OC_LT;
|
||
lten: result:=OC_LTE;
|
||
equaln: result:=OC_EQ;
|
||
unequaln: result:=OC_NE;
|
||
else
|
||
internalerror(2011010412);
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure tjvmaddnode.second_generic_compare;
|
||
var
|
||
cmpop: TOpCmp;
|
||
begin
|
||
pass_left_right;
|
||
{ swap the operands to make it easier for the optimizer to optimize
|
||
the operand stack slot reloading in case both are in a register }
|
||
if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) and
|
||
(right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
|
||
swapleftright;
|
||
cmpop:=cmpnode2signedtopcmp;
|
||
if (nf_swapped in flags) then
|
||
cmpop:=swap_opcmp(cmpop);
|
||
location_reset(location,LOC_JUMP,OS_NO);
|
||
|
||
if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
|
||
hlcg.a_cmp_loc_reg_label(current_asmdata.CurrAsmList,left.resultdef,cmpop,right.location,left.location.register,current_procinfo.CurrTrueLabel)
|
||
else case right.location.loc of
|
||
LOC_REGISTER,LOC_CREGISTER:
|
||
hlcg.a_cmp_reg_loc_label(current_asmdata.CurrAsmList,left.resultdef,cmpop,right.location.register,left.location,current_procinfo.CurrTrueLabel);
|
||
LOC_REFERENCE,LOC_CREFERENCE:
|
||
hlcg.a_cmp_ref_loc_label(current_asmdata.CurrAsmList,left.resultdef,cmpop,right.location.reference,left.location,current_procinfo.CurrTrueLabel);
|
||
LOC_CONSTANT:
|
||
hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,left.resultdef,cmpop,right.location.value,left.location,current_procinfo.CurrTrueLabel);
|
||
else
|
||
internalerror(2011010413);
|
||
end;
|
||
hlcg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
|
||
end;
|
||
|
||
procedure tjvmaddnode.pass_left_right;
|
||
begin
|
||
swapleftright;
|
||
inherited pass_left_right;
|
||
end;
|
||
|
||
|
||
procedure tjvmaddnode.second_addfloat;
|
||
var
|
||
op : TAsmOp;
|
||
commutative : boolean;
|
||
begin
|
||
pass_left_right;
|
||
|
||
location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
|
||
location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
|
||
|
||
commutative:=false;
|
||
case nodetype of
|
||
addn :
|
||
begin
|
||
if location.size=OS_F64 then
|
||
op:=a_dadd
|
||
else
|
||
op:=a_fadd;
|
||
commutative:=true;
|
||
end;
|
||
muln :
|
||
begin
|
||
if location.size=OS_F64 then
|
||
op:=a_dmul
|
||
else
|
||
op:=a_fmul;
|
||
commutative:=true;
|
||
end;
|
||
subn :
|
||
begin
|
||
if location.size=OS_F64 then
|
||
op:=a_dsub
|
||
else
|
||
op:=a_fsub;
|
||
end;
|
||
slashn :
|
||
begin
|
||
if location.size=OS_F64 then
|
||
op:=a_ddiv
|
||
else
|
||
op:=a_fdiv;
|
||
end;
|
||
else
|
||
internalerror(2011010402);
|
||
end;
|
||
|
||
{ swap the operands to make it easier for the optimizer to optimize
|
||
the operand stack slot reloading (non-commutative operations must
|
||
always be in the correct order though) }
|
||
if (commutative and
|
||
(left.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
|
||
(right.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER])) or
|
||
(not commutative and
|
||
(nf_swapped in flags)) then
|
||
swapleftright;
|
||
|
||
thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
|
||
thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location);
|
||
|
||
current_asmdata.CurrAsmList.concat(taicpu.op_none(op));
|
||
thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1+ord(location.size=OS_F64));
|
||
{ could be optimized in the future by keeping the results on the stack,
|
||
if we add code to swap the operands when necessary (a_swap for
|
||
singles, store/load/load for doubles since there is no swap for
|
||
2-slot elements -- also adjust expectloc in that case! }
|
||
thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
|
||
end;
|
||
|
||
|
||
procedure tjvmaddnode.second_cmpfloat;
|
||
var
|
||
op : tasmop;
|
||
cmpop: TOpCmp;
|
||
begin
|
||
pass_left_right;
|
||
{ swap the operands to make it easier for the optimizer to optimize
|
||
the operand stack slot reloading in case both are in a register }
|
||
if (left.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
|
||
(right.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
|
||
swapleftright;
|
||
cmpop:=cmpnode2signedtopcmp;
|
||
if (nf_swapped in flags) then
|
||
cmpop:=swap_opcmp(cmpop);
|
||
location_reset(location,LOC_JUMP,OS_NO);
|
||
|
||
thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
|
||
thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location);
|
||
|
||
{ compares two floating point values and puts 1/0/-1 on stack depending
|
||
on whether value1 >/=/< value2 }
|
||
if left.location.size=OS_F64 then
|
||
{ make sure that comparisons with NaNs always return false for </> }
|
||
if nodetype in [ltn,lten] then
|
||
op:=a_dcmpg
|
||
else
|
||
op:=a_dcmpl
|
||
else if nodetype in [ltn,lten] then
|
||
op:=a_fcmpg
|
||
else
|
||
op:=a_fcmpl;
|
||
current_asmdata.CurrAsmList.concat(taicpu.op_none(op));
|
||
thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,(1+ord(left.location.size=OS_F64))*2-1);
|
||
|
||
current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcmp2if[cmpop],current_procinfo.CurrTrueLabel));
|
||
thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
|
||
hlcg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
|
||
end;
|
||
|
||
|
||
procedure tjvmaddnode.second_cmpboolean;
|
||
begin
|
||
second_generic_compare;
|
||
end;
|
||
|
||
|
||
procedure tjvmaddnode.second_cmp64bit;
|
||
begin
|
||
second_generic_compare;
|
||
end;
|
||
|
||
|
||
procedure tjvmaddnode.second_add64bit;
|
||
begin
|
||
second_opordinal;
|
||
end;
|
||
|
||
|
||
procedure tjvmaddnode.second_cmpordinal;
|
||
begin
|
||
second_generic_compare;
|
||
end;
|
||
|
||
begin
|
||
caddnode:=tjvmaddnode;
|
||
end.
|