paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 22:07:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

* generate JVM bytecode that passes the stringent requirements of the Dalvik

Browse Source 
verifier when -Cpjvmdalvik is used (including debug information). Using
    -Cpjvmdalvik changes the semantics at the language-level in one case:
    boolean(bytevar) will no longer return a boolean that contains the same
    value as bytevar did, but will map the value to 0/1 (that also means that
    such expressions cannot be passed to var-parameters in case of
    -Cpjvmdalvik). Code compiled with -Cpjvmdalvik will also work fine on
    the regular JVM, but it may be somewhat slower (it won't necessarily
    be slower on Dalvik, because the .class -> .dex transformation
    applies many optimizations itself)

git-svn-id: branches/jvmbackend@19743 -
This commit is contained in:
Jonas Maebe 2011-12-04 14:48:54 +00:00
parent faaa86238c
commit bd990d1173
7 changed files with 168 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
compiler/jvm/cpuinfo.pas
View File

@ -31,7 +31,12 @@ Type
{ possible supported processors for this target }
tcputype =
(cpu_none
(cpu_none,
{ jvm, same as cpu_none }
cpu_jvm,
{ jvm byte code to be translated into Dalvik bytecode: more type-
sensitive }
cpu_dalvik
);
tfputype =
@ -46,7 +51,9 @@ Const
pocall_internproc
];
cputypestr : array[tcputype] of string[1] = (''
cputypestr : array[tcputype] of string[9] = ('',
'JVM',
'JVMDALVIK'
);
fputypestr : array[tfputype] of string[8] = (

163
compiler/jvm/hlcgcpu.pas
View File

@ -151,7 +151,7 @@ uses
procedure maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef);
{ performs sign/zero extension as required }
procedure resize_stack_int_val(list: TAsmList;fromsize,tosize: tcgsize; forarraystore: boolean);
procedure resize_stack_int_val(list: TAsmList;fromsize,tosize: tdef; formemstore: boolean);
{ 8/16 bit unsigned parameters and return values must be sign-extended on
the producer side, because the JVM does not support unsigned variants;
@ -165,6 +165,8 @@ uses
procedure gen_typecheck(list: TAsmList; checkop: tasmop; checkdef: tdef);
protected
procedure a_load_const_stack_intern(list : TAsmList;size : tdef;a : aint; typ: TRegisterType; legalize_const: boolean);
function get_enum_init_val_ref(def: tdef; out ref: treference): boolean;
procedure allocate_implicit_structs_for_st_with_base_ref(list: TAsmList; st: tsymtable; const ref: treference; allocvartyp: tsymtyp);
@ -299,6 +301,26 @@ implementation
a_call_name_intern(list,pd,s,true);
end;
procedure thlcgjvm.a_load_const_stack_intern(list : TAsmList;size : tdef;a : aint; typ: TRegisterType; legalize_const: boolean);
begin
if legalize_const and
(typ=R_INTREGISTER) and
(size.typ=orddef) then
begin
{ uses specific byte/short array store instructions, and the Dalvik
VM does not like it if we store values outside the range }
case torddef(size).ordtype of
u8bit:
a:=shortint(a);
u16bit:
a:=smallint(a);
end;
end;
a_load_const_stack(list,size,a,typ);
end;
procedure thlcgjvm.a_load_const_stack(list : TAsmList;size : tdef;a : aint; typ: TRegisterType);
const
int2opc: array[-1..5] of tasmop = (a_iconst_m1,a_iconst_0,a_iconst_1,
@ -324,6 +346,10 @@ implementation
list.concat(taicpu.op_const(a_sipush,a))
else
list.concat(taicpu.op_const(a_ldc,a));
{ for android verifier }
if (size.typ=orddef) and
(torddef(size).ordtype=uwidechar) then
list.concat(taicpu.op_none(a_i2c));
end;
OS_64,OS_S64:
begin
@ -419,7 +445,7 @@ implementation
cgsize:=def_cgsize(size)
else
begin
resize_stack_int_val(list,OS_32,OS_S64,false);
resize_stack_int_val(list,u32inttype,s64inttype,false);
cgsize:=OS_S64;
end;
case cgsize of
@ -482,25 +508,17 @@ implementation
var
trunc32: boolean;
begin
{ use "integer to (wide)char" narrowing opcode for "and 65535" }
if (op=OP_AND) and
(def_cgsize(size) in [OS_16,OS_S16,OS_32,OS_S32]) and
(a=65535) then
list.concat(taicpu.op_none(a_i2c))
else
begin
maybepreparedivu32(list,op,size,trunc32);
case op of
OP_NEG,OP_NOT:
internalerror(2011010801);
OP_SHL,OP_SHR,OP_SAR:
{ the second argument here is an int rather than a long }
a_load_const_stack(list,s32inttype,a,R_INTREGISTER);
else
a_load_const_stack(list,size,a,R_INTREGISTER);
end;
a_op_stack(list,op,size,trunc32);
end;
maybepreparedivu32(list,op,size,trunc32);
case op of
OP_NEG,OP_NOT:
internalerror(2011010801);
OP_SHL,OP_SHR,OP_SAR:
{ the second argument here is an int rather than a long }
a_load_const_stack(list,s32inttype,a,R_INTREGISTER);
else
a_load_const_stack(list,size,a,R_INTREGISTER);
end;
a_op_stack(list,op,size,trunc32);
end;
procedure thlcgjvm.a_op_reg_stack(list: TAsmList; op: topcg; size: tdef; reg: tregister);
@ -720,7 +738,7 @@ implementation
st_shortstring:
begin
inc(parasize);
a_load_const_stack(list,s8inttype,shortint(tstringdef(elemdef).len),R_INTREGISTER);
a_load_const_stack_intern(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER,true);
g_call_system_proc(list,'fpc_initialize_array_shortstring');
end;
st_ansistring:
@ -863,7 +881,7 @@ implementation
begin
if (op in overflowops) and
(def_cgsize(size) in [OS_8,OS_S8,OS_16,OS_S16]) then
resize_stack_int_val(list,OS_S32,def_cgsize(size),false);
resize_stack_int_val(list,s32inttype,size,false);
end;
procedure thlcgjvm.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
@ -900,6 +918,7 @@ implementation
procedure thlcgjvm.g_copyvalueparas(p: TObject; arg: pointer);
var
list: tasmlist;
tmpref: treference;
begin
{ zero-extend < 32 bit primitive types (FPC can zero-extend when calling,
but that doesn't help when we're called from Java code or indirectly
@ -915,7 +934,13 @@ implementation
(torddef(tparavarsym(p).vardef).high>=(1 shl (tparavarsym(p).vardef.size*8-1))) then
begin
list:=TAsmList(arg);
a_op_const_loc(list,OP_AND,tparavarsym(p).vardef,(1 shl (tparavarsym(p).vardef.size*8))-1,tparavarsym(p).initialloc);
{ store value in new location to keep Android verifier happy }
tg.gethltemp(list,tparavarsym(p).vardef,tparavarsym(p).vardef.size,tt_persistent,tmpref);
a_load_loc_stack(list,tparavarsym(p).vardef,tparavarsym(p).initialloc);
a_op_const_stack(list,OP_AND,tparavarsym(p).vardef,(1 shl (tparavarsym(p).vardef.size*8))-1);
a_load_stack_ref(list,tparavarsym(p).vardef,tmpref,prepare_stack_for_ref(list,tmpref,false));
location_reset_ref(tparavarsym(p).localloc,LOC_REFERENCE,def_cgsize(tparavarsym(p).vardef),4);
tparavarsym(p).localloc.reference:=tmpref;
end;
inherited g_copyvalueparas(p, arg);
@ -1032,7 +1057,7 @@ implementation
extra_slots: longint;
begin
extra_slots:=prepare_stack_for_ref(list,ref,false);
a_load_const_stack(list,tosize,a,def2regtyp(tosize));
a_load_const_stack_intern(list,tosize,a,def2regtyp(tosize),(ref.arrayreftype<>art_none) or assigned(ref.symbol));
a_load_stack_ref(list,tosize,ref,extra_slots);
end;
@ -1043,7 +1068,7 @@ implementation
extra_slots:=prepare_stack_for_ref(list,ref,false);
a_load_reg_stack(list,fromsize,register);
if def2regtyp(fromsize)=R_INTREGISTER then
resize_stack_int_val(list,def_cgsize(fromsize),def_cgsize(tosize),ref.arrayreftype<>art_none);
resize_stack_int_val(list,fromsize,tosize,(ref.arrayreftype<>art_none) or assigned(ref.symbol));
a_load_stack_ref(list,tosize,ref,extra_slots);
end;
@ -1051,7 +1076,7 @@ implementation
begin
a_load_reg_stack(list,fromsize,reg1);
if def2regtyp(fromsize)=R_INTREGISTER then
resize_stack_int_val(list,def_cgsize(fromsize),def_cgsize(tosize),false);
resize_stack_int_val(list,fromsize,tosize,false);
a_load_stack_reg(list,tosize,reg2);
end;
@ -1063,7 +1088,7 @@ implementation
a_load_ref_stack(list,fromsize,ref,extra_slots);
if def2regtyp(fromsize)=R_INTREGISTER then
resize_stack_int_val(list,def_cgsize(fromsize),def_cgsize(tosize),false);
resize_stack_int_val(list,fromsize,tosize,false);
a_load_stack_reg(list,tosize,register);
end;
@ -1078,7 +1103,7 @@ implementation
extra_sslots:=prepare_stack_for_ref(list,sref,false);
a_load_ref_stack(list,fromsize,sref,extra_sslots);
if def2regtyp(fromsize)=R_INTREGISTER then
resize_stack_int_val(list,def_cgsize(fromsize),def_cgsize(tosize),dref.arrayreftype<>art_none);
resize_stack_int_val(list,fromsize,tosize,(dref.arrayreftype<>art_none) or assigned(dref.symbol));
a_load_stack_ref(list,tosize,dref,extra_dslots);
end;
@ -1946,46 +1971,68 @@ implementation
end;
end;
procedure thlcgjvm.resize_stack_int_val(list: TAsmList; fromsize, tosize: tcgsize; forarraystore: boolean);
procedure thlcgjvm.resize_stack_int_val(list: TAsmList; fromsize, tosize: tdef; formemstore: boolean);
var
fromcgsize, tocgsize: tcgsize;
begin
if fromsize in [OS_S64,OS_64] then
{ When storing to an array, field or global variable, make sure the
static type verification can determine that the stored value fits
within the boundaries of the declared type (to appease the Dalvik VM).
Local variables either get their type upgraded in the debug info,
or have no type information at all }
if formemstore and
(tosize.typ=orddef) then
if (torddef(tosize).ordtype in [u8bit,uchar]) then
tosize:=s8inttype
else if torddef(tosize).ordtype=u16bit then
tosize:=s16inttype;
fromcgsize:=def_cgsize(fromsize);
tocgsize:=def_cgsize(tosize);
if fromcgsize in [OS_S64,OS_64] then
begin
if not(tosize in [OS_S64,OS_64]) then
if not(tocgsize in [OS_S64,OS_64]) then
begin
{ truncate }
list.concat(taicpu.op_none(a_l2i));
decstack(list,1);
end;
end
else if tosize in [OS_S64,OS_64] then
else if tocgsize in [OS_S64,OS_64] then
begin
{ extend }
list.concat(taicpu.op_none(a_i2l));
incstack(list,1);
{ if it was an unsigned 32 bit value, remove sign extension }
if fromsize=OS_32 then
if fromcgsize=OS_32 then
a_op_const_stack(list,OP_AND,s64inttype,cardinal($ffffffff));
end;
{ if the value is immediately stored to an array afterwards, the store
instruction will properly truncate the value; otherwise we may need
additional truncation, except for 64/32 bit conversions, which are
already handled above }
if not forarraystore and
(not(fromsize in [OS_S64,OS_64,OS_32,OS_S32]) or
not(tosize in [OS_S64,OS_64,OS_32,OS_S32])) and
(tcgsize2size[fromsize]>tcgsize2size[tosize]) or
((tcgsize2size[fromsize]=tcgsize2size[tosize]) and
(fromsize<>tosize)) or
{ needs to mask out the sign in the top 16 bits }
((fromsize=OS_S8) and
(tosize=OS_16)) then
case tosize of
{ Conversions between 32 and 64 bit types have been completely handled
above. We still may have to truncare or sign extend in case the
destination type is smaller that the source type, or has a different
sign. In case the destination is a widechar and the source is not, we
also have to insert a conversion to widechar }
if (not(fromcgsize in [OS_S64,OS_64,OS_32,OS_S32]) or
not(tocgsize in [OS_S64,OS_64,OS_32,OS_S32])) and
((tcgsize2size[fromcgsize]>tcgsize2size[tocgsize]) or
((tcgsize2size[fromcgsize]=tcgsize2size[tocgsize]) and
(fromcgsize<>tocgsize)) or
{ needs to mask out the sign in the top 16 bits }
(((fromcgsize=OS_S8) and
(tocgsize=OS_16)) or
((tosize=cwidechartype) and
(fromsize<>cwidechartype)))) then
case tocgsize of
OS_8:
a_op_const_stack(list,OP_AND,s32inttype,255);
OS_S8:
list.concat(taicpu.op_none(a_i2b));
OS_16:
list.concat(taicpu.op_none(a_i2c));
if (tosize.typ=orddef) and
(torddef(tosize).ordtype=uwidechar) then
list.concat(taicpu.op_none(a_i2c))
else
a_op_const_stack(list,OP_AND,s32inttype,65535);
OS_S16:
list.concat(taicpu.op_none(a_i2s));
end;
@ -1993,25 +2040,25 @@ implementation
procedure thlcgjvm.maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
var
cgsize: tcgsize;
convsize: tdef;
begin
if (retdef.typ=orddef) then
begin
if (torddef(retdef).ordtype in [u8bit,u16bit,uchar]) and
(torddef(retdef).high>=(1 shl (retdef.size*8-1))) then
begin
cgsize:=OS_NO;
convsize:=nil;
if callside then
if torddef(retdef).ordtype in [u8bit,uchar] then
cgsize:=OS_S8
convsize:=s8inttype
else
cgsize:=OS_S16
convsize:=s16inttype
else if torddef(retdef).ordtype in [u8bit,uchar] then
cgsize:=OS_8
convsize:=u8inttype
else
cgsize:=OS_16;
if cgsize<>OS_NO then
resize_stack_int_val(list,OS_S32,cgsize,false);
convsize:=u16inttype;
if assigned(convsize) then
resize_stack_int_val(list,s32inttype,convsize,false);
end;
end;
end;
@ -2201,7 +2248,7 @@ implementation
begin
{ needs zero-extension to 64 bit, because the JVM only supports
signed divisions }
resize_stack_int_val(list,OS_32,OS_S64,false);
resize_stack_int_val(list,u32inttype,s64inttype,false);
op:=OP_IDIV;
isdivu32:=true;
end

32
compiler/jvm/jvmdef.pas
View File

@ -861,6 +861,7 @@ implementation
container: tsymtable;
vsym: tabstractvarsym;
csym: tconstsym;
usedef: tdef;
begin
case sym.typ of
staticvarsym,
@ -869,12 +870,31 @@ implementation
fieldvarsym:
begin
vsym:=tabstractvarsym(sym);
result:=jvmencodetype(vsym.vardef,false);
{ for local and paravarsyms that are unsigned 8/16 bit, change the
outputted type to signed 16/32 bit:
a) the stack slots are all 32 bit anyway, so the storage allocation
is still correct
b) since at the JVM level all types are signed, this makes sure
that the values in the stack slots are valid for the specified
types
}
usedef:=vsym.vardef;
if vsym.typ in [localvarsym,paravarsym] then
begin
if (usedef.typ=orddef) then
case torddef(usedef).ordtype of
u8bit,uchar:
usedef:=s16inttype;
u16bit:
usedef:=s32inttype;
end;
end;
result:=jvmencodetype(usedef,false);
if withsignature and
jvmtypeneedssignature(vsym.vardef) then
jvmtypeneedssignature(usedef) then
begin
result:=result+' signature "';
result:=result+jvmencodetype(vsym.vardef,true)+'"';
result:=result+jvmencodetype(usedef,true)+'"';
end;
if (vsym.typ=paravarsym) and
(vo_is_self in tparavarsym(vsym).varoptions) then
@ -886,9 +906,9 @@ implementation
begin
{ add array indirection if required }
if (vsym.typ=paravarsym) and
(vsym.vardef.typ=formaldef) or
((vsym.varspez in [vs_var,vs_out,vs_constref]) and
not jvmimplicitpointertype(vsym.vardef)) then
((usedef.typ=formaldef) or
((vsym.varspez in [vs_var,vs_out,vs_constref]) and
not jvmimplicitpointertype(usedef))) then
result:='['+result;
{ single quotes for definitions to prevent clashes with Java
opcodes }

6
compiler/jvm/njvmcnv.pas
View File

@ -99,7 +99,7 @@ implementation
cgbase,cgutils,pass_1,pass_2,
nbas,ncon,ncal,ninl,nld,nmem,procinfo,
nutils,paramgr,
cpubase,aasmcpu,
cpubase,cpuinfo,aasmcpu,
tgobj,hlcgobj,hlcgcpu;
@ -717,8 +717,10 @@ implementation
{ Explicit typecasts from any ordinal type to a boolean type }
{ must not change the ordinal value }
{ Exception: Android verifier... }
if (nf_explicit in flags) and
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
not(current_settings.cputype=cpu_dalvik) then
begin
location_copy(location,left.location);
newsize:=def_cgsize(resultdef);

18
compiler/jvm/njvmld.pas
View File

@ -27,6 +27,7 @@ interface
uses
globtype,
aasmdata,
symtype,
cgutils,
node, ncgld, ncgnstld;
@ -45,6 +46,7 @@ type
tjvmassignmentnode = class(tcgassignmentnode)
protected
function direct_shortstring_assignment: boolean; override;
function maybechangetemp(list: TAsmList; var n: tnode; const newref: treference): boolean;override;
public
function pass_1: tnode; override;
end;
@ -59,13 +61,12 @@ type
implementation
uses
verbose,
aasmdata,
verbose,globals,
nbas,nld,ncal,ncon,ninl,nmem,ncnv,
symconst,symsym,symdef,symtable,defutil,jvmdef,
paramgr,
pass_1,
cgbase,hlcgobj;
cgbase,hlcgobj,cpuinfo;
{ tjvmassignmentnode }
@ -77,6 +78,17 @@ function tjvmassignmentnode.direct_shortstring_assignment: boolean;
end;
function tjvmassignmentnode.maybechangetemp(list: TAsmList; var n: tnode; const newref: treference): boolean;
begin
{ don't do this when compiling for Dalvik, because it can invalidate the
debug information (which Dalvik uses as extra type information) }
if current_settings.cputype<>cpu_dalvik then
result:=inherited
else
result:=false;
end;
function tjvmassignmentnode.pass_1: tnode;
var
block: tblocknode;

6
compiler/jvm/njvmmat.pas
View File

@ -115,14 +115,14 @@ implementation
else
begin
thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
thlcgjvm(hlcg).resize_stack_int_val(current_asmdata.CurrAsmList,OS_32,OS_S64,false);
thlcgjvm(hlcg).resize_stack_int_val(current_asmdata.CurrAsmList,u32inttype,s64inttype,false);
end;
if right.location.loc=LOC_CONSTANT then
thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s64inttype,right.location.value,R_INTREGISTER)
else
begin
thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location);
thlcgjvm(hlcg).resize_stack_int_val(current_asmdata.CurrAsmList,OS_32,OS_S64,false);
thlcgjvm(hlcg).resize_stack_int_val(current_asmdata.CurrAsmList,u32inttype,s64inttype,false);
end;
end;
if isu32int or
@ -137,7 +137,7 @@ implementation
thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
end;
if isu32int then
thlcgjvm(hlcg).resize_stack_int_val(current_asmdata.CurrAsmList,OS_S64,OS_32,false);
thlcgjvm(hlcg).resize_stack_int_val(current_asmdata.CurrAsmList,s64inttype,u32inttype,false);
end;
thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
end;

8
compiler/ncgld.pas
View File

@ -29,6 +29,7 @@ interface
uses
globtype,
symtype,
aasmdata,
node,nld,cgutils;
type
@ -42,6 +43,9 @@ interface
end;
tcgassignmentnode = class(tassignmentnode)
protected
function maybechangetemp(list: TAsmList; var n: tnode; const newref: treference): boolean;virtual;
public
procedure pass_generate_code;override;
end;
@ -67,7 +71,7 @@ implementation
nutils,
symtable,symconst,symdef,symsym,defutil,paramgr,
ncnv,ncon,nmem,nbas,ncgrtti,
aasmbase,aasmtai,aasmdata,aasmcpu,
aasmbase,aasmtai,aasmcpu,
cgbase,pass_2,
procinfo,
cpubase,parabase,
@ -158,7 +162,7 @@ implementation
end;
function maybechangetemp(list: TAsmList; var n: tnode; const newref: treference): boolean;
function tcgassignmentnode.maybechangetemp(list: TAsmList; var n: tnode; const newref: treference): boolean;
var
rr: treplacerefrec;
begin