Browse Source

+ full support for sets on the JVM target
o sets of enums are handled as JUEnumSet instances, others as JUBitSet
derivatives (both smallsets and varsets, to make interoperability with
Java easier)
o special handling of set constants: these have to be constructed at run
time. In case of constants in the code, create an internal constsym to
represent them. These and regular constsyms are then aliased by an
another internal staticvarsym that is used to initialise them in the
unit initialisation code.
o until they are constructed at run time, set constants are encoded as
constant Java strings (with the characters containing the set bits)
o hlcgobj conversion of tcginnode.pass_generate_code() for the genjumps
part (that's the only part of the generic code that's used by the JVM
target)
o as far as explicit typecasting support is concerned, currently the
following ones are supported (both from/to setdefs): ordinal types,
enums, any other set types (whose size is the same on native targets)
o enum setdefs also emit signatures
o overloading routines for different ordinal set types, or for different
enum set types, is not supported on the JVM target

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

Jonas Maebe 14 years ago
parent
commit
37aa2d8443

+ 3 - 0
.gitattributes

@@ -229,6 +229,7 @@ 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/njvmtcon.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
@@ -7364,6 +7365,8 @@ rtl/java/jint64.inc svneol=native#text/plain
 rtl/java/jmathh.inc svneol=native#text/plain
 rtl/java/jrec.inc svneol=native#text/plain
 rtl/java/jrech.inc svneol=native#text/plain
+rtl/java/jset.inc svneol=native#text/plain
+rtl/java/jseth.inc svneol=native#text/plain
 rtl/java/objpas.pp svneol=native#text/plain
 rtl/java/rtl.cfg svneol=native#text/plain
 rtl/java/rtti.inc svneol=native#text/plain

+ 2 - 2
compiler/agjasmin.pas

@@ -782,9 +782,9 @@ implementation
             result:='';
         else
           begin
-            { enums are initialized as typed constants }
+            { enums and sets are initialized as typed constants }
             if not assigned(csym.constdef) or
-               (csym.constdef.typ<>enumdef) then
+               not(csym.constdef.typ in [enumdef,setdef]) then
               result:=' = '+ConstValue(csym)
           end;
         end;

+ 1 - 1
compiler/jvm/cpunode.pas

@@ -35,6 +35,6 @@ implementation
     njvmadd,njvmcal,njvmmat,njvmcnv,njvmcon,njvminl,njvmmem,njvmflw,njvmld,
     njvmset
     { these are not really nodes }
-    ,rgcpu,tgcpu,njvmutil;
+    ,rgcpu,tgcpu,njvmutil,njvmtcon;
 
 end.

+ 60 - 22
compiler/jvm/hlcgcpu.pas

@@ -187,6 +187,7 @@ uses
       { concatcopy helpers }
       procedure concatcopy_normal_array(list: TAsmList; size: tdef; const source, dest: treference);
       procedure concatcopy_record(list: TAsmList; size: tdef; const source, dest: treference);
+      procedure concatcopy_set(list: TAsmList; size: tdef; const source, dest: treference);
       procedure concatcopy_shortstring(list: TAsmList; size: tdef; const source, dest: treference);
 
       { generate a call to a routine in the system unit }
@@ -252,13 +253,9 @@ implementation
       case def.typ of
         { records and enums are implemented via classes }
         recorddef,
-        enumdef:
-          result:=R_ADDRESSREGISTER;
+        enumdef,
         setdef:
-          if is_smallset(def) then
-            result:=R_INTREGISTER
-          else
-            result:=R_ADDRESSREGISTER;
+          result:=R_ADDRESSREGISTER;
         { shortstrings are implemented via classes }
         else if is_shortstring(def) or
         { voiddef can only be typecasted into (implicit) pointers }
@@ -644,22 +641,32 @@ implementation
       { all dimensions are removed from the stack, an array reference is
         added }
       decstack(list,initdim-1);
-      { in case of an array of records or shortstrings, initialise }
+      { in case of an array of records, sets or shortstrings, initialise }
       elemdef:=tarraydef(arrdef).elementdef;
       for i:=1 to pred(initdim) do
         elemdef:=tarraydef(elemdef).elementdef;
-      if (elemdef.typ=recorddef) or
+      if (elemdef.typ in [recorddef,setdef]) or
          is_shortstring(elemdef) then
         begin
-          { duplicate array reference }
+          { duplicate array/string/set instance }
           list.concat(taicpu.op_none(a_dup));
           incstack(list,1);
           a_load_const_stack(list,s32inttype,initdim-1,R_INTREGISTER);
-          if elemdef.typ=recorddef then
+          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));
-              g_call_system_proc(list,'fpc_initialize_array_record');
+              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
+              end;
               tg.ungettemp(list,recref);
             end
           else
@@ -1135,6 +1142,11 @@ implementation
           end;
         recorddef:
           procname:='FPC_COPY_JRECORD_ARRAY';
+        setdef:
+          if tsetdef(eledef).elementdef.typ=enumdef then
+            procname:='FPC_COPY_JENUMSET_ARRAY'
+          else
+            procname:='FPC_COPY_JBITSET_ARRAY';
         floatdef:
           procname:='FPC_COPY_SHALLOW_ARRAY';
         stringdef:
@@ -1142,7 +1154,6 @@ implementation
             procname:='FPC_COPY_JSHORTSTRING_ARRAY'
           else
             procname:='FPC_COPY_SHALLOW_ARRAY';
-        setdef,
         variantdef:
           begin
 {$ifndef nounsupported}
@@ -1198,6 +1209,20 @@ implementation
       end;
 
 
+    procedure thlcgjvm.concatcopy_set(list: TAsmList; size: tdef; const source, dest: treference);
+      begin
+        a_load_ref_stack(list,size,source,prepare_stack_for_ref(list,source,false));
+        a_load_ref_stack(list,size,dest,prepare_stack_for_ref(list,dest,false));
+        { call set copy helper }
+        if tsetdef(size).elementdef.typ=enumdef then
+          g_call_system_proc(list,'fpc_enumset_copy')
+        else
+          g_call_system_proc(list,'fpc_bitset_copy');
+        { both parameters are removed, no function result }
+        decstack(list,2);
+      end;
+
+
     procedure thlcgjvm.concatcopy_shortstring(list: TAsmList; size: tdef; const source, dest: treference);
       var
         srsym: tsym;
@@ -1238,6 +1263,11 @@ implementation
             concatcopy_record(list,size,source,dest);
             handled:=true;
           end;
+        setdef:
+          begin
+            concatcopy_set(list,size,source,dest);
+            handled:=true;
+          end;
         stringdef:
           begin
             if is_shortstring(size) then
@@ -1324,10 +1354,7 @@ implementation
               opc:=a_ireturn;
           end;
         setdef:
-          if is_smallset(retdef) then
-            opc:=a_ireturn
-          else
-            opc:=a_areturn;
+          opc:=a_areturn;
         floatdef:
           case tfloatdef(retdef).floattype of
             s32real:
@@ -1378,7 +1405,7 @@ implementation
   procedure thlcgjvm.g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string);
     var
       normaldim: longint;
-      recref: treference;
+      eleref: treference;
     begin
       { only in case of initialisation, we have to set all elements to "empty" }
       if name<>'FPC_INITIALIZE_ARRAY' then
@@ -1402,12 +1429,18 @@ implementation
         g_call_system_proc(list,'fpc_initialize_array_ansistring')
       else if is_dynamic_array(t) then
         g_call_system_proc(list,'fpc_initialize_array_dynarr')
-      else if is_record(t) then
+      else if is_record(t) or
+              (t.typ=setdef) then
         begin
-          tg.gethltemp(list,t,t.size,tt_persistent,recref);
-          a_load_ref_stack(list,t,recref,prepare_stack_for_ref(list,recref,false));
-          g_call_system_proc(list,'fpc_initialize_array_record');
-          tg.ungettemp(list,recref);
+          tg.gethltemp(list,t,t.size,tt_persistent,eleref);
+          a_load_ref_stack(list,t,eleref,prepare_stack_for_ref(list,eleref,false));
+          if is_record(t) then
+            g_call_system_proc(list,'fpc_initialize_array_record')
+          else if tsetdef(t).elementdef.typ=enumdef then
+            g_call_system_proc(list,'fpc_initialize_array_enumset')
+          else
+            g_call_system_proc(list,'fpc_initialize_array_bitset');
+          tg.ungettemp(list,eleref);
         end
       else
         internalerror(2011031901);
@@ -1851,6 +1884,11 @@ implementation
           vs:=tabstractvarsym(st.symlist[i]);
           if sp_internal in vs.symoptions then
             continue;
+          { vo_is_external and vo_has_local_copy means a staticvarsym that is
+            alias for a constsym, whose sole purpose is for allocating and
+            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);

+ 231 - 36
compiler/jvm/njvmadd.pas

@@ -37,6 +37,7 @@ interface
           function pass_1: tnode;override;
        protected
           function first_addstring: tnode; override;
+          function jvm_first_addset: tnode;
 
           function cmpnode2signedtopcmp: TOpCmp;
 
@@ -46,7 +47,6 @@ interface
           procedure second_addfloat;override;
           procedure second_cmpfloat;override;
           procedure second_cmpboolean;override;
-          procedure second_cmpsmallset;override;
           procedure second_cmp64bit;override;
           procedure second_add64bit; override;
           procedure second_cmpordinal;override;
@@ -56,13 +56,14 @@ interface
 
     uses
       systems,
-      cutils,verbose,constexp,
+      cutils,verbose,constexp,globtype,
       symconst,symtable,symdef,
-      paramgr,procinfo,
+      paramgr,procinfo,pass_1,
       aasmtai,aasmdata,aasmcpu,defutil,
       hlcgobj,hlcgcpu,cgutils,
       cpupara,
-      ncon,nset,nadd,ncal,ncnv,
+      nbas,ncon,nset,nadd,ncal,ncnv,nld,nmat,nmem,
+      njvmcon,
       cgobj;
 
 {*****************************************************************************
@@ -85,6 +86,13 @@ interface
             inserttypeconv_explicit(left,s32inttype);
             inserttypeconv_explicit(right,s32inttype);
           end;
+        { special handling for sets: all sets are JUBitSet/JUEnumSet on the JVM
+          target to ease interoperability with Java code }
+        if left.resultdef.typ=setdef then
+          begin
+            result:=jvm_first_addset;
+            exit;
+          end;
         result:=inherited pass_1;
         if expectloc=LOC_FLAGS then
           expectloc:=LOC_JUMP;
@@ -156,6 +164,225 @@ interface
         end;
       end;
 
+
+    function tjvmaddnode.jvm_first_addset: tnode;
+
+      procedure call_set_helper_paras(const n : string; isenum: boolean; paras: tcallparanode);
+        var
+          block: tblocknode;
+          stat: tstatementnode;
+          temp: ttempcreatenode;
+        begin
+          result:=ccallnode.createinternmethod(left,'CLONE',nil);
+          if isenum then
+            inserttypeconv_explicit(result,java_juenumset)
+          else
+            inserttypeconv_explicit(result,java_jubitset);
+          if isenum then
+            begin
+              { all enum instance methods return a boolean, while we are
+                interested in the resulting set }
+              block:=internalstatements(stat);
+              temp:=ctempcreatenode.create(java_juenumset,4,tt_persistent,true);
+              addstatement(stat,temp);
+              addstatement(stat,cassignmentnode.create(
+                ctemprefnode.create(temp),result));
+              addstatement(stat,ccallnode.createinternmethod(
+                ctemprefnode.create(temp),n,paras));
+              addstatement(stat,ctempdeletenode.create_normal_temp(temp));
+              addstatement(stat,ctemprefnode.create(temp));
+              result:=block;
+            end
+          else
+            result:=ccallnode.createinternmethod(result,n,paras);
+        end;
+
+      procedure call_set_helper(const n: string; isenum: boolean);
+        begin
+          call_set_helper_paras(n,isenum,ccallparanode.create(right,nil));
+        end;
+
+      var
+        procname: string;
+        tmpn: tnode;
+        paras: tcallparanode;
+        isenum: boolean;
+      begin
+        isenum:=
+          (assigned(tsetdef(left.resultdef).elementdef) and
+           (tsetdef(left.resultdef).elementdef.typ=enumdef)) or
+          ((right.nodetype=setelementn) and
+           (tsetelementnode(right).left.resultdef.typ=enumdef)) or
+          ((right.resultdef.typ=setdef) and
+           assigned(tsetdef(right.resultdef).elementdef) and
+           (tsetdef(right.resultdef).elementdef.typ=enumdef));
+        { don't destroy optimization opportunity }
+        if not((nodetype=addn) and
+               (right.nodetype=setelementn) and
+               is_emptyset(left)) then
+          begin
+            left:=caddrnode.create_internal(left);
+            include(left.flags,nf_typedaddr);
+            if isenum then
+              begin
+                inserttypeconv_explicit(left,java_juenumset);
+                if right.resultdef.typ=setdef then
+                  begin
+                    right:=caddrnode.create_internal(right);
+                    include(right.flags,nf_typedaddr);
+                    inserttypeconv_explicit(right,java_juenumset);
+                  end;
+              end
+            else
+              begin
+                inserttypeconv_explicit(left,java_jubitset);
+                if right.resultdef.typ=setdef then
+                  begin
+                    right:=caddrnode.create_internal(right);
+                    include(right.flags,nf_typedaddr);
+                    inserttypeconv_explicit(right,java_jubitset);
+                  end;
+              end;
+          end
+        else
+          tjvmsetconstnode(left).setconsttype:=sct_notransform;
+        firstpass(left);
+        firstpass(right);
+        case nodetype of
+          equaln,unequaln,lten,gten:
+            begin
+              case nodetype of
+                equaln,unequaln:
+                  procname:='EQUALS';
+                lten,gten:
+                  begin
+                    { (left <= right) = (right >= left) }
+                    if nodetype=lten then
+                      begin
+                        tmpn:=left;
+                        left:=right;
+                        right:=tmpn;
+                      end;
+                      procname:='CONTAINSALL'
+                    end;
+                end;
+              result:=ccallnode.createinternmethod(left,procname,ccallparanode.create(right,nil));
+              { for an unequaln, we have to negate the result of equals }
+              if nodetype=unequaln then
+                result:=cnotnode.create(result);
+            end;
+          addn:
+            begin
+              { optimize first loading of a set }
+              if (right.nodetype=setelementn) and
+                  is_emptyset(left) then
+                begin
+                  paras:=nil;
+                  procname:='OF';
+                  if isenum then
+                    begin
+                      inserttypeconv_explicit(tsetelementnode(right).left,tenumdef(tsetelementnode(right).left.resultdef).getbasedef.classdef);
+                      result:=cloadvmtaddrnode.create(ctypenode.create(java_juenumset));
+                    end
+                  else
+                    begin
+                      { for boolean, char, etc }
+                      inserttypeconv_explicit(tsetelementnode(right).left,s32inttype);
+                      result:=cloadvmtaddrnode.create(ctypenode.create(java_jubitset));
+                    end;
+                  paras:=ccallparanode.create(tsetelementnode(right).left,nil);
+                  tsetelementnode(right).left:=nil;
+                  if assigned(tsetelementnode(right).right) then
+                    begin
+                      procname:='RANGE';
+                      if isenum then
+                        begin
+                          inserttypeconv_explicit(tsetelementnode(right).right,tenumdef(tsetelementnode(right).right.resultdef).getbasedef.classdef);
+                        end
+                      else
+                        begin
+                          inserttypeconv_explicit(tsetelementnode(right).right,s32inttype);
+                        end;
+                      paras:=ccallparanode.create(tsetelementnode(right).right,paras);
+                      tsetelementnode(right).right:=nil;
+                    end;
+                  right.free;
+                  result:=ccallnode.createinternmethod(result,procname,paras)
+                end
+              else
+                begin
+                  if right.nodetype=setelementn then
+                    begin
+                      paras:=nil;
+                      { get a copy of left to add to }
+                      procname:='ADD';
+                      if isenum then
+                        begin
+                          inserttypeconv_explicit(tsetelementnode(right).left,tenumdef(tsetelementnode(right).left.resultdef).getbasedef.classdef);
+                        end
+                      else
+                        begin
+                          { for boolean, char, etc }
+                          inserttypeconv_explicit(tsetelementnode(right).left,s32inttype);
+                        end;
+                      paras:=ccallparanode.create(tsetelementnode(right).left,paras);
+                      tsetelementnode(right).left:=nil;
+                      if assigned(tsetelementnode(right).right) then
+                        begin
+                          procname:='ADDALL';
+                          { create a set containing the range via the class
+                            factory method, then add all of its elements }
+                          if isenum then
+                            begin
+                              inserttypeconv_explicit(tsetelementnode(right).right,tenumdef(tsetelementnode(right).right.resultdef).getbasedef.classdef);
+                              tmpn:=cloadvmtaddrnode.create(ctypenode.create(java_juenumset));
+                            end
+                          else
+                            begin
+                              inserttypeconv_explicit(tsetelementnode(right).right,s32inttype);
+                              tmpn:=cloadvmtaddrnode.create(ctypenode.create(java_jubitset));
+                            end;
+                          paras:=ccallparanode.create(ccallnode.createinternmethod(tmpn,'RANGE',ccallparanode.create(tsetelementnode(right).right,paras)),nil);
+                          tsetelementnode(right).right:=nil;
+                        end;
+                      call_set_helper_paras(procname,isenum,paras);
+                    end
+                  else
+                    call_set_helper('ADDALL',isenum)
+                end
+            end;
+          subn:
+            call_set_helper('REMOVEALL',isenum);
+          symdifn:
+            if isenum then
+              begin
+                { "s1 xor s2" is the same as "(s1 + s2) - (s1 * s2)"
+                  -> call helper to prevent double evaluations }
+                result:=ccallnode.createintern('fpc_enumset_symdif',
+                  ccallparanode.create(right,ccallparanode.create(left,nil)));
+                left:=nil;
+                right:=nil;
+              end
+            else
+              call_set_helper('SYMDIF',isenum);
+          muln:
+            call_set_helper('RETAINALL',isenum)
+          else
+            internalerror(2011062807);
+        end;
+        { convert helper result back to original set type for further expression
+          evaluation }
+        if not is_boolean(resultdef) then
+          begin
+            inserttypeconv_explicit(result,getpointerdef(resultdef));
+            result:=cderefnode.create(result);
+          end;
+        { left and right are reused as parameters }
+        left:=nil;
+        right:=nil;
+      end;
+
+
     function tjvmaddnode.cmpnode2signedtopcmp: TOpCmp;
       begin
         case nodetype of
@@ -323,38 +550,6 @@ interface
       end;
 
 
-    procedure tjvmaddnode.second_cmpsmallset;
-      begin
-        if (nodetype in [equaln,unequaln]) then
-          begin
-            second_generic_compare;
-            exit;
-          end;
-        case nodetype of
-          lten,gten:
-            begin
-              pass_left_right;
-              If (not(nf_swapped in flags) and
-                  (nodetype=lten)) or
-                 ((nf_swapped in flags) and
-                  (nodetype=gten)) then
-                swapleftright;
-              location_reset(location,LOC_JUMP,OS_NO);
-              // now we have to check whether left >= right:
-              // (right and not(left)=0)
-              thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
-              thlcgjvm(hlcg).a_op_reg_stack(current_asmdata.CurrAsmList,OP_NOT,left.resultdef,NR_NO);
-              thlcgjvm(hlcg).a_op_loc_stack(current_asmdata.CurrAsmList,OP_AND,right.resultdef,right.location);
-              current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_ifeq,current_procinfo.CurrTrueLabel));
-              thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
-              hlcg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
-            end;
-          else
-            internalerror(2011010414);
-        end;
-      end;
-
-
     procedure tjvmaddnode.second_cmp64bit;
       begin
         second_generic_compare;

+ 186 - 8
compiler/jvm/njvmcnv.pas

@@ -35,6 +35,7 @@ interface
           function typecheck_char_to_string: tnode; override;
           function pass_1: tnode; override;
           function simplify(forinline: boolean): tnode; override;
+          function first_set_to_set : tnode;override;
 
           procedure second_int_to_int;override;
          { procedure second_string_to_string;override; }
@@ -88,7 +89,7 @@ interface
 implementation
 
    uses
-      verbose,globals,globtype,
+      verbose,globals,globtype,constexp,
       symconst,symdef,symsym,symtable,aasmbase,aasmdata,
       defutil,defcmp,jvmdef,
       cgbase,cgutils,pass_1,pass_2,
@@ -229,6 +230,71 @@ implementation
       end;
 
 
+    function tjvmtypeconvnode.first_set_to_set: tnode;
+      var
+        setclassdef: tdef;
+        helpername: string;
+      begin
+        result:=nil;
+        if (left.nodetype=setconstn) then
+          result:=inherited
+        { on native targets, only the binary layout has to match. Here, both
+          sets also have to be either of enums or ordinals, and in case of
+          enums they have to be of the same base type }
+        else if (tsetdef(left.resultdef).elementdef.typ=enumdef)=(tsetdef(resultdef).elementdef.typ=enumdef) and
+            ((tsetdef(left.resultdef).elementdef.typ<>enumdef) or
+             (tenumdef(tsetdef(left.resultdef).elementdef).getbasedef=tenumdef(tsetdef(resultdef).elementdef).getbasedef)) and
+            (tsetdef(left.resultdef).setbase=tsetdef(resultdef).setbase) and
+            (left.resultdef.size=resultdef.size) then
+          begin
+            result:=left;
+            left:=nil;
+          end
+        else
+          begin
+            { 'deep' conversion }
+            if tsetdef(resultdef).elementdef.typ<>enumdef then
+              begin
+                if tsetdef(left.resultdef).elementdef.typ<>enumdef then
+                  helpername:='fpc_bitset_to_bitset'
+                else
+                  helpername:='fpc_enumset_to_bitset';
+                result:=ccallnode.createintern(helpername,ccallparanode.create(
+                  genintconstnode(tsetdef(resultdef).setbase), ccallparanode.create(
+                    genintconstnode(tsetdef(left.resultdef).setbase),
+                      ccallparanode.create(left,nil))));
+              end
+            else
+              begin
+                if tsetdef(left.resultdef).elementdef.typ<>enumdef then
+                  begin
+                    helpername:='fpcBitSetToEnumSet';
+                    setclassdef:=java_jubitset;
+                  end
+                else
+                  begin
+                    helpername:='fpcEnumSetToEnumSet';
+                    setclassdef:=java_juenumset;
+                  end;
+                left:=caddrnode.create_internal(left);
+                include(left.flags,nf_typedaddr);
+                inserttypeconv_explicit(left,setclassdef);
+                result:=ccallnode.createinternmethod(
+                  cloadvmtaddrnode.create(ctypenode.create(setclassdef)),
+                  helpername,ccallparanode.create(
+                    genintconstnode(tsetdef(resultdef).setbase), ccallparanode.create(
+                      genintconstnode(tsetdef(left.resultdef).setbase),
+                        ccallparanode.create(left,nil))));
+              end;
+            inserttypeconv_explicit(result,getpointerdef(resultdef));
+            result:=cderefnode.create(result);
+            { reused }
+            left:=nil;
+          end;
+
+      end;
+
+
 {*****************************************************************************
                              SecondTypeConv
 *****************************************************************************}
@@ -587,6 +653,68 @@ implementation
           left:=nil;
         end;
 
+      function from_set_explicit_typecast: tnode;
+        var
+          helpername: string;
+          setconvdef: tdef;
+        begin
+         if tsetdef(left.resultdef).elementdef.typ=enumdef then
+           begin
+             setconvdef:=java_juenumset;
+             helpername:='fpc_enumset_to_'
+           end
+         else
+           begin
+             setconvdef:=java_jubitset;
+             helpername:='fpc_bitset_to_'
+           end;
+         if left.resultdef.size<=4 then
+           helpername:=helpername+'int'
+         else
+           helpername:=helpername+'long';
+          result:=ccallnode.createintern(helpername,ccallparanode.create(
+            genintconstnode(left.resultdef.size),ccallparanode.create(genintconstnode(tsetdef(left.resultdef).setbase),
+            ccallparanode.create(ctypeconvnode.create_explicit(left,setconvdef),nil))));
+          left:=nil;
+        end;
+
+      function to_set_explicit_typecast: tnode;
+        var
+          enumclassdef: tobjectdef;
+          mp: tnode;
+          helpername: string;
+        begin
+          if tsetdef(resultdef).elementdef.typ=enumdef then
+            begin
+              inserttypeconv_explicit(left,s64inttype);
+              enumclassdef:=tenumdef(tsetdef(resultdef).elementdef).getbasedef.classdef;
+              mp:=cloadvmtaddrnode.create(ctypenode.create(enumclassdef));
+              helpername:='fpcLongToEnumSet';
+              { enumclass.fpcLongToEnumSet(left,setbase,setsize) }
+              result:=ccallnode.createinternmethod(mp,helpername,
+                ccallparanode.create(genintconstnode(resultdef.size),
+                  ccallparanode.create(genintconstnode(tsetdef(resultdef).setbase),
+                    ccallparanode.create(left,nil))));
+            end
+          else
+            begin
+              if left.resultdef.size<=4 then
+                begin
+                  helpername:='fpc_int_to_bitset';
+                  inserttypeconv_explicit(left,s32inttype);
+                end
+              else
+                begin
+                  helpername:='fpc_long_to_bitset';
+                  inserttypeconv_explicit(left,s64inttype);
+                end;
+              result:=ccallnode.createintern(helpername,
+                ccallparanode.create(genintconstnode(resultdef.size),
+                  ccallparanode.create(genintconstnode(tsetdef(resultdef).setbase),
+                    ccallparanode.create(left,nil))));
+            end;
+        end;
+
       function ptr_no_typecheck_required(fromdef, todef: tdef): boolean;
 
         function check_type_equality(def1,def2: tdef): boolean;
@@ -603,6 +731,23 @@ implementation
                 if is_shortstring(tpointerdef(def1).pointeddef) and
                    (def2=java_shortstring) then
                   exit;
+                { pointer-to-set to JUEnumSet/JUBitSet }
+                if (tpointerdef(def1).pointeddef.typ=setdef) then
+                  begin
+                    if not assigned(tsetdef(tpointerdef(def1).pointeddef).elementdef) then
+                      begin
+                        if (def2=java_jubitset) or
+                           (def2=java_juenumset) then
+                          exit;
+                      end
+                    else if tsetdef(tpointerdef(def1).pointeddef).elementdef.typ=enumdef then
+                      begin
+                        if def2=java_juenumset then
+                          exit;
+                      end
+                    else if def2=java_jubitset then
+                      exit;
+                  end;
               end;
             result:=false;
           end;
@@ -841,14 +986,41 @@ implementation
              end
           end;
 
-{$ifndef nounsupported}
-        if (left.resultdef.typ in [orddef,enumdef,setdef]) and
-           (resultdef.typ in [orddef,enumdef,setdef]) then
+        { sets }
+        if (left.resultdef.typ=setdef) or
+           (resultdef.typ=setdef) then
           begin
-            result:=false;
-            exit;
+            { set -> ord/enum/other-set-type }
+            if (resultdef.typ in [orddef,enumdef]) then
+              begin
+                if not check_only then
+                  begin
+                    resnode:=from_set_explicit_typecast;
+                    { convert to desired result }
+                    inserttypeconv_explicit(resnode,resultdef);
+                  end;
+                result:=true;
+                exit;
+              end
+            { ord/enum -> set }
+            else if (left.resultdef.typ in [orddef,enumdef]) then
+              begin
+                if not check_only then
+                  begin
+                    resnode:=to_set_explicit_typecast;
+                    { convert to desired result }
+                    inserttypeconv_explicit(resnode,getpointerdef(resultdef));
+                    resnode:=cderefnode.create(resnode);
+                  end;
+                result:=true;
+                exit;
+              end;
+            { if someone needs it, float->set and set->float explicit typecasts
+              could also be added (cannot be handled by the above, because
+              float(intvalue) will convert rather than re-interpret the value) }
           end;
 
+{$ifndef nounsupported}
         { non-literal type conversions }
         if convtype in
              [tc_char_2_string,
@@ -858,7 +1030,6 @@ implementation
               tc_real_2_real,
               tc_proc_2_procvar,
               tc_arrayconstructor_2_set,
-              tc_set_to_set,
               tc_class_2_intf,
               tc_array_2_dynarray] then
           begin
@@ -1027,7 +1198,14 @@ implementation
       else if checkdef.typ=pointerdef then
         checkdef:=tpointerdef(checkdef).pointeddef
       else if checkdef.typ=enumdef then
-        checkdef:=tenumdef(checkdef).classdef;
+        checkdef:=tenumdef(checkdef).classdef
+      else if checkdef.typ=setdef then
+        begin
+          if tsetdef(checkdef).elementdef.typ=enumdef then
+            checkdef:=java_juenumset
+          else
+            checkdef:=java_jubitset;
+        end;
 {$ifndef nounsupported}
       if checkdef.typ=procvardef then
         checkdef:=java_jlobject

+ 265 - 3
compiler/jvm/njvmcon.pas

@@ -26,8 +26,9 @@ unit njvmcon;
 interface
 
     uses
+       globtype,aasmbase,
        symtype,
-       node,ncon,ncgcon;
+       node,ncal,ncon,ncgcon;
 
     type
        tjvmordconstnode = class(tcgordconstnode)
@@ -49,14 +50,44 @@ interface
           procedure pass_generate_code;override;
        end;
 
+       tjvmsetconsttype = (
+         { create symbol for the set constant; the symbol will be initialized
+           in the class constructor/unit init code (default) }
+         sct_constsymbol,
+         { normally, we convert the set constant into a constructor/factory
+           method to create a set instance. In some cases (simple "in"
+           expressions, adding an element to an empty set, ...) we want to
+           keep the set constant instead }
+         sct_notransform,
+         { actually construct a JUBitSet/JUEnumSet that contains the set value
+           (for initializing the sets contstants) }
+         sct_construct
+         );
+       tjvmsetconstnode = class(tcgsetconstnode)
+          setconsttype: tjvmsetconsttype;
+          function pass_1: tnode; override;
+          procedure pass_generate_code; override;
+          constructor create(s : pconstset;def:tdef);override;
+          function docompare(p: tnode): boolean; override;
+          function dogetcopy: tnode; override;
+         protected
+          function emitvarsetconst: tasmsymbol; override;
+          { in case the set has only a single run of consecutive elements,
+            this function will return its starting index and length }
+          function find_single_elements_run(from: longint; out start, len: longint): boolean;
+          function buildbitset: tnode;
+          function buildenumset(const eledef: tdef): tnode;
+          function buildsetfromstring(const helpername: string; otherparas: tcallparanode): tnode;
+       end;
+
 
 implementation
 
     uses
-      globtype,cutils,widestr,verbose,constexp,
+      cutils,widestr,verbose,constexp,fmodule,
       symdef,symsym,symtable,symconst,
       aasmdata,aasmcpu,defutil,
-      ncal,nld,
+      ncnv,nld,nmem,pjvm,pass_1,
       cgbase,hlcgobj,hlcgcpu,cgutils,cpubase
       ;
 
@@ -203,9 +234,240 @@ implementation
       end;
 
 
+    {*****************************************************************************
+                               TJVMSETCONSTNODE
+    *****************************************************************************}
+
+    function tjvmsetconstnode.buildsetfromstring(const helpername: string; otherparas: tcallparanode): tnode;
+      var
+        pw: pcompilerwidestring;
+        wc: tcompilerwidechar;
+        i, j, bit, nulls: longint;
+      begin
+        initwidestring(pw);
+        nulls:=0;
+        for i:=0 to 15 do
+          begin
+            wc:=0;
+            for bit:=0 to 15 do
+              if (i*16+bit) in value_set^ then
+                wc:=wc or (1 shl (15-bit));
+            { don't add trailing zeroes }
+            if wc=0 then
+              inc(nulls)
+            else
+              begin
+                for j:=1 to nulls do
+                  concatwidestringchar(pw,0);
+                nulls:=0;
+                concatwidestringchar(pw,wc);
+              end;
+          end;
+        result:=ccallnode.createintern(helpername,
+          ccallparanode.create(cstringconstnode.createwstr(pw),otherparas));
+        donewidestring(pw);
+      end;
+
+
+    function tjvmsetconstnode.buildbitset: tnode;
+      var
+        mp: tnode;
+      begin
+        if value_set^=[] then
+          begin
+            mp:=cloadvmtaddrnode.create(ctypenode.create(java_jubitset));
+            result:=ccallnode.createinternmethod(mp,'CREATE',nil);
+            exit;
+          end;
+        result:=buildsetfromstring('fpc_bitset_from_string',nil);
+      end;
+
+
+    function tjvmsetconstnode.buildenumset(const eledef: tdef): tnode;
+      var
+        stopnode: tnode;
+        startnode: tnode;
+        mp: tnode;
+        len: longint;
+        start: longint;
+        enumele: tnode;
+        paras: tcallparanode;
+        hassinglerun: boolean;
+      begin
+        hassinglerun:=find_single_elements_run(0, start, len);
+        mp:=cloadvmtaddrnode.create(ctypenode.create(java_juenumset));
+        if hassinglerun then
+          begin
+            if len=0 then
+              begin
+                enumele:=cloadvmtaddrnode.create(ctypenode.create(tenumdef(eledef).getbasedef.classdef));
+                inserttypeconv_explicit(enumele,search_system_type('JLCLASS').typedef);
+                paras:=ccallparanode.create(enumele,nil);
+                result:=ccallnode.createinternmethod(mp,'NONEOF',paras)
+              end
+            else
+              begin
+                startnode:=cordconstnode.create(start,eledef,false);
+                { immediately firstpass so the enum gets translated into a JLEnum
+                  instance }
+                firstpass(startnode);
+                if len=1 then
+                  result:=ccallnode.createinternmethod(mp,'OF',ccallparanode.create(startnode,nil))
+                else
+                  begin
+                    stopnode:=cordconstnode.create(start+len-1,eledef,false);
+                    firstpass(stopnode);
+                    result:=ccallnode.createinternmethod(mp,'RANGE',ccallparanode.create(stopnode,ccallparanode.create(startnode,nil)));
+                  end
+              end
+          end
+        else
+          begin
+            enumele:=cordconstnode.create(tenumsym(tenumdef(eledef).symtable.symlist[0]).value,eledef,false);
+            firstpass(enumele);
+            paras:=ccallparanode.create(enumele,nil);
+            result:=buildsetfromstring('fpc_enumset_from_string',paras);
+          end;
+      end;
+
+
+    function tjvmsetconstnode.pass_1: tnode;
+      var
+        eledef: tdef;
+      begin
+        { we want set constants to be global, so we can reuse them. However,
+          if the set's elementdef is local, we can't do that since a global
+          symbol cannot have a local definition (the compiler will crash when
+          loading the ppu file afterwards) }
+        if tsetdef(resultdef).elementdef.owner.symtabletype=localsymtable then
+          setconsttype:=sct_construct;
+        result:=nil;
+        case setconsttype of
+          sct_constsymbol:
+            begin
+              { normally a codegen pass routine, but we have to insert a typed
+                const in case the set constant does not exist yet, and that
+                should happen in pass_1 (especially since it involves creating
+                new nodes, which may even have to be tacked on to this code in
+                case it's the unit initialization code) }
+              handlevarsetconst;
+              { no smallsets }
+              expectloc:=LOC_CREFERENCE;
+            end;
+          sct_notransform:
+            begin
+              result:=inherited pass_1;
+              { no smallsets }
+              expectloc:=LOC_CREFERENCE;
+            end;
+          sct_construct:
+            begin
+              eledef:=tsetdef(resultdef).elementdef;
+              { empty sets don't have an element type, so we don't know whether we
+                have to constructor a bitset or enumset (and of which type) }
+              if not assigned(eledef) then
+                internalerror(2011070202);
+              if eledef.typ=enumdef then
+                begin
+                  result:=buildenumset(eledef);
+                end
+              else
+                begin
+                  result:=buildbitset;
+                end;
+              inserttypeconv_explicit(result,getpointerdef(resultdef));
+              result:=cderefnode.create(result);
+            end;
+          else
+            internalerror(2011060301);
+        end;
+      end;
+
+
+    procedure tjvmsetconstnode.pass_generate_code;
+      begin
+        case setconsttype of
+          sct_constsymbol:
+            begin
+              { all sets are varsets for the JVM target, no setbase differences }
+              handlevarsetconst;
+            end;
+          else
+            { must be handled in pass_1 or otherwise transformed }
+            internalerror(2011070201)
+        end;
+      end;
+
+    constructor tjvmsetconstnode.create(s: pconstset; def: tdef);
+      begin
+        inherited create(s, def);
+        setconsttype:=sct_constsymbol;
+      end;
+
+
+    function tjvmsetconstnode.docompare(p: tnode): boolean;
+      begin
+        result:=
+          inherited docompare(p) and
+          (setconsttype=tjvmsetconstnode(p).setconsttype);
+      end;
+
+
+    function tjvmsetconstnode.dogetcopy: tnode;
+      begin
+        result:=inherited dogetcopy;
+        tjvmsetconstnode(result).setconsttype:=setconsttype;
+      end;
+
+
+    function tjvmsetconstnode.emitvarsetconst: tasmsymbol;
+      var
+        csym: tconstsym;
+        ssym: tstaticvarsym;
+        ps: pnormalset;
+      begin
+        { add a read-only typed constant }
+        new(ps);
+        ps^:=value_set^;
+        csym:=tconstsym.create_ptr('_$setconst'+tostr(current_module.symlist.count),constset,ps,resultdef);
+        csym.visibility:=vis_private;
+        include(csym.symoptions,sp_internal);
+        current_module.localsymtable.insert(csym);
+        { generate assignment of the constant to the typed constant symbol }
+        ssym:=jvm_add_typed_const_initializer(csym);
+        result:=current_asmdata.RefAsmSymbol(ssym.mangledname);
+      end;
+
+
+    function tjvmsetconstnode.find_single_elements_run(from: longint; out start, len: longint): boolean;
+      var
+        i: longint;
+      begin
+        i:=from;
+        result:=true;
+        { find first element in set }
+        while (i<=255) and
+              not(i in value_set^) do
+          inc(i);
+        start:=i;
+        { go to end of the run }
+        while (i<=255) and
+              (i in value_set^) do
+          inc(i);
+        len:=i-start;
+        { rest must be unset }
+        while (i<=255) and
+              not(i in value_set^) do
+          inc(i);
+        if i<>256 then
+          result:=false;
+      end;
+
+
 
 begin
    cordconstnode:=tjvmordconstnode;
    crealconstnode:=tjvmrealconstnode;
    cstringconstnode:=tjvmstringconstnode;
+   csetconstnode:=tjvmsetconstnode;
 end.

+ 33 - 0
compiler/jvm/njvminl.pas

@@ -60,6 +60,7 @@ interface
           function first_round_real: tnode; override;
 *)
           function first_new: tnode; override;
+          function first_IncludeExclude: tnode; override;
           function first_setlength: tnode; override;
           function first_length: tnode; override;
 
@@ -314,6 +315,38 @@ implementation
       end;
 
 
+    function tjvminlinenode.first_IncludeExclude: tnode;
+      var
+        setpara: tnode;
+        valuepara: tcallparanode;
+        seteledef: tdef;
+        procname: string[6];
+      begin
+        setpara:=tcallparanode(left).left;
+        tcallparanode(left).left:=nil;
+        valuepara:=tcallparanode(tcallparanode(left).right);
+        tcallparanode(left).right:=nil;
+        seteledef:=tsetdef(setpara.resultdef).elementdef;
+        setpara:=caddrnode.create_internal(setpara);
+        include(setpara.flags,nf_typedaddr);
+        if seteledef.typ=enumdef then
+          begin
+            inserttypeconv_explicit(setpara,java_juenumset);
+            inserttypeconv_explicit(valuepara.left,tenumdef(seteledef).getbasedef.classdef);
+          end
+        else
+          begin
+            inserttypeconv_explicit(setpara,java_jubitset);
+            inserttypeconv_explicit(valuepara.left,s32inttype);
+          end;
+        if inlinenumber=in_include_x_y then
+          procname:='ADD'
+        else
+          procname:='REMOVE';
+        result:=ccallnode.createinternmethod(setpara,procname,valuepara);
+      end;
+
+
     function tjvminlinenode.first_setlength_array: tnode;
       var
         assignmenttarget,

+ 56 - 1
compiler/jvm/njvmset.pas

@@ -30,6 +30,10 @@ interface
       node,nset,ncgset;
 
     type
+      tjvminnode = class(tcginnode)
+         function pass_1: tnode; override;
+      end;
+
       tjvmcasenode = class(tcgcasenode)
          function pass_1: tnode; override;
       end;
@@ -40,7 +44,57 @@ implementation
     uses
       symconst,symdef,
       pass_1,
-      ncnv;
+      ncal,ncnv,ncon,nmem,
+      njvmcon,
+      cgbase;
+
+{*****************************************************************************
+                             TJVMINNODE
+*****************************************************************************}
+
+    function tjvminnode.pass_1: tnode;
+      var
+        setparts: Tsetparts;
+        numparts: byte;
+        use_small: boolean;
+        isenum: boolean;
+      begin
+        { before calling "inherited pass_1", so that in case left is an enum
+          constant it's not yet translated into a class instance }
+        isenum:=left.resultdef.typ=enumdef;
+        { if we can use jumps, don't transform the set constant and (if
+          applicable) the value to be tested }
+        if checkgenjumps(setparts,numparts,use_small) then
+          begin
+            if right.nodetype=setconstn then
+              tjvmsetconstnode(right).setconsttype:=sct_notransform;
+            if isenum and
+               (left.nodetype=ordconstn) then
+              tjvmordconstnode(left).enumconstok:=true;
+          end;
+        result:=inherited pass_1;
+        if assigned(result) then
+          exit;
+        { in case of jumps let the regular code handle it }
+        if expectloc=LOC_JUMP then
+          exit;
+        { otherwise call set helper }
+        right:=caddrnode.create_internal(right);
+        include(right.flags,nf_typedaddr);
+        if isenum then
+          begin
+            inserttypeconv_explicit(left,java_jlenum);
+            inserttypeconv_explicit(right,java_juenumset);
+          end
+        else
+          begin
+            inserttypeconv_explicit(left,s32inttype);
+            inserttypeconv_explicit(right,java_jubitset);
+          end;
+        result:=ccallnode.createinternmethod(right,'CONTAINS',ccallparanode.create(left,nil));
+        right:=nil;
+        left:=nil;
+      end;
 
 
 {*****************************************************************************
@@ -60,5 +114,6 @@ implementation
 
 
 begin
+   cinnode:=tjvminnode;
    ccasenode:=tjvmcasenode;
 end.

+ 57 - 0
compiler/jvm/njvmtcon.pas

@@ -0,0 +1,57 @@
+{
+    Copyright (c) 2011 by Jonas Maebe
+
+    Generates nodes for typed constant declarations
+
+    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 njvmtcon;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node,
+      symdef,
+      ngtcon;
+
+
+    type
+      tjvmtypedconstbuilder = class(tnodetreetypedconstbuilder)
+       protected
+        procedure tc_emit_setdef(def: tsetdef; var node: tnode);override;
+      end;
+
+implementation
+
+    uses
+      njvmcon;
+
+
+    procedure tjvmtypedconstbuilder.tc_emit_setdef(def: tsetdef; var node: tnode);
+      begin
+        { indicate that set constant nodes have to be transformed into
+          constructors here }
+        if node.nodetype=setconstn then
+          tjvmsetconstnode(node).setconsttype:=sct_construct;
+        inherited tc_emit_setdef(def,node);
+      end;
+
+begin
+  ctypedconstbuilder:=tjvmtypedconstbuilder;
+end.

+ 43 - 4
compiler/jvm/tgcpu.pas

@@ -124,12 +124,51 @@ unit tgcpu;
             end;
           setdef:
             begin
-              if is_smallset(def) then
-                exit;
-{$ifndef nounsupported}
+              if tsetdef(def).elementdef.typ=enumdef then
+                begin
+                  { load enum class type }
+                  list.concat(taicpu.op_sym(a_ldc,current_asmdata.RefAsmSymbol(tenumdef(tsetdef(def).elementdef).getbasedef.classdef.jvm_full_typename(true))));
+                  thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
+                  { call tenumset.noneOf() class method }
+                  sym:=tsym(tobjectdef(java_juenumset).symtable.find('NONEOF'));
+                  if assigned(sym) and
+                     (sym.typ=procsym) then
+                    begin
+                      if tprocsym(sym).procdeflist.Count<>1 then
+                        internalerror(2011062801);
+                      pd:=tprocdef(tprocsym(sym).procdeflist[0]);
+                    end;
+                  hlcg.a_call_name(list,pd,pd.mangledname,false);
+                  { static calls method replaces parameter with set instance
+                    -> no change in stack height }
+                end
+              else
+                begin
+                  list.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(java_jubitset.jvm_full_typename(true))));
+                  { the constructor doesn't return anything, so put a duplicate of the
+                    self pointer on the evaluation stack for use as function result
+                    after the constructor has run }
+                  list.concat(taicpu.op_none(a_dup));
+                  thlcgjvm(hlcg).incstack(list,2);
+                  { call the constructor }
+                  sym:=tsym(java_jubitset.symtable.find('CREATE'));
+                  if assigned(sym) and
+                     (sym.typ=procsym) then
+                    begin
+                      pd:=tprocsym(sym).find_bytype_parameterless(potype_constructor);
+                      if not assigned(pd) then
+                        internalerror(2011062802);
+                    end
+                  else
+                    internalerror(2011062803);
+                  hlcg.a_call_name(list,pd,pd.mangledname,false);
+                  { duplicate self pointer is removed }
+                  thlcgjvm(hlcg).decstack(list,1);
+                end;
+              { store reference to instance }
               gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
+              thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
               result:=true;
-{$endif}
             end;
           stringdef:
             begin

+ 28 - 20
compiler/jvmdef.pas

@@ -93,7 +93,8 @@ implementation
       begin
         result:=false;
         case def.typ of
-          classrefdef :
+          classrefdef,
+          setdef:
             begin
               result:=true;
             end;
@@ -140,8 +141,14 @@ implementation
             end;
           setdef :
             begin
-              { maybe one day }
-              internalerror(2011051404);
+              if tsetdef(def).elementdef.typ=enumdef then
+                begin
+                  encodedstr:=encodedstr+'Ljava/util/EnumSet<';
+                  jvmaddencodedtype(tenumdef(tsetdef(def).elementdef).getbasedef,false,encodedstr,true,founderror);
+                  encodedstr:=encodedstr+'>;';
+                end
+              else
+                internalerror(2011051404);
             end;
           arraydef :
             begin
@@ -283,25 +290,20 @@ implementation
               { we can however annotate it with extra signature information in
                 using Java's generic annotations }
               else
-                begin
-                  encodedstr:=encodedstr+'Ljava/lang/Class<';
-                  result:=jvmaddencodedtype(tclassrefdef(def).pointeddef,true,encodedstr,forcesignature,founderror);
-                  encodedstr:=encodedstr+'>;';
-                end;
+                jvmaddencodedsignature(def,false,encodedstr);
               result:=true;
             end;
           setdef :
             begin
-              if is_smallset(def) then
-                encodedstr:=encodedstr+'I'
+              if tsetdef(def).elementdef.typ=enumdef then
+                begin
+                  if forcesignature then
+                    jvmaddencodedsignature(def,false,encodedstr)
+                  else
+                    result:=jvmaddencodedtype(java_juenumset,false,encodedstr,forcesignature,founderror)
+                end
               else
-{$ifndef nounsupported}
-                result:=jvmaddencodedtype(java_jlobject,false,encodedstr,forcesignature,founderror);
-{$else}
-                { will be hanlded via wrapping later, although wrapping may
-                  happen at higher level }
-                result:=false;
-{$endif}
+                result:=jvmaddencodedtype(java_jubitset,false,encodedstr,forcesignature,founderror)
             end;
           formaldef :
             begin
@@ -461,6 +463,13 @@ implementation
           result:='R'
         else if is_shortstring(def) then
           result:='T'
+        else if def.typ=setdef then
+          begin
+            if tsetdef(def).elementdef.typ=enumdef then
+              result:='E'
+            else
+              result:='L'
+          end
         else
           begin
             if not jvmtryencodetype(def,res,false,errdef) then
@@ -481,12 +490,11 @@ implementation
                 is_open_array(def) or
                 is_array_of_const(def) or
                 is_array_constructor(def);
-          recorddef:
+          recorddef,
+          setdef:
             result:=true;
           objectdef:
             result:=is_object(def);
-          setdef:
-            result:=not is_smallset(def);
           stringdef :
             result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
           else

+ 0 - 6
compiler/nadd.pas

@@ -2112,12 +2112,6 @@ 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:

+ 52 - 49
compiler/ncgcon.pas

@@ -27,6 +27,7 @@ unit ncgcon;
 interface
 
     uses
+       aasmbase,
        node,ncon;
 
     type
@@ -51,6 +52,10 @@ interface
        end;
 
        tcgsetconstnode = class(tsetconstnode)
+         protected
+          function emitvarsetconst: tasmsymbol; virtual;
+          procedure handlevarsetconst;
+         public
           procedure pass_generate_code;override;
        end;
 
@@ -68,7 +73,7 @@ implementation
     uses
       globtype,widestr,systems,
       verbose,globals,cutils,
-      symconst,symdef,aasmbase,aasmtai,aasmdata,aasmcpu,defutil,
+      symconst,symdef,aasmtai,aasmdata,aasmcpu,defutil,
       cpuinfo,cpubase,
       cgbase,cgobj,cgutils,
       ncgutil, cclasses,asmutils,tgobj
@@ -372,11 +377,52 @@ implementation
                            TCGSETCONSTNODE
 *****************************************************************************}
 
-    procedure tcgsetconstnode.pass_generate_code;
-
+    function tcgsetconstnode.emitvarsetconst: tasmsymbol;
       type
-         setbytes=array[0..31] of byte;
-         Psetbytes=^setbytes;
+        setbytes=array[0..31] of byte;
+        Psetbytes=^setbytes;
+      var
+        lab: tasmlabel;
+        i: longint;
+      begin
+        current_asmdata.getdatalabel(lab);
+        result:=lab;
+        lab_set:=lab;
+        maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
+        new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,result.name,const_align(8));
+        current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lab));
+        if (source_info.endian=target_info.endian) then
+          for i:=0 to 31 do
+            current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(Psetbytes(value_set)^[i]))
+        else
+          for i:=0 to 31 do
+            current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(reverse_byte(Psetbytes(value_set)^[i])));
+      end;
+
+
+    procedure tcgsetconstnode.handlevarsetconst;
+      var
+         i           : longint;
+         entry       : PHashSetItem;
+      begin
+        location_reset_ref(location,LOC_CREFERENCE,OS_NO,const_align(8));
+        { const already used ? }
+        if not assigned(lab_set) then
+          begin
+            if current_asmdata.ConstPools[sp_varsets] = nil then
+              current_asmdata.ConstPools[sp_varsets] := THashSet.Create(64, True, False);
+            entry := current_asmdata.ConstPools[sp_varsets].FindOrAdd(value_set, 32);
+
+             { :-(, we must generate a new entry }
+             if not assigned(entry^.Data) then
+               entry^.Data:=emitvarsetconst;
+             lab_set := TAsmSymbol(entry^.Data);
+          end;
+        location.reference.symbol:=lab_set;
+      end;
+
+
+    procedure tcgsetconstnode.pass_generate_code;
 
         procedure smallsetconst;
         begin
@@ -403,49 +449,6 @@ implementation
             location.value:=location.value shr (32-resultdef.size*8);
         end;
 
-        procedure varsetconst;
-        var
-           lastlabel   : tasmlabel;
-           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 ? }
-          if not assigned(lab_set) then
-            begin
-              if current_asmdata.ConstPools[sp_varsets] = nil then
-                current_asmdata.ConstPools[sp_varsets] := THashSet.Create(64, True, False);
-              entry := current_asmdata.ConstPools[sp_varsets].FindOrAdd(value_set, 32);
-
-              lab_set := TAsmLabel(entry^.Data);  // is it needed anymore?
-
-               { :-(, we must generate a new entry }
-               if not assigned(entry^.Data) then
-                 begin
-                   current_asmdata.getdatalabel(lastlabel);
-                   lab_set:=lastlabel;
-                   entry^.Data:=lastlabel;
-                   maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
-                   new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(8));
-                   current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel));
-                   if (source_info.endian=target_info.endian) then
-                     for i:=0 to 31 do
-                       current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(Psetbytes(value_set)^[i]))
-                   else
-                     for i:=0 to 31 do
-                       current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(reverse_byte(Psetbytes(value_set)^[i])));
-                 end;
-            end;
-          location.reference.symbol:=lab_set;
-        end;
 
       begin
         adjustforsetbase;
@@ -454,7 +457,7 @@ implementation
         if is_smallset(resultdef) then
           smallsetconst
         else
-          varsetconst;
+          handlevarsetconst;
       end;
 
 

+ 24 - 22
compiler/ncgset.pas

@@ -215,8 +215,11 @@ implementation
          pleftreg   : tregister;
          setparts   : Tsetparts;
          opsize     : tcgsize;
+         opdef      : tdef;
          uopsize    : tcgsize;
+         uopdef     : tdef;
          orgopsize  : tcgsize;
+         orgopdef   : tdef;
          genjumps,
          use_small,
          isjump     : boolean;
@@ -228,12 +231,21 @@ implementation
 
          genjumps := checkgenjumps(setparts,numparts,use_small);
 
+
          orgopsize := def_cgsize(left.resultdef);
+         orgopdef := left.resultdef;
          uopsize := OS_32;
+         uopdef := u32inttype;
          if is_signed(left.resultdef) then
-           opsize := tcgsize(ord(uopsize)+(ord(OS_S8)-ord(OS_8)))
+           begin
+             opsize := OS_S32;
+             opdef := s32inttype;
+           end
          else
-           opsize := uopsize;
+           begin
+             opsize := uopsize;
+             opdef := uopdef;
+           end;
          needslabel := false;
 
          isjump:=false;
@@ -259,7 +271,8 @@ implementation
          secondpass(left);
          if isjump then
            begin
-             location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true);
+             hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,orgopdef,opdef,true);
+             left.resultdef:=opdef;
              current_procinfo.CurrTrueLabel:=otl;
              current_procinfo.CurrFalseLabel:=ofl;
            end
@@ -276,17 +289,6 @@ 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
@@ -294,7 +296,7 @@ implementation
             location_reset(location,LOC_JUMP,OS_NO);
 
             { If register is used, use only lower 8 bits }
-            location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false);
+            hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,opdef,false);
             pleftreg := left.location.register;
 
             { how much have we already substracted from the x in the }
@@ -319,15 +321,15 @@ implementation
                          (hr<>pleftreg) then
                         begin
                           { don't change this back to a_op_const_reg/a_load_reg_reg, since pleftreg must not be modified }
-                          hr:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
-                          cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,opsize,setparts[i].start,pleftreg,hr);
+                          hr:=hlcg.getintregister(current_asmdata.CurrAsmList,opdef);
+                          hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,opdef,setparts[i].start,pleftreg,hr);
                           pleftreg:=hr;
                         end
                       else
                         begin
                           { otherwise, the value is already in a register   }
                           { that can be modified                            }
-                          cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,opsize,
+                          hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,opdef,
                              setparts[i].start-adjustment,pleftreg)
                         end;
                     { new total value substracted from x:           }
@@ -338,25 +340,25 @@ implementation
                     { we need a carry in case the element is in the range }
                     { (this will never overflow since we check at the     }
                     { beginning whether stop-start <> 255)                }
-                    cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_B,
+                    hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opdef, OC_B,
                       setparts[i].stop-setparts[i].start+1,pleftreg,current_procinfo.CurrTrueLabel);
                   end
                 else
                   { if setparts[i].start = 0 and setparts[i].stop = 255,  }
                   { it's always true since "in" is only allowed for bytes }
                   begin
-                    cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
+                    hlcg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
                   end;
               end
              else
               begin
                 { Emit code to check if left is an element }
-                cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ,
+                hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opdef, OC_EQ,
                       setparts[i].stop-adjustment,pleftreg,current_procinfo.CurrTrueLabel);
               end;
              { To compensate for not doing a second pass }
              right.location.reference.symbol:=nil;
-             cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
+             hlcg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
           end
          else
          {*****************************************************************}

+ 1 - 1
compiler/ncon.pas

@@ -144,7 +144,7 @@ interface
           typedef : tdef;
           typedefderef : tderef;
           value_set : pconstset;
-          lab_set : tasmlabel;
+          lab_set : tasmsymbol;
           constructor create(s : pconstset;def:tdef);virtual;
           destructor destroy;override;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;

+ 2 - 2
compiler/nmem.pas

@@ -476,11 +476,11 @@ implementation
         make_not_regable(left,[ra_addr_regable,ra_addr_taken]);
 
         { don't allow constants, for internal use we also
-          allow taking the address of strings }
+          allow taking the address of strings and sets }
         if is_constnode(left) and
            not(
                (nf_internal in flags) and
-               (left.nodetype in [stringconstn])
+               (left.nodetype in [stringconstn,setconstn])
               ) then
          begin
            CGMessagePos(left.fileinfo,type_e_no_addr_of_constant);

+ 1 - 1
compiler/pdecl.pas

@@ -212,7 +212,7 @@ implementation
                          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
+                          (tconstsym(sym).constdef.typ in [enumdef,setdef]) then
                          jvm_add_typed_const_initializer(tconstsym(sym));
 {$endif}
                      end

+ 4 - 0
compiler/pdecobj.pas

@@ -1303,6 +1303,10 @@ implementation
                         java_shortstring:=current_objectdef
                       else if (current_objectdef.objname^='JLENUM') then
                         java_jlenum:=current_objectdef
+                      else if (current_objectdef.objname^='JUENUMSET') then
+                        java_juenumset:=current_objectdef
+                      else if (current_objectdef.objname^='FPCBITSET') then
+                        java_jubitset:=current_objectdef
                     end;
                 end;
               end;

+ 75 - 4
compiler/pjvm.pas

@@ -41,7 +41,7 @@ interface
 
     procedure jvm_maybe_create_enum_class(const name: TIDString; def: tdef);
 
-    procedure jvm_add_typed_const_initializer(csym: tconstsym);
+    function jvm_add_typed_const_initializer(csym: tconstsym): tstaticvarsym;
 
     function jvm_wrap_method_with_vis(pd: tprocdef; vis: tvisibility): tprocdef;
 
@@ -53,7 +53,7 @@ implementation
     verbose,systems,
     fmodule,
     parabase,aasmdata,
-    pdecsub,
+    pdecsub,ngenutil,
     symtable,symcreat,defcmp,jvmdef,
     defutil,paramgr;
 
@@ -346,6 +346,22 @@ implementation
           internalerror(2011062302);
         include(pd.procoptions,po_staticmethod);
         pd.synthetickind:=tsk_jvm_enum_valueof;
+
+        { add instance method to convert an ordinal and an array into a set of
+          (we always need/can use both in case of subrange types and/or array
+           -> set type casts) }
+        if not str_parse_method_dec('function fpcLongToEnumSet(__val: jlong; __setbase, __setsize: jint): JUEnumSet;',potype_function,true,enumclass,pd) then
+          internalerror(2011070501);
+        pd.synthetickind:=tsk_jvm_enum_long2set;
+
+        if not str_parse_method_dec('function fpcBitSetToEnumSet(const __val: FpcBitSet; __fromsetbase, __tosetbase: jint): JUEnumSet; static;',potype_function,true,enumclass,pd) then
+          internalerror(2011071004);
+        pd.synthetickind:=tsk_jvm_enum_bitset2set;
+
+        if not str_parse_method_dec('function fpcEnumSetToEnumSet(const __val: JUEnumSet; __fromsetbase, __tosetbase: jint): JUEnumSet; static;',potype_function,true,enumclass,pd) then
+          internalerror(2011071005);
+        pd.synthetickind:=tsk_jvm_enum_set2set;
+
         { create array called "$VALUES" that will contain a reference to all
           enum instances (JDK convention)
           Disable duplicate identifier checking when inserting, because it will
@@ -381,12 +397,16 @@ implementation
       end;
 
 
-    procedure jvm_add_typed_const_initializer(csym: tconstsym);
+    function jvm_add_typed_const_initializer(csym: tconstsym): tstaticvarsym;
       var
         ssym: tstaticvarsym;
         esym: tenumsym;
         i: longint;
         sstate: tscannerstate;
+        elemdef: tdef;
+        elemdefname,
+        conststr: ansistring;
+        first: boolean;
       begin
         case csym.constdef.typ of
           enumdef:
@@ -414,7 +434,58 @@ implementation
                 end;
               str_parse_typedconst(current_asmdata.asmlists[al_typedconsts],esym.name+';',ssym);
               restore_scanner(sstate);
-            end
+              result:=ssym;
+            end;
+          setdef:
+            begin
+              replace_scanner('jvm_set_const',sstate);
+              { make sure we don't emit a definition for this field (we'll do
+                that for the constsym already) -> mark as external;
+                on the other hand, we don't create instances for constsyms in
+                (or external syms) the program/unit initialization code -> add
+                vo_has_local_copy to indicate that this should be done after all
+                (in thlcgjvm.allocate_implicit_structs_for_st_with_base_ref) }
+
+              { the constant can be defined in the body of a function and its
+                def can also belong to that -> will be freed when the function
+                has been compiler -> insert a copy in the unit's staticsymtable
+              }
+              symtablestack.push(current_module.localsymtable);
+              ssym:=tstaticvarsym.create(internal_static_field_name(csym.realname),vs_final,tsetdef(csym.constdef).getcopy,[vo_is_external,vo_has_local_copy]);
+              symtablestack.top.insert(ssym);
+              symtablestack.pop(current_module.localsymtable);
+              { alias storage to the constsym }
+              ssym.set_mangledname(csym.realname);
+              { ensure that we allocate space for global symbols (won't actually
+                allocate space for this one, since it's external, but for the
+                constsym) }
+              cnodeutils.insertbssdata(ssym);
+              elemdef:=tsetdef(csym.constdef).elementdef;
+              if not assigned(elemdef) then
+                begin
+                  internalerror(2011070502);
+                end
+              else
+                begin
+                  elemdefname:=elemdef.typename;
+                  conststr:='[';
+                  first:=true;
+                  for i:=0 to 255 do
+                    if i in pnormalset(csym.value.valueptr)^ then
+                      begin
+                        if not first then
+                          conststr:=conststr+',';
+                        first:=false;
+                        { instead of looking up all enum value names/boolean
+                           names, type cast integers to the required type }
+                        conststr:=conststr+elemdefname+'('+tostr(i)+')';
+                      end;
+                  conststr:=conststr+'];';
+                end;
+              str_parse_typedconst(current_asmdata.asmlists[al_typedconsts],conststr,ssym);
+              restore_scanner(sstate);
+              result:=ssym;
+            end;
           else
             internalerror(2011062701);
         end;

+ 66 - 0
compiler/symcreat.pas

@@ -537,6 +537,66 @@ implementation
     end;
 
 
+  procedure implement_jvm_enum_long2set(pd: tprocdef);
+    begin
+      str_parse_method_impl(
+        'var '+
+          'i, setval: jint;'+
+        'begin '+
+          'result:=JUEnumSet.noneOf(JLClass(__FPC_TEnumClassAlias));'+
+          'if __val<>0 then '+
+            'begin '+
+              '__setsize:=__setsize*8;'+
+              'for i:=0 to __setsize-1 do '+
+              // setsize-i because JVM = big endian
+              'if (__val and (jlong(1) shl (__setsize-i)))<>0 then '+
+                'result.add(fpcValueOf(i+__setbase));'+
+            'end '+
+          'end;',
+        pd,true);
+    end;
+
+
+  procedure implement_jvm_enum_bitset2set(pd: tprocdef);
+    begin
+      str_parse_method_impl(
+        'var '+
+          'i, setval: jint;'+
+        'begin '+
+          'result:=JUEnumSet.noneOf(JLClass(__FPC_TEnumClassAlias));'+
+          'i:=__val.nextSetBit(0);'+
+          'while i>=0 do '+
+            'begin '+
+              'setval:=-__fromsetbase;'+
+              'result.add(fpcValueOf(setval+__tosetbase));'+
+              'i:=__val.nextSetBit(i+1);'+
+            'end '+
+          'end;',
+        pd,true);
+    end;
+
+
+  procedure implement_jvm_enum_set2set(pd: tprocdef);
+    begin
+      str_parse_method_impl(
+        'var '+
+          'it: JUIterator;'+
+          'ele: FpcEnumValueObtainable;'+
+          'i: longint;'+
+        'begin '+
+          'result:=JUEnumSet.noneOf(JLClass(__FPC_TEnumClassAlias));'+
+          'it:=__val.iterator;'+
+          'while it.hasNext do '+
+            'begin '+
+              'ele:=FpcEnumValueObtainable(it.next);'+
+              'i:=ele.fpcOrdinal-__fromsetbase;'+
+              'result.add(fpcValueOf(i+__tosetbase));'+
+             'end '+
+          'end;',
+        pd,true);
+    end;
+
+
   procedure add_synthetic_method_implementations_for_struct(struct: tabstractrecorddef);
     var
       i   : longint;
@@ -576,6 +636,12 @@ implementation
               implement_jvm_enum_fpcordinal(pd);
             tsk_jvm_enum_fpcvalueof:
               implement_jvm_enum_fpcvalueof(pd);
+            tsk_jvm_enum_long2set:
+              implement_jvm_enum_long2set(pd);
+            tsk_jvm_enum_bitset2set:
+              implement_jvm_enum_bitset2set(pd);
+            tsk_jvm_enum_set2set:
+              implement_jvm_enum_set2set(pd);
             else
               internalerror(2011032801);
           end;

+ 12 - 1
compiler/symdef.pas

@@ -507,7 +507,10 @@ interface
          tsk_jvm_enum_classconstr,  // Java class constructor for JLEnum descendants
          tsk_jvm_enum_jumps_constr, // Java constructor for JLEnum descendants for enums with jumps
          tsk_jvm_enum_fpcordinal,   // Java FPCOrdinal function that returns the enum's ordinal value from an FPC POV
-         tsk_jvm_enum_fpcvalueof    // Java FPCValueOf function that returns the enum instance corresponding to an ordinal from an FPC POV
+         tsk_jvm_enum_fpcvalueof,   // Java FPCValueOf function that returns the enum instance corresponding to an ordinal from an FPC POV
+         tsk_jvm_enum_long2set,     // Java fpcLongToEnumSet function that returns an enumset corresponding to a bit pattern in a jlong
+         tsk_jvm_enum_bitset2set,   // Java fpcBitSetToEnumSet function that returns an enumset corresponding to a BitSet
+         tsk_jvm_enum_set2Set       // Java fpcEnumSetToEnumSet function that returns an enumset corresponding to another enumset (different enum kind)
        );
 
 {$ifdef oldregvars}
@@ -841,6 +844,10 @@ interface
        java_jlstring             : tobjectdef;
        { java.lang.Enum }
        java_jlenum               : tobjectdef;
+       { java.util.EnumSet }
+       java_juenumset            : tobjectdef;
+       { java.util.BitSet }
+       java_jubitset             : tobjectdef;
        { FPC java implementation of ansistrings }
        java_ansistring           : tobjectdef;
        { FPC java implementation of shortstrings }
@@ -5004,6 +5011,10 @@ implementation
                java_shortstring:=self
              else if (objname^='JLENUM') then
                java_jlenum:=self
+             else if (objname^='JUENUMSET') then
+               java_juenumset:=self
+             else if (objname^='FPCBITSET') then
+               java_jubitset:=self
            end;
          writing_class_record_dbginfo:=false;
        end;

+ 21 - 0
rtl/java/compproc.inc

@@ -627,8 +627,29 @@ procedure fpc_initialize_array_unicodestring(arr: TJObjectArray; normalarrdim: l
   level elements types of the array) }
 procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint);compilerproc;
 procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseRecordType);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_shortstring(arr: TJObjectArray; normalarrdim: longint; maxlen: byte);compilerproc;
 
+{ set helpers }
+procedure fpc_bitset_copy(const src: FpcBitSet; dst: FpcBitSet); compilerproc;
+procedure fpc_enumset_copy(const src: JUEnumSet; dst: JUEnumSet); compilerproc;
+
+function fpc_enumset_symdif(const set1, set2: JUEnumSet): JUEnumSet; compilerproc;
+
+function fpc_bitset_from_string(const s: unicodestring): FpcBitSet; compilerproc;
+function fpc_enumset_from_string(dummy: FpcEnumValueObtainable; const s: unicodestring): JUEnumSet; compilerproc;
+
+function fpc_enumset_to_int(const s: JUEnumSet; setbase, setsize: longint): jint; compilerproc;
+function fpc_enumset_to_long(const s: JUEnumSet; setbase, setsize: longint): jlong; compilerproc;
+function fpc_bitset_to_int(const s: FpcBitSet; setbase, setsize: longint): jint; compilerproc;
+function fpc_bitset_to_long(const s: FpcBitSet; setbase, setsize: longint): jlong; compilerproc;
+function fpc_int_to_bitset(const val: jint; setbase, setsize: jint): FpcBitSet; compilerproc;
+function fpc_long_to_bitset(const val: jint; setbase, setsize: jint): FpcBitSet; compilerproc;
+
+function fpc_enumset_to_bitset(const val: JUEnumSet; fromsetbase, tosetbase: jint): FpcBitSet; compilerproc;
+function fpc_bitset_to_bitset(const s: FpcBitSet; fromsetbase, tosetbase: jint): FpcBitSet; compilerproc;
+
 (*
 {$ifdef FPC_SETBASE_USED}
 procedure fpc_varset_load(const l;sourcesize : longint;var dest;size,srcminusdstbase : ptrint); compilerproc;

+ 6 - 0
rtl/java/java_sys.inc

@@ -347,6 +347,12 @@
     function equals(para1: JLObject): jboolean; overload;
   end;
 
+  JUIterator = interface external 'java.util' name 'Iterator' 
+    function hasNext(): jboolean; overload;
+    function next(): JLObject; overload;
+    procedure remove(); overload;
+  end;
+
   JUMap = interface external 'java.util' name 'Map' 
     type
       InnerEntry = interface;

+ 6 - 6
rtl/java/java_sysh.inc

@@ -1,4 +1,4 @@
-{ Imports for Java packages/classes: java.io.Serializable, java.lang.AbstractStringBuilder, java.lang.Appendable, java.lang.Boolean, java.lang.Byte, java.lang.CharSequence, java.lang.Character, java.lang.Class, java.lang.Cloneable, java.lang.Comparable, java.lang.Double, java.lang.Enum, java.lang.Error, java.lang.Exception, java.lang.Float, java.lang.IllegalArgumentException, java.lang.IndexOutOfBoundsException, java.lang.Integer, java.lang.Iterable, java.lang.LinkageError, java.lang.Long, java.lang.Number, java.lang.Object, java.lang.RuntimeException, java.lang.Short, java.lang.String, java.lang.StringBuffer, java.lang.StringBuilder, java.lang.System, java.lang.Throwable, java.lang.reflect.AnnotatedElement, java.lang.reflect.Array, java.lang.reflect.GenericDeclaration, java.lang.reflect.Type, java.text.Collator, java.util.AbstractCollection, java.util.AbstractMap, java.util.AbstractSet, java.util.Arrays, java.util.BitSet, java.util.Collection, java.util.Comparator, java.util.EnumSet, java.util.HashMap, java.util.Map, java.util.Set }
+{ Imports for Java packages/classes: java.io.Serializable, java.lang.AbstractStringBuilder, java.lang.Appendable, java.lang.Boolean, java.lang.Byte, java.lang.CharSequence, java.lang.Character, java.lang.Class, java.lang.Cloneable, java.lang.Comparable, java.lang.Double, java.lang.Enum, java.lang.Error, java.lang.Exception, java.lang.Float, java.lang.IllegalArgumentException, java.lang.IndexOutOfBoundsException, java.lang.Integer, java.lang.Iterable, java.lang.LinkageError, java.lang.Long, java.lang.Number, java.lang.Object, java.lang.RuntimeException, java.lang.Short, java.lang.String, java.lang.StringBuffer, java.lang.StringBuilder, java.lang.System, java.lang.Throwable, java.lang.reflect.AnnotatedElement, java.lang.reflect.Array, java.lang.reflect.GenericDeclaration, java.lang.reflect.Type, java.text.Collator, java.util.AbstractCollection, java.util.AbstractMap, java.util.AbstractSet, java.util.Arrays, java.util.BitSet, java.util.Collection, java.util.Comparator, java.util.EnumSet, java.util.HashMap, java.util.Iterator, java.util.Map, java.util.Set }
 type
   JLStringBuffer = class;
   Arr1JLStringBuffer = array of JLStringBuffer;
@@ -170,6 +170,11 @@ type
   Arr2JLIterable = array of Arr1JLIterable;
   Arr3JLIterable = array of Arr2JLIterable;
 
+  JUIterator = interface;
+  Arr1JUIterator = array of JUIterator;
+  Arr2JUIterator = array of Arr1JUIterator;
+  Arr3JUIterator = array of Arr2JUIterator;
+
   JLCloneable = interface;
   Arr1JLCloneable = array of JLCloneable;
   Arr2JLCloneable = array of Arr1JLCloneable;
@@ -325,11 +330,6 @@ type
   Arr2JLAAnnotation = array of Arr1JLAAnnotation;
   Arr3JLAAnnotation = array of Arr2JLAAnnotation;
 
-  JUIterator = interface external 'java.util' name 'Iterator';
-  Arr1JUIterator = array of JUIterator;
-  Arr2JUIterator = array of Arr1JUIterator;
-  Arr3JUIterator = array of Arr2JUIterator;
-
   JNCChannel = interface external 'java.nio.channels' name 'Channel';
   Arr1JNCChannel = array of JNCChannel;
   Arr2JNCChannel = array of Arr1JNCChannel;

+ 115 - 121
rtl/java/jdk15.inc

@@ -4630,12 +4630,6 @@
       ALTERNATE = 4;
   end;
 
-  JUIterator = interface external 'java.util' name 'Iterator' 
-    function hasNext(): jboolean; overload;
-    function next(): JLObject; overload;
-    procedure remove(); overload;
-  end;
-
   JULocaleISOData = class external 'java.util' name 'LocaleISOData' (JLObject)
   end;
 
@@ -23380,6 +23374,104 @@
     function peek(): JLObject; overload;
   end;
 
+  JUListIterator = interface external 'java.util' name 'ListIterator' (JUIterator)
+    function hasNext(): jboolean; overload;
+    function next(): JLObject; overload;
+    function hasPrevious(): jboolean; overload;
+    function previous(): JLObject; overload;
+    function nextIndex(): jint; overload;
+    function previousIndex(): jint; overload;
+    procedure remove(); overload;
+    procedure &set(para1: JLObject); overload;
+    procedure add(para1: JLObject); overload;
+  end;
+
+  JUScanner = class sealed external 'java.util' name 'Scanner' (JLObject, JUIterator)
+  public
+    constructor create(para1: JLReadable); overload;
+    constructor create(para1: JIInputStream); overload;
+    constructor create(para1: JIInputStream; para2: JLString); overload;
+    constructor create(para1: JIFile); overload;  // throws java.io.FileNotFoundException
+    constructor create(para1: JIFile; para2: JLString); overload;  // throws java.io.FileNotFoundException
+    constructor create(para1: JLString); overload;
+    constructor create(para1: JNCReadableByteChannel); overload;
+    constructor create(para1: JNCReadableByteChannel; para2: JLString); overload;
+    procedure close(); overload; virtual;
+    function ioException(): JIIOException; overload; virtual;
+    function delimiter(): JURPattern; overload; virtual;
+    function useDelimiter(para1: JURPattern): JUScanner; overload; virtual;
+    function useDelimiter(para1: JLString): JUScanner; overload; virtual;
+    function locale(): JULocale; overload; virtual;
+    function useLocale(para1: JULocale): JUScanner; overload; virtual;
+    function radix(): jint; overload; virtual;
+    function useRadix(para1: jint): JUScanner; overload; virtual;
+    function match(): JURMatchResult; overload; virtual;
+    function toString(): JLString; overload; virtual;
+    function hasNext(): jboolean; overload; virtual;
+    function next(): JLString; overload; virtual;
+    procedure remove(); overload; virtual;
+    function hasNext(para1: JLString): jboolean; overload; virtual;
+    function next(para1: JLString): JLString; overload; virtual;
+    function hasNext(para1: JURPattern): jboolean; overload; virtual;
+    function next(para1: JURPattern): JLString; overload; virtual;
+    function hasNextLine(): jboolean; overload; virtual;
+    function nextLine(): JLString; overload; virtual;
+    function findInLine(para1: JLString): JLString; overload; virtual;
+    function findInLine(para1: JURPattern): JLString; overload; virtual;
+    function findWithinHorizon(para1: JLString; para2: jint): JLString; overload; virtual;
+    function findWithinHorizon(para1: JURPattern; para2: jint): JLString; overload; virtual;
+    function skip(para1: JURPattern): JUScanner; overload; virtual;
+    function skip(para1: JLString): JUScanner; overload; virtual;
+    function hasNextBoolean(): jboolean; overload; virtual;
+    function nextBoolean(): jboolean; overload; virtual;
+    function hasNextByte(): jboolean; overload; virtual;
+    function hasNextByte(para1: jint): jboolean; overload; virtual;
+    function nextByte(): jbyte; overload; virtual;
+    function nextByte(para1: jint): jbyte; overload; virtual;
+    function hasNextShort(): jboolean; overload; virtual;
+    function hasNextShort(para1: jint): jboolean; overload; virtual;
+    function nextShort(): jshort; overload; virtual;
+    function nextShort(para1: jint): jshort; overload; virtual;
+    function hasNextInt(): jboolean; overload; virtual;
+    function hasNextInt(para1: jint): jboolean; overload; virtual;
+    function nextInt(): jint; overload; virtual;
+    function nextInt(para1: jint): jint; overload; virtual;
+    function hasNextLong(): jboolean; overload; virtual;
+    function hasNextLong(para1: jint): jboolean; overload; virtual;
+    function nextLong(): jlong; overload; virtual;
+    function nextLong(para1: jint): jlong; overload; virtual;
+    function hasNextFloat(): jboolean; overload; virtual;
+    function nextFloat(): jfloat; overload; virtual;
+    function hasNextDouble(): jboolean; overload; virtual;
+    function nextDouble(): jdouble; overload; virtual;
+    function hasNextBigInteger(): jboolean; overload; virtual;
+    function hasNextBigInteger(para1: jint): jboolean; overload; virtual;
+    function nextBigInteger(): JMBigInteger; overload; virtual;
+    function nextBigInteger(para1: jint): JMBigInteger; overload; virtual;
+    function hasNextBigDecimal(): jboolean; overload; virtual;
+    function nextBigDecimal(): JMBigDecimal; overload; virtual;
+    function reset(): JUScanner; overload; virtual;
+    function next(): JLObject; overload; virtual;
+  end;
+
+  JISPartialOrderIterator = class external 'javax.imageio.spi' name 'PartialOrderIterator' (JLObject, JUIterator)
+  public
+    constructor create(para1: JUIterator); overload;
+    function hasNext(): jboolean; overload; virtual;
+    function next(): JLObject; overload; virtual;
+    procedure remove(); overload; virtual;
+  end;
+
+  JXSXMLEventReader = interface external 'javax.xml.stream' name 'XMLEventReader' (JUIterator)
+    function nextEvent(): JXSEXMLEvent; overload;  // throws javax.xml.stream.XMLStreamException
+    function hasNext(): jboolean; overload;
+    function peek(): JXSEXMLEvent; overload;  // throws javax.xml.stream.XMLStreamException
+    function getElementText(): JLString; overload;  // throws javax.xml.stream.XMLStreamException
+    function nextTag(): JXSEXMLEvent; overload;  // throws javax.xml.stream.XMLStreamException
+    function getProperty(para1: JLString): JLObject; overload;  // throws java.lang.IllegalArgumentException
+    procedure close(); overload;  // throws javax.xml.stream.XMLStreamException
+  end;
+
   JIFile = class external 'java.io' name 'File' (JLObject, JISerializable, JLComparable)
   public
     type
@@ -31686,104 +31778,6 @@
     procedure undoableEditHappened(para1: JSEUndoableEditEvent); overload;
   end;
 
-  JUListIterator = interface external 'java.util' name 'ListIterator' (JUIterator)
-    function hasNext(): jboolean; overload;
-    function next(): JLObject; overload;
-    function hasPrevious(): jboolean; overload;
-    function previous(): JLObject; overload;
-    function nextIndex(): jint; overload;
-    function previousIndex(): jint; overload;
-    procedure remove(); overload;
-    procedure &set(para1: JLObject); overload;
-    procedure add(para1: JLObject); overload;
-  end;
-
-  JUScanner = class sealed external 'java.util' name 'Scanner' (JLObject, JUIterator)
-  public
-    constructor create(para1: JLReadable); overload;
-    constructor create(para1: JIInputStream); overload;
-    constructor create(para1: JIInputStream; para2: JLString); overload;
-    constructor create(para1: JIFile); overload;  // throws java.io.FileNotFoundException
-    constructor create(para1: JIFile; para2: JLString); overload;  // throws java.io.FileNotFoundException
-    constructor create(para1: JLString); overload;
-    constructor create(para1: JNCReadableByteChannel); overload;
-    constructor create(para1: JNCReadableByteChannel; para2: JLString); overload;
-    procedure close(); overload; virtual;
-    function ioException(): JIIOException; overload; virtual;
-    function delimiter(): JURPattern; overload; virtual;
-    function useDelimiter(para1: JURPattern): JUScanner; overload; virtual;
-    function useDelimiter(para1: JLString): JUScanner; overload; virtual;
-    function locale(): JULocale; overload; virtual;
-    function useLocale(para1: JULocale): JUScanner; overload; virtual;
-    function radix(): jint; overload; virtual;
-    function useRadix(para1: jint): JUScanner; overload; virtual;
-    function match(): JURMatchResult; overload; virtual;
-    function toString(): JLString; overload; virtual;
-    function hasNext(): jboolean; overload; virtual;
-    function next(): JLString; overload; virtual;
-    procedure remove(); overload; virtual;
-    function hasNext(para1: JLString): jboolean; overload; virtual;
-    function next(para1: JLString): JLString; overload; virtual;
-    function hasNext(para1: JURPattern): jboolean; overload; virtual;
-    function next(para1: JURPattern): JLString; overload; virtual;
-    function hasNextLine(): jboolean; overload; virtual;
-    function nextLine(): JLString; overload; virtual;
-    function findInLine(para1: JLString): JLString; overload; virtual;
-    function findInLine(para1: JURPattern): JLString; overload; virtual;
-    function findWithinHorizon(para1: JLString; para2: jint): JLString; overload; virtual;
-    function findWithinHorizon(para1: JURPattern; para2: jint): JLString; overload; virtual;
-    function skip(para1: JURPattern): JUScanner; overload; virtual;
-    function skip(para1: JLString): JUScanner; overload; virtual;
-    function hasNextBoolean(): jboolean; overload; virtual;
-    function nextBoolean(): jboolean; overload; virtual;
-    function hasNextByte(): jboolean; overload; virtual;
-    function hasNextByte(para1: jint): jboolean; overload; virtual;
-    function nextByte(): jbyte; overload; virtual;
-    function nextByte(para1: jint): jbyte; overload; virtual;
-    function hasNextShort(): jboolean; overload; virtual;
-    function hasNextShort(para1: jint): jboolean; overload; virtual;
-    function nextShort(): jshort; overload; virtual;
-    function nextShort(para1: jint): jshort; overload; virtual;
-    function hasNextInt(): jboolean; overload; virtual;
-    function hasNextInt(para1: jint): jboolean; overload; virtual;
-    function nextInt(): jint; overload; virtual;
-    function nextInt(para1: jint): jint; overload; virtual;
-    function hasNextLong(): jboolean; overload; virtual;
-    function hasNextLong(para1: jint): jboolean; overload; virtual;
-    function nextLong(): jlong; overload; virtual;
-    function nextLong(para1: jint): jlong; overload; virtual;
-    function hasNextFloat(): jboolean; overload; virtual;
-    function nextFloat(): jfloat; overload; virtual;
-    function hasNextDouble(): jboolean; overload; virtual;
-    function nextDouble(): jdouble; overload; virtual;
-    function hasNextBigInteger(): jboolean; overload; virtual;
-    function hasNextBigInteger(para1: jint): jboolean; overload; virtual;
-    function nextBigInteger(): JMBigInteger; overload; virtual;
-    function nextBigInteger(para1: jint): JMBigInteger; overload; virtual;
-    function hasNextBigDecimal(): jboolean; overload; virtual;
-    function nextBigDecimal(): JMBigDecimal; overload; virtual;
-    function reset(): JUScanner; overload; virtual;
-    function next(): JLObject; overload; virtual;
-  end;
-
-  JISPartialOrderIterator = class external 'javax.imageio.spi' name 'PartialOrderIterator' (JLObject, JUIterator)
-  public
-    constructor create(para1: JUIterator); overload;
-    function hasNext(): jboolean; overload; virtual;
-    function next(): JLObject; overload; virtual;
-    procedure remove(); overload; virtual;
-  end;
-
-  JXSXMLEventReader = interface external 'javax.xml.stream' name 'XMLEventReader' (JUIterator)
-    function nextEvent(): JXSEXMLEvent; overload;  // throws javax.xml.stream.XMLStreamException
-    function hasNext(): jboolean; overload;
-    function peek(): JXSEXMLEvent; overload;  // throws javax.xml.stream.XMLStreamException
-    function getElementText(): JLString; overload;  // throws javax.xml.stream.XMLStreamException
-    function nextTag(): JXSEXMLEvent; overload;  // throws javax.xml.stream.XMLStreamException
-    function getProperty(para1: JLString): JLObject; overload;  // throws java.lang.IllegalArgumentException
-    procedure close(); overload;  // throws javax.xml.stream.XMLStreamException
-  end;
-
   JUListResourceBundle = class abstract external 'java.util' name 'ListResourceBundle' (JUResourceBundle)
   public
     constructor create(); overload;
@@ -43690,6 +43684,23 @@
     function drainTo(para1: JUCollection; para2: jint): jint; overload;
   end;
 
+  JXSUEventReaderDelegate = class external 'javax.xml.stream.util' name 'EventReaderDelegate' (JLObject, JXSXMLEventReader)
+  public
+    constructor create(); overload;
+    constructor create(para1: JXSXMLEventReader); overload;
+    procedure setParent(para1: JXSXMLEventReader); overload; virtual;
+    function getParent(): JXSXMLEventReader; overload; virtual;
+    function nextEvent(): JXSEXMLEvent; overload; virtual;  // throws javax.xml.stream.XMLStreamException
+    function next(): JLObject; overload; virtual;
+    function hasNext(): jboolean; overload; virtual;
+    function peek(): JXSEXMLEvent; overload; virtual;  // throws javax.xml.stream.XMLStreamException
+    procedure close(); overload; virtual;  // throws javax.xml.stream.XMLStreamException
+    function getElementText(): JLString; overload; virtual;  // throws javax.xml.stream.XMLStreamException
+    function nextTag(): JXSEXMLEvent; overload; virtual;  // throws javax.xml.stream.XMLStreamException
+    function getProperty(para1: JLString): JLObject; overload; virtual;  // throws java.lang.IllegalArgumentException
+    procedure remove(); overload; virtual;
+  end;
+
   JTRuleBasedCollationKey = class sealed external 'java.text' name 'RuleBasedCollationKey' (JTCollationKey)
   public
     function compareTo(para1: JTCollationKey): jint; overload; virtual;
@@ -49566,23 +49577,6 @@
     procedure recalcWidthCache(); overload; virtual;
   end;
 
-  JXSUEventReaderDelegate = class external 'javax.xml.stream.util' name 'EventReaderDelegate' (JLObject, JXSXMLEventReader)
-  public
-    constructor create(); overload;
-    constructor create(para1: JXSXMLEventReader); overload;
-    procedure setParent(para1: JXSXMLEventReader); overload; virtual;
-    function getParent(): JXSXMLEventReader; overload; virtual;
-    function nextEvent(): JXSEXMLEvent; overload; virtual;  // throws javax.xml.stream.XMLStreamException
-    function next(): JLObject; overload; virtual;
-    function hasNext(): jboolean; overload; virtual;
-    function peek(): JXSEXMLEvent; overload; virtual;  // throws javax.xml.stream.XMLStreamException
-    procedure close(); overload; virtual;  // throws javax.xml.stream.XMLStreamException
-    function getElementText(): JLString; overload; virtual;  // throws javax.xml.stream.XMLStreamException
-    function nextTag(): JXSEXMLEvent; overload; virtual;  // throws javax.xml.stream.XMLStreamException
-    function getProperty(para1: JLString): JLObject; overload; virtual;  // throws java.lang.IllegalArgumentException
-    procedure remove(); overload; virtual;
-  end;
-
   JAAccessibleResourceBundle = class external 'javax.accessibility' name 'AccessibleResourceBundle' (JUListResourceBundle)
   public
     constructor create(); overload;

+ 15 - 15
rtl/java/jdk15.pas

@@ -6935,16 +6935,16 @@ type
   Arr2JNByteBufferAsIntBufferRL = array of Arr1JNByteBufferAsIntBufferRL;
   Arr3JNByteBufferAsIntBufferRL = array of Arr2JNByteBufferAsIntBufferRL;
 
-  JXVSchemaFactoryLoader = class;
-  Arr1JXVSchemaFactoryLoader = array of JXVSchemaFactoryLoader;
-  Arr2JXVSchemaFactoryLoader = array of Arr1JXVSchemaFactoryLoader;
-  Arr3JXVSchemaFactoryLoader = array of Arr2JXVSchemaFactoryLoader;
-
   JTRuleBasedCollator = class;
   Arr1JTRuleBasedCollator = array of JTRuleBasedCollator;
   Arr2JTRuleBasedCollator = array of Arr1JTRuleBasedCollator;
   Arr3JTRuleBasedCollator = array of Arr2JTRuleBasedCollator;
 
+  JXVSchemaFactoryLoader = class;
+  Arr1JXVSchemaFactoryLoader = array of JXVSchemaFactoryLoader;
+  Arr2JXVSchemaFactoryLoader = array of Arr1JXVSchemaFactoryLoader;
+  Arr3JXVSchemaFactoryLoader = array of Arr2JXVSchemaFactoryLoader;
+
   JSPBBasicTextPaneUI = class;
   Arr1JSPBBasicTextPaneUI = array of JSPBBasicTextPaneUI;
   Arr2JSPBBasicTextPaneUI = array of Arr1JSPBBasicTextPaneUI;
@@ -17775,16 +17775,16 @@ type
   Arr2OWDDOMImplementation = array of Arr1OWDDOMImplementation;
   Arr3OWDDOMImplementation = array of Arr2OWDDOMImplementation;
 
-  OOCUNSUPPORTED_POLICY = interface;
-  Arr1OOCUNSUPPORTED_POLICY = array of OOCUNSUPPORTED_POLICY;
-  Arr2OOCUNSUPPORTED_POLICY = array of Arr1OOCUNSUPPORTED_POLICY;
-  Arr3OOCUNSUPPORTED_POLICY = array of Arr2OOCUNSUPPORTED_POLICY;
-
   JTCharacterIterator = interface;
   Arr1JTCharacterIterator = array of JTCharacterIterator;
   Arr2JTCharacterIterator = array of Arr1JTCharacterIterator;
   Arr3JTCharacterIterator = array of Arr2JTCharacterIterator;
 
+  OOCUNSUPPORTED_POLICY = interface;
+  Arr1OOCUNSUPPORTED_POLICY = array of OOCUNSUPPORTED_POLICY;
+  Arr2OOCUNSUPPORTED_POLICY = array of Arr1OOCUNSUPPORTED_POLICY;
+  Arr3OOCUNSUPPORTED_POLICY = array of Arr2OOCUNSUPPORTED_POLICY;
+
   JXBAXmlSchemaType = interface;
   Arr1JXBAXmlSchemaType = array of JXBAXmlSchemaType;
   Arr2JXBAXmlSchemaType = array of Arr1JXBAXmlSchemaType;
@@ -19665,11 +19665,6 @@ type
   Arr2JNLExtendedResponse = array of Arr1JNLExtendedResponse;
   Arr3JNLExtendedResponse = array of Arr2JNLExtendedResponse;
 
-  JUIterator = interface;
-  Arr1JUIterator = array of JUIterator;
-  Arr2JUIterator = array of Arr1JUIterator;
-  Arr3JUIterator = array of Arr2JUIterator;
-
   JAEComponentListener = interface;
   Arr1JAEComponentListener = array of JAEComponentListener;
   Arr2JAEComponentListener = array of Arr1JAEComponentListener;
@@ -20830,6 +20825,11 @@ type
   Arr2JLCloneable = array of Arr1JLCloneable;
   Arr3JLCloneable = array of Arr2JLCloneable;
 
+  JUIterator = interface external 'java.util' name 'Iterator';
+  Arr1JUIterator = array of JUIterator;
+  Arr2JUIterator = array of Arr1JUIterator;
+  Arr3JUIterator = array of Arr2JUIterator;
+
   JUCollection = interface external 'java.util' name 'Collection';
   Arr1JUCollection = array of JUCollection;
   Arr2JUCollection = array of Arr1JUCollection;

+ 6 - 0
rtl/java/jdynarrh.inc

@@ -25,6 +25,8 @@ type
   TJDoubleArray = array of jdouble;
   TJObjectArray = array of JLObject;
   TJRecordArray = array of FpcBaseRecordType;
+  TJEnumSetArray = array of JUEnumSet;
+  TJBitSetArray = array of JUBitSet;
   TShortstringArray = array of ShortstringClass;
   TJStringArray = array of unicodestring;
 
@@ -38,6 +40,8 @@ const
   FPCJDynArrTypeJDouble = 'D';
   FPCJDynArrTypeJObject = 'A';
   FPCJDynArrTypeRecord  = 'R';
+  FPCJDynArrTypeEnumSet = 'E';
+  FPCJDynArrTypeBitSet  = 'L';
   FPCJDynArrTypeShortstring  = 'T';
 
 { 1-dimensional setlength routines
@@ -54,6 +58,8 @@ function fpc_setlength_dynarr_jshortstring(aorg, anew: TShortstringArray; deepco
 
 procedure fpc_copy_shallow_array(src, dst: JLObject; srcstart: jint = -1; srccopylen: jint = -1);
 procedure fpc_copy_jrecord_array(src, dst: TJRecordArray; srcstart: jint = -1; srccopylen: jint = -1);
+procedure fpc_copy_jenumset_array(src, dst: TJEnumSetArray; srcstart: jint = -1; srccopylen: jint = -1);
+procedure fpc_copy_jbitset_array(src, dst: TJBitSetArray; srcstart: jint = -1; srccopylen: jint = -1);
 procedure fpc_copy_jshortstring_array(src, dst: TShortstringArray; srcstart: jint = -1; srccopylen: jint = -1);
 
 { multi-dimendional setlength routine: all intermediate dimensions are arrays

+ 284 - 0
rtl/java/jset.inc

@@ -0,0 +1,284 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2011 by Jonas Maebe,
+    members of the Free Pascal development team.
+
+    This file implements support infrastructure for sets under the JVM
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+
+  function FpcBitSet.add(elem: jint): FpcBitSet;
+    begin
+      &set(elem);
+      result:=self;
+    end;
+
+
+  function FpcBitSet.addAll(s: FpcBitSet): FpcBitSet;
+    begin
+      &or(s);
+      result:=self;
+    end;
+
+
+  function FpcBitSet.remove(elem: jint): FpcBitSet;
+    begin
+      clear(elem);
+      result:=self;
+    end;
+
+
+  function FpcBitSet.removeAll(s: FpcBitSet): FpcBitSet;
+    begin
+      andnot(s);
+      result:=self;
+    end;
+
+
+  function FpcBitSet.retainAll(s: FpcBitSet): FpcBitSet;
+    begin
+      &and(s);
+      result:=self;
+    end;
+
+
+  function FpcBitSet.contains(elem: jint): boolean;
+    begin
+      result:=get(elem);
+    end;
+
+
+  function FpcBitSet.containsAll(s: FpcBitSet): boolean;
+    var
+      tmp: FpcBitSet;
+    begin
+      tmp:=FpcBitSet(clone);
+      tmp.&and(s);
+      result:=tmp.equals(s);
+    end;
+
+
+  function FpcBitSet.symdif(s: FpcBitSet): FpcBitSet;
+    begin
+      s.&xor(s);
+      result:=self;
+    end;
+
+
+  class function FpcBitSet.range(start, stop: jint): FpcBitSet;
+    begin
+      result:=FpcBitSet.create(stop);
+      result.&set(start,stop+1);
+    end;
+
+
+  class function FpcBitSet.&of(elem: jint): FpcBitSet;
+    begin
+      result:=FpcBitSet.create(elem);
+      result.&set(elem);
+    end;
+
+
+  procedure fpc_bitset_copy(const src: FpcBitSet; dst: FpcBitSet); compilerproc;
+    begin
+      dst.clear();
+      dst.&or(src);
+    end;
+
+
+  procedure fpc_enumset_copy(const src: JUEnumSet; dst: JUEnumSet); compilerproc;
+    begin
+      dst.clear();
+      dst.addAll(src);
+    end;
+
+
+  function fpc_enumset_symdif(const set1, set2: JUEnumSet): JUEnumSet; compilerproc;
+    var
+      tmp: JUEnumSet;
+    begin
+      { (set1 + set 2) - (set1 * set2) }
+      result:=JUEnumSet(set1.clone);
+      result.addAll(set2);
+      tmp:=JUEnumSet(set1.clone);
+      tmp.retainAll(set2);
+      result.removeAll(tmp);
+    end;
+
+
+  function fpc_bitset_from_string(const s: unicodestring): FpcBitSet; compilerproc;
+    var
+      i, bits: longint;
+      wc: word;
+    begin
+      { all bits are encoded in the string characters }
+      result:=FpcBitSet.Create(cardinal(length(s)+15) div 16);
+      for i:=1 to length(s) do
+        begin
+          wc:=word(s[i]);
+          if wc=0 then
+            continue;
+          for bits:=15 downto 0 do
+            if (wc and (1 shl bits)) <> 0 then
+              result.&set((i-1)*16+15-bits);
+        end;
+    end;
+
+
+  function fpc_enumset_from_string(dummy: FpcEnumValueObtainable; const s: unicodestring): JUEnumSet; compilerproc;
+    var
+      i, bits: longint;
+      wc: word;
+    begin
+      { all bits are encoded in the string characters }
+      result:=JUEnumSet.noneOf(JLObject(dummy).getClass);
+      for i:=1 to length(s) do
+        begin
+          wc:=word(s[i]);
+          if wc=0 then
+            continue;
+          for bits:=15 downto 0 do
+            if (wc and (1 shl bits)) <> 0 then
+              result.add(dummy.fpcGenericValueOf((i-1)*16+15-bits));
+        end;
+    end;
+
+
+  function fpc_enumset_to_int(const s: JUEnumSet; setbase, setsize: longint): jint; compilerproc;
+    var
+      it: JUIterator;
+      ele: FpcEnumValueObtainable;
+      val: longint;
+    begin
+      it:=s.iterator;
+      result:=0;
+      setsize:=setsize*8;
+      while it.hasNext do
+        begin
+          ele:=FpcEnumValueObtainable(it.next);
+          val:=ele.fpcOrdinal-setbase;
+          result:=result or (1 shl (setsize-val));
+        end;
+    end;
+
+
+  function fpc_enumset_to_long(const s: JUEnumSet; setbase, setsize: longint): jlong; compilerproc;
+    var
+      it: JUIterator;
+      ele: FpcEnumValueObtainable;
+      val: longint;
+    begin
+      it:=s.iterator;
+      result:=0;
+      setsize:=setsize*8;
+      while it.hasNext do
+        begin
+          ele:=FpcEnumValueObtainable(it.next);
+          val:=ele.fpcOrdinal-setbase;
+          result:=result or (1 shl (setsize-val));
+        end;
+    end;
+
+
+  function fpc_bitset_to_int(const s: FpcBitSet; setbase, setsize: longint): jint; compilerproc;
+    var
+      i, val: longint;
+    begin
+      result:=0;
+      setsize:=setsize*8;
+      i:=s.nextSetBit(0);
+      while i>=0 do
+        begin
+          val:=i-setbase;
+          result:=result or (1 shl (setsize-val));
+          i:=s.nextSetBit(i+1);
+        end;
+    end;
+
+
+  function fpc_bitset_to_long(const s: FpcBitSet; setbase, setsize: longint): jlong; compilerproc;
+    var
+      i, val: longint;
+    begin
+      result:=0;
+      setsize:=setsize*8;
+      i:=s.nextSetBit(0);
+      while i>=0 do
+        begin
+          val:=i-setbase;
+          result:=result or (1 shl (setsize-val));
+          i:=s.nextSetBit(i+1);
+        end;
+    end;
+
+
+  function fpc_int_to_bitset(const val: jint; setbase, setsize: jint): FpcBitSet; compilerproc;
+    var
+      i, setval: jint;
+    begin
+      result:=FpcBitSet.create;
+      if val<>0 then
+        begin
+          setsize:=setsize*8;
+          for i:=0 to setsize-1 do
+            if (val and (jint(1) shl (setsize-i)))<>0 then
+              result.&set(i+setbase);
+        end;
+    end;
+
+
+function fpc_long_to_bitset(const val: jint; setbase, setsize: jint): FpcBitSet; compilerproc;
+  var
+    i, setval: jint;
+  begin
+    result:=FpcBitSet.create;
+    if val<>0 then
+      begin
+        setsize:=setsize*8;
+        for i:=0 to setsize-1 do
+          if (val and (jlong(1) shl (setsize-i)))<>0 then
+            result.&set(i+setbase);
+      end;
+  end;
+
+
+  function fpc_enumset_to_bitset(const val: JUEnumSet; fromsetbase, tosetbase: jint): FpcBitSet; compilerproc;
+    var
+      it: JUIterator;
+      ele: FpcEnumValueObtainable;
+      i: longint;
+    begin
+      result:=FpcBitSet.Create;
+      it:=val.iterator;
+      while it.hasNext do
+        begin
+          ele:=FpcEnumValueObtainable(it.next);
+          i:=ele.fpcOrdinal-fromsetbase;
+          result.&set(i+tosetbase);
+        end;
+    end;
+
+
+  function fpc_bitset_to_bitset(const s: FpcBitSet; fromsetbase, tosetbase: jint): FpcBitSet; compilerproc;
+    var
+      i, val: longint;
+    begin
+      result:=FpcBitSet.create;
+      i:=s.nextSetBit(0);
+      while i>=0 do
+        begin
+          val:=i-fromsetbase;
+          result.&set(val+tosetbase);
+          i:=s.nextSetBit(i+1);
+        end;
+    end;
+
+

+ 33 - 0
rtl/java/jseth.inc

@@ -0,0 +1,33 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2011 by Jonas Maebe,
+    members of the Free Pascal development team.
+
+    This file declares support infrastructure for sets under the JVM
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+type
+  { Adds support for a "base" value that is used as lower bound for the set's
+    contents }
+
+  FpcBitSet = class sealed (JUBitSet)
+    function add(elem: jint): FpcBitSet;
+    function addAll(s: FpcBitSet): FpcBitSet;
+    function remove(elem: jint): FpcBitSet;
+    function removeAll(s: FpcBitSet): FpcBitSet;
+    function retainAll(s: FpcBitSet): FpcBitSet;
+    function contains(elem: jint): boolean;
+    function containsAll(s: FpcBitSet): boolean;
+    function symdif(s: FpcBitSet): FpcBitSet;
+    class function range(start, stop: jint): FpcBitSet; static;
+    class function &of(elem: jint): FpcBitSet; static;
+  end;
+

+ 42 - 0
rtl/java/rtti.inc

@@ -87,6 +87,48 @@ procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint;
   end;
 
 
+{ exactly the same as fpc_initialize_array_record, but can't use generic
+  routine because of Java clonable design :( (except by rtti/invoke, but that's
+  not particularly fast either) }
+procedure fpc_initialize_array_bitset_intern(arr: TJObjectArray; normalarrdim: longint; inst: FpcBitSet); external name 'fpc_initialize_array_bitset';
+
+procedure fpc_initialize_array_bitset(arr: TJObjectArray; normalarrdim: longint; inst: FpcBitSet);compilerproc;
+  var
+    i: longint;
+  begin
+    if normalarrdim > 0 then
+      begin
+        for i:=low(arr) to high(arr) do
+          fpc_initialize_array_bitset_intern(TJObjectArray(arr[i]),normalarrdim-1,inst);
+      end
+    else
+      begin
+        for i:=low(arr) to high(arr) do
+          arr[i]:=inst.clone;
+      end;
+  end;
+
+
+{ idem }
+procedure fpc_initialize_array_enumset_intern(arr: TJObjectArray; normalarrdim: longint; inst: JUEnumSet); external name 'fpc_initialize_array_enumset';
+
+procedure fpc_initialize_array_enumset(arr: TJObjectArray; normalarrdim: longint; inst: JUEnumSet);compilerproc;
+  var
+    i: longint;
+  begin
+    if normalarrdim > 0 then
+      begin
+        for i:=low(arr) to high(arr) do
+          fpc_initialize_array_enumset_intern(TJObjectArray(arr[i]),normalarrdim-1,inst);
+      end
+    else
+      begin
+        for i:=low(arr) to high(arr) do
+          arr[i]:=inst.clone;
+      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;

+ 85 - 0
rtl/java/system.pp

@@ -129,6 +129,7 @@ type
 {$i innr.inc}
 {$i jmathh.inc}
 {$i jrech.inc}
+{$i jseth.inc}
 {$i sstringh.inc}
 {$i jdynarrh.inc}
 {$i astringh.inc}
@@ -287,6 +288,7 @@ function min(a,b : longint) : longint;
 {$i ustrings.inc}
 {$i rtti.inc}
 {$i jrec.inc}
+{$i jset.inc}
 {$i jint64.inc}
 
 { copying helpers }
@@ -340,6 +342,48 @@ procedure fpc_copy_jrecord_array(src, dst: TJRecordArray; srcstart: jint = -1; s
   end;
 
 
+procedure fpc_copy_jenumset_array(src, dst: TJEnumSetArray; srcstart: jint = -1; srccopylen: jint = -1);
+  var
+    i: longint;
+    srclen, dstlen: jint;
+  begin
+    srclen:=length(src);
+    dstlen:=length(dst);
+    if srcstart=-1 then
+      srcstart:=0
+    else if srcstart>=srclen then
+      exit;
+    if srccopylen=-1 then
+      srccopylen:=srclen
+    else if srcstart+srccopylen>srclen then
+      srccopylen:=srclen-srcstart;
+    { no arraycopy, have to clone each element }
+    for i:=0 to min(srccopylen,dstlen)-1 do
+      dst[i]:=JUEnumSet(src[srcstart+i].clone);
+  end;
+
+
+procedure fpc_copy_jbitset_array(src, dst: TJBitSetArray; srcstart: jint = -1; srccopylen: jint = -1);
+  var
+    i: longint;
+    srclen, dstlen: jint;
+  begin
+    srclen:=length(src);
+    dstlen:=length(dst);
+    if srcstart=-1 then
+      srcstart:=0
+    else if srcstart>=srclen then
+      exit;
+    if srccopylen=-1 then
+      srccopylen:=srclen
+    else if srcstart+srccopylen>srclen then
+      srccopylen:=srclen-srcstart;
+    { no arraycopy, have to clone each element }
+    for i:=0 to min(srccopylen,dstlen)-1 do
+      dst[i]:=JUBitset(src[srcstart+i].clone);
+  end;
+
+
 procedure fpc_copy_jshortstring_array(src, dst: TShortstringArray; srcstart: jint = -1; srccopylen: jint = -1);
   var
     i: longint;
@@ -405,6 +449,33 @@ function fpc_setlength_dynarr_jrecord(aorg, anew: TJRecordArray; deepcopy: boole
   end;
 
 
+function fpc_setlength_dynarr_jenumset(aorg, anew: TJEnumSetArray; deepcopy: boolean): TJEnumSetArray;
+  begin
+    if deepcopy or
+       (length(aorg)<>length(anew)) then
+      begin
+        fpc_copy_jenumset_array(aorg,anew);
+        result:=anew
+      end
+    else
+      result:=aorg;
+  end;
+
+
+function fpc_setlength_dynarr_jbitset(aorg, anew: TJBitSetArray; deepcopy: boolean): TJBitSetArray;
+  begin
+    if deepcopy or
+       (length(aorg)<>length(anew)) then
+      begin
+        fpc_copy_jbitset_array(aorg,anew);
+        result:=anew
+      end
+    else
+      result:=aorg;
+  end;
+
+
+
 function fpc_setlength_dynarr_jshortstring(aorg, anew: TShortstringArray; deepcopy: boolean): TShortstringArray;
   begin
     if deepcopy or
@@ -451,6 +522,20 @@ function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: bool
               for i:=succ(partdone) to high(result) do
                 result[i]:=JLObject(fpc_setlength_dynarr_jrecord(nil,TJRecordArray(anew[i]),deepcopy));
             end;
+          FPCJDynArrTypeEnumSet:
+            begin
+              for i:=low(result) to partdone do
+                result[i]:=JLObject(fpc_setlength_dynarr_jenumset(TJEnumSetArray(aorg[i]),TJEnumSetArray(anew[i]),deepcopy));
+              for i:=succ(partdone) to high(result) do
+                result[i]:=JLObject(fpc_setlength_dynarr_jenumset(nil,TJEnumSetArray(anew[i]),deepcopy));
+            end;
+          FPCJDynArrTypeBitSet:
+            begin
+              for i:=low(result) to partdone do
+                result[i]:=JLObject(fpc_setlength_dynarr_jbitset(TJBitSetArray(aorg[i]),TJBitSetArray(anew[i]),deepcopy));
+              for i:=succ(partdone) to high(result) do
+                result[i]:=JLObject(fpc_setlength_dynarr_jbitset(nil,TJBitSetArray(anew[i]),deepcopy));
+            end;
           FPCJDynArrTypeShortstring:
             begin
               for i:=low(result) to partdone do