paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-25 18:42:30 +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 } { possible supported processors for this target }
tcputype = 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 = tfputype =
@ -46,7 +51,9 @@ Const
pocall_internproc pocall_internproc
]; ];
cputypestr : array[tcputype] of string[1] = ('' cputypestr : array[tcputype] of string[9] = ('',
'JVM',
'JVMDALVIK'
); );
fputypestr : array[tfputype] of string[8] = ( fputypestr : array[tfputype] of string[8] = (

139
compiler/jvm/hlcgcpu.pas
View File

@ -151,7 +151,7 @@ uses
procedure maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef); procedure maybe_adjust_op_result(list: TAsmList; op: TOpCg; size: tdef);
{ performs sign/zero extension as required } { 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 { 8/16 bit unsigned parameters and return values must be sign-extended on
the producer side, because the JVM does not support unsigned variants; 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); procedure gen_typecheck(list: TAsmList; checkop: tasmop; checkdef: tdef);
protected 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; 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); 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); a_call_name_intern(list,pd,s,true);
end; 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); procedure thlcgjvm.a_load_const_stack(list : TAsmList;size : tdef;a : aint; typ: TRegisterType);
const const
int2opc: array[-1..5] of tasmop = (a_iconst_m1,a_iconst_0,a_iconst_1, 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)) list.concat(taicpu.op_const(a_sipush,a))
else else
list.concat(taicpu.op_const(a_ldc,a)); 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; end;
OS_64,OS_S64: OS_64,OS_S64:
begin begin
@ -419,7 +445,7 @@ implementation
cgsize:=def_cgsize(size) cgsize:=def_cgsize(size)
else else
begin begin
resize_stack_int_val(list,OS_32,OS_S64,false); resize_stack_int_val(list,u32inttype,s64inttype,false);
cgsize:=OS_S64; cgsize:=OS_S64;
end; end;
case cgsize of case cgsize of
@ -481,13 +507,6 @@ implementation
procedure thlcgjvm.a_op_const_stack(list: TAsmList;op: topcg;size: tdef;a: aint); procedure thlcgjvm.a_op_const_stack(list: TAsmList;op: topcg;size: tdef;a: aint);
var var
trunc32: boolean; 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 begin
maybepreparedivu32(list,op,size,trunc32); maybepreparedivu32(list,op,size,trunc32);
case op of case op of
@ -501,7 +520,6 @@ implementation
end; end;
a_op_stack(list,op,size,trunc32); a_op_stack(list,op,size,trunc32);
end; end;
end;
procedure thlcgjvm.a_op_reg_stack(list: TAsmList; op: topcg; size: tdef; reg: tregister); procedure thlcgjvm.a_op_reg_stack(list: TAsmList; op: topcg; size: tdef; reg: tregister);
var var
@ -720,7 +738,7 @@ implementation
st_shortstring: st_shortstring:
begin begin
inc(parasize); 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'); g_call_system_proc(list,'fpc_initialize_array_shortstring');
end; end;
st_ansistring: st_ansistring:
@ -863,7 +881,7 @@ implementation
begin begin
if (op in overflowops) and if (op in overflowops) and
(def_cgsize(size) in [OS_8,OS_S8,OS_16,OS_S16]) then (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; end;
procedure thlcgjvm.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); 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); procedure thlcgjvm.g_copyvalueparas(p: TObject; arg: pointer);
var var
list: tasmlist; list: tasmlist;
tmpref: treference;
begin begin
{ zero-extend < 32 bit primitive types (FPC can zero-extend when calling, { 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 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 (torddef(tparavarsym(p).vardef).high>=(1 shl (tparavarsym(p).vardef.size*8-1))) then
begin begin
list:=TAsmList(arg); 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; end;
inherited g_copyvalueparas(p, arg); inherited g_copyvalueparas(p, arg);
@ -1032,7 +1057,7 @@ implementation
extra_slots: longint; extra_slots: longint;
begin begin
extra_slots:=prepare_stack_for_ref(list,ref,false); 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); a_load_stack_ref(list,tosize,ref,extra_slots);
end; end;
@ -1043,7 +1068,7 @@ implementation
extra_slots:=prepare_stack_for_ref(list,ref,false); extra_slots:=prepare_stack_for_ref(list,ref,false);
a_load_reg_stack(list,fromsize,register); a_load_reg_stack(list,fromsize,register);
if def2regtyp(fromsize)=R_INTREGISTER then 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); a_load_stack_ref(list,tosize,ref,extra_slots);
end; end;
@ -1051,7 +1076,7 @@ implementation
begin begin
a_load_reg_stack(list,fromsize,reg1); a_load_reg_stack(list,fromsize,reg1);
if def2regtyp(fromsize)=R_INTREGISTER then 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); a_load_stack_reg(list,tosize,reg2);
end; end;
@ -1063,7 +1088,7 @@ implementation
a_load_ref_stack(list,fromsize,ref,extra_slots); a_load_ref_stack(list,fromsize,ref,extra_slots);
if def2regtyp(fromsize)=R_INTREGISTER then 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); a_load_stack_reg(list,tosize,register);
end; end;
@ -1078,7 +1103,7 @@ implementation
extra_sslots:=prepare_stack_for_ref(list,sref,false); extra_sslots:=prepare_stack_for_ref(list,sref,false);
a_load_ref_stack(list,fromsize,sref,extra_sslots); a_load_ref_stack(list,fromsize,sref,extra_sslots);
if def2regtyp(fromsize)=R_INTREGISTER then 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); a_load_stack_ref(list,tosize,dref,extra_dslots);
end; end;
@ -1946,46 +1971,68 @@ implementation
end; end;
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 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 begin
if not(tosize in [OS_S64,OS_64]) then if not(tocgsize in [OS_S64,OS_64]) then
begin begin
{ truncate } { truncate }
list.concat(taicpu.op_none(a_l2i)); list.concat(taicpu.op_none(a_l2i));
decstack(list,1); decstack(list,1);
end; end;
end end
else if tosize in [OS_S64,OS_64] then else if tocgsize in [OS_S64,OS_64] then
begin begin
{ extend } { extend }
list.concat(taicpu.op_none(a_i2l)); list.concat(taicpu.op_none(a_i2l));
incstack(list,1); incstack(list,1);
{ if it was an unsigned 32 bit value, remove sign extension } { 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)); a_op_const_stack(list,OP_AND,s64inttype,cardinal($ffffffff));
end; end;
{ if the value is immediately stored to an array afterwards, the store { Conversions between 32 and 64 bit types have been completely handled
instruction will properly truncate the value; otherwise we may need above. We still may have to truncare or sign extend in case the
additional truncation, except for 64/32 bit conversions, which are destination type is smaller that the source type, or has a different
already handled above } sign. In case the destination is a widechar and the source is not, we
if not forarraystore and also have to insert a conversion to widechar }
(not(fromsize in [OS_S64,OS_64,OS_32,OS_S32]) or if (not(fromcgsize in [OS_S64,OS_64,OS_32,OS_S32]) or
not(tosize in [OS_S64,OS_64,OS_32,OS_S32])) and not(tocgsize in [OS_S64,OS_64,OS_32,OS_S32])) and
(tcgsize2size[fromsize]>tcgsize2size[tosize]) or ((tcgsize2size[fromcgsize]>tcgsize2size[tocgsize]) or
((tcgsize2size[fromsize]=tcgsize2size[tosize]) and ((tcgsize2size[fromcgsize]=tcgsize2size[tocgsize]) and
(fromsize<>tosize)) or (fromcgsize<>tocgsize)) or
{ needs to mask out the sign in the top 16 bits } { needs to mask out the sign in the top 16 bits }
((fromsize=OS_S8) and (((fromcgsize=OS_S8) and
(tosize=OS_16)) then (tocgsize=OS_16)) or
case tosize of ((tosize=cwidechartype) and
(fromsize<>cwidechartype)))) then
case tocgsize of
OS_8: OS_8:
a_op_const_stack(list,OP_AND,s32inttype,255); a_op_const_stack(list,OP_AND,s32inttype,255);
OS_S8: OS_S8:
list.concat(taicpu.op_none(a_i2b)); list.concat(taicpu.op_none(a_i2b));
OS_16: 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: OS_S16:
list.concat(taicpu.op_none(a_i2s)); list.concat(taicpu.op_none(a_i2s));
end; end;
@ -1993,25 +2040,25 @@ implementation
procedure thlcgjvm.maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean); procedure thlcgjvm.maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
var var
cgsize: tcgsize; convsize: tdef;
begin begin
if (retdef.typ=orddef) then if (retdef.typ=orddef) then
begin begin
if (torddef(retdef).ordtype in [u8bit,u16bit,uchar]) and if (torddef(retdef).ordtype in [u8bit,u16bit,uchar]) and
(torddef(retdef).high>=(1 shl (retdef.size*8-1))) then (torddef(retdef).high>=(1 shl (retdef.size*8-1))) then
begin begin
cgsize:=OS_NO; convsize:=nil;
if callside then if callside then
if torddef(retdef).ordtype in [u8bit,uchar] then if torddef(retdef).ordtype in [u8bit,uchar] then
cgsize:=OS_S8 convsize:=s8inttype
else else
cgsize:=OS_S16 convsize:=s16inttype
else if torddef(retdef).ordtype in [u8bit,uchar] then else if torddef(retdef).ordtype in [u8bit,uchar] then
cgsize:=OS_8 convsize:=u8inttype
else else
cgsize:=OS_16; convsize:=u16inttype;
if cgsize<>OS_NO then if assigned(convsize) then
resize_stack_int_val(list,OS_S32,cgsize,false); resize_stack_int_val(list,s32inttype,convsize,false);
end; end;
end; end;
end; end;
@ -2201,7 +2248,7 @@ implementation
begin begin
{ needs zero-extension to 64 bit, because the JVM only supports { needs zero-extension to 64 bit, because the JVM only supports
signed divisions } signed divisions }
resize_stack_int_val(list,OS_32,OS_S64,false); resize_stack_int_val(list,u32inttype,s64inttype,false);
op:=OP_IDIV; op:=OP_IDIV;
isdivu32:=true; isdivu32:=true;
end end

30
compiler/jvm/jvmdef.pas
View File

@ -861,6 +861,7 @@ implementation
container: tsymtable; container: tsymtable;
vsym: tabstractvarsym; vsym: tabstractvarsym;
csym: tconstsym; csym: tconstsym;
usedef: tdef;
begin begin
case sym.typ of case sym.typ of
staticvarsym, staticvarsym,
@ -869,12 +870,31 @@ implementation
fieldvarsym: fieldvarsym:
begin begin
vsym:=tabstractvarsym(sym); 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 if withsignature and
jvmtypeneedssignature(vsym.vardef) then jvmtypeneedssignature(usedef) then
begin begin
result:=result+' signature "'; result:=result+' signature "';
result:=result+jvmencodetype(vsym.vardef,true)+'"'; result:=result+jvmencodetype(usedef,true)+'"';
end; end;
if (vsym.typ=paravarsym) and if (vsym.typ=paravarsym) and
(vo_is_self in tparavarsym(vsym).varoptions) then (vo_is_self in tparavarsym(vsym).varoptions) then
@ -886,9 +906,9 @@ implementation
begin begin
{ add array indirection if required } { add array indirection if required }
if (vsym.typ=paravarsym) and if (vsym.typ=paravarsym) and
(vsym.vardef.typ=formaldef) or ((usedef.typ=formaldef) or
((vsym.varspez in [vs_var,vs_out,vs_constref]) and ((vsym.varspez in [vs_var,vs_out,vs_constref]) and
not jvmimplicitpointertype(vsym.vardef)) then not jvmimplicitpointertype(usedef))) then
result:='['+result; result:='['+result;
{ single quotes for definitions to prevent clashes with Java { single quotes for definitions to prevent clashes with Java
opcodes } opcodes }

6
compiler/jvm/njvmcnv.pas
View File

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

18
compiler/jvm/njvmld.pas
View File

@ -27,6 +27,7 @@ interface
uses uses
globtype, globtype,
aasmdata,
symtype, symtype,
cgutils, cgutils,
node, ncgld, ncgnstld; node, ncgld, ncgnstld;
@ -45,6 +46,7 @@ type
tjvmassignmentnode = class(tcgassignmentnode) tjvmassignmentnode = class(tcgassignmentnode)
protected protected
function direct_shortstring_assignment: boolean; override; function direct_shortstring_assignment: boolean; override;
function maybechangetemp(list: TAsmList; var n: tnode; const newref: treference): boolean;override;
public public
function pass_1: tnode; override; function pass_1: tnode; override;
end; end;
@ -59,13 +61,12 @@ type
implementation implementation
uses uses
verbose, verbose,globals,
aasmdata,
nbas,nld,ncal,ncon,ninl,nmem,ncnv, nbas,nld,ncal,ncon,ninl,nmem,ncnv,
symconst,symsym,symdef,symtable,defutil,jvmdef, symconst,symsym,symdef,symtable,defutil,jvmdef,
paramgr, paramgr,
pass_1, pass_1,
cgbase,hlcgobj; cgbase,hlcgobj,cpuinfo;
{ tjvmassignmentnode } { tjvmassignmentnode }
@ -77,6 +78,17 @@ function tjvmassignmentnode.direct_shortstring_assignment: boolean;
end; 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; function tjvmassignmentnode.pass_1: tnode;
var var
block: tblocknode; block: tblocknode;

6
compiler/jvm/njvmmat.pas
View File

@ -115,14 +115,14 @@ implementation
else else
begin begin
thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location); 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; end;
if right.location.loc=LOC_CONSTANT then if right.location.loc=LOC_CONSTANT then
thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s64inttype,right.location.value,R_INTREGISTER) thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s64inttype,right.location.value,R_INTREGISTER)
else else
begin begin
thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location); 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;
end; end;
if isu32int or if isu32int or
@ -137,7 +137,7 @@ implementation
thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1); thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
end; end;
if isu32int then 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; end;
thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register); thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
end; end;

8
compiler/ncgld.pas
View File

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