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

* unless compiled with -dnounsupported, the compiler will now accept not

Browse Source 
only JVM constructs that are already implemented, but also ones that
    will be supported in the future but that aren't implemented yet (to
    make it easier to already adapt code to the future changes)

git-svn-id: branches/jvmbackend@18498 -
This commit is contained in:
Jonas Maebe 2011-08-20 08:04:51 +00:00
parent 4491dafd48
commit d1a1d30e04
16 changed files with 259 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
compiler/jvm/njvmadd.pas
View File

@ -85,6 +85,14 @@ interface
case nodetype of
addn:
begin
{$ifndef nounsupported}
if not is_wide_or_unicode_string(resultdef) then
begin
result:=left;
left:=nil;
exit;
end;
{$endif nounsupported}
if (left.nodetype=stringconstn) and (tstringconstnode(left).len=0) then
begin
result:=right;
@ -113,6 +121,9 @@ interface
end;
ltn,lten,gtn,gten,equaln,unequaln :
begin
{$ifndef nounsupported}
left.resultdef:=cunicodestringtype;
{$endif nounsupported}
{ call compare routine }
cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare';
{ for equality checks use optimized version }

14
compiler/jvm/njvmcnv.pas
View File

@ -550,6 +550,20 @@ implementation
result:=true;
exit;
end;
{$ifndef nounsupported}
if ((left.resultdef.typ=procvardef) and
((resultdef=methodpointertype) or
(resultdef=search_system_type('TMETHOD').typedef))) or
((resultdef.typ=procvardef) and
((left.resultdef=methodpointertype) or
(left.resultdef=search_system_type('TMETHOD').typedef))) then
begin
convtype:=tc_equal;
result:=true;
exit;
end;
{$endif}
end;

25
compiler/jvm/njvmmem.pas
View File

@ -31,6 +31,10 @@ interface
node,nmem,ncgmem;
type
tjvmloadparentfpnode = class(tcgloadparentfpnode)
procedure pass_generate_code;override;
end;
tjvmvecnode = class(tcgvecnode)
function pass_1: tnode; override;
procedure pass_generate_code;override;
@ -46,6 +50,19 @@ implementation
aasmdata,pass_2,
cgutils,hlcgobj,hlcgcpu;
{ tjvmloadparentfpnode }
procedure tjvmloadparentfpnode.pass_generate_code;
begin
{$ifndef nounsupported}
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(2011041301);
{$endif}
end;
{*****************************************************************************
TJVMVECNODE
*****************************************************************************}
@ -77,6 +94,14 @@ implementation
var
newsize: tcgsize;
begin
{$ifndef nounsupported}
if left.resultdef.typ=stringdef then
begin
location:=left.location;
exit;
end;
{$endif}
{ This routine is not used for Strings, as they are a class type and
you have to use charAt() there to load a character (and you cannot
change characters; you have to create a new string in that case)

9
compiler/jvm/tgcpu.pas
View File

@ -120,6 +120,15 @@ unit tgcpu;
thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
result:=true;
end;
setdef:
begin
if is_smallset(def) then
exit;
{$ifndef nounsupported}
gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
result:=true;
{$endif}
end;
end;
end;

36
compiler/jvmdef.pas
View File

@ -91,8 +91,12 @@ implementation
st_unicodestring:
encodedstr:=encodedstr+'Ljava/lang/String;';
else
{$ifndef nounsupported}
result:=jvmaddencodedtype(java_jlobject,false,encodedstr,founderror);
{$else}
{ May be handled via wrapping later }
result:=false;
{$endif}
end;
end;
enumdef,
@ -127,6 +131,11 @@ implementation
end;
pointerdef :
begin
{$ifndef nounsupported}
if def=voidpointertype then
result:=jvmaddencodedtype(java_jlobject,false,encodedstr,founderror)
else
{$endif}
{ some may be handled via wrapping later }
result:=false;
end;
@ -156,17 +165,25 @@ implementation
end;
classrefdef :
begin
{$ifndef nounsupported}
result:=jvmaddencodedtype(java_jlobject,false,encodedstr,founderror);
{$else}
{ may be handled via wrapping later }
result:=false;
{$endif}
end;
setdef :
begin
if is_smallset(def) then
encodedstr:=encodedstr+'I'
else
{ will be hanlded via wrapping later, although wrapping may
happen at higher level }
result:=false;
{$ifndef nounsupported}
result:=jvmaddencodedtype(java_jlobject,false,encodedstr,founderror);
{$else}
{ will be hanlded via wrapping later, although wrapping may
happen at higher level }
result:=false;
{$endif}
end;
formaldef :
begin
@ -175,8 +192,13 @@ implementation
end;
arraydef :
begin
if is_array_of_const(def) or
is_packed_array(def) then
if is_array_of_const(def) then
{$ifndef nounsupported}
result:=jvmaddencodedtype(java_jlobject,false,encodedstr,founderror)
{$else}
result:=false
{$endif}
else if is_packed_array(def) then
result:=false
else
begin
@ -191,9 +213,13 @@ implementation
end;
procvardef :
begin
{$ifndef nounsupported}
result:=jvmaddencodedtype(java_jlobject,false,encodedstr,founderror);
{$else}
{ will be hanlded via wrapping later, although wrapping may
happen at higher level }
result:=false;
{$endif}
end;
objectdef :
case tobjectdef(def).objecttype of

6
compiler/nadd.pas
View File

@ -2112,6 +2112,12 @@ implementation
newstatement : tstatementnode;
temp : ttempcreatenode;
begin
{$ifdef jvm}
{$ifndef nounsupported}
result:=cnothingnode.create;
exit;
{$endif nounsupported}
{$endif}
result:=nil;
case nodetype of
equaln,unequaln,lten,gten:

6
compiler/ncal.pas
View File

@ -1628,6 +1628,12 @@ implementation
function tcallnode.gen_procvar_context_tree:tnode;
begin
{$ifdef jvm}
{$ifndef nounsupported}
result:=cnilnode.create;
exit;
{$endif}
{$endif}
{ Load tmehodpointer(right).self (either self or parentfp) }
result:=genloadfield(ctypeconvnode.create_internal(
right.getcopy,methodpointertype),

4
compiler/ncgcal.pas
View File

@ -839,6 +839,7 @@ implementation
else
{ now procedure variable case }
begin
{$if defined(nounsupported) or not defined(jvm)}
secondpass(right);
pvreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
@ -848,6 +849,7 @@ implementation
else
cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_ADDR,right.location,pvreg);
location_freetemp(current_asmdata.CurrAsmList,right.location);
{$endif defined(nounsupported) or not defined(jvm)}
{ Load parameters that are in temporary registers in the
correct parameter register }
@ -858,6 +860,7 @@ implementation
freeparas;
end;
{$if defined(nounsupported) or not defined(jvm)}
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
if cg.uses_registers(R_FPUREGISTER) then
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
@ -870,6 +873,7 @@ implementation
extra_interrupt_code;
extra_call_code;
cg.a_call_reg(current_asmdata.CurrAsmList,pvreg);
{$endif defined(nounsupported) or not defined(jvm)}
extra_post_call_code;
end;

23
compiler/ncgcnv.pas
View File

@ -360,6 +360,13 @@ interface
procedure tcgtypeconvnode.second_char_to_string;
begin
{$ifdef jvm}
{$ifndef nounsupported}
location_reset_ref(location,LOC_REFERENCE,OS_NO,1);
tg.gethltemp(current_asmdata.CurrAsmList,cshortstringtype,256,tt_normal,location.reference);
exit;
{$endif nounsupported}
{$endif jvm}
location_reset_ref(location,LOC_REFERENCE,OS_NO,2);
case tstringdef(resultdef).stringtype of
st_shortstring :
@ -479,6 +486,14 @@ interface
var
tmpreg: tregister;
begin
{$ifdef jvm}
{$ifndef nounsupported}
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);
exit;
{$endif nounsupported}
{$endif jvm}
if tabstractprocdef(resultdef).is_addressonly then
begin
location_reset(location,LOC_REGISTER,OS_ADDR);
@ -513,6 +528,14 @@ interface
var r:Treference;
begin
{$ifdef jvm}
{$ifndef nounsupported}
tg.gethltemp(current_asmdata.currasmlist,java_jlobject,java_jlobject.size,tt_normal,r);
location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),0);
location.reference:=r;
exit;
{$endif}
{$endif}
tg.gethltemp(current_asmdata.currasmlist,methodpointertype,methodpointertype.size,tt_normal,r);
location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),0);
location.reference:=r;

9
compiler/ncgcon.pas
View File

@ -71,7 +71,7 @@ implementation
symconst,symdef,aasmbase,aasmtai,aasmdata,aasmcpu,defutil,
cpuinfo,cpubase,
cgbase,cgobj,cgutils,
ncgutil, cclasses,asmutils
ncgutil, cclasses,asmutils,tgobj
;
@ -409,6 +409,13 @@ implementation
i : longint;
entry : PHashSetItem;
begin
{$ifdef jvm}
{$ifndef nounsupported}
location_reset_ref(location,LOC_REFERENCE,OS_ADDR,1);
tg.gethltemp(current_asmdata.CurrAsmList,resultdef,resultdef.size,tt_persistent,location.reference);
exit;
{$endif nounsupported}
{$endif jvm}
location_reset_ref(location,LOC_CREFERENCE,OS_NO,const_align(8));
lastlabel:=nil;
{ const already used ? }

3
compiler/ncginl.pas
View File

@ -528,6 +528,9 @@ implementation
var
setpara, elepara: tnode;
begin
{$if defined(jvm) and not defined(nounsupported)}
exit;
{$endif}
{ the set }
secondpass(tcallparanode(left).left);
{ the element to set }

12
compiler/ncgld.pas
View File

@ -412,6 +412,7 @@ implementation
localvarsym :
begin
vs:=tabstractnormalvarsym(symtableentry);
{$if not defined(jvm) or not defined(nounsupported)}
{ Nested variable }
if assigned(left) then
begin
@ -423,6 +424,7 @@ implementation
reference_reset_base(location.reference,left.location.register,vs.localloc.reference.offset,vs.localloc.reference.alignment);
end
else
{$endif}
location:=vs.localloc;
{ handle call by reference variables when they are not
@ -455,6 +457,14 @@ implementation
end;
procsym:
begin
{$ifdef jvm}
{$ifndef nounsupported}
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);
exit;
{$endif nounsupported}
{$endif jvm}
if not assigned(procdef) then
internalerror(200312011);
if assigned(left) then
@ -1095,6 +1105,7 @@ implementation
if dovariant then
begin
{$if not defined(jvm) or defined(nounsupported)}
{ find the correct vtype value }
vtype:=$ff;
vaddr:=false;
@ -1214,6 +1225,7 @@ implementation
cg.a_load_const_ref(current_asmdata.CurrAsmList, OS_INT,vtype,href);
{ goto next array element }
advancearrayoffset(href,sizeof(pint)*2);
{$endif not jvm or nounsupported}
end
else
{ normal array constructor of the same type }

24
compiler/ncgmem.pas
View File

@ -101,6 +101,14 @@ implementation
entry : PHashSetItem;
begin
{$ifdef jvm}
{$ifndef nounsupported}
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);
exit;
{$endif nounsupported}
{$endif jvm}
location_reset(location,LOC_REGISTER,OS_ADDR);
if (left.nodetype=typen) then
begin
@ -151,6 +159,14 @@ implementation
hsym : tparavarsym;
href : treference;
begin
{$ifdef jvm}
{$ifndef nounsupported}
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);
exit;
{$endif nounsupported}
{$endif jvm}
if (current_procinfo.procdef.parast.symtablelevel=parentpd.parast.symtablelevel) then
begin
location_reset(location,LOC_REGISTER,OS_ADDR);
@ -192,6 +208,14 @@ implementation
procedure tcgaddrnode.pass_generate_code;
begin
{$ifdef jvm}
{$ifndef nounsupported}
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);
exit;
{$endif nounsupported}
{$endif jvm}
secondpass(left);
location_reset(location,LOC_REGISTER,OS_ADDR);

11
compiler/ncgset.pas
View File

@ -276,6 +276,17 @@ implementation
if nf_swapped in flags then
swapleftright;
{$if defined(jvm) and not defined(nounsupported)}
if not is_smallset(left.resultdef) then
begin
location_reset(location, LOC_REGISTER, uopsize{def_cgsize(resultdef)});
{ allocate a register for the result }
location.register:=cg.getintregister(current_asmdata.CurrAsmList, uopsize);
hlcg.a_load_const_reg(current_asmdata.CurrAsmList,s32inttype,0,location.register);
exit;
end;
{$endif}
setbase:=tsetdef(right.resultdef).setbase;
if genjumps then
begin

11
compiler/psystem.pas
View File

@ -401,6 +401,15 @@ implementation
addfield(hrecst,tfieldvarsym.create('$self',vs_value,voidpointertype,[]));
methodpointertype:=trecorddef.create('',hrecst);
addtype('$methodpointer',methodpointertype);
end
else
begin
{$if defined(jvm) and not defined(nounsupported)}
hrecst:=trecordsymtable.create('',1);
addfield(hrecst,tfieldvarsym.create('$proc',vs_value,voidpointertype,[]));
methodpointertype:=trecorddef.create('',hrecst);
addtype('$methodpointer',methodpointertype);
{$endif}
end;
symtablestack.pop(systemunit);
end;
@ -477,7 +486,9 @@ implementation
end;
loadtype('variant',cvarianttype);
loadtype('olevariant',colevarianttype);
{$if defined(nounsupported) or not defined(jvm)}
if not(target_info.system in systems_managed_vm) then
{$endif}
loadtype('methodpointer',methodpointertype);
loadtype('HRESULT',hresultdef);
{$ifdef cpu64bitaddr}

61
rtl/java/system.pp
View File

@ -124,6 +124,67 @@ type
{$i jrech.inc}
{$i jdynarrh.inc}
{$ifndef nounsupported}
type
tmethod = record
code: jlobject;
end;
const
vtInteger = 0;
vtBoolean = 1;
vtChar = 2;
{$ifndef FPUNONE}
vtExtended = 3;
{$endif}
vtString = 4;
vtPointer = 5;
vtPChar = 6;
vtObject = 7;
vtClass = 8;
vtWideChar = 9;
vtPWideChar = 10;
vtAnsiString = 11;
vtCurrency = 12;
vtVariant = 13;
vtInterface = 14;
vtWideString = 15;
vtInt64 = 16;
vtQWord = 17;
vtUnicodeString = 18;
type
TVarRec = record
case VType : sizeint of
{$ifdef ENDIAN_BIG}
vtInteger : ({$IFDEF CPU64}integerdummy1 : Longint;{$ENDIF CPU64}VInteger: Longint);
vtBoolean : ({$IFDEF CPU64}booldummy : Longint;{$ENDIF CPU64}booldummy1,booldummy2,booldummy3: byte; VBoolean: Boolean);
vtChar : ({$IFDEF CPU64}chardummy : Longint;{$ENDIF CPU64}chardummy1,chardummy2,chardummy3: byte; VChar: Char);
vtWideChar : ({$IFDEF CPU64}widechardummy : Longint;{$ENDIF CPU64}wchardummy1,VWideChar: WideChar);
{$else ENDIAN_BIG}
vtInteger : (VInteger: Longint);
vtBoolean : (VBoolean: Boolean);
vtChar : (VChar: Char);
vtWideChar : (VWideChar: WideChar);
{$endif ENDIAN_BIG}
// vtString : (VString: PShortString);
// vtPointer : (VPointer: Pointer);
/// vtPChar : (VPChar: PChar);
vtObject : (VObject: TObject);
// vtClass : (VClass: TClass);
// vtPWideChar : (VPWideChar: PWideChar);
vtAnsiString : (VAnsiString: JLString);
vtCurrency : (VCurrency: Currency);
// vtVariant : (VVariant: PVariant);
vtInterface : (VInterface: JLObject);
vtWideString : (VWideString: JLString);
vtInt64 : (VInt64: Int64);
vtUnicodeString : (VUnicodeString: JLString);
vtQWord : (VQWord: QWord);
end;
{$endif}
Function lo(i : Integer) : byte; [INTERNPROC: fpc_in_lo_Word];
Function lo(w : Word) : byte; [INTERNPROC: fpc_in_lo_Word];
Function lo(l : Longint) : Word; [INTERNPROC: fpc_in_lo_long];