* since enums are represented by classes in the JVM, initialize global

    variables, class/record fields and arrays with enumtype(0) on
    creation, so that using them without explicitly initializing them
    doesn't cause a null-pointer exception. If enumtype(0) is not a
    valid enum, they are not initialized (and since they wouldn't have
    a valid value on native targets either in that case, an exception
    on use is acceptable)

git-svn-id: branches/jvmbackend@18755 -

compiler/jvm/hlcgcpu.pas

@@ -155,7 +155,10 @@ uses
 
       procedure gen_initialize_fields_code(list:TAsmList);
      protected
+      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_enum_with_base_ref(list: TAsmList; vs: tabstractvarsym; const initref: treference; destbaseref: treference);
       procedure allocate_implicit_struct_with_base_ref(list: TAsmList; vs: tabstractvarsym; ref: treference);
       procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
 
@@ -605,7 +608,8 @@ implementation
 
   procedure thlcgjvm.g_newarray(list: TAsmList; arrdef: tdef; initdim: longint);
     var
-      recref: treference;
+      recref,
+      enuminitref: treference;
       elemdef: tdef;
       i: longint;
       mangledname: string;
@@ -646,38 +650,47 @@ implementation
       for i:=1 to pred(initdim) do
         elemdef:=tarraydef(elemdef).elementdef;
       if (elemdef.typ in [recorddef,setdef]) or
+         ((elemdef.typ=enumdef) and
+          get_enum_init_val_ref(elemdef,enuminitref)) or
          is_shortstring(elemdef) or
          ((elemdef.typ=procvardef) and
           not tprocvardef(elemdef).is_addressonly) then
         begin
-          { duplicate array/string/set instance }
+          { duplicate array instance }
           list.concat(taicpu.op_none(a_dup));
           incstack(list,1);
           a_load_const_stack(list,s32inttype,initdim-1,R_INTREGISTER);
-          if elemdef.typ in [recorddef,setdef,procvardef] then
-            begin
-              tg.gethltemp(list,elemdef,elemdef.size,tt_persistent,recref);
-              a_load_ref_stack(list,elemdef,recref,prepare_stack_for_ref(list,recref,false));
-              case elemdef.typ of
-                recorddef:
-                  g_call_system_proc(list,'fpc_initialize_array_record');
-                setdef:
-                  begin
-                    if tsetdef(elemdef).elementdef.typ=enumdef then
-                      g_call_system_proc(list,'fpc_initialize_array_enumset')
-                    else
-                      g_call_system_proc(list,'fpc_initialize_array_bitset')
-                  end;
-                procvardef:
-                  g_call_system_proc(list,'fpc_initialize_array_procvar');
+          case elemdef.typ of
+            recorddef,setdef,procvardef:
+              begin
+                tg.gethltemp(list,elemdef,elemdef.size,tt_persistent,recref);
+                a_load_ref_stack(list,elemdef,recref,prepare_stack_for_ref(list,recref,false));
+                case elemdef.typ of
+                  recorddef:
+                    g_call_system_proc(list,'fpc_initialize_array_record');
+                  setdef:
+                    begin
+                      if tsetdef(elemdef).elementdef.typ=enumdef then
+                        g_call_system_proc(list,'fpc_initialize_array_enumset')
+                      else
+                        g_call_system_proc(list,'fpc_initialize_array_bitset')
+                    end;
+                  procvardef:
+                    g_call_system_proc(list,'fpc_initialize_array_procvar');
+                end;
+                tg.ungettemp(list,recref);
               end;
-              tg.ungettemp(list,recref);
-            end
-          else
-            begin
-              a_load_const_stack(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER);
-              g_call_system_proc(list,'fpc_initialize_array_shortstring');
-            end;
+            enumdef:
+              begin
+                a_load_ref_stack(list,java_jlobject,enuminitref,prepare_stack_for_ref(list,enuminitref,false));
+                g_call_system_proc(list,'fpc_initialize_array_object');
+              end;
+            else
+              begin
+                a_load_const_stack(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER);
+                g_call_system_proc(list,'fpc_initialize_array_shortstring');
+              end;
+          end;
           decstack(list,3);
         end;
     end;
@@ -1495,6 +1508,14 @@ implementation
             g_call_system_proc(list,'fpc_initialize_array_bitset');
           tg.ungettemp(list,eleref);
         end
+      else if (t.typ=enumdef) then
+        begin
+          if get_enum_init_val_ref(t,eleref) then
+            begin
+              a_load_ref_stack(list,java_jlobject,eleref,prepare_stack_for_ref(list,eleref,false));
+              g_call_system_proc(list,'fpc_initialize_array_object');
+            end;
+        end
       else
         internalerror(2011031901);
     end;
@@ -1933,11 +1954,35 @@ implementation
       tg.ungettemp(list,tmpref);
     end;
 
+
+  procedure thlcgjvm.allocate_enum_with_base_ref(list: TAsmList; vs: tabstractvarsym; const initref: treference; destbaseref: treference);
+    begin
+      destbaseref.symbol:=current_asmdata.RefAsmSymbol(vs.mangledname);
+      { only copy the reference, not the actual data }
+      a_load_ref_ref(list,java_jlobject,java_jlobject,initref,destbaseref);
+    end;
+
+
+  function thlcgjvm.get_enum_init_val_ref(def: tdef; out ref: treference): boolean;
+    var
+      sym: tstaticvarsym;
+    begin
+      result:=false;
+      sym:=tstaticvarsym(tenumdef(def).getbasedef.classdef.symtable.Find('__FPC_ZERO_INITIALIZER'));
+      { no enum with ordinal value 0 -> exit }
+      if not assigned(sym) then
+        exit;
+      reference_reset_symbol(ref,current_asmdata.RefAsmSymbol(sym.mangledname),0,4);
+      result:=true;
+    end;
+
+
   procedure thlcgjvm.allocate_implicit_structs_for_st_with_base_ref(list: TAsmList; st: tsymtable; const ref: treference; allocvartyp: tsymtyp);
     var
       vs: tabstractvarsym;
       def: tdef;
       i: longint;
+      initref: treference;
     begin
       for i:=0 to st.symlist.count-1 do
         begin
@@ -1951,9 +1996,16 @@ implementation
             intialising the constant }
           if [vo_is_external,vo_has_local_copy]*vs.varoptions=[vo_is_external] then
              continue;
-          if not jvmimplicitpointertype(vs.vardef) then
-            continue;
-          allocate_implicit_struct_with_base_ref(list,vs,ref);
+          if jvmimplicitpointertype(vs.vardef) then
+            allocate_implicit_struct_with_base_ref(list,vs,ref)
+          { enums are class instances in Java, while they are ordinals in
+            Pascal. When they are initialized with enum(0), such as in
+            constructors or global variables, initialize them with the
+            enum instance for 0 if it exists (if not, it remains nil since
+            there is no valid enum value in it) }
+          else if (vs.vardef.typ=enumdef) and
+                  get_enum_init_val_ref(vs.vardef,initref) then
+            allocate_enum_with_base_ref(list,vs,initref,ref);
         end;
       { process symtables of routines part of this symtable (for local typed
         constants) }
@@ -1978,6 +2030,7 @@ implementation
 
   procedure thlcgjvm.gen_initialize_fields_code(list: TAsmList);
     var
+      sym: tsym;
       selfpara: tparavarsym;
       selfreg: tregister;
       ref: treference;
@@ -1989,12 +2042,17 @@ implementation
       { check whether there are any fields that need initialisation }
       needinit:=false;
       for i:=0 to obj.symtable.symlist.count-1 do
-        if (tsym(obj.symtable.symlist[i]).typ=fieldvarsym) and
-           jvmimplicitpointertype(tfieldvarsym(obj.symtable.symlist[i]).vardef) then
-          begin
-            needinit:=true;
-            break;
-          end;
+        begin
+          sym:=tsym(obj.symtable.symlist[i]);
+          if (sym.typ=fieldvarsym) and
+             (jvmimplicitpointertype(tfieldvarsym(sym).vardef) or
+              ((tfieldvarsym(sym).vardef.typ=enumdef) and
+               get_enum_init_val_ref(tfieldvarsym(sym).vardef,ref))) then
+            begin
+              needinit:=true;
+              break;
+            end;
+        end;
       if not needinit then
         exit;
       selfpara:=tparavarsym(current_procinfo.procdef.parast.find('self'));

compiler/jvm/njvmcon.pas

@@ -101,7 +101,6 @@ implementation
         basedef: tenumdef;
         sym: tenumsym;
         classfield: tsym;
-        i: longint;
       begin
         if (resultdef.typ<>enumdef) or
            enumconstok then
@@ -113,20 +112,15 @@ implementation
         { 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;
+        sym:=tenumsym(tenumdef(resultdef).int2enumsym(int64(value)));
         if not assigned(sym) then
           begin
             Message(parser_e_range_check_error);
+            result:=nil;
             exit;
           end;
         { b) find the corresponding class field }
+        basedef:=tenumdef(resultdef).getbasedef;
         classfield:=search_struct_member(basedef.classdef,sym.name);
 
         { c) create loadnode of the field }

compiler/pjvm.pas

@@ -270,7 +270,8 @@ implementation
         pd: tprocdef;
         old_current_structdef: tabstractrecorddef;
         i: longint;
-        sym: tstaticvarsym;
+        sym,
+        aliassym: tstaticvarsym;
         fsym: tfieldvarsym;
         sstate: tscannerstate;
         sl: tpropaccesslist;
@@ -333,6 +334,14 @@ implementation
             fsym:=tfieldvarsym.create(tenumsym(tenumdef(def).symtable.symlist[i]).realname,vs_final,enumclass,[]);
             enumclass.symtable.insert(fsym);
             sym:=make_field_static(enumclass.symtable,fsym);
+            { add alias for the field representing ordinal(0), for use in
+              initialization code }
+            if tenumsym(tenumdef(def).symtable.symlist[i]).value=0 then
+              begin
+                aliassym:=tstaticvarsym.create('__FPC_Zero_Initializer',vs_final,enumclass,[vo_is_external]);
+                enumclass.symtable.insert(aliassym);
+                aliassym.set_raw_mangledname(sym.mangledname);
+              end;
           end;
         { create local "array of enumtype" type for the "values" functionality
           (used internally by the JDK) }

compiler/symdef.pas

@@ -737,6 +737,7 @@ interface
           function  min:asizeint;
           function  max:asizeint;
           function  getfirstsym:tsym;
+          function  int2enumsym(l: asizeint): tsym;
           { returns basedef if assigned, otherwise self }
           function getbasedef: tenumdef;
        end;
@@ -1895,6 +1896,30 @@ implementation
       end;
 
 
+    function tenumdef.int2enumsym(l: asizeint): tsym;
+      var
+        i: longint;
+        sym: tsym;
+        bdef: tenumdef;
+      begin
+        result:=nil;
+        if (l<minval) or
+           (l>maxval) then
+          exit;
+        bdef:=getbasedef;
+        for i:=0 to bdef.symtable.symlist.count-1 do
+          begin
+            sym:=tsym(bdef.symtable.symlist[i]);
+            if (sym.typ=enumsym) and
+               (tenumsym(sym).value=l) then
+              begin
+                result:=sym;
+                exit;
+              end;
+          end;
+      end;
+
+
     function tenumdef.getbasedef: tenumdef;
       begin
         if not assigned(basedef) then

compiler/symsym.pas

@@ -227,6 +227,7 @@ interface
           function mangledname:TSymStr;override;
           procedure set_mangledbasename(const s: TSymStr);
           procedure set_mangledname(const s:TSymStr);
+          procedure set_raw_mangledname(const s:TSymStr);
       end;
 
       tabsolutevarsym = class(tabstractvarsym)
@@ -1623,6 +1624,18 @@ implementation
       end;
 
 
+    procedure tstaticvarsym.set_raw_mangledname(const s: TSymStr);
+      begin
+{$ifndef symansistr}
+        stringdispose(_mangledname);
+        _mangledname:=stringdup(s);
+{$else}
+        _mangledname:=s;
+{$endif}
+        include(varoptions,vo_has_mangledname);
+      end;
+
+
 {****************************************************************************
                                TLOCALVARSYM
 ****************************************************************************}

rtl/java/compproc.inc

@@ -637,6 +637,7 @@ procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint;
 procedure fpc_initialize_array_procvar(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseProcVarType);compilerproc;
 procedure fpc_initialize_array_bitset(arr: TJObjectArray; normalarrdim: longint; inst: FpcBitSet);compilerproc;
 procedure fpc_initialize_array_enumset(arr: TJObjectArray; normalarrdim: longint; inst: JUEnumSet);compilerproc;
+procedure fpc_initialize_array_object(arr: TJObjectArray; normalarrdim: longint; inst: JLObject);compilerproc;
 procedure fpc_initialize_array_shortstring(arr: TJObjectArray; normalarrdim: longint; maxlen: byte);compilerproc;
 
 { set helpers }

rtl/java/rtti.inc

@@ -148,6 +148,27 @@ procedure fpc_initialize_array_enumset(arr: TJObjectArray; normalarrdim: longint
   end;
 
 
+{ initialize entire array with the same object, without making copies. Used for
+  initialization with enum instance }
+procedure fpc_initialize_array_object_intern(arr: TJObjectArray; normalarrdim: longint; inst: JLObject); external name 'fpc_initialize_array_object';
+
+procedure fpc_initialize_array_object(arr: TJObjectArray; normalarrdim: longint; inst: JLObject);compilerproc;
+  var
+    i: longint;
+  begin
+    if normalarrdim > 0 then
+      begin
+        for i:=low(arr) to high(arr) do
+          fpc_initialize_array_object_intern(TJObjectArray(arr[i]),normalarrdim-1,inst);
+      end
+    else
+      begin
+        for i:=low(arr) to high(arr) do
+          arr[i]:=inst;
+      end;
+  end;
+
+
 procedure fpc_initialize_array_shortstring_intern(arr: TJObjectArray; normalarrdim: longint; maxlen: byte); external name 'fpc_initialize_array_shortstring';
 
 procedure fpc_initialize_array_shortstring(arr: TJObjectArray; normalarrdim: longint; maxlen: byte);compilerproc;