* 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

@@ -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

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;
 

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;
 

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

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;

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

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.

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);
+                <original loop body>
+              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;

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

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.

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" }

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;

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

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);

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);

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.

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;

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;