+ added hook for "individual value to open array of one element"-conversion,

    so it can be intercepted by the JVM backend (it has to create an actual
    array)
  + JVM support for the elem_2_open_array hook

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

compiler/defcmp.pas

@@ -90,7 +90,8 @@ interface
           tc_enum_2_variant,
           tc_interface_2_variant,
           tc_variant_2_interface,
-          tc_array_2_dynarray
+          tc_array_2_dynarray,
+          tc_elem_2_openarray
        );
 
     function compare_defs_ext(def_from,def_to : tdef;
@@ -680,7 +681,7 @@ implementation
                   (def_from.typ=tarraydef(def_to).elementdef.typ) and
                   equal_defs(def_from,tarraydef(def_to).elementdef) then
                 begin
-                  doconv:=tc_equal;
+                  doconv:=tc_elem_2_openarray;
                   { also update in htypechk.pas/var_para_allowed if changed
                     here }
                   eq:=te_convert_l3;

compiler/jvm/njvmcnv.pas

@@ -54,6 +54,7 @@ interface
          { procedure second_pchar_to_string;override; }
          { procedure second_class_to_intf;override; }
          { procedure second_char_to_char;override; }
+          procedure second_elem_to_openarray; override;
           function target_specific_explicit_typeconv: boolean; override;
           function target_specific_general_typeconv: boolean; override;
          protected
@@ -443,6 +444,36 @@ implementation
      end;
 
 
+    procedure tjvmtypeconvnode.second_elem_to_openarray;
+      var
+        primitivetype: boolean;
+        opc: tasmop;
+        mangledname: string;
+        basereg: tregister;
+        arrayref: treference;
+      begin
+        { create an array with one element of the required type }
+        thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,1,R_INTREGISTER);
+        mangledname:=jvmarrtype(left.resultdef,primitivetype);
+        if primitivetype then
+          opc:=a_newarray
+        else
+          opc:=a_anewarray;
+        { doesn't change stack height: one int replaced by one reference }
+        current_asmdata.CurrAsmList.concat(taicpu.op_sym(opc,current_asmdata.RefAsmSymbol(mangledname)));
+        { store the data in the newly created array }
+        basereg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
+        thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,java_jlobject,basereg);
+        reference_reset_base(arrayref,basereg,0,4);
+        arrayref.arrayreftype:=art_indexconst;
+        arrayref.indexoffset:=0;
+        hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,arrayref);
+        location_reset_ref(location,LOC_REFERENCE,OS_ADDR,4);
+        tg.gethltemp(current_asmdata.CurrAsmList,java_jlobject,4,tt_normal,location.reference);
+        hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,java_jlobject,java_jlobject,basereg,location.reference);
+      end;
+
+
     procedure get_most_nested_types(var fromdef, todef: tdef);
       begin
        while is_dynamic_array(fromdef) and

compiler/ncgcnv.pas

@@ -50,6 +50,7 @@ interface
          procedure second_ansistring_to_pchar;override;
          procedure second_class_to_intf;override;
          procedure second_char_to_char;override;
+         procedure second_elem_to_openarray;override;
          procedure second_nothing;override;
          procedure pass_generate_code;override;
 {$ifdef cpuflags}
@@ -705,6 +706,12 @@ interface
         internalerror(2007081202);
       end;
 
+    procedure tcgtypeconvnode.second_elem_to_openarray;
+      begin
+        { nothing special to do by default }
+        second_nothing;
+      end;
+
 
     procedure tcgtypeconvnode.second_nothing;
       var

compiler/ncnv.pas

@@ -95,6 +95,7 @@ interface
           function typecheck_variant_to_interface : tnode; virtual;
           function typecheck_interface_to_variant : tnode; virtual;
           function typecheck_array_2_dynarray : tnode; virtual;
+          function typecheck_elem_2_openarray : tnode; virtual;
        private
           function _typecheck_int_to_int : tnode;
           function _typecheck_cord_to_pointer : tnode;
@@ -124,6 +125,7 @@ interface
           function _typecheck_variant_to_interface : tnode;
           function _typecheck_interface_to_variant : tnode;
           function _typecheck_array_2_dynarray : tnode;
+          function _typecheck_elem_2_openarray : tnode;
        protected
           function first_int_to_int : tnode;virtual;
           function first_cstring_to_pchar : tnode;virtual;
@@ -199,6 +201,7 @@ interface
           procedure _second_ansistring_to_pchar;virtual;
           procedure _second_class_to_intf;virtual;
           procedure _second_char_to_char;virtual;
+          procedure _second_elem_to_openarray;virtual;
           procedure _second_nothing; virtual;
 
         protected
@@ -223,6 +226,7 @@ interface
           procedure second_ansistring_to_pchar;virtual;abstract;
           procedure second_class_to_intf;virtual;abstract;
           procedure second_char_to_char;virtual;abstract;
+          procedure second_elem_to_openarray;virtual;abstract;
           procedure second_nothing; virtual;abstract;
        end;
        ttypeconvnodeclass = class of ttypeconvnode;
@@ -904,7 +908,8 @@ implementation
           'tc_enum_2_variant',
           'tc_interface_2_variant',
           'tc_variant_2_interface',
-          'tc_array_2_dynarray'
+          'tc_array_2_dynarray',
+          'tc_elem_2_openarray'
         );
       begin
         inherited printnodeinfo(t);
@@ -1619,6 +1624,12 @@ implementation
       end;
 
 
+    function ttypeconvnode.typecheck_elem_2_openarray : tnode;
+      begin
+        result:=nil;
+      end;
+
+
     function ttypeconvnode._typecheck_int_to_int : tnode;
       begin
         result := typecheck_int_to_int;
@@ -1787,6 +1798,12 @@ implementation
       end;
 
 
+    function ttypeconvnode._typecheck_elem_2_openarray : tnode;
+      begin
+        result := typecheck_elem_2_openarray;
+      end;
+
+
     function ttypeconvnode.target_specific_general_typeconv: boolean;
       begin
         result:=false;
@@ -1901,7 +1918,8 @@ implementation
           { enum_2_variant} @ttypeconvnode._typecheck_enum_to_variant,
           { variant_2_interface} @ttypeconvnode._typecheck_interface_to_variant,
           { interface_2_variant} @ttypeconvnode._typecheck_variant_to_interface,
-          { array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray
+          { array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray,
+          { elem_2_openarray } @ttypeconvnode._typecheck_elem_2_openarray
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -3281,7 +3299,8 @@ implementation
            nil,
            nil,
            nil,
-           nil
+           nil,
+           @ttypeconvnode._first_nothing
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -3490,6 +3509,12 @@ implementation
       end;
 
 
+    procedure ttypeconvnode._second_elem_to_openarray;
+      begin
+        second_elem_to_openarray;
+      end;
+
+
     procedure ttypeconvnode._second_nothing;
       begin
         second_nothing;
@@ -3538,7 +3563,8 @@ implementation
            @ttypeconvnode._second_nothing,  { enum_2_variant }
            @ttypeconvnode._second_nothing,  { variant_2_interface }
            @ttypeconvnode._second_nothing,  { interface_2_variant }
-           @ttypeconvnode._second_nothing   { array_2_dynarray }
+           @ttypeconvnode._second_nothing,  { array_2_dynarray }
+           @ttypeconvnode._second_elem_to_openarray   { elem_2_openarray }
          );
       type
          tprocedureofobject = procedure of object;