* handle string/jlstring/jlobject typecasts properly again after the reworked

    typeconversion handling
  + support for class reference types in the JVM (although without class virtual
    methods, they're not that useful)

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

compiler/jvm/njvmcnv.pas

@@ -471,12 +471,12 @@ implementation
         fromclasscompatible:=
           (left.resultdef.typ=objectdef) or
           is_dynamic_array(left.resultdef) or
-          ((left.resultdef.typ=recorddef) and
+          ((left.resultdef.typ in [recorddef,stringdef]) and
            (resultdef.typ=objectdef));
         toclasscompatible:=
           (resultdef.typ=objectdef) or
           is_dynamic_array(resultdef) or
-          ((resultdef.typ=recorddef) and
+          ((resultdef.typ in [recorddef,stringdef]) and
            (left.resultdef.typ=objectdef));
         if fromclasscompatible and toclasscompatible then
           begin
@@ -520,6 +520,31 @@ implementation
             exit;
           end;
 
+        { from classrefdef to JLClass and JLObject and back }
+        if (left.resultdef.typ=classrefdef) or
+           (resultdef.typ=classrefdef) then
+          begin
+            if (left.resultdef.typ=classrefdef) and
+               (resultdef.typ=classrefdef) then
+              begin
+                if not tclassrefdef(left.resultdef).pointeddef.is_related(resultdef) and
+                   not tclassrefdef(resultdef).pointeddef.is_related(left.resultdef) then
+                 CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
+              end
+            else
+              begin
+                jlclass:=search_system_type('JLCLASS').typedef;
+                if (left.resultdef<>jlclass) and
+                   (left.resultdef<>java_jlobject) and
+                   (resultdef<>jlclass) and
+                   (resultdef<>java_jlobject) then
+                  CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
+              end;
+            result:=true;
+            exit;
+          end;
+
+
         { don't allow conversions between different classes of primitive types,
           except for a few special cases }
 
@@ -636,45 +661,57 @@ implementation
         else
       end;
 
+    function isstringconv(var res: boolean): boolean;
+      begin
+        if is_wide_or_unicode_string(realtodef) then
+          result:=
+            (realfromdef=java_jlobject) or
+            (realfromdef=java_jlstring)
+        else if is_wide_or_unicode_string(realfromdef) then
+          result:=
+            (realtodef=java_jlobject) or
+            (realtodef=java_jlstring)
+        else
+      end;
+
     begin
       realfromdef:=maybe_find_real_class_definition(node.left.resultdef,false);
       realtodef:=node.right.resultdef;
       if realtodef.typ=classrefdef then
         realtodef:=tclassrefdef(realtodef).pointeddef;
       realtodef:=maybe_find_real_class_definition(realtodef,false);
-      if not isrecordconv(result) then
-      { dynamic arrays can be converted to java.lang.Object and vice versa }
-      if realtodef=java_jlobject then
-        { dynamic array to java.lang.Object }
-        result:=is_dynamic_array(realfromdef)
-      else if is_dynamic_array(realtodef) then
-        begin
-          { <x> to dynamic array: only if possibly valid }
-          fromelt:=node.left.resultdef;
-          toelt:=realtodef;
-          get_most_nested_types(fromelt,toelt);
-          { final levels must be convertable:
-              a) from array (dynamic or not) to java.lang.Object or vice versa,
-               or
-              b) the same primitive/class type
-          }
-          if not isrecordconv(result) then
-            result:=
-             (compare_defs(fromelt,toelt,node.left.nodetype) in [te_exact,te_equal]) or
-             (((fromelt.typ=objectdef) or
-               (fromelt.typ=arraydef)) and
-              ((toelt.typ=objectdef) or
-               (toelt.typ=arraydef)));
-        end
-      else
-        begin
-          { full class reference support requires using the Java reflection API,
-            not yet implemented }
-          if (node.right.nodetype<>loadvmtaddrn) or
-             (tloadvmtaddrnode(node.right).left.nodetype<>typen) then
-            internalerror(2011012601);
-          result:=false;
-        end;
+      if not isrecordconv(result) and
+         not isstringconv(result) then
+        { dynamic arrays can be converted to java.lang.Object and vice versa }
+        if realtodef=java_jlobject then
+          { dynamic array to java.lang.Object }
+          result:=is_dynamic_array(realfromdef)
+        else if is_dynamic_array(realtodef) then
+          begin
+            { <x> to dynamic array: only if possibly valid }
+            fromelt:=node.left.resultdef;
+            toelt:=realtodef;
+            get_most_nested_types(fromelt,toelt);
+            { final levels must be convertable:
+                a) from array (dynamic or not) to java.lang.Object or vice versa,
+                 or
+                b) the same primitive/class type
+            }
+            if not isrecordconv(result) then
+              result:=
+               (compare_defs(fromelt,toelt,node.left.nodetype) in [te_exact,te_equal]) or
+               (((fromelt.typ=objectdef) or
+                 (fromelt.typ=arraydef)) and
+                ((toelt.typ=objectdef) or
+                 (toelt.typ=arraydef)));
+          end
+        else
+          begin
+            if (node.right.resultdef.typ<>classrefdef) then
+              result:=false
+            else
+              result:=true;
+          end;
       if result then
         if node.nodetype=asn then
           begin
@@ -688,10 +725,61 @@ implementation
     end;
 
 
-  procedure asis_generate_code(node: tasisnode; opcode: tasmop);
+  function asis_pass_1(node: tasisnode; const methodname: string): tnode;
+    var
+      ps: tsym;
+      call: tnode;
+      jlclass: tobjectdef;
+    begin
+      result:=nil;
+      firstpass(node.left);
+      if not(node.right.nodetype in [typen,loadvmtaddrn]) then
+        begin
+          if (node.nodetype=isn) or
+             not assigned(tasnode(node).call) then
+            begin
+              if not is_javaclassref(node.right.resultdef) then
+                internalerror(2011041920);
+              firstpass(node.right);
+              jlclass:=tobjectdef(search_system_type('JLCLASS').typedef);
+              ps:=search_struct_member(jlclass,methodname);
+              if not assigned(ps) or
+                 (ps.typ<>procsym) then
+                internalerror(2011041910);
+              call:=ccallnode.create(ccallparanode.create(node.left,nil),tprocsym(ps),ps.owner,ctypeconvnode.create_explicit(node.right,jlclass),[]);
+              node.left:=nil;
+              node.right:=nil;
+              firstpass(call);
+              if codegenerror then
+                exit;
+              if node.nodetype=isn then
+                result:=call
+              else
+                begin
+                  tasnode(node).call:=call;
+                  node.expectloc:=call.expectloc;
+                end;
+            end;
+        end
+      else
+        begin
+          node.expectloc:=LOC_REGISTER;
+          result:=nil;
+        end;
+    end;
+
+
+  function asis_generate_code(node: tasisnode; opcode: tasmop): boolean;
     var
       checkdef: tdef;
     begin
+      if (node.nodetype=asn) and
+         assigned(tasnode(node).call) then
+        begin
+          result:=false;
+          exit;
+        end;
+      result:=true;
       secondpass(node.left);
       thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,node.left.resultdef,node.left.location);
       location_freetemp(current_asmdata.CurrAsmList,node.left.location);
@@ -727,19 +815,14 @@ implementation
 
   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);
-      if right.nodetype<>typen then
-        firstpass(right);
-      expectloc:=LOC_REGISTER;
-      result:=nil;
+      result:=asis_pass_1(self,'CAST');
     end;
 
 
   procedure tjvmasnode.pass_generate_code;
     begin
-      asis_generate_code(self,a_checkcast);
+      if not asis_generate_code(self,a_checkcast) then
+        inherited;
     end;
 
 
@@ -756,17 +839,14 @@ implementation
 
   function tjvmisnode.pass_1: tnode;
     begin
-      firstpass(left);
-      if right.nodetype<>typen then
-        firstpass(right);
-      expectloc:=LOC_REGISTER;
-      result:=nil;
+      result:=asis_pass_1(self,'ISINSTANCE');
     end;
 
 
   procedure tjvmisnode.pass_generate_code;
     begin
-      asis_generate_code(self,a_instanceof);
+      if not asis_generate_code(self,a_instanceof) then
+        inherited;
     end;
 
 

compiler/jvm/njvmmem.pas

@@ -31,6 +31,10 @@ interface
       node,nmem,ncgmem;
 
     type
+       tjvmloadvmtaddrnode = class(tcgloadvmtaddrnode)
+         procedure pass_generate_code; override;
+       end;
+
        tjvmloadparentfpnode = class(tcgloadparentfpnode)
          procedure pass_generate_code;override;
        end;
@@ -47,9 +51,24 @@ implementation
       cutils,verbose,constexp,
       symconst,symtype,symtable,symsym,symdef,defutil,
       nadd,ncal,ncnv,ncon,
-      aasmdata,pass_2,
+      aasmdata,aasmcpu,pass_2,
       cgutils,hlcgobj,hlcgcpu;
 
+{*****************************************************************************
+                         TJVMLOADVMTADDRNODE
+*****************************************************************************}
+
+    procedure tjvmloadvmtaddrnode.pass_generate_code;
+      begin
+        current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_ldc,current_asmdata.RefAsmSymbol(
+          tobjectdef(tclassrefdef(resultdef).pointeddef).jvm_full_typename(true))));
+        thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
+        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;
+
+
     { tjvmloadparentfpnode }
 
     procedure tjvmloadparentfpnode.pass_generate_code;
@@ -168,4 +187,5 @@ implementation
 
 begin
    cvecnode:=tjvmvecnode;
+   cloadvmtaddrnode:=tjvmloadvmtaddrnode;
 end.

compiler/ncgmem.pas

@@ -101,14 +101,6 @@ implementation
         entry   : PHashSetItem;
 
       begin
-{$ifdef jvm}
-{$ifndef nounsupported}
-         location_reset(location,LOC_REGISTER,OS_ADDR);
-         location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
-         hlcg.a_load_const_reg(current_asmdata.CurrAsmList,java_jlobject,0,location.register);
-         exit;
-{$endif nounsupported}
-{$endif jvm}
          location_reset(location,LOC_REGISTER,OS_ADDR);
          if (left.nodetype=typen) then
            begin

compiler/nmem.pas

@@ -235,12 +235,24 @@ implementation
                  { reused }
                  left:=nil;
                end
+             else if is_javaclass(left.resultdef) and
+                (left.nodetype<>typen) then
+               begin
+                 { call java.lang.Object.getClass() }
+                 vs:=search_struct_member(tobjectdef(left.resultdef),'GETCLASS');
+                 if not assigned(vs) or
+                    (tsym(vs).typ<>procsym) then
+                   internalerror(2011041901);
+                 result:=ccallnode.create(nil,tprocsym(vs),vs.owner,left,[]);
+                 inserttypeconv_explicit(result,resultdef);
+               end
              else
                firstpass(left)
            end
          else if not is_objcclass(left.resultdef) and
                  not is_objcclassref(left.resultdef) and
-                 not is_javaclass(left.resultdef) then
+                 not is_javaclass(left.resultdef) and
+                 not is_javaclassref(left.resultdef) then
            begin
              if not(nf_ignore_for_wpo in flags) and
                 (not assigned(current_procinfo) or

compiler/symdef.pas

@@ -644,6 +644,7 @@ interface
           function alignment : shortint;override;
           function  needs_inittable : boolean;override;
           function  getvardef:longint;override;
+          function  is_related(d : tdef) : boolean;override;
        end;
 
        { tenumdef }
@@ -871,6 +872,7 @@ interface
     function is_record(def: tdef): boolean;
 
     function is_javaclass(def: tdef): boolean;
+    function is_javaclassref(def: tdef): boolean;
     function is_javainterface(def: tdef): boolean;
     function is_java_class_or_interface(def: tdef): boolean;
 
@@ -1601,6 +1603,15 @@ implementation
         result:=vardef[stringtype];
       end;
 
+    function tstringdef.is_related(d: tdef): boolean;
+      begin
+        result:=
+          (target_info.system=system_jvm_java32) and
+          (stringtype in [st_unicodestring,st_widestring]) and
+          ((d=java_jlobject) or
+           (d=java_jlstring));
+      end;
+
 
     function tstringdef.alignment : shortint;
       begin
@@ -6218,6 +6229,14 @@ implementation
           (tobjectdef(def).objecttype=odt_javaclass);
       end;
 
+    function is_javaclassref(def: tdef): boolean;
+      begin
+        is_javaclassref:=
+          assigned(def) and
+          (def.typ=classrefdef) and
+          is_javaclass(tclassrefdef(def).pointeddef);
+      end;
+
     function is_javainterface(def: tdef): boolean;
       begin
         result:=