From 569228447dc9419ce7391da2633d6ec45384222d Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sat, 20 Aug 2011 08:15:54 +0000 Subject: [PATCH] * converted all enum handling for the JVM target so that it uses the JDK class-style enums rather than plain ordinals like in Pascal o for Pascal code, nothing changes, except that for the JVM target you can always typecast any enum into a class instance (to interface with the JDK) o to Java programs, FPC enums look exactly like Java enum types git-svn-id: branches/jvmbackend@18620 - --- .gitattributes | 1 + compiler/agjasmin.pas | 7 ++- compiler/jvm/cpunode.pas | 3 +- compiler/jvm/hlcgcpu.pas | 5 +- compiler/jvm/njvmadd.pas | 18 ++++++- compiler/jvm/njvmcnv.pas | 105 ++++++++++++++++++++++++++++++++++++--- compiler/jvm/njvmcon.pas | 74 ++++++++++++++++++++++++++- compiler/jvm/njvmflw.pas | 59 +++++++++++++++++++++- compiler/jvm/njvmmem.pas | 36 +++++++++++++- compiler/jvm/njvmset.pas | 64 ++++++++++++++++++++++++ compiler/jvmdef.pas | 5 +- compiler/ncgld.pas | 2 + compiler/ncnv.pas | 8 +++ compiler/ninl.pas | 12 ++++- compiler/pdecl.pas | 11 ++++ compiler/pjvm.pas | 47 ++++++++++++++++-- compiler/symcreat.pas | 30 +++++++++++ compiler/symdef.pas | 11 ++++ 18 files changed, 474 insertions(+), 24 deletions(-) create mode 100644 compiler/jvm/njvmset.pas diff --git a/.gitattributes b/.gitattributes index 822d27042e..a78470b8c0 100644 --- a/.gitattributes +++ b/.gitattributes @@ -228,6 +228,7 @@ compiler/jvm/njvminl.pas svneol=native#text/plain compiler/jvm/njvmld.pas svneol=native#text/plain compiler/jvm/njvmmat.pas svneol=native#text/plain compiler/jvm/njvmmem.pas svneol=native#text/plain +compiler/jvm/njvmset.pas svneol=native#text/plain compiler/jvm/njvmutil.pas svneol=native#text/plain compiler/jvm/rgcpu.pas svneol=native#text/plain compiler/jvm/rjvmcon.inc svneol=native#text/plain diff --git a/compiler/agjasmin.pas b/compiler/agjasmin.pas index b1184e4344..e49de6fd69 100644 --- a/compiler/agjasmin.pas +++ b/compiler/agjasmin.pas @@ -776,7 +776,12 @@ implementation constnil: result:=''; else - result:=' = '+ConstValue(csym) + begin + { enums are initialized as typed constants } + if not assigned(csym.constdef) or + (csym.constdef.typ<>enumdef) then + result:=' = '+ConstValue(csym) + end; end; end; diff --git a/compiler/jvm/cpunode.pas b/compiler/jvm/cpunode.pas index c12daa3f9b..f06dc3eb33 100644 --- a/compiler/jvm/cpunode.pas +++ b/compiler/jvm/cpunode.pas @@ -32,7 +32,8 @@ implementation uses ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset, ncgadd, ncgcal,ncgmat,ncginl, - njvmadd,njvmcal,njvmmat,njvmcnv,njvmcon,njvminl,njvmmem,njvmflw,njvmld + njvmadd,njvmcal,njvmmat,njvmcnv,njvmcon,njvminl,njvmmem,njvmflw,njvmld, + njvmset { these are not really nodes } ,rgcpu,tgcpu,njvmutil; diff --git a/compiler/jvm/hlcgcpu.pas b/compiler/jvm/hlcgcpu.pas index e001c318a3..2c672f8e8d 100644 --- a/compiler/jvm/hlcgcpu.pas +++ b/compiler/jvm/hlcgcpu.pas @@ -250,8 +250,9 @@ implementation function thlcgjvm.def2regtyp(def: tdef): tregistertype; begin case def.typ of - { records are implemented via classes } - recorddef: + { records and enums are implemented via classes } + recorddef, + enumdef: result:=R_ADDRESSREGISTER; setdef: if is_smallset(def) then diff --git a/compiler/jvm/njvmadd.pas b/compiler/jvm/njvmadd.pas index 69eac35e6d..f5e67b6371 100644 --- a/compiler/jvm/njvmadd.pas +++ b/compiler/jvm/njvmadd.pas @@ -57,12 +57,12 @@ interface uses systems, cutils,verbose,constexp, - symtable,symdef, + symconst,symtable,symdef, paramgr,procinfo, aasmtai,aasmdata,aasmcpu,defutil, hlcgobj,hlcgcpu,cgutils, cpupara, - ncon,nset,nadd,ncal, + ncon,nset,nadd,ncal,ncnv, cgobj; {***************************************************************************** @@ -71,6 +71,20 @@ interface 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; result:=inherited pass_1; if expectloc=LOC_FLAGS then expectloc:=LOC_JUMP; diff --git a/compiler/jvm/njvmcnv.pas b/compiler/jvm/njvmcnv.pas index 8982d060ab..e407775cb4 100644 --- a/compiler/jvm/njvmcnv.pas +++ b/compiler/jvm/njvmcnv.pas @@ -534,6 +534,42 @@ implementation left:=nil; end; + function ord_enum_explicit_typecast(fdef: torddef; todef: tenumdef): tnode; + var + psym: tsym; + begin + { we only create a class for the basedefs } + todef:=todef.getbasedef; + psym:=search_struct_member(todef.classdef,'FPCVALUEOF'); + if not assigned(psym) or + (psym.typ<>procsym) then + internalerror(2011062601); + result:=ccallnode.create(ccallparanode.create(left,nil), + tprocsym(psym),psym.owner, + cloadvmtaddrnode.create(ctypenode.create(todef.classdef)),[]); + { convert the result to the result type of this type conversion node } + inserttypeconv_explicit(result,resultdef); + { left is reused } + left:=nil; + end; + + function enum_ord_explicit_typecast(fdef: tenumdef; todef: torddef): tnode; + var + psym: tsym; + begin + { we only create a class for the basedef } + fdef:=fdef.getbasedef; + psym:=search_struct_member(fdef.classdef,'FPCORDINAL'); + if not assigned(psym) or + (psym.typ<>procsym) then + internalerror(2011062602); + result:=ccallnode.create(nil,tprocsym(psym),psym.owner,left,[]); + { convert the result to the result type of this type conversion node } + inserttypeconv_explicit(result,resultdef); + { left is reused } + left:=nil; + end; + function ptr_no_typecheck_required(fromdef, todef: tdef): boolean; function check_type_equality(def1,def2: tdef): boolean; @@ -635,6 +671,7 @@ implementation is_dynamic_array(left.resultdef) or ((left.resultdef.typ in [stringdef,classrefdef]) and not is_shortstring(left.resultdef)) or + (left.resultdef.typ=enumdef) or procvarconv; toclasscompatible:= (resultdef.typ=pointerdef) or @@ -642,6 +679,7 @@ implementation is_dynamic_array(resultdef) or ((resultdef.typ in [stringdef,classrefdef]) and not is_shortstring(resultdef)) or + (resultdef.typ=enumdef) or procvarconv; { typescasts from void (the result of untyped_ptr^) to an implicit pointertype (record, array, ...) also needs a typecheck } @@ -668,6 +706,11 @@ implementation fromdef:=left.resultdef; todef:=resultdef; get_most_nested_types(fromdef,todef); + { in case of enums, get the equivalent class definitions } + if (fromdef.typ=enumdef) then + fromdef:=tenumdef(fromdef).getbasedef; + if (todef.typ=enumdef) then + todef:=tenumdef(todef).getbasedef; fromarrtype:=jvmarrtype_setlength(fromdef); toarrtype:=jvmarrtype_setlength(todef); if not ptr_no_typecheck_required(fromdef,todef) then @@ -723,6 +766,8 @@ implementation begin if (convtype<>tc_int_2_real) then begin + if (left.resultdef.typ=enumdef) then + inserttypeconv_explicit(left,s32inttype); if not check_only then resnode:=int_real_explicit_typecast(tfloatdef(resultdef),'INTBITSTOFLOAT','LONGBITSTODOUBLE'); result:=true; @@ -731,12 +776,48 @@ implementation result:=false; exit; end; - { nothing special required when going between ordinals and enums } - if (left.resultdef.typ in [orddef,enumdef]) and - (resultdef.typ in [orddef,enumdef]) then + + { enums } + if (left.resultdef.typ=enumdef) or + (resultdef.typ=enumdef) then begin - result:=false; - exit; + { both enum? } + if (resultdef.typ=left.resultdef.typ) then + begin + { same base type -> nothing special } + fromdef:=tenumdef(left.resultdef).getbasedef; + todef:=tenumdef(resultdef).getbasedef; + if fromdef=todef then + begin + result:=false; + exit; + end; + { convert via ordinal intermediate } + if not check_only then + begin; + inserttypeconv_explicit(left,s32inttype); + inserttypeconv_explicit(left,resultdef); + resnode:=left; + left:=nil + end; + result:=true; + exit; + end; + { enum to orddef & vice versa } + if left.resultdef.typ=orddef then + begin + if not check_only then + resnode:=ord_enum_explicit_typecast(torddef(left.resultdef),tenumdef(resultdef)); + result:=true; + exit; + end + else if resultdef.typ=orddef then + begin + if not check_only then + resnode:=enum_ord_explicit_typecast(tenumdef(left.resultdef),torddef(resultdef)); + result:=true; + exit; + end end; {$ifndef nounsupported} @@ -792,6 +873,16 @@ implementation function tjvmtypeconvnode.target_specific_general_typeconv: boolean; begin result:=false; + { on the JVM platform, enums can always be converted to class instances, + because enums /are/ class instances there. To prevent the + typechecking/conversion code from assuming it can treat it like any + ordinal constant, firstpass() it so that the ordinal constant gets + replaced with a load of a staticvarsym. This is not done in + pass_typecheck, because that would prevent many optimizations } + if (left.nodetype=ordconstn) and + (left.resultdef.typ=enumdef) and + (resultdef.typ=objectdef) then + firstpass(left); {$ifndef nounsupported} { generated in nmem; replace voidpointertype with java_jlobject } if nf_load_procvar in flags then @@ -913,7 +1004,9 @@ implementation if checkdef=voidpointertype then checkdef:=java_jlobject else if checkdef.typ=pointerdef then - checkdef:=tpointerdef(checkdef).pointeddef; + checkdef:=tpointerdef(checkdef).pointeddef + else if checkdef.typ=enumdef then + checkdef:=tenumdef(checkdef).classdef; {$ifndef nounsupported} if checkdef.typ=procvardef then checkdef:=java_jlobject diff --git a/compiler/jvm/njvmcon.pas b/compiler/jvm/njvmcon.pas index 0c64f4a9ec..300f381304 100644 --- a/compiler/jvm/njvmcon.pas +++ b/compiler/jvm/njvmcon.pas @@ -30,6 +30,16 @@ interface node,ncon,ncgcon; type + tjvmordconstnode = class(tcgordconstnode) + { normally, we convert the enum constant into a load of the + appropriate enum class field in pass_1. In some cases (array index), + we want to keep it as an enum constant however } + enumconstok: boolean; + function pass_1: tnode; override; + function docompare(p: tnode): boolean; override; + function dogetcopy: tnode; override; + end; + tjvmrealconstnode = class(tcgrealconstnode) procedure pass_generate_code;override; end; @@ -43,14 +53,73 @@ interface implementation uses - globtype,cutils,widestr,verbose, + globtype,cutils,widestr,verbose,constexp, symdef,symsym,symtable,symconst, aasmdata,aasmcpu,defutil, - ncal, + ncal,nld, cgbase,hlcgobj,hlcgcpu,cgutils,cpubase ; +{***************************************************************************** + TJVMORDCONSTNODE +*****************************************************************************} + + function tjvmordconstnode.pass_1: tnode; + var + basedef: tenumdef; + sym: tenumsym; + classfield: tsym; + i: longint; + begin + if (resultdef.typ<>enumdef) or + enumconstok then + begin + result:=inherited pass_1; + exit; + end; + { convert into JVM class instance } + { a) find the enumsym corresponding to the value (may not exist in case + of an explicit typecast of an integer -> error) } + sym:=nil; + basedef:=tenumdef(resultdef).getbasedef; + for i:=0 to tenumdef(resultdef).symtable.symlist.count-1 do + begin + sym:=tenumsym(basedef.symtable.symlist[i]); + if sym.value=value then + break; + sym:=nil; + end; + if not assigned(sym) then + begin + Message(parser_e_range_check_error); + exit; + end; + { b) find the corresponding class field } + classfield:=search_struct_member(basedef.classdef,sym.name); + if not assigned(classfield) or + (classfield.typ<>staticvarsym) then + internalerror(2011062606); + { c) create loadnode of the field } + result:=cloadnode.create(classfield,classfield.owner); + end; + + + function tjvmordconstnode.docompare(p: tnode): boolean; + begin + result:=inherited docompare(p); + if result then + result:=(enumconstok=tjvmordconstnode(p).enumconstok); + end; + + + function tjvmordconstnode.dogetcopy: tnode; + begin + result:=inherited dogetcopy; + tjvmordconstnode(result).enumconstok:=enumconstok; + end; + + {***************************************************************************** TJVMREALCONSTNODE *****************************************************************************} @@ -136,6 +205,7 @@ implementation begin + cordconstnode:=tjvmordconstnode; crealconstnode:=tjvmrealconstnode; cstringconstnode:=tjvmstringconstnode; end. diff --git a/compiler/jvm/njvmflw.pas b/compiler/jvm/njvmflw.pas index 52f4ea7240..100d73186f 100644 --- a/compiler/jvm/njvmflw.pas +++ b/compiler/jvm/njvmflw.pas @@ -26,9 +26,13 @@ unit njvmflw; interface uses - aasmbase,node,nflw; + aasmbase,node,nflw,ncgflw; type + tjvmfornode = class(tcgfornode) + function pass_1: tnode; override; + end; + tjvmraisenode = class(traisenode) function pass_typecheck: tnode; override; procedure pass_generate_code;override; @@ -53,11 +57,61 @@ implementation symconst,symdef,symsym,aasmtai,aasmdata,aasmcpu,defutil,jvmdef, procinfo,cgbase,pass_2,parabase, cpubase,cpuinfo, - nld,ncon, + nbas,nld,ncon,ncnv, tgobj,paramgr, cgutils,hlcgobj,hlcgcpu ; +{***************************************************************************** + TFJVMFORNODE +*****************************************************************************} + + function tjvmfornode.pass_1: tnode; + var + iteratortmp: ttempcreatenode; + olditerator: tnode; + block, + newbody: tblocknode; + stat, + newbodystat: tstatementnode; + begin + { transform for-loops with enums to: + for tempint:=ord(lowval) to ord(upperval) do + begin + originalctr:=tenum(tempint); + + end; + + enums are class instances in Java and hence can't be increased or so. + The type conversion consists of an array lookup in a final method, + so it shouldn't be too expensive. + } + if left.resultdef.typ=enumdef then + begin + block:=internalstatements(stat); + iteratortmp:=ctempcreatenode.create(s32inttype,left.resultdef.size,tt_persistent,true); + addstatement(stat,iteratortmp); + olditerator:=left; + left:=ctemprefnode.create(iteratortmp); + inserttypeconv_explicit(right,s32inttype); + inserttypeconv_explicit(t1,s32inttype); + newbody:=internalstatements(newbodystat); + addstatement(newbodystat,cassignmentnode.create(olditerator, + ctypeconvnode.create_explicit(ctemprefnode.create(iteratortmp), + olditerator.resultdef))); + addstatement(newbodystat,t2); + addstatement(stat,cfornode.create(left,right,t1,newbody,lnf_backward in loopflags)); + addstatement(stat,ctempdeletenode.create(iteratortmp)); + left:=nil; + right:=nil; + t1:=nil; + t2:=nil; + result:=block + end + else + result:=inherited pass_1; + end; + {***************************************************************************** SecondRaise *****************************************************************************} @@ -425,6 +479,7 @@ implementation end; begin + cfornode:=tjvmfornode; craisenode:=tjvmraisenode; ctryexceptnode:=tjvmtryexceptnode; ctryfinallynode:=tjvmtryfinallynode; diff --git a/compiler/jvm/njvmmem.pas b/compiler/jvm/njvmmem.pas index 2393f5d08b..3d04cdce7d 100644 --- a/compiler/jvm/njvmmem.pas +++ b/compiler/jvm/njvmmem.pas @@ -57,7 +57,7 @@ implementation cutils,verbose,constexp, symconst,symtype,symtable,symsym,symdef,defutil,jvmdef, htypechk, - nadd,ncal,ncnv,ncon,pass_1, + nadd,ncal,ncnv,ncon,pass_1,njvmcon, aasmdata,aasmcpu,pass_2, cgutils,hlcgobj,hlcgcpu; @@ -235,12 +235,21 @@ implementation exit; end else - result:=inherited; + begin + { keep indices that are enum constants that way, rather than + transforming them into a load of the class instance that + represents this constant (since we then would have to extract + the int constant value again at run time anyway) } + if right.nodetype=ordconstn then + tjvmordconstnode(right).enumconstok:=true; + result:=inherited; + end; end; procedure tjvmvecnode.pass_generate_code; var + psym: tsym; newsize: tcgsize; begin if left.resultdef.typ=stringdef then @@ -269,6 +278,29 @@ implementation if (right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and (right.location.reference.arrayreftype<>art_none) then hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true); + { replace enum class instance with the corresponding integer value } + if (right.resultdef.typ=enumdef) then + begin + if (right.location.loc<>LOC_CONSTANT) then + begin + psym:=search_struct_member(tenumdef(right.resultdef).classdef,'FPCORDINAL'); + if not assigned(psym) or + (psym.typ<>procsym) or + (tprocsym(psym).ProcdefList.count<>1) then + internalerror(2011062607); + thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location); + hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(tprocsym(psym).procdeflist[0]),tprocdef(tprocsym(psym).procdeflist[0]).mangledname,false); + { call replaces self parameter with longint result -> no stack + height change } + location_reset(right.location,LOC_REGISTER,OS_S32); + right.location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,s32inttype); + thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,s32inttype,right.location.register); + end; + { always force to integer location, because enums are handled as + object instances (since that's what they are in Java) } + right.resultdef:=s32inttype; + right.location.size:=OS_S32; + end; { adjust index if necessary } if not is_special_array(left.resultdef) and diff --git a/compiler/jvm/njvmset.pas b/compiler/jvm/njvmset.pas new file mode 100644 index 0000000000..1725ecfe5f --- /dev/null +++ b/compiler/jvm/njvmset.pas @@ -0,0 +1,64 @@ +{ + Copyright (c) 2011 by Jonas Maebe + + Generate JVM bytecode for in set/case nodes + + 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 njvmset; + +{$i fpcdefs.inc} + +interface + + uses + globtype, + node,nset,ncgset; + + type + tjvmcasenode = class(tcgcasenode) + function pass_1: tnode; override; + end; + + +implementation + + uses + symconst,symdef, + pass_1, + ncnv; + + +{***************************************************************************** + TJVMCASENODE +*****************************************************************************} + + function tjvmcasenode.pass_1: tnode; + begin + { convert case expression to an integer in case it's an enum, since + enums are class instances in the JVM. All labels are stored as + ordinal values, so it doesn't matter that we change the type } + if left.resultdef.typ=enumdef then + inserttypeconv_explicit(left,s32inttype); + result:=inherited pass_1; + end; + + + +begin + ccasenode:=tjvmcasenode; +end. diff --git a/compiler/jvmdef.pas b/compiler/jvmdef.pas index ccc8910bc8..852d6f05e6 100644 --- a/compiler/jvmdef.pas +++ b/compiler/jvmdef.pas @@ -204,7 +204,10 @@ implementation result:=false; end; end; - enumdef, + enumdef: + begin + result:=jvmaddencodedtype(tenumdef(def).classdef,false,encodedstr,forcesignature,founderror); + end; orddef : begin { for procedure "results" } diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas index 5f0c74a7f0..2177a1b8bc 100644 --- a/compiler/ncgld.pas +++ b/compiler/ncgld.pas @@ -309,6 +309,7 @@ implementation staticvarsym : begin gvs:=tstaticvarsym(symtableentry); +{$ifndef jvm} if ([vo_is_dll_var,vo_is_external] * gvs.varoptions <> []) then begin { assume external variables use the default alignment } @@ -319,6 +320,7 @@ implementation exit; end else +{$endif jvm} begin location.reference.alignment:=var_align(gvs.vardef.alignment); end; diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index 3abce060eb..39bd904720 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -2221,6 +2221,14 @@ implementation { structured types } if not( (left.resultdef.typ=formaldef) or +{$ifdef jvm} + { enums /are/ class instances on the JVM + platform } + (((left.resultdef.typ=enumdef) and + (resultdef.typ=objectdef)) or + ((resultdef.typ=enumdef) and + (left.resultdef.typ=objectdef))) or +{$endif} ( not(is_open_array(left.resultdef)) and not(is_array_constructor(left.resultdef)) and diff --git a/compiler/ninl.pas b/compiler/ninl.pas index 0b687e328e..60cee049e9 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -2992,7 +2992,10 @@ implementation expectloc:=LOC_REGISTER; { in case of range/overflow checking, use a regular addnode because it's too complex to handle correctly otherwise } +{$ifndef jvm} + { enums are class instances in the JVM -> always need conversion } if ([cs_check_overflow,cs_check_range]*current_settings.localswitches)<>[] then +{$endif} begin { create constant 1 } hp:=cordconstnode.create(1,left.resultdef,false); @@ -3053,11 +3056,16 @@ implementation { range/overflow checking doesn't work properly } { with the inc/dec code that's generated (JM) } - if (current_settings.localswitches * [cs_check_overflow,cs_check_range] <> []) and + if ((current_settings.localswitches * [cs_check_overflow,cs_check_range] <> []) and { No overflow check for pointer operations, because inc(pointer,-1) will always trigger an overflow. For uint32 it works because then the operation is done in 64bit. Range checking is not applicable to pointers either } - (tcallparanode(left).left.resultdef.typ<>pointerdef) then + (tcallparanode(left).left.resultdef.typ<>pointerdef)) +{$ifdef jvm} + { enums are class instances on the JVM -> special treatment } + or (tcallparanode(left).left.resultdef.typ=enumdef) +{$endif} + then { convert to simple add (JM) } begin newblock := internalstatements(newstatement); diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index ac8ccbe618..2308cd2d02 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -71,6 +71,9 @@ implementation { parser } scanner, pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj, +{$ifdef jvm} + pjvm, +{$endif} { cpu-information } cpuinfo ; @@ -204,6 +207,14 @@ implementation sym.deprecatedmsg:=deprecatedmsg; sym.visibility:=symtablestack.top.currentvisibility; symtablestack.top.insert(sym); +{$ifdef jvm} + { for the JVM target, some constants need to be + initialized at run time (enums, sets) -> create fake + typed const to do so } + if assigned(tconstsym(sym).constdef) and + (tconstsym(sym).constdef.typ=enumdef) then + jvm_add_typed_const_initializer(tconstsym(sym)); +{$endif} end else stringdispose(deprecatedmsg); diff --git a/compiler/pjvm.pas b/compiler/pjvm.pas index 27a4b6ca05..ec197682a2 100644 --- a/compiler/pjvm.pas +++ b/compiler/pjvm.pas @@ -28,7 +28,7 @@ interface uses globtype, - symtype,symbase,symdef; + symtype,symbase,symdef,symsym; { the JVM specs require that you add a default parameterless constructor in case the programmer hasn't specified any } @@ -41,6 +41,7 @@ interface procedure jvm_maybe_create_enum_class(const name: TIDString; def: tdef); + procedure jvm_add_typed_const_initializer(csym: tconstsym); implementation @@ -49,9 +50,9 @@ implementation cutils,cclasses, verbose,systems, fmodule, - parabase, + parabase,aasmdata, pdecsub, - symtable,symconst,symsym,symcreat,defcmp,jvmdef, + symtable,symconst,symcreat,defcmp,jvmdef, defutil,paramgr; @@ -329,4 +330,44 @@ implementation restore_scanner(sstate); end; + + procedure jvm_add_typed_const_initializer(csym: tconstsym); + var + ssym: tstaticvarsym; + esym: tenumsym; + i: longint; + sstate: symcreat.tscannerstate; + begin + case csym.constdef.typ of + enumdef: + begin + replace_scanner('jvm_enum_const',sstate); + { make sure we don't emit a definition for this field (we'll do + that for the constsym already) -> mark as external } + ssym:=tstaticvarsym.create(internal_static_field_name(csym.realname),vs_final,csym.constdef,[vo_is_external]); + csym.owner.insert(ssym); + { alias storage to the constsym } + ssym.set_mangledname(csym.realname); + for i:=0 to tenumdef(csym.constdef).symtable.symlist.count-1 do + begin + esym:=tenumsym(tenumdef(csym.constdef).symtable.symlist[i]); + if esym.value=csym.value.valueord.svalue then + break; + esym:=nil; + end; + { can happen in case of explicit typecast from integer constant + to enum type } + if not assigned(esym) then + begin + MessagePos(csym.fileinfo,parser_e_range_check_error); + exit; + end; + str_parse_typedconst(current_asmdata.asmlists[al_typedconsts],esym.name+';',ssym); + restore_scanner(sstate); + end + else + internalerror(2011062701); + end; + end; + end. diff --git a/compiler/symcreat.pas b/compiler/symcreat.pas index e013155e22..bb29c5647e 100644 --- a/compiler/symcreat.pas +++ b/compiler/symcreat.pas @@ -61,6 +61,15 @@ interface } function str_parse_method_impl(str: ansistring; usefwpd: tprocdef; is_classdef: boolean):boolean; + { parses a typed constant assignment to ssym + + WARNINGS: + * save the scanner state before calling this routine, and restore when done. + * the code *must* be written in objfpc style + } + procedure str_parse_typedconst(list: TAsmList; str: ansistring; ssym: tstaticvarsym); + + { in the JVM, constructors are not automatically inherited (so you can hide them). To emulate the Pascal behaviour, we have to automatically add @@ -209,6 +218,27 @@ implementation end; + procedure str_parse_typedconst(list: TAsmList; str: ansistring; ssym: tstaticvarsym); + var + old_block_type: tblock_type; + old_parse_only: boolean; + begin + Message1(parser_d_internal_parser_string,str); + { a string that will be interpreted as the start of a new section -> + typed constant parsing will stop } + str:=str+'type '; + old_parse_only:=parse_only; + old_block_type:=block_type; + parse_only:=true; + block_type:=bt_const; + current_scanner.substitutemacro('typed_const_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index); + current_scanner.readtoken(false); + read_typed_const(list,ssym,ssym.owner.symtabletype in [recordsymtable,objectsymtable]); + parse_only:=old_parse_only; + block_type:=old_block_type; + end; + + procedure add_missing_parent_constructors_intf(obj: tobjectdef; forcevis: tvisibility); var parent: tobjectdef; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 79c07b5737..60b1ed9b4e 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -701,6 +701,8 @@ interface function min:asizeint; function max:asizeint; function getfirstsym:tsym; + { returns basedef if assigned, otherwise self } + function getbasedef: tenumdef; end; tsetdef = class(tstoreddef) @@ -1844,6 +1846,15 @@ implementation end; + function tenumdef.getbasedef: tenumdef; + begin + if not assigned(basedef) then + result:=self + else + result:=basedef; + end; + + procedure tenumdef.buildderef; begin inherited buildderef;