+ dynamic array support for the JVM target: setlength(), length(), high():

o since the JVM does not support call-by-reference, setlength() works
     by taking an argument pointing to the old array and one to the new
     array (the latter is always created in advance on the caller side,
     even if not strictly required, because we cannot easily create it
     on the callee side in an efficient way). Then we copy parts of the
     old array to the new array as necessary
   o to represent creating a new dynamic array, the JVM target uses
     an in_new_x tinlinenode
  + tasnode support for the JVM. Special: it can also be used to convert
    java.lang.Object to dynamic arrays, and dynamic arrays of java.lang.Object
    to dynamic arrays with more dimensions (arrays are special JVM objects,
    and such support is required for the setlength support)
  + check whether explicit type conversions are valid, and if so, add the
    necessary conversion code since we cannot simply reinterpret bit patterns
    in most cases in the JVM:
   o in case of class and/or dynamic array types, convert to an as-node
   o in case of int-to-float or float-to-int, use java.lang.Float/Double
     helpers (+ added the definitions of these helpers to the system unit)

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

.gitattributes

@@ -7343,6 +7343,7 @@ rtl/inc/wstrings.inc svneol=native#text/plain
 rtl/inc/wustrings.inc svneol=native#text/plain
 rtl/java/Makefile svneol=native#text/plain
 rtl/java/Makefile.fpc svneol=native#text/plain
+rtl/java/jdynarrh.inc svneol=native#text/plain
 rtl/java/jmathh.inc svneol=native#text/plain
 rtl/java/objpas.pp svneol=native#text/plain
 rtl/java/rtl.cfg svneol=native#text/plain

compiler/jvm/aasmcpu.pas

@@ -51,6 +51,8 @@ uses
          constructor op_ref(op : tasmop;const _op1 : treference);
          constructor op_sym(op : tasmop;_op1 : tasmsymbol);
 
+         constructor op_sym_const(op : tasmop;_op1 : tasmsymbol;_op2 : aint);
+
          constructor op_single(op : tasmop;_op1 : single);
          constructor op_double(op : tasmop;_op1 : double);
          constructor op_string(op : tasmop;_op1len : aint;_op1 : pchar);
@@ -125,6 +127,16 @@ implementation
         loadsymbol(0,_op1,0);
       end;
 
+
+    constructor taicpu.op_sym_const(op: tasmop; _op1: tasmsymbol; _op2: aint);
+      begin
+        inherited create(op);
+        ops:=2;
+        loadsymbol(0,_op1,0);
+        loadconst(1,_op2);
+      end;
+
+
     constructor taicpu.op_single(op: tasmop; _op1: single);
       begin
         inherited create(op);

compiler/jvm/hlcgcpu.pas

@@ -113,6 +113,11 @@ uses
 
       procedure g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation); override;
 
+      { assumes that initdim dimensions have already been pushed on the
+        evaluation stack, and creates a new array of type arrdef with these
+        dimensions }
+      procedure g_newarray(list : TAsmList; arrdef: tdef; initdim: longint);
+
       { this routine expects that all values are already massaged into the
         required form (sign bits xor'ed for gt/lt comparisons for OS_32/OS_64,
         see http://stackoverflow.com/questions/4068973/c-performing-signed-comparison-in-unsigned-variables-without-casting ) }
@@ -169,7 +174,7 @@ implementation
     verbose,cutils,globals,
     defutil,
     aasmtai,aasmcpu,
-    symconst,
+    symconst,jvmdef,
     procinfo,cgcpu;
 
   const
@@ -463,7 +468,6 @@ implementation
       end;
     end;
 
-
   procedure thlcgjvm.g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation);
 
     procedure handle_reg_move(regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
@@ -521,6 +525,62 @@ implementation
       end;
     end;
 
+  procedure thlcgjvm.g_newarray(list: TAsmList; arrdef: tdef; initdim: longint);
+    var
+      recref: treference;
+      elemdef: tdef;
+      i: longint;
+      mangledname: string;
+      opc: tasmop;
+      primitivetype: boolean;
+    begin
+      elemdef:=arrdef;
+      if initdim>1 then
+        begin
+          { multianewarray typedesc ndim }
+          list.concat(taicpu.op_sym_const(a_multianewarray,
+            current_asmdata.RefAsmSymbol(jvmarrtype(elemdef,primitivetype)),initdim));
+          { has to be a multi-dimensional array type }
+          if primitivetype then
+            internalerror(2011012207);
+        end
+      else
+        begin
+          { for primitive types:
+              newarray typedesc
+            for reference types:
+              anewarray typedesc
+          }
+          { get the type of the elements of the array we are creating }
+          elemdef:=tarraydef(arrdef).elementdef;
+          mangledname:=jvmarrtype(elemdef,primitivetype);
+          if primitivetype then
+            opc:=a_newarray
+          else
+            opc:=a_anewarray;
+          list.concat(taicpu.op_sym(opc,current_asmdata.RefAsmSymbol(mangledname)));
+        end;
+      { all dimensions are removed from the stack, an array reference is
+        added }
+      decstack(list,initdim-1);
+      { in case of an array of records, initialise }
+      elemdef:=tarraydef(arrdef).elementdef;
+      for i:=1 to pred(initdim) do
+        elemdef:=tarraydef(elemdef).elementdef;
+      if elemdef.typ=recorddef then
+        begin
+          { duplicate array reference }
+          list.concat(taicpu.op_none(a_dup));
+          incstack(list,1);
+          a_load_const_stack(list,s32inttype,initdim-1,R_INTREGISTER);
+          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');
+          tg.ungettemp(list,recref);
+          decstack(list,3);
+        end;
+    end;
+
     procedure thlcgjvm.a_cmp_stack_label(list: TAsmlist; size: tdef; cmp_op: topcmp; lab: tasmlabel);
       const
         opcmp2icmp: array[topcmp] of tasmop = (A_None,

compiler/jvm/njvmcnv.pas

@@ -25,11 +25,11 @@ unit njvmcnv;
 interface
 
     uses
-      node,ncnv,ncgcnv,defcmp;
+      node,ncnv,ncgcnv,
+      symtype;
 
     type
        tjvmtypeconvnode = class(tcgtypeconvnode)
-         protected
           procedure second_int_to_int;override;
          { procedure second_string_to_string;override; }
          { procedure second_cstring_to_pchar;override; }
@@ -50,16 +50,26 @@ interface
          { procedure second_pchar_to_string;override; }
          { procedure second_class_to_intf;override; }
          { procedure second_char_to_char;override; }
+         protected
+          function target_specific_explicit_typeconv: tnode; override;
+       end;
+
+       tjvmasnode = class(tcgasnode)
+        protected
+         function target_specific_typecheck: boolean;override;
+        public
+         function pass_1 : tnode;override;
+         procedure pass_generate_code; override;
        end;
 
 implementation
 
    uses
       verbose,globals,globtype,
-      symconst,symtype,symdef,aasmbase,aasmdata,
-      defutil,
+      symconst,symdef,symsym,symtable,aasmbase,aasmdata,
+      defutil,defcmp,jvmdef,
       cgbase,cgutils,pass_1,pass_2,
-      ncon,ncal,procinfo,
+      nbas,ncon,ncal,nld,nmem,procinfo,
       nutils,
       cpubase,aasmcpu,
       tgobj,hlcgobj,hlcgcpu;
@@ -333,6 +343,203 @@ implementation
      end;
 
 
+    procedure get_most_nested_types(var fromdef, todef: tdef);
+      begin
+       while is_dynamic_array(fromdef) and
+             is_dynamic_array(todef) do
+         begin
+           fromdef:=tarraydef(fromdef).elementdef;
+           todef:=tarraydef(todef).elementdef;
+         end;
+      end;
+
+
+    function tjvmtypeconvnode.target_specific_explicit_typeconv: tnode;
+
+      { handle explicit typecast from int to to real or vice versa }
+      function int_real_explicit_typecast(fdef: tfloatdef; const singlemethod, doublemethod: string): tnode;
+        var
+          csym: ttypesym;
+          psym: tsym;
+        begin
+         { use the float/double to raw bits methods to get the bit pattern }
+          if fdef.floattype=s32real then
+            begin
+              csym:=search_system_type('TJFLOAT');
+              psym:=search_struct_member(tobjectdef(csym.typedef),singlemethod);
+            end
+          else
+            begin
+              csym:=search_system_type('TJDOUBLE');
+              psym:=search_struct_member(tobjectdef(csym.typedef),doublemethod);
+            end;
+          if not assigned(psym) or
+             (psym.typ<>procsym) then
+            internalerror(2011012901);
+          { call the (static class) method to get the raw bits }
+          result:=ccallnode.create(ccallparanode.create(left,nil),
+            tprocsym(psym),psym.owner,
+            cloadvmtaddrnode.create(ctypenode.create(csym.typedef)),[]);
+          { convert the result to the result type of this type conversion node }
+          inserttypeconv_explicit(result,resultdef);
+          { left is reused }
+          left:=nil;
+        end;
+
+
+      var
+        frominclass,
+        toinclass: boolean;
+        fromdef,
+        todef: tdef;
+      begin
+        result:=nil;
+        { This routine is only called for explicit typeconversions of same-sized
+          entities that aren't handled by normal type conversions -> bit pattern
+          reinterpretations. In the JVM, many of these also need special
+          handling because of the type safety. }
+
+        { don't allow conversions between object-based and non-object-based
+          types }
+        frominclass:=
+          (left.resultdef.typ=objectdef) or
+          is_dynamic_array(left.resultdef);
+        toinclass:=
+          (resultdef.typ=objectdef) or
+          is_dynamic_array(resultdef);
+        if frominclass and
+           toinclass then
+          begin
+            { we need an as-node to check the validity of the conversion (since
+              it wasn't handled by another type conversion, we know it can't
+              have been valid normally)
+
+              Exception: (most nested) destination is java.lang.Object, since
+                everything is compatible with that type }
+            fromdef:=left.resultdef;
+            todef:=resultdef;
+            get_most_nested_types(fromdef,todef);
+            if ((fromdef.typ<>objectdef) and
+                not is_dynamic_array(fromdef)) or
+               (todef<>java_jlobject) then
+              begin
+                result:=casnode.create(left,ctypenode.create(resultdef));
+                left:=nil;
+              end;
+            exit;
+          end;
+
+        { don't allow conversions between different classes of primitive types,
+          except for a few special cases }
+
+        { float to int/enum explicit type conversion: get the bits }
+        if (left.resultdef.typ=floatdef) and
+           (is_integer(resultdef) or
+            (resultdef.typ=enumdef)) then
+          begin
+            result:=int_real_explicit_typecast(tfloatdef(left.resultdef),'FLOATTORAWINTBITS','DOUBLETORAWLONGBITS');
+            exit;
+          end;
+        { int to float explicit type conversion: also use the bits }
+        if (is_integer(left.resultdef) or
+            (left.resultdef.typ=enumdef)) and
+           (resultdef.typ=floatdef) then
+          begin
+            result:=int_real_explicit_typecast(tfloatdef(resultdef),'INTBITSTOFLOAT','LONGBITSTODOUBLE');
+            exit;
+          end;
+        { nothing special required when going between ordinals and enums }
+        if (left.resultdef.typ in [orddef,enumdef])=(resultdef.typ in [orddef,enumdef]) then
+          exit;
+
+        { Todo:
+            * int to set and vice versa
+            * set to float and vice versa (via int) (maybe)
+            * regular array of primitive to primitive and vice versa (maybe)
+            * packed record to primitive and vice versa (maybe)
+          Definitely not:
+            * unpacked record to anything and vice versa (no alignment rules
+              for Java)
+        }
+        { anything not explicitly handled is a problem }
+        CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
+      end;
+
+    {*****************************************************************************
+                                 TJVMAsNode
+    *****************************************************************************}
+
+  function tjvmasnode.target_specific_typecheck: boolean;
+    var
+      fromelt, toelt: tdef;
+    begin
+      { dynamic arrays can be converted to java.lang.Object and vice versa }
+      if right.resultdef=java_jlobject then
+        { dynamic array to java.lang.Object }
+        result:=is_dynamic_array(left.resultdef)
+      else if is_dynamic_array(right.resultdef) then
+        begin
+          { <x> to dynamic array: only if possibly valid }
+          fromelt:=left.resultdef;
+          toelt:=right.resultdef;
+          get_most_nested_types(fromelt,toelt);
+          { final levels must be convertable:
+              a) from dynarray to java.lang.Object or vice versa, or
+              b) the same primitive/class type
+          }
+          result:=
+           (compare_defs(fromelt,toelt,left.nodetype) in [te_exact,te_equal]) or
+           (((fromelt.typ=objectdef) or
+             is_dynamic_array(fromelt)) and
+            ((toelt.typ=objectdef) or
+             is_dynamic_array(toelt)));
+        end
+      else
+        begin
+          { full class reference support requires using the Java reflection API,
+            not yet implemented }
+          if (right.nodetype<>typen) then
+            internalerror(2011012601);
+          result:=false;
+        end;
+      if result then
+        resultdef:=right.resultdef;
+    end;
+
+
+  function tjvmasnode.pass_1: tnode;
+    begin
+      { call-by-reference does not exist in Java, so it's no problem to
+        change a memory location to a register }
+      firstpass(left);
+      expectloc:=LOC_REGISTER;
+      result:=nil;
+    end;
+
+
+  procedure tjvmasnode.pass_generate_code;
+    begin
+      secondpass(left);
+      thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,resultdef,left.location);
+      location_freetemp(current_asmdata.CurrAsmList,left.location);
+      { Perform a checkcast instruction, which will raise an exception in case
+        the actual type does not match/inherit from the expected type.
+
+        Object types need the full type name (package+class name), arrays only
+        the array definition }
+      if resultdef.typ=objectdef then
+        current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_checkcast,current_asmdata.RefAsmSymbol(tobjectdef(resultdef).jvm_full_typename)))
+      else
+        current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_checkcast,current_asmdata.RefAsmSymbol(jvmencodetype(resultdef))));
+      location_reset(location,LOC_REGISTER,OS_ADDR);
+      location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
+      thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
+    end;
+
+
+
+
 begin
   ctypeconvnode:=tjvmtypeconvnode;
+  casnode:=tjvmasnode;
 end.

compiler/jvm/njvminl.pas

@@ -31,6 +31,14 @@ interface
 
     type
        tjvminlinenode = class(tcginlinenode)
+         protected
+          function typecheck_length(var handled: boolean): tnode;
+          function typecheck_high(var handled: boolean): tnode;
+          function typecheck_new(var handled: boolean): tnode;
+         public
+          { typecheck override to intercept handling }
+          function pass_typecheck: tnode; override;
+
           { first pass override
             so that the code generator will actually generate
             these nodes.
@@ -42,6 +50,12 @@ interface
           function first_trunc_real: tnode; override;
 (*
           function first_round_real: tnode; override;
+*)
+          function first_new: tnode; override;
+          function first_setlength: tnode; override;
+
+          procedure second_length; override;
+(*
           procedure second_sqrt_real; override;
           procedure second_abs_real; override;
 *)
@@ -50,6 +64,7 @@ interface
 (*
           procedure second_round_real; override;
 *)
+          procedure second_new; override;
        protected
           procedure load_fpu_location;
        end;
@@ -57,11 +72,12 @@ interface
 implementation
 
     uses
-      cutils,globals,verbose,globtype,
-      aasmtai,aasmdata,aasmcpu,
-      symconst,symdef,
+      cutils,globals,verbose,globtype,constexp,
+      aasmbase,aasmtai,aasmdata,aasmcpu,
+      symtype,symconst,symdef,symtable,jvmdef,
       defutil,
-      cgbase,pass_2,
+      nbas,ncon,ncnv,ncal,nld,
+      cgbase,pass_1,pass_2,
       cpuinfo,ncgutil,
       cgutils,hlcgobj,hlcgcpu;
 
@@ -69,6 +85,99 @@ implementation
 {*****************************************************************************
                               tjvminlinenode
 *****************************************************************************}
+
+    function tjvminlinenode.typecheck_length(var handled: boolean): tnode;
+      begin
+        typecheckpass(left);
+        if is_dynamic_array(left.resultdef) then
+          begin
+            resultdef:=s32inttype;
+            result:=nil;
+            handled:=true;
+          end;
+      end;
+
+
+    function tjvminlinenode.typecheck_high(var handled: boolean): tnode;
+      begin
+        typecheckpass(left);
+        if is_dynamic_array(left.resultdef) then
+          begin
+            { replace with pred(length(arr)) }
+            result:=cinlinenode.create(in_pred_x,false,
+              cinlinenode.create(in_length_x,false,left));
+            left:=nil;
+            handled:=true;
+          end;
+      end;
+
+
+    function tjvminlinenode.typecheck_new(var handled: boolean): tnode;
+      var
+        para: tcallparanode;
+        elemdef: tdef;
+      begin
+        { normally never exists; used by the JVM backend to create new
+          arrays because it requires special opcodes }
+        tcallparanode(left).get_paratype;
+        if is_dynamic_array(left.resultdef) then
+          begin
+            para:=tcallparanode(left);
+            { need at least one extra parameter in addition to the
+              array }
+            if not assigned(para.right) then
+              internalerror(2011012206);
+            elemdef:=tarraydef(left.resultdef).elementdef;
+            while elemdef.typ=arraydef do
+              begin
+                { if we have less length specifiers than dimensions, make
+                  the last array an array of length 0 }
+                if not assigned(para.right) then
+                  begin
+                    para.right:=ccallparanode.create(
+                      cordconstnode.create(0,s32inttype,false),nil);
+                    tcallparanode(para.right).get_paratype;
+                    break;
+                  end
+                else
+                  begin
+                    inserttypeconv(tcallparanode(para.right).left,s32inttype);
+                    tcallparanode(para.right).get_paratype;
+                  end;
+                para:=tcallparanode(para.right);
+                elemdef:=tarraydef(elemdef).elementdef;
+              end;
+            result:=nil;
+            resultdef:=left.resultdef;
+            handled:=true;
+          end;
+      end;
+
+
+    function tjvminlinenode.pass_typecheck: tnode;
+      var
+        handled: boolean;
+      begin
+         handled:=false;
+         case inlinenumber of
+           in_length_x:
+             begin
+               result:=typecheck_length(handled);
+             end;
+           in_high_x:
+             begin
+               result:=typecheck_high(handled);
+             end;
+           in_new_x:
+             begin
+               result:=typecheck_new(handled);
+             end;
+         end;
+        if not handled then
+          result:=inherited pass_typecheck;
+      end;
+
+
 (*
     function tjvminlinenode.first_sqrt_real : tnode;
       begin
@@ -95,6 +204,163 @@ implementation
         first_trunc_real:=nil;
       end;
 
+
+    function tjvminlinenode.first_new: tnode;
+      begin
+        { skip the array; it's a type node }
+        tcallparanode(tcallparanode(left).right).firstcallparan;
+        expectloc:=LOC_REGISTER;
+        result:=nil;
+      end;
+
+
+    function tjvminlinenode.first_setlength: tnode;
+      var
+        assignmenttarget,
+        ppn,
+        newparas: tnode;
+        newnode: tnode;
+        eledef,
+        objarraydef: tdef;
+        ndims: longint;
+        finaltype: char;
+        setlenroutine: string;
+        lefttemp: ttempcreatenode;
+        newblock: tblocknode;
+        newstatement: tstatementnode;
+        primitive: boolean;
+      begin
+        { reverse the parameter order so we can process them more easily }
+        left:=reverseparameters(tcallparanode(left));
+        { first parameter is the array, the rest are the dimensions }
+        newparas:=tcallparanode(left).right;
+        tcallparanode(left).right:=nil;
+        { count the number of specified dimensions, and determine the type of
+          the final one }
+        ppn:=newparas;
+        eledef:=tarraydef(left.resultdef).elementdef;
+        { ppn already points to the first dimension }
+        ndims:=1;
+        while assigned(tcallparanode(ppn).right) do
+          begin
+            inc(ndims);
+            eledef:=tarraydef(eledef).elementdef;
+            ppn:=tcallparanode(ppn).right;
+          end;
+        { prepend type parameter for the array }
+        newparas:=ccallparanode.create(ctypenode.create(left.resultdef),newparas);
+        ttypenode(tcallparanode(newparas).left).allowed:=true;
+        { node to create the new array }
+        newnode:=cinlinenode.create(in_new_x,false,newparas);
+        { Common parameters for setlength helper }
+        { start with org (save assignmenttarget itself to assign the result back to) }
+        { store left into a temp in case it may contain a function call
+          (which must not be evaluated twice) }
+        lefttemp:=maybereplacewithtempref(tcallparanode(left).left,tcallparanode(left).left.resultdef.size,false);
+        if assigned(lefttemp) then
+          begin
+            newblock:=internalstatements(newstatement);
+            addstatement(newstatement,lefttemp);
+            assignmenttarget:=ctemprefnode.create(lefttemp);
+            typecheckpass(tnode(assignmenttarget));
+          end
+        else
+          assignmenttarget:=tcallparanode(left).left.getcopy;
+        newparas:=left;
+        left:=nil;
+        { if more than 1 dimension, typecast to generic array of tobject }
+        if ndims>1 then
+          begin
+            objarraydef:=search_system_type('TJOBJECTARRAY').typedef;
+            tcallparanode(newparas).left:=ctypeconvnode.create_explicit(tcallparanode(newparas).left,objarraydef);
+            newnode:=ctypeconvnode.create_explicit(newnode,objarraydef);
+          end;
+        { prepend new }
+        newparas:=ccallparanode.create(newnode,newparas);
+        { prepend deepcopy }
+        newparas:=ccallparanode.create(cordconstnode.create(0,pasbool8type,false),newparas);
+        { call the right setlenght helper }
+        if ndims>1 then
+          begin
+            finaltype:=jvmarrtype_setlength(eledef);
+            setlenroutine:='FPC_SETLENGTH_DYNARR_MULTIDIM';
+            { create proper parameters, from right to left:
+               eletype=finaltype, ndim=ndims, deepcopy=false, new=newnode,
+               assignmenttarget=tcallparanode(left).left }
+            { prepend ndim }
+            newparas:=ccallparanode.create(cordconstnode.create(ndims,s32inttype,false),newparas);
+            { prepend eletype }
+            newparas:=ccallparanode.create(cordconstnode.create(ord(finaltype),cwidechartype,false),newparas);
+          end
+        else
+          begin
+            setlenroutine:=jvmarrtype(eledef,primitive);
+            if not primitive then
+              setlenroutine:='OBJECT'
+            else
+              uppervar(setlenroutine);
+            setlenroutine:='FPC_SETLENGTH_DYNARR_J'+setlenroutine;
+            { create proper parameters, from right to left:
+               deepcopy=false, new=newnode, assignmenttarget=tcallparnode(left).left
+              -> already done in common part above }
+          end;
+        result:=ccallnode.createintern(setlenroutine,newparas);
+        { assign result back to org (no call-by-reference for Java) }
+        result:=cassignmentnode.create(assignmenttarget,
+          ctypeconvnode.create_explicit(result,assignmenttarget.resultdef));
+        if assigned(lefttemp) then
+          begin
+            addstatement(newstatement,result);
+            addstatement(newstatement,ctempdeletenode.create(lefttemp));
+            result:=newblock;
+          end;
+      end;
+
+
+    procedure tjvminlinenode.second_length;
+      var
+        nillab,endlab: tasmlabel;
+      begin
+        if is_dynamic_array(left.resultdef) then
+          begin
+            { inline because we have to use the arraylength opcode, which
+              cannot be represented directly in Pascal. Even though the JVM
+              supports allocated arrays with length=0, we still also have to
+              check for nil pointers because even if FPC always generates
+              allocated empty arrays under all circumstances, external Java
+              code could pass in nil pointers.
+
+              Note that this means that assigned(arr) can be different from
+              length(arr)<>0 when targeting the JVM.
+            }
+
+            { if assigned(arr) then result:=arraylength(arr) else result:=0 }
+            location_reset(location,LOC_REGISTER,OS_S32);
+            location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,s32inttype);
+            secondpass(left);
+            current_asmdata.getjumplabel(nillab);
+            current_asmdata.getjumplabel(endlab);
+            thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
+            current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dup));
+            thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
+            current_asmdata.CurrAsmList.concat(taicpu.op_none(a_aconst_null));
+            thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
+            current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_if_acmpeq,nillab));
+            thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,2);
+            current_asmdata.CurrAsmList.concat(taicpu.op_none(a_arraylength));
+            hlcg.a_jmp_always(current_asmdata.CurrAsmList,endlab);
+            hlcg.a_label(current_asmdata.CurrAsmList,nillab);
+            current_asmdata.CurrAsmList.concat(taicpu.op_none(a_pop));
+            thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
+            current_asmdata.CurrAsmList.concat(taicpu.op_none(a_iconst_0));
+            thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
+            hlcg.a_label(current_asmdata.CurrAsmList,endlab);
+            thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
+          end
+        else
+          internalerror(2011012004);
+      end;
+
 (*
      function tjvminlinenode.first_round_real : tnode;
       begin
@@ -186,6 +452,36 @@ implementation
       end;
 
 
+    procedure tjvminlinenode.second_new;
+      var
+        arr: tnode;
+        hp: tcallparanode;
+        paracount: longint;
+      begin
+        hp:=tcallparanode(left);
+        { we don't second pass this one, it's only a type node }
+        arr:=hp.left;
+        if not is_dynamic_array(arr.resultdef) then
+          internalerror(2011012204);
+        hp:=tcallparanode(hp.right);
+        if not assigned(hp) then
+          internalerror(2011012205);
+        paracount:=0;
+        { put all the dimensions on the stack }
+        repeat
+          inc(paracount);
+          secondpass(hp.left);
+          thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,hp.left.resultdef,hp.left.location);
+          hp:=tcallparanode(hp.right);
+        until not assigned(hp);
+        { create the array }
+        thlcgjvm(hlcg).g_newarray(current_asmdata.CurrAsmList,arr.resultdef,paracount);
+        location_reset(location,LOC_REGISTER,OS_ADDR);
+        location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
+        thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,arr.resultdef,location.register);
+      end;
+
+
 begin
    cinlinenode:=tjvminlinenode;
 end.

compiler/jvmdef.pas

@@ -36,6 +36,9 @@ interface
       and in that case also the failing definition.  }
     function jvmtryencodetype(def: tdef; out encodedtype: string; out founderror: tdef): boolean;
 
+    { same as above, but throws an internal error on failure }
+    function jvmencodetype(def: tdef): string;
+
     { Check whether a type can be used in a JVM methom signature or field
       declaration.  }
     function jvmchecktype(def: tdef; out founderror: tdef): boolean;
@@ -49,6 +52,11 @@ interface
     { generate internal static field name based on regular field name }
     function jvminternalstaticfieldname(const fieldname: string): string;
 
+    { returns type string for a single-dimensional array (different from normal
+      typestring in case of a primitive type) }
+    function jvmarrtype(def: tdef; out primitivetype: boolean): string;
+    function jvmarrtype_setlength(def: tdef): char;
+
 implementation
 
   uses
@@ -251,10 +259,60 @@ implementation
       end;
 
 
+    function jvmarrtype(def: tdef; out primitivetype: boolean): string;
+      var
+        errdef: tdef;
+      begin
+        if not jvmtryencodetype(def,result,errdef) then
+          internalerror(2011012205);
+        primitivetype:=false;
+        if length(result)=1 then
+          begin
+            case result[1] of
+              'Z': result:='boolean';
+              'C': result:='char';
+              'B': result:='byte';
+              'S': result:='short';
+              'I': result:='int';
+              'J': result:='long';
+              'F': result:='float';
+              'D': result:='double';
+              else
+                internalerror(2011012206);
+              end;
+            primitivetype:=true;
+          end;
+        { in other cases, use the actual reference type }
+      end;
+
+
+    function jvmarrtype_setlength(def: tdef): char;
+      var
+        errdef: tdef;
+        res: string;
+      begin
+        if not jvmtryencodetype(def,res,errdef) then
+          internalerror(2011012209);
+        if length(res)=1 then
+          result:=res[1]
+        else
+          result:='A';
+      end;
+
+
 {******************************************************************
                     jvm type validity checking
 *******************************************************************}
 
+   function jvmencodetype(def: tdef): string;
+     var
+       errordef: tdef;
+     begin
+       if not jvmtryencodetype(def,result,errordef) then
+         internalerror(2011012305);
+     end;
+
+
    function jvmchecktype(def: tdef; out founderror: tdef): boolean;
       var
         encodedtype: string;

rtl/java/jdynarrh.inc

@@ -0,0 +1,66 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2011 by Jonas Maebe
+    member of the Free Pascal development team.
+
+    This file implements the helper routines for dyn. Arrays in FPC
+
+    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
+  TJByteArray = array of jbyte;
+  TJShortArray = array of jshort;
+  TJIntArray = array of jint;
+  TJLongArray = array of jlong;
+  TJCharArray = array of jchar;
+  TJFloatArray = array of jfloat;
+  TJDoubleArray = array of jdouble;
+  TJObjectArray = array of tobject;
+
+const
+  FPCJDynArrTypeJByte   = 'B';
+  FPCJDynArrTypeJShort  = 'S';
+  FPCJDynArrTypeJInt    = 'I';
+  FPCJDynArrTypeJLong   = 'J';
+  FPCJDynArrTypeJChar   = 'C';
+  FPCJDynArrTypeJFloat  = 'F';
+  FPCJDynArrTypeJDouble = 'D';
+  FPCJDynArrTypeJObject = 'A';
+
+{ 1-dimensional setlength routines
+
+  Convention: aorg, is the current array, anew: is a newly allocated array of the
+    size specified to setlength. The function either returns org if it had the
+    right size already, or copies (part of) org in new and returns new.
+}
+function fpc_setlength_dynarr_jbyte(aorg, anew: TJByteArray; deepcopy: boolean): TJByteArray;
+function fpc_setlength_dynarr_jshort(aorg, anew: TJShortArray; deepcopy: boolean): TJShortArray;
+function fpc_setlength_dynarr_jint(aorg, anew: TJIntArray; deepcopy: boolean): TJIntArray;
+function fpc_setlength_dynarr_jlong(aorg, anew: TJLongArray; deepcopy: boolean): TJLongArray;
+function fpc_setlength_dynarr_jchar(aorg, anew: TJCharArray; deepcopy: boolean): TJCharArray;
+function fpc_setlength_dynarr_jfloat(aorg, anew: TJFloatArray; deepcopy: boolean): TJFloatArray;
+function fpc_setlength_dynarr_jdouble(aorg, anew: TJDoubleArray; deepcopy: boolean): TJDoubleArray;
+function fpc_setlength_dynarr_jobject(aorg, anew: TJObjectArray; deepcopy: boolean; docopy : boolean = true): TJObjectArray;
+
+{ multi-dimendional setlength routine: all intermediate dimensions are arrays
+  of arrays, so that's the same for all array kinds. Only the type of the final
+  dimension matters.
+
+  org is the current array, new is a newly allocated array of the
+  (multi-demensional) size specified to setlength.
+
+  This routine uses the intermediate levels from the old array if possible so
+  that an unchanged array remains in the same place.
+
+  Warning: ndim must be >= 2 when this routine is called.
+}
+function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: boolean; ndim: longint; eletype: jchar): TJObjectArray;
+

rtl/java/system.pp

@@ -69,6 +69,20 @@ type
     function hashcode: longint;
   end;
 
+  { Java Float class type }
+  TJFloat = class external 'java.lang' name 'Float'
+   constructor create(f: jfloat);
+   class function floatToRawIntBits(f: jfloat): jint; static;
+   class function intBitsToFloat(j: jint): jfloat; static;
+  end;
+
+  { Java Dloat class type }
+  TJDouble = class external 'java.lang' name 'Double'
+   constructor create(d: jdouble);
+   class function doubleToRawLongBits(d: jdouble): jlong; static;
+   class function longBitsToDouble(l: jlong): jdouble; static;
+  end;
+
 {$i innr.inc}
 {$i jmathh.inc}
 {$i jdynarrh.inc}