+ support for pointers to types that are implicit pointer types in the JVM

(non-dynamic arrays, records, shortstrings)
  - removed the ability to typecast such types directly into related class
    types, you have to use the @-operator first now to get a pointer to
    the type
   o updated the RTL and internal compiler code to properly use this
     new convention
   o allowed removing several special cases from
     tjvmtypeconvnode.target_specific_general_typeconv(), and that
     method can probably be removed completely over time
  * no longer give compile time errors for pointer-related typecasts that
    will fail at run time, because the checking was too complex and could
    be worked around via actual pointer typecasts anyway
  * removed some unnecessary checkcast operations (for shortstring/
    shortstringclass)

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

compiler/jvm/njvmcnv.pas

@@ -112,7 +112,9 @@ implementation
           if def1.typ<>procvardef then
             exit;
           if tprocvardef(def1).is_addressonly then
-            result:=def2=java_jlobject
+            result:=
+              (def2=java_jlobject) or
+              (def2=voidpointertype)
           else
             begin
               if not assigned(tmethoddef) then
@@ -533,6 +535,81 @@ implementation
           left:=nil;
         end;
 
+      function ptr_no_typecheck_required(fromdef, todef: tdef): boolean;
+
+        function check_type_equality(def1,def2: tdef): boolean;
+          begin
+            result:=true;
+            if is_ansistring(def1) and
+               (def2=java_ansistring) then
+              exit;
+            if is_wide_or_unicode_string(def1) and
+               (def2=java_jlstring) then
+              exit;
+            if def1.typ=pointerdef then
+              begin
+                if is_shortstring(tpointerdef(def1).pointeddef) and
+                   (def2=java_shortstring) then
+                  exit;
+              end;
+            result:=false;
+          end;
+
+        function check_array_type_equality(def1,def2: tdef): boolean;
+          begin
+            result:=true;
+            if is_shortstring(def1) and
+               (def2=java_shortstring) then
+              exit;
+            result:=false;
+          end;
+
+        begin
+          result:=true;
+          if (todef=java_jlobject) or
+             (todef=voidpointertype) then
+            exit;
+          if compare_defs(fromdef,todef,nothingn)>=te_equal then
+            exit;
+          { trecorddef.is_related() must work for inheritance/method checking,
+            but do not allow records to be directly typecasted into class/
+            pointer types (you have to use FpcBaseRecordType(@rec) instead) }
+          if not is_record(fromdef) and
+             fromdef.is_related(todef) then
+            exit;
+          if check_type_equality(fromdef,todef) then
+            exit;
+          if check_type_equality(todef,fromdef) then
+            exit;
+          if (fromdef.typ=pointerdef) and
+             (tpointerdef(fromdef).pointeddef.typ=recorddef) and
+             (todef=java_fpcbaserecordtype) then
+            exit;
+          { all classrefs are currently java.lang.Class at the bytecode level }
+          if (fromdef.typ=classrefdef) and
+             (todef.typ=objectdef) and
+             (todef=search_system_type('JLCLASS').typedef) then
+            exit;
+          if (fromdef.typ=classrefdef) and
+             (todef.typ=classrefdef) and
+             tclassrefdef(fromdef).pointeddef.is_related(tclassrefdef(todef).pointeddef) then
+            exit;
+          { special case: "array of shortstring" to "array of ShortstringClass"
+            and "array of <record>" to "array of FpcRecordBaseType" (normally
+            you have to use ShortstringClass(@shortstrvar) etc, but that's not
+            possible in case of passing arrays to e.g. setlength) }
+          if is_dynamic_array(left.resultdef) and
+             is_dynamic_array(resultdef) then
+            begin
+             if check_array_type_equality(fromdef,todef) or
+                check_array_type_equality(todef,fromdef) then
+               exit;
+             if is_record(fromdef) and
+                (todef=java_fpcbaserecordtype) then
+               exit;
+            end;
+          result:=false;
+        end;
 
       var
         fromclasscompatible,
@@ -553,16 +630,18 @@ implementation
           types }
         procvarconv:=isvalidprocvartypeconv(left.resultdef,resultdef);
         fromclasscompatible:=
+          (left.resultdef.typ=pointerdef) or
           (left.resultdef.typ=objectdef) or
           is_dynamic_array(left.resultdef) or
-          ((left.resultdef.typ in [recorddef,stringdef,classrefdef]) and
+          ((left.resultdef.typ in [stringdef,classrefdef]) and
-           (resultdef.typ=objectdef)) or
+           not is_shortstring(left.resultdef)) or
           procvarconv;
         toclasscompatible:=
+          (resultdef.typ=pointerdef) or
           (resultdef.typ=objectdef) or
           is_dynamic_array(resultdef) or
-          ((resultdef.typ in [recorddef,stringdef,classrefdef]) and
+          ((resultdef.typ in [stringdef,classrefdef]) and
-           (left.resultdef.typ=objectdef)) or
+           not is_shortstring(resultdef)) or
           procvarconv;
         if fromclasscompatible and toclasscompatible then
           begin
@@ -582,32 +661,28 @@ implementation
             get_most_nested_types(fromdef,todef);
             fromarrtype:=jvmarrtype_setlength(fromdef);
             toarrtype:=jvmarrtype_setlength(todef);
-            if (compare_defs(fromdef,todef,nothingn)<te_equal) and
+            if not ptr_no_typecheck_required(fromdef,todef) then
-               not fromdef.is_related(todef) and
-               (todef<>java_jlobject) and
-               ((fromarrtype in ['A','R']) or
-                (fromarrtype<>toarrtype)) and
-               ((fromdef.typ<>classrefdef) or
-                (todef.typ<>classrefdef) or
-                not tclassrefdef(fromdef).pointeddef.is_related(tclassrefdef(todef).pointeddef)) then
               begin
-                if not check_only and
+                if (fromarrtype in ['A','R','T']) or
-                   not assignment_side then
+                   (fromarrtype<>toarrtype) then
                   begin
-                    resnode:=ctypenode.create(resultdef);
+                    if not check_only and
-                    if resultdef.typ=objectdef then
+                       not assignment_side then
-                      resnode:=cloadvmtaddrnode.create(resnode);
+                      begin
-                    resnode:=casnode.create(left,resnode);
+                        resnode:=ctypenode.create(resultdef);
-                    if resultdef.typ=classrefdef then
+                        if resultdef.typ=objectdef then
-                      tjvmasnode(resnode).classreftypecast:=true;
+                          resnode:=cloadvmtaddrnode.create(resnode);
-                    left:=nil;
+                        resnode:=casnode.create_internal(left,resnode);
+                        if resultdef.typ=classrefdef then
+                          tjvmasnode(resnode).classreftypecast:=true;
+                        left:=nil;
+                      end
                   end
-              end
+                { typecasting from a child to a parent type on the assignment side
-            { typecasting from a child to a parent type on the assignment side
+                  will (rightly) mess up the type safety verification of the JVM }
-              will (rightly) mess up the type safety verification of the JVM }
+                else if assignment_side then
-            else if assignment_side and
+                  CGMessage(type_e_no_managed_assign_generic_typecast);
-                    (compare_defs(fromdef,todef,nothingn)<te_equal) then
+              end;
-              CGMessage(type_e_no_managed_assign_generic_typecast);
             result:=true;
             exit;
           end;
@@ -702,36 +777,6 @@ implementation
     function tjvmtypeconvnode.target_specific_general_typeconv: boolean;
       begin
         result:=false;
-        { deal with explicit typecasts between records and classes (for
-          FpcBaseRecordType) }
-        if ((left.resultdef.typ=recorddef) and
-            (resultdef.typ=objectdef) and
-            left.resultdef.is_related(resultdef)) or
-           ((left.resultdef.typ=objectdef) and
-            (resultdef.typ=recorddef) and
-            resultdef.is_related(left.resultdef)) and
-           (nf_explicit in flags) then
-          begin
-            convtype:=tc_equal;
-            result:=true;
-            exit;
-          end;
-
-        { deal with explicit typecasts between shortstrings and classes (for
-          ShortstringClass) }
-        if (is_shortstring(left.resultdef) and
-            (resultdef.typ=objectdef) and
-            left.resultdef.is_related(resultdef)) or
-           ((left.resultdef.typ=objectdef) and
-            is_shortstring(resultdef) and
-            resultdef.is_related(left.resultdef)) and
-           (nf_explicit in flags) then
-          begin
-            convtype:=tc_equal;
-            result:=true;
-            exit;
-          end;
-
 {$ifndef nounsupported}
         { generated in nmem; replace voidpointertype with java_jlobject }
         if nf_load_procvar in flags then
@@ -754,169 +799,24 @@ implementation
     *****************************************************************************}
 
   function asis_target_specific_typecheck(node: tasisnode): boolean;
-
-    function isrecordconv(fromdef, todef: tdef): boolean;
-      begin
-        if isvalidprocvartypeconv(fromdef,todef) then
-          begin
-            result:=true;
-            exit;
-          end;
-
-        if is_record(todef) then
-          begin
-            result:=
-              (fromdef=java_jlobject) or
-              (fromdef=java_fpcbaserecordtype);
-          end
-        else if is_record(fromdef) then
-          begin
-            result:=
-              (todef=java_jlobject) or
-              (todef=java_fpcbaserecordtype)
-          end
-        else
-          result:=false;
-      end;
-
-    function isstringconv(fromdef, todef: tdef): boolean;
-
-      function unicodestrcompatible(def: tdef): boolean;
-        begin
-          result:=
-            (def=java_jlobject) or
-            (def=java_jlstring);
-        end;
-
-      function ansistrcompatible(def: tdef): boolean;
-        begin
-          result:=
-            (def=java_jlobject) or
-            (def=java_ansistring);
-        end;
-
-      function shortstrcompatible(def: tdef): boolean;
-        begin
-           result:=
-             (def=java_jlobject) or
-             (def=java_shortstring);
-        end;
-
-      begin
-        if is_wide_or_unicode_string(todef) then
-          begin
-            result:=unicodestrcompatible(fromdef)
-          end
-        else if is_wide_or_unicode_string(fromdef) then
-          begin
-            result:=unicodestrcompatible(todef);
-          end
-        else if is_ansistring(todef) then
-          begin
-            result:=ansistrcompatible(fromdef);
-          end
-        else if is_ansistring(fromdef) then
-          begin
-            result:=ansistrcompatible(todef);
-          end
-        else if is_shortstring(todef) then
-          begin
-            result:=shortstrcompatible(fromdef)
-          end
-        else if is_shortstring(fromdef) then
-          begin
-            result:=shortstrcompatible(todef)
-          end
-        else
-          result:=false;
-      end;
-
-    function isclassrefconv(fromdef, todef: tdef): boolean;
-      var
-        jlclass: tdef;
-      begin
-        jlclass:=nil;
-        if fromdef.typ=classrefdef then
-          begin
-            result:=todef=java_jlobject;
-            if not result and
-               (todef.typ=classrefdef) then
-              { the fromdef.is_related(todef) case should not become an as-node,
-                handled in typeconversion itself and ignored since always ok
-                -- this one is not very useful either since everything is plain
-                JLClass anyway, but maybe in the future it will be different }
-              result:=tclassrefdef(todef).pointeddef.is_related(tclassrefdef(fromdef).pointeddef);
-            if not result then
-              begin
-                jlclass:=search_system_type('JLCLASS').typedef;
-                result:=todef=jlclass;
-              end;
-          end
-        else if todef.typ=classrefdef then
-          begin
-            result:=fromdef=java_jlobject;
-            if not result then
-              begin
-                jlclass:=search_system_type('JLCLASS').typedef;
-                result:=fromdef=jlclass;
-              end;
-          end
-        else
-          result:=false;
-      end;
-
-
     var
-      fromelt, toelt: tdef;
-      realfromdef,
       realtodef: tdef;
     begin
-      if is_java_class_or_interface(node.left.resultdef) and
+      if not(nf_internal in node.flags) then
-         (node.right.resultdef.typ=classrefdef) and
-         ((node.nodetype<>asn) or
-          not tjvmasnode(node).classreftypecast) then
         begin
           { handle using normal code }
           result:=false;
           exit;
         end;
-      realfromdef:=maybe_find_real_class_definition(node.left.resultdef,false);
+      result:=true;
+      { these are converted type conversion nodes, to insert the checkcast
+        operations }
       realtodef:=node.right.resultdef;
       if (realtodef.typ=classrefdef) and
          ((node.nodetype<>asn) or
           not tjvmasnode(node).classreftypecast) then
         realtodef:=tclassrefdef(realtodef).pointeddef;
       realtodef:=maybe_find_real_class_definition(realtodef,false);
-      result:=isrecordconv(realfromdef,realtodef);
-      if not result then
-        result:=isstringconv(realfromdef,realtodef);
-      if not result then
-        result:=isclassrefconv(realfromdef,realtodef);
-      if not 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
-            }
-            result:=
-             isrecordconv(fromelt,toelt) or
-             isstringconv(fromelt,toelt) or
-             (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;
       if result then
         if node.nodetype=asn then
           node.resultdef:=realtodef
@@ -995,6 +895,10 @@ implementation
       else
         checkdef:=node.right.resultdef;
       { replace special types with their equivalent class type }
+      if checkdef=voidpointertype then
+        checkdef:=java_jlobject
+      else if checkdef.typ=pointerdef then
+        checkdef:=tpointerdef(checkdef).pointeddef;
 {$ifndef nounsupported}
       if checkdef.typ=procvardef then
         checkdef:=java_jlobject

compiler/jvm/njvminl.pas

@@ -87,7 +87,7 @@ implementation
       aasmbase,aasmtai,aasmdata,aasmcpu,
       symtype,symconst,symdef,symsym,symtable,jvmdef,
       defutil,
-      nbas,ncon,ncnv,ncal,nld,nflw,nutils,
+      nbas,ncon,ncnv,nmem,ncal,nld,nflw,nutils,
       cgbase,pass_1,pass_2,
       cpuinfo,ncgutil,
       cgutils,hlcgobj,hlcgcpu;
@@ -577,7 +577,7 @@ implementation
               internalerror(2011052402);
             result:=
               ccallnode.create(nil,tprocsym(psym),psym.owner,
-                ctypeconvnode.create_explicit(left,java_shortstring),[]);
+                ctypeconvnode.create_explicit(caddrnode.create_internal(left),java_shortstring),[]);
             { reused }
             left:=nil;
           end

compiler/jvm/njvmld.pas

@@ -93,7 +93,8 @@ function tjvmassignmentnode.pass_1: tnode;
             byte(str[x]):=12;
         }
         inserttypeconv_explicit(right,cchartype);
-        { call ShortstringClass(shortstring).setChar(index,char) }
+        { call ShortstringClass(@shortstring).setChar(index,char) }
+        tvecnode(target).left:=caddrnode.create_internal(tvecnode(target).left);
         inserttypeconv_explicit(tvecnode(target).left,java_shortstring);
         psym:=search_struct_member(tabstractrecorddef(java_shortstring),'SETCHAR');
         if not assigned(psym) or

compiler/jvm/njvmmem.pas

@@ -36,6 +36,11 @@ interface
          procedure pass_generate_code; override;
        end;
 
+       tjvmderefnode = class(tcgderefnode)
+          function pass_typecheck:tnode;override;
+          procedure pass_generate_code; override;
+       end;
+
        tjvmloadvmtaddrnode = class(tcgloadvmtaddrnode)
          procedure pass_generate_code; override;
        end;
@@ -60,6 +65,35 @@ implementation
       aasmdata,aasmcpu,pass_2,
       cgutils,hlcgobj,hlcgcpu;
 
+{*****************************************************************************
+                              TJVMDEREFNODE
+*****************************************************************************}
+
+    function tjvmderefnode.pass_typecheck: tnode;
+      begin
+        result:=inherited;
+        if not(left.resultdef.typ=pointerdef) or
+          not jvmimplicitpointertype(tpointerdef(left.resultdef).pointeddef) then
+          begin
+            CGMessage(parser_e_illegal_expression);
+            exit
+          end;
+      end;
+
+    procedure tjvmderefnode.pass_generate_code;
+      begin
+        secondpass(left);
+        if (left.resultdef.typ=pointerdef) or
+           jvmimplicitpointertype(left.resultdef) then
+          begin
+            { this is basically a typecast: the left node is a regular
+              'pointer', and we typecast it to an implicit pointer }
+            location_copy(location,left.location);
+          end
+        else
+          internalerror(2011052901);
+      end;
+
 {*****************************************************************************
                               TJVMADDRNODE
 *****************************************************************************}
@@ -82,26 +116,15 @@ implementation
           begin
             result:=inherited;
             exit;
-          end;
+          end
-
+        else
-        if not jvmimplicitpointertype(left.resultdef) then
           begin
-            CGMessage(parser_e_illegal_expression);
+            if not jvmimplicitpointertype(left.resultdef) then
-            exit
+              begin
-          end;
+                CGMessage(parser_e_illegal_expression);
-
+                exit
-        resultdef:=java_jlobject;
+              end;
-
+            result:=inherited;
-        if mark_read_written then
-          begin
-            { This is actually only "read", but treat it nevertheless as  }
-            { modified due to the possible use of pointers                }
-            { To avoid false positives regarding "uninitialised"          }
-            { warnings when using arrays, perform it in two steps         }
-            set_varstate(left,vs_written,[]);
-            { vsf_must_be_valid so it doesn't get changed into }
-            { vsf_referred_not_inited                          }
-            set_varstate(left,vs_read,[vsf_must_be_valid]);
           end;
       end;
 
@@ -174,7 +197,10 @@ implementation
               st_widestring:
                 stringclass:=java_jlstring;
               st_shortstring:
-                stringclass:=java_shortstring;
+                begin
+                  stringclass:=java_shortstring;
+                  left:=caddrnode.create_internal(left);
+                end
               else
                 internalerror(2011052407);
             end;
@@ -267,8 +293,9 @@ implementation
 
 
 begin
+   cderefnode:=tjvmderefnode;
+   caddrnode:=tjvmaddrnode;
    cvecnode:=tjvmvecnode;
    cloadparentfpnode:=tjvmloadparentfpnode;
    cloadvmtaddrnode:=tjvmloadvmtaddrnode;
-   caddrnode:=tjvmaddrnode;
 end.

compiler/jvmdef.pas

@@ -236,13 +236,12 @@ implementation
             end;
           pointerdef :
             begin
-{$ifndef nounsupported}
               if def=voidpointertype then
                 result:=jvmaddencodedtype(java_jlobject,false,encodedstr,forcesignature,founderror)
+              else if jvmimplicitpointertype(tpointerdef(def).pointeddef) then
+                result:=jvmaddencodedtype(tpointerdef(def).pointeddef,false,encodedstr,forcesignature,founderror)
               else
-{$endif}
+                result:=false;
-              { some may be handled via wrapping later }
-              result:=false;
             end;
           floatdef :
             begin

compiler/ncnv.pas

@@ -255,6 +255,7 @@ interface
           }
           call: tnode;
           constructor create(l,r : tnode);virtual;
+          constructor create_internal(l,r : tnode);virtual;
           function pass_1 : tnode;override;
           function dogetcopy: tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -264,6 +265,7 @@ interface
 
        tisnode = class(tasisnode)
           constructor create(l,r : tnode);virtual;
+          constructor create_internal(l,r : tnode);virtual;
           function pass_1 : tnode;override;
           procedure pass_generate_code;override;
        end;
@@ -3702,6 +3704,15 @@ implementation
          inherited create(isn,l,r);
       end;
 
+
+    constructor tisnode.create_internal(l, r: tnode);
+
+      begin
+        create(l,r);
+        include(flags,nf_internal);
+      end;
+
+
     function tisnode.pass_1 : tnode;
       var
         procname: string;
@@ -3758,6 +3769,14 @@ implementation
       end;
 
 
+    constructor tasnode.create_internal(l,r : tnode);
+
+      begin
+        create(l,r);
+        include(flags,nf_internal);
+      end;
+
+
     destructor tasnode.destroy;
 
       begin

compiler/symcreat.pas

@@ -255,7 +255,7 @@ implementation
         internalerror(2011032812);
       { the inherited clone will already copy all fields in a shallow way ->
         copy records/regular arrays in a regular way }
-      str:='begin clone:=inherited;';
+      str:='type _fpc_ptrt = ^'+struct.typesym.realname+'; begin clone:=inherited;';
       for i:=0 to struct.symtable.symlist.count-1 do
         begin
           sym:=tsym(struct.symtable.symlist[i]);
@@ -267,7 +267,7 @@ implementation
                   not is_dynamic_array(fsym.vardef)) or
                  ((fsym.vardef.typ=setdef) and
                   not is_smallset(fsym.vardef)) then
-                str:=str+struct.typesym.realname+'(clone).'+fsym.realname+':='+fsym.realname+';';
+                str:=str+'_fpc_ptrt(clone)^.'+fsym.realname+':='+fsym.realname+';';
             end;
         end;
       str:=str+'end;';

compiler/symdef.pas

@@ -1616,10 +1616,7 @@ implementation
              (d=java_jlstring))) or
            ((stringtype=st_ansistring) and
             ((d=java_jlobject) or
-             (d=java_ansistring))) or
+             (d=java_ansistring))));
-           ((stringtype=st_shortstring) and
-            ((d=java_jlobject) or
-             (d=java_shortstring))));
       end;
 
 
@@ -3168,16 +3165,19 @@ implementation
 
     function trecorddef.is_related(d: tdef): boolean;
       begin
-        if d.typ=objectdef then
-          d:=find_real_class_definition(tobjectdef(d),false);
         { records are implemented via classes in the JVM target, and are
           all descendents of the java_fpcbaserecordtype class }
-        if (target_info.system=system_jvm_java32) and
+        is_related:=false;
-           ((d=java_jlobject) or
+        if (target_info.system=system_jvm_java32) then
-            (d=java_fpcbaserecordtype)) then
+          begin
-          is_related:=true
+            if d.typ=objectdef then
-        else
+              begin
-          is_related:=false;
+                d:=find_real_class_definition(tobjectdef(d),false);
+                if (d=java_jlobject) or
+                   (d=java_fpcbaserecordtype) then
+                  is_related:=true
+              end;
+          end;
       end;
 
 

rtl/java/astrings.inc

@@ -52,7 +52,7 @@ end;
 
 constructor AnsistringClass.Create(const s: shortstring);
 begin
-  Create(ShortstringClass(s).fdata);
+  Create(ShortstringClass(@s).fdata);
 end;
 
 
@@ -99,7 +99,7 @@ end;
 
 function AnsistringClass.toShortstring(maxlen: byte): shortstring;
 begin
-  result:=shortstring(ShortstringClass.Create(ansistring(self),maxlen));
+  result:=pshortstring(ShortstringClass.Create(ansistring(self),maxlen))^;
 end;
 
 
@@ -217,7 +217,7 @@ begin
      Size:=Length(S2);
      If Size>high(res) then
        Size:=high(res);
-     JLSystem.ArrayCopy(JLObject(AnsistringClass(S2).fdata),0,JLObject(ShortstringClass(res).fdata),0,Size);
+     JLSystem.ArrayCopy(JLObject(AnsistringClass(S2).fdata),0,JLObject(ShortstringClass(@res).fdata),0,Size);
      setlength(res,Size);
    end;
 end;
@@ -233,7 +233,7 @@ begin
   Size:=Length(S2);
   Setlength (result,Size);
   if Size>0 then
-    JLSystem.ArrayCopy(JLObject(ShortstringClass(S2).fdata),0,JLObject(AnsistringClass(result).fdata),0,Size);
+    JLSystem.ArrayCopy(JLObject(ShortstringClass(@S2).fdata),0,JLObject(AnsistringClass(result).fdata),0,Size);
 end;
 
 
@@ -447,7 +447,7 @@ begin
    ofs:=Length(S);
    SetLength(S,ofs+length(Str));
    { the pbyte cast avoids an unique call which isn't necessary because SetLength was just called }
-   JLSystem.ArrayCopy(JLObject(ShortstringClass(Str).fdata),0,JLObject(AnsistringClass(S).fdata),ofs,length(Str));
+   JLSystem.ArrayCopy(JLObject(ShortstringClass(@Str).fdata),0,JLObject(AnsistringClass(S).fdata),ofs,length(Str));
 end;
 
 Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc;

rtl/java/sstrings.inc

@@ -69,7 +69,7 @@ begin
   if system.length(s)=0 then
     exit;
   curlen:=min(system.length(s),maxlen);
-  JLSystem.ArrayCopy(JLObject(ShortstringClass(s).fdata),0,JLObject(fdata),0,min(system.length(s),maxlen));
+  JLSystem.ArrayCopy(JLObject(ShortstringClass(@s).fdata),0,JLObject(fdata),0,min(system.length(s),maxlen));
 end;
 
 
@@ -101,10 +101,10 @@ var
   i: longint;
 begin
   { used to construct constant shortstrings from Java string constants }
-  ShortstringClass(result).curlen:=min(system.length(u),255);
+  ShortstringClass(@result).curlen:=min(system.length(u),255);
-  setlength(ShortstringClass(result).fdata,ShortstringClass(result).curlen);
+  setlength(ShortstringClass(@result).fdata,ShortstringClass(@result).curlen);
-  for i:=1 to ShortstringClass(result).curlen do
+  for i:=1 to ShortstringClass(@result).curlen do
-    ShortstringClass(result).fdata[i-1]:=ansichar(ord(u[i]));
+    ShortstringClass(@result).fdata[i-1]:=ansichar(ord(u[i]));
 end;
 
 
@@ -149,7 +149,7 @@ end;
 
 function ShortstringClass.toAnsistring: ansistring;
 begin
-  result:=ansistring(AnsistringClass.Create(shortstring(self)));
+  result:=ansistring(AnsistringClass.Create(pshortstring(self)^));
 end;
 
 
@@ -164,7 +164,7 @@ end;
 
 function ShortstringClass.clone: JLObject;
 begin
-  result:=ShortstringClass.Create(Shortstring(self),system.length(fdata));
+  result:=ShortstringClass.Create(pshortstring(self)^,system.length(fdata));
 end;
 
 
@@ -189,7 +189,7 @@ procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
 begin
   if len>255 then
     len:=255;
-  ShortstringClass(s).curlen:=len;
+  ShortstringClass(@s).curlen:=len;
 end;
 
 
@@ -200,8 +200,8 @@ begin
   len:=length(sstr);
   if len>high(res) then
     len:=high(res);
-  ShortstringClass(res).curlen:=len;
+  ShortstringClass(@res).curlen:=len;
-  JLSystem.ArrayCopy(JLObject(ShortstringClass(sstr).fdata),0,JLObject(ShortstringClass(res).fdata),0,len);
+  JLSystem.ArrayCopy(JLObject(ShortstringClass(@sstr).fdata),0,JLObject(ShortstringClass(@res).fdata),0,len);
 end;
 
 
@@ -218,19 +218,19 @@ begin
         s1l:=high(dests);
       s2l:=high(dests)-s1l;
     end;
-  if ShortstringClass(dests)=ShortstringClass(s1) then
+  if ShortstringClass(@dests)=ShortstringClass(@s1) then
-    JLSystem.ArrayCopy(JLObject(ShortstringClass(s2).fdata),0,JLObject(ShortstringClass(dests).fdata),s1l,s2l)
+    JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l)
-  else if ShortstringClass(dests)=ShortstringClass(s2) then
+  else if ShortstringClass(@dests)=ShortstringClass(@s2) then
     begin
-      JLSystem.ArrayCopy(JLObject(ShortstringClass(dests).fdata),0,JLObject(ShortstringClass(dests).fdata),s1l,s2l);
+      JLSystem.ArrayCopy(JLObject(ShortstringClass(@dests).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l);
-      JLSystem.ArrayCopy(JLObject(ShortstringClass(s1).fdata),0,JLObject(ShortstringClass(dests).fdata),0,s1l);
+      JLSystem.ArrayCopy(JLObject(ShortstringClass(@s1).fdata),0,JLObject(ShortstringClass(@dests).fdata),0,s1l);
     end
   else
     begin
-      JLSystem.ArrayCopy(JLObject(ShortstringClass(s1).fdata),0,JLObject(ShortstringClass(dests).fdata),0,s1l);
+      JLSystem.ArrayCopy(JLObject(ShortstringClass(@s1).fdata),0,JLObject(ShortstringClass(@dests).fdata),0,s1l);
-      JLSystem.ArrayCopy(JLObject(ShortstringClass(s2).fdata),0,JLObject(ShortstringClass(dests).fdata),s1l,s2l)
+      JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l)
     end;
-  ShortstringClass(dests).curlen:=s1l+s2l;
+  ShortstringClass(@dests).curlen:=s1l+s2l;
 end;
 
 
@@ -249,14 +249,14 @@ begin
       exit;
     end;
   lowstart:=low(sarr);
-  if ShortstringClass(DestS)=sarr[lowstart] then
+  if ShortstringClass(@DestS)=sarr[lowstart] then
     inc(lowstart);
   { Check for another reuse, then we can't use
     the append optimization and need to use a temp }
   needtemp:=false;
   for i:=lowstart to high(sarr) do
     begin
-      if ShortstringClass(DestS)=sarr[i] then
+      if ShortstringClass(@DestS)=sarr[i] then
         begin
           needtemp:=true;
           break;
@@ -266,7 +266,7 @@ begin
     begin
       lowstart:=low(sarr);
       tmpstr:='';
-      pdest:=ShortstringClass(tmpstr)
+      pdest:=ShortstringClass(@tmpstr)
     end
   else
     begin
@@ -274,7 +274,7 @@ begin
         the first array element }
       if lowstart=low(sarr) then
         DestS:='';
-      pdest:=ShortstringClass(DestS);
+      pdest:=ShortstringClass(@DestS);
     end;
   { Concat all strings, except the string we already
     copied in DestS }
@@ -305,7 +305,7 @@ begin
   s2l:=length(s2);
   if s1l+s2l>high(s1) then
     s2l:=high(s1)-s1l;
-  JLSystem.ArrayCopy(JLObject(ShortstringClass(s2).fdata),0,JLObject(ShortstringClass(s1).fdata),s1l,s2l);
+  JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@s1).fdata),s1l,s2l);
   s1[0]:=chr(s1l+s2l);
 end;
 
@@ -314,7 +314,7 @@ function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerp
 Var
   MaxI,Temp, i : SizeInt;
 begin
-  if ShortstringClass(left)=ShortstringClass(right) then
+  if ShortstringClass(@left)=ShortstringClass(@right) then
     begin
       result:=0;
       exit;
@@ -327,7 +327,7 @@ begin
     begin
       for i:=0 to MaxI-1 do
         begin
-          result:=ord(ShortstringClass(left).fdata[i])-ord(ShortstringClass(right).fdata[i]);
+          result:=ord(ShortstringClass(@left).fdata[i])-ord(ShortstringClass(@right).fdata[i]);
           if result<>0 then
             exit;
         end;
@@ -342,12 +342,12 @@ function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; com
 Var
   MaxI,Temp : SizeInt;
 begin
-  if ShortstringClass(left)=ShortstringClass(right) then
+  if ShortstringClass(@left)=ShortstringClass(@right) then
     begin
       result:=0;
       exit;
     end;
-  result:=ord(not JUArrays.equals(TJByteArray(ShortstringClass(left).fdata),TJByteArray(ShortstringClass(right).fdata)));
+  result:=ord(not JUArrays.equals(TJByteArray(ShortstringClass(@left).fdata),TJByteArray(ShortstringClass(@right).fdata)));
 end;
 
 
@@ -379,8 +379,8 @@ begin
     end
   else
     len:=l;
-  JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(ShortstringClass(res).fdata),0,len);
+  JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(ShortstringClass(@res).fdata),0,len);
-  ShortstringClass(res).curlen:=len;
+  ShortstringClass(@res).curlen:=len;
 end;
 
 
@@ -393,7 +393,7 @@ begin
     len:=length(res);
   { make sure we don't access char 1 if length is 0 (JM) }
   if len>0 then
-    JLSystem.ArrayCopy(JLObject(ShortstringClass(src).fdata),0,JLObject(@res),0,len);
+    JLSystem.ArrayCopy(JLObject(ShortstringClass(@src).fdata),0,JLObject(@res),0,len);
   JUArrays.fill(TJByteArray(@res),len,high(res),0);
 end;
 
@@ -405,7 +405,7 @@ procedure fpc_Char_To_ShortStr(out res : shortstring;const c : AnsiChar) compile
 
 begin
   setlength(res,1);
-  ShortstringClass(res).fdata[0]:=c;
+  ShortstringClass(@res).fdata[0]:=c;
 end;
 
 
@@ -422,8 +422,8 @@ begin
   else
    if count>length(s)-index then
     count:=length(s)-index;
-  ShortstringClass(result).curlen:=count;
+  ShortstringClass(@result).curlen:=count;
-  JLSystem.ArrayCopy(JLObject(ShortstringClass(s).fdata),index,JLObject(ShortstringClass(result).fdata),0,count);
+  JLSystem.ArrayCopy(JLObject(ShortstringClass(@s).fdata),index,JLObject(ShortstringClass(@result).fdata),0,count);
 end;
 
 
@@ -470,7 +470,7 @@ begin
         j:=0;
         k:=i-1;
         while (j<SubstrLen) and
-              (ShortstringClass(SubStr).fdata[j]=ShortstringClass(Source).fdata[k]) do
+              (ShortstringClass(@SubStr).fdata[j]=ShortstringClass(@Source).fdata[k]) do
           begin
             inc(j);
             inc(k);
@@ -495,7 +495,7 @@ var
 begin
   for i:=1 to length(s) do
    begin
-     if ShortstringClass(s).fdata[i-1]=c then
+     if ShortstringClass(@s).fdata[i-1]=c then
       begin
         pos:=i;
         exit;

rtl/java/system.pp

@@ -24,7 +24,7 @@ Unit system;
 
 {$define FPC_IS_SYSTEM}
 
-{$I-,Q-,H-,R-,V-,P+}
+{$I-,Q-,H-,R-,V-,P+,T+}
 {$implicitexceptions off}
 {$mode objfpc}
 
@@ -55,11 +55,13 @@ Type
   AnsiChar    = Char;
   UnicodeChar = WideChar;
 
-  { map comp to int64, }
+  { map comp to int64 }
   Comp = Int64;
 
   HResult = type longint;
 
+  PShortString        = ^ShortString;
+
   { Java primitive types }
   jboolean = boolean;
   jbyte = shortint;

rtl/java/ustrings.inc

@@ -64,7 +64,7 @@ begin
   result:='';
   Size:=Length(S2);
   if Size>0 then
-    result:=unicodestring(JLString.Create(TJByteArray(ShortstringClass(S2).fdata),0,length(S2)));
+    result:=unicodestring(JLString.Create(TJByteArray(ShortstringClass(@S2).fdata),0,length(S2)));
 end;
 
 Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString): AnsiString; compilerproc;