+ shortstring support for the JVM target (including accessing character 0 as

    the "length byte")

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

.gitattributes

@@ -7364,6 +7364,8 @@ rtl/java/jrech.inc svneol=native#text/plain
 rtl/java/objpas.pp svneol=native#text/plain
 rtl/java/rtl.cfg svneol=native#text/plain
 rtl/java/rtti.inc svneol=native#text/plain
+rtl/java/sstringh.inc svneol=native#text/plain
+rtl/java/sstrings.inc svneol=native#text/plain
 rtl/java/system.pp svneol=native#text/plain
 rtl/java/ustringh.inc svneol=native#text/plain
 rtl/java/ustrings.inc svneol=native#text/plain

compiler/jvm/hlcgcpu.pas

@@ -76,6 +76,7 @@ uses
       procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
 
       procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);override;
+      procedure g_copyshortstring(list : TAsmList;const source,dest : treference;strdef:tstringdef);override;
 
       procedure a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference); override;
       procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override;
@@ -186,6 +187,7 @@ uses
       { concatcopy helpers }
       procedure concatcopy_normal_array(list: TAsmList; size: tdef; const source, dest: treference);
       procedure concatcopy_record(list: TAsmList; size: tdef; const source, dest: treference);
+      procedure concatcopy_shortstring(list: TAsmList; size: tdef; const source, dest: treference);
 
       { generate a call to a routine in the system unit }
       procedure g_call_system_proc(list: TAsmList; const procname: string);
@@ -256,6 +258,9 @@ implementation
             result:=R_INTREGISTER
           else
             result:=R_ADDRESSREGISTER;
+        { shortstrings are implemented via classes }
+        else if is_shortstring(def) then
+          result:=R_ADDRESSREGISTER
         else
           result:=inherited;
       end;
@@ -636,20 +641,29 @@ implementation
       { all dimensions are removed from the stack, an array reference is
         added }
       decstack(list,initdim-1);
-      { in case of an array of records, initialise }
+      { in case of an array of records or shortstrings, initialise }
       elemdef:=tarraydef(arrdef).elementdef;
       for i:=1 to pred(initdim) do
         elemdef:=tarraydef(elemdef).elementdef;
-      if elemdef.typ=recorddef then
+      if (elemdef.typ=recorddef) or
+         is_shortstring(elemdef) 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);
+          if elemdef.typ=recorddef then
+            begin
+              tg.gethltemp(list,elemdef,elemdef.size,tt_persistent,recref);
+              a_load_ref_stack(list,elemdef,recref,prepare_stack_for_ref(list,recref,false));
+              g_call_system_proc(list,'fpc_initialize_array_record');
+              tg.ungettemp(list,recref);
+            end
+          else
+            begin
+              a_load_const_stack(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER);
+              g_call_system_proc(list,'fpc_initialize_array_shortstring');
+            end;
           decstack(list,3);
         end;
     end;
@@ -1120,9 +1134,13 @@ implementation
           end;
         recorddef:
           procname:='FPC_COPY_JRECORD_ARRAY';
-        floatdef,
-        stringdef:
+        floatdef:
           procname:='FPC_COPY_SHALLOW_ARRAY';
+        stringdef:
+          if is_shortstring(eledef) then
+            procname:='FPC_COPY_JSHORTSTRING_ARRAY'
+          else
+            procname:='FPC_COPY_SHALLOW_ARRAY';
         setdef,
         variantdef:
           begin
@@ -1179,6 +1197,27 @@ implementation
       end;
 
 
+    procedure thlcgjvm.concatcopy_shortstring(list: TAsmList; size: tdef; const source, dest: treference);
+      var
+        srsym: tsym;
+        pd: tprocdef;
+      begin
+        { self }
+        a_load_ref_stack(list,size,source,prepare_stack_for_ref(list,source,false));
+        { result }
+        a_load_ref_stack(list,size,dest,prepare_stack_for_ref(list,dest,false));
+        { call fpcDeepCopy helper }
+        srsym:=search_struct_member(java_shortstring,'FPCDEEPCOPY');
+        if not assigned(srsym) or
+           (srsym.typ<>procsym) then
+          Message1(cg_f_unknown_compilerproc,'ShortstringClass.FpcDeepCopy');
+        pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
+        a_call_name(list,pd,pd.mangledname,false);
+        { both parameters are removed, no function result }
+        decstack(list,2);
+      end;
+
+
   procedure thlcgjvm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
     var
       handled: boolean;
@@ -1198,11 +1237,24 @@ implementation
             concatcopy_record(list,size,source,dest);
             handled:=true;
           end;
+        stringdef:
+          begin
+            if is_shortstring(size) then
+              begin
+                concatcopy_shortstring(list,size,source,dest);
+                handled:=true;
+              end;
+          end;
       end;
       if not handled then
         inherited;
     end;
 
+  procedure thlcgjvm.g_copyshortstring(list: TAsmList; const source, dest: treference; strdef: tstringdef);
+    begin
+      concatcopy_shortstring(list,strdef,source,dest);
+    end;
+
   procedure thlcgjvm.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference);
     var
       dstack_slots: longint;

compiler/jvm/njvmadd.pas

@@ -86,14 +86,15 @@ interface
         case nodetype of
           addn:
             begin
-{$ifndef nounsupported}
                if is_shortstring(resultdef) then
                  begin
-                   result:=left;
-                   left:=nil;
+                   result:=inherited;
                    exit;
                  end;
-{$endif nounsupported}
+              { unicode/ansistring operations use functions rather than
+                procedures for efficiency reasons (were also implemented before
+                var-parameters were supported; may go to procedures for
+                maintenance reasons though }
               if (left.nodetype=stringconstn) and (tstringconstnode(left).len=0) then
                 begin
                   result:=right;
@@ -122,9 +123,6 @@ interface
             end;
           ltn,lten,gtn,gten,equaln,unequaln :
             begin
-{$ifndef nounsupported}
-             left.resultdef:=cunicodestringtype;
-{$endif nounsupported}
               { call compare routine }
               cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare';
               { for equality checks use optimized version }

compiler/jvm/njvmcnv.pas

@@ -717,6 +717,21 @@ implementation
             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
@@ -780,6 +795,13 @@ implementation
             (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
@@ -797,6 +819,14 @@ implementation
           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;
@@ -972,7 +1002,9 @@ implementation
       else if is_wide_or_unicode_string(checkdef) then
         checkdef:=java_jlstring
       else if is_ansistring(checkdef) then
-        checkdef:=java_ansistring;
+        checkdef:=java_ansistring
+      else if is_shortstring(checkdef) then
+        checkdef:=java_shortstring;
       if checkdef.typ in [objectdef,recorddef] then
         current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcode,current_asmdata.RefAsmSymbol(tabstractrecorddef(checkdef).jvm_full_typename(true))))
       else if checkdef.typ=classrefdef then

compiler/jvm/njvmcon.pas

@@ -68,7 +68,7 @@ implementation
 
     function tjvmstringconstnode.pass_1: tnode;
       var
-        astrclass: tobjectdef;
+        strclass: tobjectdef;
         psym: tsym;
         pw: pcompilerwidestring;
       begin
@@ -89,11 +89,21 @@ implementation
         ascii2unicode(value_str,len,pw,false);
         ansistringdispose(value_str,len);
         pcompilerwidestring(value_str):=pw;
-        cst_type:=cst_unicodestring;
         { and now add a node to convert the data into ansistring format at
           run time }
-        astrclass:=tobjectdef(search_system_type('ANSISTRINGCLASS').typedef);
-        psym:=search_struct_member(astrclass,'CREATEFROMLITERALSTRINGBYTES');
+        case cst_type of
+          cst_ansistring:
+            strclass:=tobjectdef(search_system_type('ANSISTRINGCLASS').typedef);
+          cst_shortstring:
+            strclass:=tobjectdef(search_system_type('SHORTSTRINGCLASS').typedef);
+          cst_conststring:
+            { used for array of char }
+            strclass:=tobjectdef(search_system_type('ANSICHARARRAYCLASS').typedef);
+          else
+           internalerror(2011052401);
+        end;
+        cst_type:=cst_unicodestring;
+        psym:=search_struct_member(strclass,'CREATEFROMLITERALSTRINGBYTES');
         if not assigned(psym) or
            (psym.typ<>procsym) then
           internalerror(2011052001);

compiler/jvm/njvminl.pas

@@ -100,9 +100,8 @@ implementation
     function tjvminlinenode.typecheck_length(var handled: boolean): tnode;
       begin
         typecheckpass(left);
-        if is_dynamic_array(left.resultdef) or
-           is_open_array(left.resultdef) or
-           is_wide_or_unicode_string(left.resultdef) then
+        if is_open_array(left.resultdef) or
+           is_dynamic_array(left.resultdef) then
           begin
             resultdef:=s32inttype;
             result:=nil;
@@ -391,17 +390,25 @@ implementation
           end
         else
           begin
-            if finaltype<>'R' then
-              begin
-                { expects JLObject }
-                setlenroutine:='FPC_SETLENGTH_DYNARR_GENERIC';
-                objarraydef:=java_jlobject;
-              end
-            else
-              begin
-                { expects array of FpcBaseRecord}
-                setlenroutine:='FPC_SETLENGTH_DYNARR_JRECORD';
-                objarraydef:=search_system_type('TJRECORDARRAY').typedef;
+            case finaltype of
+              'R':
+                begin
+                  { expects array of FpcBaseRecord}
+                  setlenroutine:='FPC_SETLENGTH_DYNARR_JRECORD';
+                  objarraydef:=search_system_type('TJRECORDARRAY').typedef;
+                end;
+              'T':
+                begin
+                  { expects array of ShortstringClass}
+                  setlenroutine:='FPC_SETLENGTH_DYNARR_JSHORTSTRING';
+                  objarraydef:=search_system_type('TSHORTSTRINGARRAY').typedef;
+                end;
+              else
+                begin
+                  { expects JLObject }
+                  setlenroutine:='FPC_SETLENGTH_DYNARR_GENERIC';
+                  objarraydef:=java_jlobject;
+                end
               end;
           end;
         tcallparanode(newparas).left:=ctypeconvnode.create_explicit(tcallparanode(newparas).left,objarraydef);
@@ -476,22 +483,21 @@ implementation
               end;
             left:=nil;
           end
-{$ifndef nounsupported}
-        else if left.resultdef.typ=stringdef then
-          begin
-            result:=cnothingnode.create;
-          end
-{$endif}
         else
           internalerror(2011031405);
       end;
 
 
     function tjvminlinenode.first_setlength: tnode;
-
       begin
         { reverse the parameter order so we can process them more easily }
         left:=reverseparameters(tcallparanode(left));
+        if is_shortstring(left.resultdef) then
+          begin
+            left:=reverseparameters(tcallparanode(left));
+            result:=inherited first_setlength;
+            exit;
+          end;
         { treat setlength(x,0) specially: used to init uninitialised locations }
         if not assigned(tcallparanode(tcallparanode(left).right).right) and
            is_constintnode(tcallparanode(tcallparanode(left).right).left) and
@@ -563,12 +569,21 @@ implementation
             addstatement(newstatement,ctemprefnode.create(lentemp));
             result:=newblock;
           end
-{$ifndef nounsupported}
-        else if left.resultdef.typ=stringdef then
+        else if is_shortstring(left.resultdef) then
           begin
-            result:=nil;
+            psym:=search_struct_member(tabstractrecorddef(java_shortstring),'LENGTH');
+            if not assigned(psym) or
+               (psym.typ<>procsym) then
+              internalerror(2011052402);
+            result:=
+              ccallnode.create(nil,tprocsym(psym),psym.owner,
+                ctypeconvnode.create_explicit(left,java_shortstring),[]);
+            { reused }
+            left:=nil;
           end
-{$endif}
+        { should be no other string types }
+        else if left.resultdef.typ=stringdef then
+          internalerror(2011052403)
        else
          result:=inherited first_length;
       end;
@@ -585,14 +600,6 @@ implementation
             thlcgjvm(hlcg).g_getarraylen(current_asmdata.CurrAsmList,left.location);
             thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
           end
-{$ifndef nounsupported}
-        else if left.resultdef.typ=stringdef then
-          begin
-            location_reset(location,LOC_REGISTER,OS_S32);
-            location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,s32inttype);
-            thlcgjvm(hlcg).a_load_const_reg(current_asmdata.CurrAsmList,s32inttype,0,location.register);
-          end
-{$endif}
         else
           internalerror(2011012004);
       end;
@@ -738,17 +745,13 @@ implementation
             current_asmdata.CurrAsmList.concat(taicpu.op_string(a_ldc,0,@emptystr));
             thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
           end
+        else if is_ansistring(target.resultdef) then
+          thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,java_jlobject,0,R_ADDRESSREGISTER)
         else if is_dynamic_array(target.resultdef) then
           begin
             thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,0,R_INTREGISTER);
             thlcgjvm(hlcg).g_newarray(current_asmdata.CurrAsmList,target.resultdef,1);
           end
-{$ifndef nounsupported}
-        else if left.resultdef.typ=stringdef then
-          begin
-            thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,java_jlobject,0,R_ADDRESSREGISTER);
-          end
-{$endif}
         else
           internalerror(2011031401);
         thlcgjvm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,target.resultdef,target.location);

compiler/jvm/njvmld.pas

@@ -53,7 +53,7 @@ uses
   verbose,
   aasmdata,
   nbas,nld,ncal,nmem,ncnv,
-  symconst,symsym,symdef,defutil,jvmdef,
+  symconst,symsym,symdef,symtable,defutil,jvmdef,
   paramgr,
   cgbase,hlcgobj;
 
@@ -62,6 +62,7 @@ uses
 function tjvmassignmentnode.pass_1: tnode;
   var
     target: tnode;
+    psym: tsym;
   begin
     { intercept writes to string elements, because Java strings are immutable
       -> detour via StringBuilder
@@ -85,6 +86,29 @@ function tjvmassignmentnode.pass_1: tnode;
         tvecnode(target).right:=nil;
         exit;
       end
+    else if (target.nodetype=vecn) and
+       is_shortstring(tvecnode(target).left.resultdef) then
+      begin
+        { prevent errors in case of an expression such as
+            byte(str[x]):=12;
+        }
+        inserttypeconv_explicit(right,cchartype);
+        { call ShortstringClass(shortstring).setChar(index,char) }
+        inserttypeconv_explicit(tvecnode(target).left,java_shortstring);
+        psym:=search_struct_member(tabstractrecorddef(java_shortstring),'SETCHAR');
+        if not assigned(psym) or
+           (psym.typ<>procsym) then
+          internalerror(2011052408);
+        result:=
+          ccallnode.create(
+            ccallparanode.create(right,
+              ccallparanode.create(tvecnode(target).right,nil)),
+            tprocsym(psym),psym.owner,tvecnode(target).left,[]);
+        right:=nil;
+        tvecnode(target).left:=nil;
+        tvecnode(target).right:=nil;
+        exit;
+      end
     else
       result:=inherited;
   end;

compiler/jvm/njvmmem.pas

@@ -165,13 +165,19 @@ implementation
         psym: tsym;
         stringclass: tdef;
       begin
-        if is_wide_or_unicode_string(left.resultdef) or
-           is_ansistring(left.resultdef) then
+        if (left.resultdef.typ=stringdef) then
           begin
-            if is_ansistring(left.resultdef) then
-              stringclass:=java_ansistring
-            else
-              stringclass:=java_jlstring;
+            case tstringdef(left.resultdef).stringtype of
+              st_ansistring:
+                stringclass:=java_ansistring;
+              st_unicodestring,
+              st_widestring:
+                stringclass:=java_jlstring;
+              st_shortstring:
+                stringclass:=java_shortstring;
+              else
+                internalerror(2011052407);
+            end;
             psym:=search_struct_member(tabstractrecorddef(stringclass),'CHARAT');
             if not assigned(psym) or
                (psym.typ<>procsym) then

compiler/jvm/tgcpu.pas

@@ -133,13 +133,24 @@ unit tgcpu;
             begin
               if is_shortstring(def) then
                 begin
-{$ifndef nounsupported}
                   gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
+                  { add the maxlen parameter }
+                  thlcgjvm(hlcg).a_load_const_stack(list,u8inttype,tstringdef(def).len,R_INTREGISTER);
+                  { call the constructor }
+                  sym:=tsym(tobjectdef(java_shortstring).symtable.find('CREATEEMPTY'));
+                  if assigned(sym) and
+                     (sym.typ=procsym) then
+                    begin
+                      if tprocsym(sym).procdeflist.Count<>1 then
+                        internalerror(2011052404);
+                      pd:=tprocdef(tprocsym(sym).procdeflist[0]);
+                    end;
+                  hlcg.a_call_name(list,pd,pd.mangledname,false);
+                  { static calls method replaces parameter with string instance
+                    -> no change in stack height }
+                  { store reference to instance }
+                  thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
                   result:=true;
-{$else}
-                  internalerror(2011051701);
-{$endif}
-
                 end;
             end;
         end;

compiler/jvmdef.pas

@@ -197,14 +197,11 @@ implementation
                   encodedstr:=encodedstr+'Ljava/lang/String;';
                 st_ansistring:
                   result:=jvmaddencodedtype(java_ansistring,false,encodedstr,forcesignature,founderror);
-{$ifndef nounsupported}
                 st_shortstring:
-                  encodedstr:=encodedstr+'Lorg/freepascal/rtl/ShortString;';
-{$else}
+                  result:=jvmaddencodedtype(java_shortstring,false,encodedstr,forcesignature,founderror);
                 else
                   { May be handled via wrapping later  }
                   result:=false;
-{$endif}
               end;
             end;
           enumdef,
@@ -453,8 +450,11 @@ implementation
         errdef: tdef;
         res: string;
       begin
+        { keep in sync with rtl/java/jdynarrh.inc and usage in njvminl }
         if is_record(def) then
           result:='R'
+        else if is_shortstring(def) then
+          result:='T'
         else
           begin
             if not jvmtryencodetype(def,res,false,errdef) then

compiler/ncgcnv.pas

@@ -361,13 +361,6 @@ interface
 
     procedure tcgtypeconvnode.second_char_to_string;
       begin
-{$ifdef jvm}
-{$ifndef nounsupported}
-         location_reset_ref(location,LOC_REFERENCE,OS_NO,1);
-         tg.gethltemp(current_asmdata.CurrAsmList,cshortstringtype,256,tt_normal,location.reference);
-         exit;
-{$endif nounsupported}
-{$endif jvm}
          location_reset_ref(location,LOC_REFERENCE,OS_NO,2);
          case tstringdef(resultdef).stringtype of
            st_shortstring :

compiler/ncnv.pas

@@ -1091,9 +1091,10 @@ implementation
               result:=hp;
            end
          else
-           { shortstrings are handled 'inline' (except for widechars) }
+           { shortstrings are handled 'inline' for non-vm targets (except for widechars) }
            if (tstringdef(resultdef).stringtype <> st_shortstring) or
-              (torddef(left.resultdef).ordtype = uwidechar) then
+              (torddef(left.resultdef).ordtype = uwidechar) or
+              (target_info.system in systems_managed_vm) then
              begin
                if (tstringdef(resultdef).stringtype <> st_shortstring) then
                  begin
@@ -1115,7 +1116,11 @@ implementation
                    newblock:=internalstatements(newstat);
                    restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
                    addstatement(newstat,restemp);
-                   addstatement(newstat,ccallnode.createintern('fpc_wchar_to_shortstr',ccallparanode.create(left,ccallparanode.create(
+                   if torddef(left.resultdef).ordtype<>uwidechar then
+                     procname := 'fpc_char_to_shortstr'
+                   else
+                     procname := 'fpc_wchar_to_shortstr';
+                   addstatement(newstat,ccallnode.createintern(procname,ccallparanode.create(left,ccallparanode.create(
                      ctemprefnode.create(restemp),nil))));
                    addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
                    addstatement(newstat,ctemprefnode.create(restemp));
@@ -2240,7 +2245,10 @@ implementation
                              { perform target-specific explicit typecast
                                checks }
                              if target_specific_explicit_typeconv then
-                               exit;
+                               begin
+                                 result:=simplify(false);
+                                 exit;
+                               end;
                            end;
                        end;
                    end
@@ -3115,17 +3123,6 @@ implementation
         newstat  : tstatementnode;
         restemp  : ttempcreatenode;
       begin
-{$if defined(jvm) and not defined(nounsupported)}
-        if (not is_ansistring(left.resultdef) and
-            not is_unicodestring(left.resultdef)) or
-           (not is_ansistring(resultdef) and
-            not is_unicodestring(resultdef)) then
-          begin
-            convtype:=tc_equal;
-            result:=nil;
-            exit;
-          end;
-{$endif}
         { get the correct procedure name }
         procname := 'fpc_'+tstringdef(left.resultdef).stringtypname+
                     '_to_'+tstringdef(resultdef).stringtypname;

compiler/nld.pas

@@ -590,8 +590,9 @@ implementation
            { insert typeconv, except for chars that are handled in
              secondpass and except for ansi/wide string that can
              be converted immediatly }
-           if not(is_char(right.resultdef) or
-                  (right.resultdef.typ=stringdef)) then
+           if (not is_char(right.resultdef) or
+               (target_info.system in systems_managed_vm)) and
+              (right.resultdef.typ<>stringdef) then
              inserttypeconv(right,left.resultdef);
            if right.resultdef.typ=stringdef then
             begin

compiler/nopt.pas

@@ -319,8 +319,12 @@ begin
       inserttypeconv(sn,p.resultdef);
       if is_shortstr then
         begin
+{$ifndef jvm}
           sn:=caddrnode.create(sn);
           include(sn.flags,nf_internal);
+{$else not jvm}
+          inserttypeconv_internal(sn,java_shortstring);
+{$endif jvm}
         end;
       arrp:=carrayconstructornode.create(sn,arrp);
       hp:=taddnode(hp).left;

compiler/pdecobj.pas

@@ -1275,8 +1275,8 @@ implementation
                   odt_javaclass:
                     begin
                       if (current_structdef.objname^='TOBJECT') then
-                        class_tobject:=current_objectdef;
-                      if (current_objectdef.objname^='JLOBJECT') then
+                        class_tobject:=current_objectdef
+                      else if (current_objectdef.objname^='JLOBJECT') then
                         begin
                           java_jlobject:=current_objectdef;
                           { the methodpointer type is normally created in
@@ -1288,15 +1288,17 @@ implementation
                           hrecst.addfield(fsym,vis_hidden);
                           methodpointertype:=trecorddef.create('',hrecst);
                           systemunit.insert(ttypesym.create('$methodpointer',methodpointertype));
-                        end;
-                      if (current_objectdef.objname^='JLTHROWABLE') then
-                        java_jlthrowable:=current_objectdef;
-                      if (current_objectdef.objname^='FPCBASERECORDTYPE') then
-                        java_fpcbaserecordtype:=current_objectdef;
-                      if (current_objectdef.objname^='JLSTRING') then
-                        java_jlstring:=current_objectdef;
-                      if (current_objectdef.objname^='ANSISTRINGCLASS') then
-                        java_ansistring:=current_objectdef;
+                        end
+                      else if (current_objectdef.objname^='JLTHROWABLE') then
+                        java_jlthrowable:=current_objectdef
+                      else if (current_objectdef.objname^='FPCBASERECORDTYPE') then
+                        java_fpcbaserecordtype:=current_objectdef
+                      else if (current_objectdef.objname^='JLSTRING') then
+                        java_jlstring:=current_objectdef
+                      else if (current_objectdef.objname^='ANSISTRINGCLASS') then
+                        java_ansistring:=current_objectdef
+                      else if (current_objectdef.objname^='SHORTSTRINGCLASS') then
+                        java_shortstring:=current_objectdef
                     end;
                 end;
               end;

compiler/symdef.pas

@@ -800,6 +800,8 @@ interface
        java_jlstring             : tobjectdef;
        { FPC java implementation of ansistrings }
        java_ansistring           : tobjectdef;
+       { FPC java implementation of shortstrings }
+       java_shortstring          : tobjectdef;
 
     const
 {$ifdef i386}
@@ -1613,8 +1615,11 @@ implementation
             ((d=java_jlobject) or
              (d=java_jlstring))) or
            ((stringtype=st_ansistring) and
-            (d=java_jlobject) or
-            (d=java_ansistring)));
+            ((d=java_jlobject) or
+             (d=java_ansistring))) or
+           ((stringtype=st_shortstring) and
+            ((d=java_jlobject) or
+             (d=java_shortstring))));
       end;
 
 
@@ -4830,15 +4835,17 @@ implementation
             not(oo_is_formal in objectoptions) then
            begin
              if (objname^='JLOBJECT') then
-               java_jlobject:=self;
-             if (objname^='JLTHROWABLE') then
-               java_jlthrowable:=self;
-             if (objname^='FPCBASERECORDTYPE') then
-               java_fpcbaserecordtype:=self;
-             if (objname^='JLSTRING') then
-               java_jlstring:=self;
-             if (objname^='ANSISTRINGCLASS') then
-               java_ansistring:=self;
+               java_jlobject:=self
+             else if (objname^='JLTHROWABLE') then
+               java_jlthrowable:=self
+             else if (objname^='FPCBASERECORDTYPE') then
+               java_fpcbaserecordtype:=self
+             else if (objname^='JLSTRING') then
+               java_jlstring:=self
+             else if (objname^='ANSISTRINGCLASS') then
+               java_ansistring:=self
+             else if (objname^='SHORTSTRINGCLASS') then
+               java_shortstring:=self
            end;
          writing_class_record_dbginfo:=false;
        end;

rtl/java/astringh.inc

@@ -15,7 +15,6 @@
  **********************************************************************}
 
 type
-  TAnsiCharArray = array of ansichar;
   AnsistringClass = class sealed
    private
     fdata: TAnsiCharArray;
@@ -24,11 +23,13 @@ type
     constructor Create(const arr: array of unicodechar);overload;
     constructor Create(const u: unicodestring);overload;
     constructor Create(const a: ansistring);overload;
+    constructor Create(const s: shortstring);overload;
     constructor Create(ch: ansichar);overload;
     constructor Create(ch: unicodechar);overload;
     class function CreateFromLiteralStringBytes(const u: unicodestring): ansistring; static;
     function charAt(index: jint): ansichar;
     function toUnicodeString: unicodestring;
+    function toShortstring(maxlen: byte): shortstring;
     function toString: JLString; override;
 //    function concat(const a: ansistring): ansistring;
 //    function concatmultiple(const arr: array of ansistring): ansistring;

rtl/java/astrings.inc

@@ -50,6 +50,12 @@ begin
 end;
 
 
+constructor AnsistringClass.Create(const s: shortstring);
+begin
+  Create(ShortstringClass(s).fdata);
+end;
+
+
 constructor AnsistringClass.Create(ch: ansichar);
 begin
   setlength(fdata,1);
@@ -91,6 +97,12 @@ begin
 end;
 
 
+function AnsistringClass.toShortstring(maxlen: byte): shortstring;
+begin
+  result:=shortstring(ShortstringClass.Create(ansistring(self),maxlen));
+end;
+
+
 function AnsistringClass.toString: JLString;
 begin
   result:=JLString.Create(TJByteArray(fdata));
@@ -191,75 +203,37 @@ procedure fpc_AnsiStr_Concat_multi (var DestS:Ansistring;const sarr:array of Ans
 end;
 
 
-(*
-{$ifndef FPC_STRTOSHORTSTRINGPROC}
-
-{ the following declaration has exactly the same effect as                   }
-{ procedure fpc_AnsiStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer);     }
-{ which is what the old helper was, so we don't need an extra implementation }
-{ of the old helper (JM)                                                     }
-function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): shortstring;[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR'];  compilerproc;
+procedure fpc_AnsiStr_To_ShortStr (out res: shortstring; const S2 : Ansistring); compilerproc;
 {
   Converts a AnsiString to a ShortString;
 }
 Var
   Size : SizeInt;
 begin
-  if S2='' then
-   fpc_AnsiStr_To_ShortStr:=''
-  else
-   begin
-     Size:=Length(S2);
-     If Size>high_of_res then
-      Size:=high_of_res;
-     Move (S2[1],fpc_AnsiStr_To_ShortStr[1],Size);
-     byte(fpc_AnsiStr_To_ShortStr[0]):=byte(Size);
-   end;
-end;
-
-{$else FPC_STRTOSHORTSTRINGPROC}
-*)
-procedure fpc_AnsiStr_To_ShortStr (out res: shortstring; const S2 : Ansistring);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR'];  compilerproc;
-{
-  Converts a AnsiString to a ShortString;
-}
-(*
-Var
-  Size : SizeInt;
-*)
-begin
-(*
   if S2='' then
    res:=''
   else
    begin
      Size:=Length(S2);
      If Size>high(res) then
-      Size:=high(res);
-     Move (S2[1],res[1],Size);
-     byte(res[0]):=byte(Size);
+       Size:=high(res);
+     JLSystem.ArrayCopy(JLObject(AnsistringClass(S2).fdata),0,JLObject(ShortstringClass(res).fdata),0,Size);
+     setlength(res,Size);
    end;
-*)
 end;
-(*
-{$endif FPC_STRTOSHORTSTRINGPROC}
-*)
+
 
 Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
 {
   Converts a ShortString to a AnsiString;
 }
-(*
 Var
   Size : SizeInt;
-*)
 begin
-(*
   Size:=Length(S2);
-  Setlength (fpc_ShortStr_To_AnsiStr,Size);
+  Setlength (result,Size);
   if Size>0 then
-    Move(S2[1],Pointer(fpc_ShortStr_To_AnsiStr)^,Size);
-*)
+    JLSystem.ArrayCopy(JLObject(ShortstringClass(S2).fdata),0,JLObject(AnsistringClass(result).fdata),0,Size);
 end;
 
 
@@ -320,8 +294,8 @@ begin
       exit;
     end;
   res:=AnsistringClass.Create;
-  setlength(res.fdata,i);
-  JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(res.fdata),0,i);
+  setlength(res.fdata,high(arr)+1);
+  JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(res.fdata),0,high(arr)+1);
   result:=Ansistring(res);
 end;
 
@@ -409,12 +383,12 @@ function fpc_AnsiStr_SetLength (S : AnsiString; l : SizeInt): Ansistring; compil
   Sets The length of string S to L.
   Makes sure S is unique, and contains enough room.
 }
-Var
-  lens, lena,
-  movelen : SizeInt;
 begin
-  setlength(AnsistringClass(s).fdata,l);
-  result:=s;
+  if not assigned(AnsistringClass(s)) then
+    result:=ansistring(AnsistringClass.Create)
+  else
+    result:=s;
+  setlength(AnsistringClass(result).fdata,l);
 end;
 
 {*****************************************************************************
@@ -465,20 +439,15 @@ begin
 end;
 
 Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); compilerproc;
-(*
 var
    ofs : SizeInt;
-*)
 begin
-(*
    if Str='' then
      exit;
    ofs:=Length(S);
    SetLength(S,ofs+length(Str));
    { the pbyte cast avoids an unique call which isn't necessary because SetLength was just called }
-   move(Str[1],(pointer(S)+ofs)^,length(Str));
-   PByte(Pointer(S)+length(S))^:=0; { Terminating Zero }
-*)
+   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/compproc.inc

@@ -36,24 +36,16 @@ type
   fpc_normal_set_byte = array[0..31] of byte;
   fpc_normal_set_long = array[0..7] of longint;
 
-(*
 procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
-{$ifndef FPC_STRTOSHORTSTRINGPROC}
-function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; compilerproc;
-{$else FPC_STRTOSHORTSTRINGPROC}
 procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
-{$endif FPC_STRTOSHORTSTRINGPROC}
 
-{$ifndef STR_CONCAT_PROCS}
-function fpc_shortstr_concat(const s1,s2:shortstring): shortstring; compilerproc;
-{$else STR_CONCAT_PROCS}
 procedure fpc_shortstr_concat(var dests:shortstring;const s1,s2:shortstring);compilerproc;
-procedure fpc_shortstr_concat_multi(var dests:shortstring;const sarr:array of pshortstring);compilerproc;
-{$endif STR_CONCAT_PROCS}
+procedure fpc_shortstr_concat_multi(var dests:shortstring;const sarr:array of ShortstringClass);compilerproc;
 procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc;
 function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc;
 function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
 
+(*
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
 {$else FPC_STRTOSHORTSTRINGPROC}
@@ -62,21 +54,14 @@ procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar); compilerproc;
 
 function fpc_pchar_length(p:pchar):longint; compilerproc;
 function fpc_pwidechar_length(p:pwidechar):longint; compilerproc;
+*)
 
-{$ifndef FPC_STRTOSHORTSTRINGPROC}
-function fpc_chararray_to_shortstr(const arr: array of AnsiChar; zerobased: boolean = true):shortstring; compilerproc;
-{$else FPC_STRTOSHORTSTRINGPROC}
 procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of AnsiChar; zerobased: boolean = true); compilerproc;
-{$endif FPC_STRTOSHORTSTRINGPROC}
-{$ifndef FPC_STRTOCHARARRAYPROC}
-function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray; compilerproc;
-{$else ndef FPC_STRTOCHARARRAYPROC}
 procedure fpc_shortstr_to_chararray(out res: array of AnsiChar; const src: ShortString); compilerproc;
-{$endif ndef FPC_STRTOCHARARRAYPROC}
 
 Function  fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
 function  fpc_char_copy(c:AnsiChar;index : SizeInt;count : SizeInt): shortstring;compilerproc;
-*)
+
 (*
 { Str() support }
 procedure fpc_ShortStr_sint(v : valsint;len : SizeInt;out s : shortstring); compilerproc;
@@ -296,15 +281,8 @@ Function  fpc_ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiSt
                         Unicode string support
 *****************************************************************************}
 
-(*
-{$ifndef VER2_2}
-{$ifndef FPC_STRTOSHORTSTRINGPROC}
-function fpc_UnicodeStr_To_ShortStr (high_of_res: SizeInt;const S2 : UnicodeString): shortstring; compilerproc;
-{$else FPC_STRTOSHORTSTRINGPROC}
-procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); compilerproc;
-{$endif FPC_STRTOSHORTSTRINGPROC}
 Function fpc_ShortStr_To_UnicodeStr (Const S2 : ShortString): UnicodeString; compilerproc;
-*)
+procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); compilerproc;
 Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString): AnsiString; compilerproc;
 Function fpc_AnsiStr_To_UnicodeStr (Const S2 : AnsiString): UnicodeString; compilerproc;
 Function fpc_UnicodeStr_To_WideStr (const S2 : UnicodeString): WideString; compilerproc;
@@ -330,32 +308,24 @@ procedure fpc_UnicodeCharArray_To_ShortStr(out res : shortstring;const arr: arra
 Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; zerobased: boolean = true): AnsiString; compilerproc;
 *)
 Function fpc_UnicodeCharArray_To_UnicodeStr(const arr: array of unicodechar; zerobased: boolean = true): UnicodeString; compilerproc;
-(*
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
 {$else FPC_STRTOSHORTSTRINGPROC}
 procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true); compilerproc;
 {$endif FPC_STRTOSHORTSTRINGPROC}
-*)
 {$ifndef nounsupported}
 Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
 {$endif}
-Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
+//Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
 Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc;
-(*
 {$ifndef FPC_STRTOCHARARRAYPROC}
 Function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray; compilerproc;
 Function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray; compilerproc;
 {$else ndef FPC_STRTOCHARARRAYPROC}
 procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
-*)
-{$ifndef nounsupported}
 procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
-{$endif}
 procedure fpc_unicodestr_to_widechararray(out res: array of widechar; const src: UnicodeString); compilerproc;
-(*
 {$endif ndef FPC_STRTOCHARARRAYPROC}
-*)
 Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt; compilerproc;
 Function fpc_UnicodeStr_Compare_equal(const S1,S2 : UnicodeString): SizeInt; compilerproc;
 (*
@@ -369,11 +339,11 @@ Function fpc_Char_To_UChar(const c : AnsiChar): UnicodeChar; compilerproc;
 Function fpc_UChar_To_Char(const c : UnicodeChar): AnsiChar; compilerproc;
 Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
 Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc;
-(*
 Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
 {$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_Char_To_ShortStr(out res : shortstring;const c : AnsiChar) compilerproc;
 procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
 {$endif FPC_STRTOSHORTSTRINGPROC}
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
@@ -388,7 +358,6 @@ Function fpc_PUnicodeChar_To_ShortStr(const p : punicodechar): shortstring; comp
 procedure fpc_PUnicodeChar_To_ShortStr(out res : shortstring;const p : punicodechar); compilerproc;
 {$endif FPC_STRTOSHORTSTRINGPROC}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
-*)
 
 (*
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
@@ -658,6 +627,7 @@ procedure fpc_initialize_array_unicodestring(arr: TJObjectArray; normalarrdim: l
   level elements types of the array) }
 procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint);compilerproc;
 procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseRecordType);compilerproc;
+procedure fpc_initialize_array_shortstring(arr: TJObjectArray; normalarrdim: longint; maxlen: byte);compilerproc;
 
 (*
 {$ifdef FPC_SETBASE_USED}

rtl/java/jdynarrh.inc

@@ -25,6 +25,7 @@ type
   TJDoubleArray = array of jdouble;
   TJObjectArray = array of JLObject;
   TJRecordArray = array of FpcBaseRecordType;
+  TShortstringArray = array of ShortstringClass;
   TJStringArray = array of unicodestring;
 
 const
@@ -37,6 +38,7 @@ const
   FPCJDynArrTypeJDouble = 'D';
   FPCJDynArrTypeJObject = 'A';
   FPCJDynArrTypeRecord  = 'R';
+  FPCJDynArrTypeShortstring  = 'T';
 
 { 1-dimensional setlength routines
 
@@ -46,11 +48,13 @@ const
 }
 function fpc_setlength_dynarr_generic(aorg, anew: JLObject; deepcopy: boolean; docopy: boolean = true): JLObject;
 function fpc_setlength_dynarr_jrecord(aorg, anew: TJRecordArray; deepcopy: boolean): TJRecordArray;
+function fpc_setlength_dynarr_jshortstring(aorg, anew: TShortstringArray; deepcopy: boolean): TShortstringArray;
 
 { array copying helpers }
 
 procedure fpc_copy_shallow_array(src, dst: JLObject; srcstart: jint = -1; srccopylen: jint = -1);
 procedure fpc_copy_jrecord_array(src, dst: TJRecordArray; srcstart: jint = -1; srccopylen: jint = -1);
+procedure fpc_copy_jshortstring_array(src, dst: TShortstringArray; srcstart: jint = -1; srccopylen: jint = -1);
 
 { 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

rtl/java/rtti.inc

@@ -86,3 +86,22 @@ procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint;
       end;
   end;
 
+
+procedure fpc_initialize_array_shortstring_intern(arr: TJObjectArray; normalarrdim: longint; maxlen: byte); external name 'fpc_initialize_array_shortstring';
+
+procedure fpc_initialize_array_shortstring(arr: TJObjectArray; normalarrdim: longint; maxlen: byte);compilerproc;
+  var
+    i: longint;
+  begin
+    if normalarrdim > 0 then
+      begin
+        for i:=low(arr) to high(arr) do
+          fpc_initialize_array_shortstring_intern(TJObjectArray(arr[i]),normalarrdim-1,maxlen);
+      end
+    else
+      begin
+        for i:=low(arr) to high(arr) do
+          arr[i]:=ShortstringClass.CreateEmpty(maxlen);
+      end;
+  end;
+

rtl/java/sstringh.inc

@@ -0,0 +1,108 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2005 by Florian Klaempfl,
+    member of the Free Pascal development team.
+
+    This file implements support routines for Shortstrings with FPC/JVM
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+type
+  TAnsiCharArray = array of ansichar;
+  ShortstringClass = class sealed (JLCloneable)
+   public
+    { "length byte" }
+    curlen: byte;
+    { length is always the maximum length of the string (so that even reads
+      past the current length of the shortstring work, just like in regular
+      shortstrings }
+    fdata: TAnsiCharArray;
+   public
+    constructor Create(const arr: array of ansichar; maxlen: byte);overload;
+    constructor Create(const arr: array of unicodechar; maxlen: byte);overload;
+    constructor Create(const u: unicodestring; maxlen: byte);overload;
+    constructor Create(const a: ansistring; maxlen: byte);overload;
+    constructor Create(const s: shortstring; maxlen: byte);overload;
+    constructor Create(ch: ansichar; maxlen: byte);overload;
+    constructor Create(ch: unicodechar; maxlen: byte);overload;
+    class function CreateEmpty(maxlen: byte): ShortstringClass; static;
+    class function CreateFromLiteralStringBytes(const u: unicodestring): shortstring; static;
+    procedure FpcDeepCopy(dest: ShortstringClass);
+    procedure setChar(index: jint; char: ansichar);
+    function charAt(index: jint): ansichar;
+    function toUnicodeString: unicodestring;
+    function toAnsistring: ansistring;
+    function toString: JLString; override;
+    function clone: JLObject; override;
+//    function concat(const a: shortstring): shortstring;
+//    function concatmultiple(const arr: array of shortstring): shortstring;
+    function length: jint;
+  end;
+
+  AnsiCharArrayClass = class sealed
+   class function CreateFromLiteralStringBytes(const u: unicodestring; maxlen: byte): TAnsiCharArray; static;
+  end;
+
+//Function Pos (Const Substr : Ansistring; Const Source : Ansistring) : SizeInt;
+//Function Pos (c : AnsiChar; Const s : Ansistring) : SizeInt;
+//Function Pos (c : AnsiString; Const s : UnicodeString) : SizeInt;
+//Function Pos (c : UnicodeString; Const s : AnsiString) : SizeInt;
+//Function Pos (c : ShortString; Const s : UnicodeString) : SizeInt;
+Function Pos (c : AnsiChar; Const s : Shortstring) : SizeInt;
+Function Pos (const substr : ShortString; Const source : Shortstring) : SizeInt;
+//Function Pos (c : char; Const s : UnicodeString) : SizeInt;
+
+Function UpCase(const s : shortstring) : shortstring;
+Function LowerCase(const s : shortstring) : shortstring;
+//Function UpCase(c:UnicodeChar):UnicodeChar;
+
+//Procedure Insert (Const Source : UnicodeString; Var S : UnicodeString; Index : SizeInt);
+//Procedure Delete (Var S : UnicodeString; Index,Size: SizeInt);
+//Procedure SetString (Out S : UnicodeString; Buf : PUnicodeChar; Len : SizeInt);
+//Procedure SetString (Out S : UnicodeString; Buf : PChar; Len : SizeInt);
+//
+//function WideCharToString(S : PWideChar) : AnsiString;
+//function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
+//function WideCharLenToString(S : PWideChar;Len : SizeInt) : AnsiString;
+//procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;out Dest : AnsiString);
+//procedure WideCharToStrVar(S : PWideChar;out Dest : AnsiString);
+//
+//function UnicodeCharToString(S : PUnicodeChar) : AnsiString;
+//function StringToUnicodeChar(const Src : AnsiString;Dest : PUnicodeChar;DestSize : SizeInt) : PUnicodeChar;
+//function UnicodeCharLenToString(S : PUnicodeChar;Len : SizeInt) : AnsiString;
+//procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : AnsiString);
+//procedure UnicodeCharToStrVar(S : PUnicodeChar;out Dest : AnsiString);
+//
+//procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
+//procedure DefaultAnsi2UnicodeMove(source:pchar;var dest:unicodestring;len:SizeInt);
+
+//function UnicodeToUtf8(Dest: PChar; Source: PUnicodeChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+//function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PUnicodeChar; SourceChars: SizeUInt): SizeUInt;
+//function Utf8ToUnicode(Dest: PUnicodeChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+//function Utf8ToUnicode(Dest: PUnicodeChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
+//function UTF8Encode(const s : Ansistring) : UTF8String; inline;
+//function UTF8Encode(const s : UnicodeString) : UTF8String;
+//function UTF8Decode(const s : UTF8String): UnicodeString;
+//function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
+//function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
+//function UnicodeStringToUCS4String(const s : UnicodeString) : UCS4String;
+//function UCS4StringToUnicodeString(const s : UCS4String) : UnicodeString;
+//function WideStringToUCS4String(const s : WideString) : UCS4String;
+//function UCS4StringToWideString(const s : UCS4String) : WideString;
+
+//Procedure GetWideStringManager (Var Manager : TUnicodeStringManager);
+//Procedure SetWideStringManager (Const New : TUnicodeStringManager);
+//Procedure SetWideStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
+
+//Procedure GetUnicodeStringManager (Var Manager : TUnicodeStringManager);
+//Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager);
+//Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
+
+

rtl/java/sstrings.inc

@@ -0,0 +1,507 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2005, 2011 by Florian Klaempfl, Jonas Maebe
+    members of the Free Pascal development team.
+
+    This file implements support routines for Shortstrings with FPC/JVM
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+constructor ShortstringClass.Create(const arr: array of ansichar; maxlen: byte);
+begin
+  setlength(fdata,maxlen);
+  if high(arr)=-1 then
+    exit;
+  curlen:=min(high(arr)+1,maxlen);
+  JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(fdata),0,curlen);
+end;
+
+
+constructor ShortstringClass.Create(const arr: array of unicodechar; maxlen: byte);
+begin
+  if high(arr)=-1 then
+    begin
+      setlength(fdata,maxlen);
+      exit;
+    end;
+  fdata:=TAnsiCharArray(JLString.Create(arr).getBytes);
+  setlength(fdata,maxlen);
+  curlen:=min(high(fdata)+1,maxlen);
+end;
+
+
+constructor ShortstringClass.Create(const u: unicodestring; maxlen: byte);
+begin
+  if system.length(u)=0 then
+    begin
+      setlength(fdata,maxlen);
+      exit;
+    end;
+  fdata:=TAnsiCharArray(JLString(u).getBytes);
+  setlength(fdata,maxlen);
+  curlen:=min(high(fdata)+1,maxlen);
+end;
+
+
+constructor ShortstringClass.Create(const a: ansistring; maxlen: byte);
+var
+  alen: jint;
+begin
+  setlength(fdata,maxlen);
+  alen:=system.length(a);
+  if alen=0 then
+    exit;
+  curlen:=min(alen,maxlen);
+  JLSystem.ArrayCopy(JLObject(AnsistringClass(a).fdata),0,JLObject(fdata),0,curlen);
+end;
+
+
+constructor ShortstringClass.Create(const s: shortstring; maxlen: byte);overload;
+begin
+  setlength(fdata,maxlen);
+  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));
+end;
+
+
+constructor ShortstringClass.Create(ch: ansichar; maxlen: byte);overload;
+begin
+  setlength(fdata,maxlen);
+  fdata[0]:=ch;
+  curlen:=1;
+end;
+
+
+constructor ShortstringClass.Create(ch: unicodechar; maxlen: byte);overload;
+begin
+  fdata:=TAnsiCharArray(JLString.Create(ch).getBytes);
+  curlen:=min(system.length(fdata),maxlen);
+  setlength(fdata,maxlen);
+end;
+
+
+class function ShortstringClass.CreateEmpty(maxlen: byte): ShortstringClass;
+begin
+  result:=ShortstringClass.Create;
+  setlength(result.fdata,maxlen);
+end;
+
+
+class function ShortstringClass.CreateFromLiteralStringBytes(const u: unicodestring): shortstring;
+var
+  i: longint;
+begin
+  { used to construct constant shortstrings from Java string constants }
+  ShortstringClass(result).curlen:=min(system.length(u),255);
+  setlength(ShortstringClass(result).fdata,ShortstringClass(result).curlen);
+  for i:=1 to ShortstringClass(result).curlen do
+    ShortstringClass(result).fdata[i-1]:=ansichar(ord(u[i]));
+end;
+
+
+procedure ShortstringClass.FpcDeepCopy(dest: ShortstringClass);
+begin
+  { should only be called for shortstrings of the same maximum length }
+  dest.curlen:=curlen;
+  JLSystem.ArrayCopy(JLObject(fdata),0,JLObject(dest.fdata),0,system.length(fdata));
+end;
+
+
+procedure ShortstringClass.setChar(index: jint; char: ansichar);
+begin
+  { index is 1-based here }
+
+  { support accessing the length byte }
+  if index=0 then
+    curlen:=ord(char)
+  else
+    fdata[index-1]:=char;
+end;
+
+
+function ShortstringClass.charAt(index: jint): ansichar;
+begin
+  { index is already decreased by one, because same calling code is used for
+    JLString.charAt() }
+
+  { support accessing the length byte }
+  if (index=-1) then
+    result:=ansichar(curlen)
+  else
+    result:=fdata[index];
+end;
+
+
+function ShortstringClass.toUnicodeString: unicodestring;
+begin
+  result:=UnicodeString(JLString.Create(TJByteArray(fdata)));
+end;
+
+
+function ShortstringClass.toAnsistring: ansistring;
+begin
+  result:=ansistring(AnsistringClass.Create(shortstring(self)));
+end;
+
+
+function ShortstringClass.toString: JLString;
+begin
+  if curlen<>0 then
+    result:=JLString.Create(TJByteArray(fdata),0,curlen-1)
+  else
+    result:='';
+end;
+
+
+function ShortstringClass.clone: JLObject;
+begin
+  result:=ShortstringClass.Create(Shortstring(self),system.length(fdata));
+end;
+
+
+function ShortstringClass.length: jint;
+begin
+  result:=curlen;
+end;
+
+
+class function AnsiCharArrayClass.CreateFromLiteralStringBytes(const u: unicodestring; maxlen: byte): TAnsiCharArray;
+var
+  i: longint;
+begin
+  { used to construct constant chararrays from Java string constants }
+  setlength(result,system.length(u));
+  for i:=1 to system.length(u) do
+    result[i-1]:=ansichar(ord(u[i]));
+end;
+
+
+procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
+begin
+  if len>255 then
+    len:=255;
+  ShortstringClass(s).curlen:=len;
+end;
+
+
+procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
+var
+  len: longint;
+begin
+  len:=length(sstr);
+  if len>high(res) then
+    len:=high(res);
+  ShortstringClass(res).curlen:=len;
+  JLSystem.ArrayCopy(JLObject(ShortstringClass(sstr).fdata),0,JLObject(ShortstringClass(res).fdata),0,len);
+end;
+
+
+procedure fpc_shortstr_concat(var dests:shortstring;const s1,s2:shortstring);compilerproc;
+var
+  tmpres: ShortstringClass;
+  s1l, s2l: longint;
+begin
+  s1l:=length(s1);
+  s2l:=length(s2);
+  if (s1l+s2l)>high(dests) then
+    begin
+      if s1l>high(dests) then
+        s1l:=high(dests);
+      s2l:=high(dests)-s1l;
+    end;
+  if ShortstringClass(dests)=ShortstringClass(s1) then
+    JLSystem.ArrayCopy(JLObject(ShortstringClass(s2).fdata),0,JLObject(ShortstringClass(dests).fdata),s1l,s2l)
+  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(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(s2).fdata),0,JLObject(ShortstringClass(dests).fdata),s1l,s2l)
+    end;
+  ShortstringClass(dests).curlen:=s1l+s2l;
+end;
+
+
+procedure fpc_shortstr_concat_multi(var dests:shortstring;const sarr:array of ShortstringClass);compilerproc;
+var
+  s2l : byte;
+  LowStart,i,
+  Len : longint;
+  needtemp : boolean;
+  tmpstr  : shortstring;
+  p,pdest  : ShortstringClass;
+begin
+  if high(sarr)=0 then
+    begin
+      DestS:='';
+      exit;
+    end;
+  lowstart:=low(sarr);
+  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
+        begin
+          needtemp:=true;
+          break;
+        end;
+    end;
+  if needtemp then
+    begin
+      lowstart:=low(sarr);
+      tmpstr:='';
+      pdest:=ShortstringClass(tmpstr)
+    end
+  else
+    begin
+      { Start with empty DestS if we start with concatting
+        the first array element }
+      if lowstart=low(sarr) then
+        DestS:='';
+      pdest:=ShortstringClass(DestS);
+    end;
+  { Concat all strings, except the string we already
+    copied in DestS }
+  Len:=pdest.curlen;
+  for i:=lowstart to high(sarr) do
+    begin
+      p:=sarr[i];
+      if assigned(p) then
+        begin
+          s2l:=p.curlen;
+          if Len+s2l>high(dests) then
+            s2l:=high(dests)-Len;
+          JLSystem.ArrayCopy(JLObject(p.fdata),0,JLObject(pdest.fdata),len,s2l);
+          inc(Len,s2l);
+        end;
+    end;
+  pdest.curlen:=len;
+  if needtemp then
+    DestS:=TmpStr;
+end;
+
+
+procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc;
+var
+  s1l, s2l : integer;
+begin
+  s1l:=length(s1);
+  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);
+  s1[0]:=chr(s1l+s2l);
+end;
+
+
+function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc;
+Var
+  MaxI,Temp, i : SizeInt;
+begin
+  if ShortstringClass(left)=ShortstringClass(right) then
+    begin
+      result:=0;
+      exit;
+    end;
+  Maxi:=Length(left);
+  temp:=Length(right);
+  If MaxI>Temp then
+    MaxI:=Temp;
+  if MaxI>0 then
+    begin
+      for i:=0 to MaxI-1 do
+        begin
+          result:=ord(ShortstringClass(left).fdata[i])-ord(ShortstringClass(right).fdata[i]);
+          if result<>0 then
+            exit;
+        end;
+      result:=Length(left)-Length(right);
+    end
+  else
+    result:=Length(left)-Length(right);
+end;
+
+
+function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
+Var
+  MaxI,Temp : SizeInt;
+begin
+  if ShortstringClass(left)=ShortstringClass(right) then
+    begin
+      result:=0;
+      exit;
+    end;
+  result:=ord(not JUArrays.equals(TJByteArray(ShortstringClass(left).fdata),TJByteArray(ShortstringClass(right).fdata)));
+end;
+
+
+procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of AnsiChar; zerobased: boolean = true); compilerproc;
+var
+ l: longint;
+ index: longint;
+ len: byte;
+ foundnull: boolean;
+begin
+  l:=high(arr)+1;
+  if l>=high(res)+1 then
+    l:=high(res)
+  else if l<0 then
+    l:=0;
+  if zerobased then
+    begin
+      foundnull:=false;
+      for index:=low(arr) to l-1 do
+        if arr[index]=#0 then
+          begin
+            foundnull:=true;
+            break;
+          end;
+      if not foundnull then
+        len:=l
+      else
+        len:=index;
+    end
+  else
+    len:=l;
+  JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(ShortstringClass(res).fdata),0,len);
+  ShortstringClass(res).curlen:=len;
+end;
+
+
+procedure fpc_shortstr_to_chararray(out res: array of AnsiChar; const src: ShortString); compilerproc;
+var
+  len: longint;
+begin
+  len:=length(src);
+  if len>length(res) then
+    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);
+  JUArrays.fill(TJByteArray(@res),len,high(res),0);
+end;
+
+
+procedure fpc_Char_To_ShortStr(out res : shortstring;const c : AnsiChar) compilerproc;
+{
+  Converts a WideChar to a ShortString;
+}
+
+begin
+  setlength(res,1);
+  ShortstringClass(res).fdata[0]:=c;
+end;
+
+
+Function  fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
+begin
+  if count<0 then
+   count:=0;
+  if index>1 then
+   dec(index)
+  else
+   index:=0;
+  if index>length(s) then
+   count:=0
+  else
+   if count>length(s)-index then
+    count:=length(s)-index;
+  ShortstringClass(result).curlen:=count;
+  JLSystem.ArrayCopy(JLObject(ShortstringClass(s).fdata),index,JLObject(ShortstringClass(result).fdata),0,count);
+end;
+
+
+function  fpc_char_copy(c:AnsiChar;index : SizeInt;count : SizeInt): shortstring;compilerproc;
+begin
+  if (index=1) and (Count>0) then
+   fpc_char_Copy:=c
+  else
+   fpc_char_Copy:='';
+end;
+
+
+function upcase(const s : shortstring) : shortstring;
+var
+  u : unicodestring;
+begin
+  u:=s;
+  result:=upcase(u);
+end;
+
+
+function lowercase(const s : shortstring) : shortstring;
+var
+  u : unicodestring;
+begin
+  u:=s;
+  result:=lowercase(u);
+end;
+
+
+Function Pos (Const Substr : Shortstring; Const Source : Shortstring) : SizeInt;
+var
+  i,j,k,MaxLen, SubstrLen : SizeInt;
+begin
+  Pos:=0;
+  SubstrLen:=Length(SubStr);
+  if SubstrLen>0 then
+   begin
+     MaxLen:=Length(source)-Length(SubStr);
+     i:=0;
+     while (i<=MaxLen) do
+      begin
+        inc(i);
+        j:=0;
+        k:=i-1;
+        while (j<SubstrLen) and
+              (ShortstringClass(SubStr).fdata[j]=ShortstringClass(Source).fdata[k]) do
+          begin
+            inc(j);
+            inc(k);
+          end;
+        if (j=SubstrLen) then
+         begin
+           Pos:=i;
+           exit;
+         end;
+      end;
+   end;
+end;
+
+
+{ Faster version for a char alone. Must be implemented because   }
+{ pos(c: char; const s: shortstring) also exists, so otherwise   }
+{ using pos(char,pchar) will always call the shortstring version }
+{ (exact match for first argument), also with $h+ (JM)           }
+Function Pos (c : AnsiChar; Const s : ShortString) : SizeInt;
+var
+  i: SizeInt;
+begin
+  for i:=1 to length(s) do
+   begin
+     if ShortstringClass(s).fdata[i-1]=c then
+      begin
+        pos:=i;
+        exit;
+      end;
+   end;
+  pos:=0;
+end;
+
+

rtl/java/system.pp

@@ -24,7 +24,7 @@ Unit system;
 
 {$define FPC_IS_SYSTEM}
 
-{$I-,Q-,H-,R-,V-}
+{$I-,Q-,H-,R-,V-,P+}
 {$implicitexceptions off}
 {$mode objfpc}
 
@@ -122,6 +122,7 @@ type
 {$i innr.inc}
 {$i jmathh.inc}
 {$i jrech.inc}
+{$i sstringh.inc}
 {$i jdynarrh.inc}
 {$i astringh.inc}
 
@@ -264,13 +265,6 @@ function SarInt64(Const AValue : Int64;Shift : Byte): Int64;[internproc:fpc_in_s
  **********************************************************************
 }
 
-{$ifndef nounsupported}
-{$i astrings.inc}
-{$endif}
-{$i ustrings.inc}
-{$i rtti.inc}
-{$i jrec.inc}
-{$i jint64.inc}
 
 function min(a,b : longint) : longint;
   begin
@@ -280,6 +274,14 @@ function min(a,b : longint) : longint;
        min:=b;
   end;
 
+
+{$i sstrings.inc}
+{$i astrings.inc}
+{$i ustrings.inc}
+{$i rtti.inc}
+{$i jrec.inc}
+{$i jint64.inc}
+
 { copying helpers }
 
 procedure fpc_copy_shallow_array(src, dst: JLObject; srcstart: jint = -1; srccopylen: jint = -1);
@@ -331,6 +333,27 @@ procedure fpc_copy_jrecord_array(src, dst: TJRecordArray; srcstart: jint = -1; s
   end;
 
 
+procedure fpc_copy_jshortstring_array(src, dst: TShortstringArray; srcstart: jint = -1; srccopylen: jint = -1);
+  var
+    i: longint;
+    srclen, dstlen: jint;
+  begin
+    srclen:=length(src);
+    dstlen:=length(dst);
+    if srcstart=-1 then
+      srcstart:=0
+    else if srcstart>=srclen then
+      exit;
+    if srccopylen=-1 then
+      srccopylen:=srclen
+    else if srcstart+srccopylen>srclen then
+      srccopylen:=srclen-srcstart;
+    { no arraycopy, have to clone each element }
+    for i:=0 to min(srccopylen,dstlen)-1 do
+      dst[i]:=ShortstringClass(src[srcstart+i].clone);
+  end;
+
+
 { 1-dimensional setlength routines }
 
 function fpc_setlength_dynarr_generic(aorg, anew: JLObject; deepcopy: boolean; docopy: boolean = true): JLObject;
@@ -375,6 +398,19 @@ function fpc_setlength_dynarr_jrecord(aorg, anew: TJRecordArray; deepcopy: boole
   end;
 
 
+function fpc_setlength_dynarr_jshortstring(aorg, anew: TShortstringArray; deepcopy: boolean): TShortstringArray;
+  begin
+    if deepcopy or
+       (length(aorg)<>length(anew)) then
+      begin
+        fpc_copy_jshortstring_array(aorg,anew);
+        result:=anew
+      end
+    else
+      result:=aorg;
+  end;
+
+
 { multi-dimensional setlength routine }
 function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: boolean; ndim: longint; eletype: jchar): TJObjectArray;
   var
@@ -408,6 +444,13 @@ function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: bool
               for i:=succ(partdone) to high(result) do
                 result[i]:=JLObject(fpc_setlength_dynarr_jrecord(nil,TJRecordArray(anew[i]),deepcopy));
             end;
+          FPCJDynArrTypeShortstring:
+            begin
+              for i:=low(result) to partdone do
+                result[i]:=JLObject(fpc_setlength_dynarr_jshortstring(TShortstringArray(aorg[i]),TShortstringArray(anew[i]),deepcopy));
+              for i:=succ(partdone) to high(result) do
+                result[i]:=JLObject(fpc_setlength_dynarr_jshortstring(nil,TShortstringArray(anew[i]),deepcopy));
+            end;
           else
             begin
               for i:=low(result) to partdone do
@@ -453,6 +496,8 @@ function fpc_dynarray_copy(src: JLObject; start, len: longint; ndim: longint; el
         case eletype of
           FPCJDynArrTypeRecord:
             fpc_copy_jrecord_array(TJRecordArray(src),TJRecordArray(result),start,len);
+          FPCJDynArrTypeShortstring:
+            fpc_copy_jshortstring_array(TShortstringArray(src),TShortstringArray(result),start,len);
           else
             fpc_copy_shallow_array(src,result,start,len);
         end

rtl/java/ustrings.inc

@@ -35,7 +35,7 @@ begin
   result:=JLString.create(data);
 end;
 
-(*
+
 procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); [Public, alias: 'FPC_UNICODESTR_TO_SHORTSTR'];compilerproc;
 {
   Converts a UnicodeString to a ShortString;
@@ -48,9 +48,7 @@ begin
   Size:=Length(S2);
   if Size>0 then
     begin
-      If Size>high(res) then
-        Size:=high(res);
-      widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(S2),temp,Size);
+      temp:=s2;
       res:=temp;
     end;
 end;
@@ -66,13 +64,8 @@ begin
   result:='';
   Size:=Length(S2);
   if Size>0 then
-    begin
-      widestringmanager.Ansi2UnicodeMoveProc(PChar(@S2[1]),result,Size);
-      { Terminating Zero }
-      PUnicodeChar(Pointer(fpc_ShortStr_To_UnicodeStr)+Size*sizeof(UnicodeChar))^:=#0;
-    end;
+    result:=unicodestring(JLString.Create(TJByteArray(ShortstringClass(S2).fdata),0,length(S2)));
 end;
-*)
 
 Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString): AnsiString; compilerproc;
 {
@@ -235,31 +228,16 @@ begin
   result:=chr(arrb[0]);
 end;
 
-(*
-{$ifndef FPC_STRTOSHORTSTRINGPROC}
-Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
-{
-  Converts a WideChar to a ShortString;
-}
-var
-  s: ansistring;
-begin
-  widestringmanager.Wide2AnsiMoveProc(@c, s, 1);
-  fpc_WChar_To_ShortStr:= s;
-end;
-{$else FPC_STRTOSHORTSTRINGPROC}
 procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
 {
   Converts a WideChar to a ShortString;
 }
 var
-  s: ansistring;
+  u: unicodestring;
 begin
-  widestringmanager.Wide2AnsiMoveProc(@c,s,1);
-  res:=s;
+  u:=c;
+  res:=u;
 end;
-{$endif FPC_STRTOSHORTSTRINGPROC}
-*)
 
 Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
 {
@@ -272,41 +250,19 @@ begin
   result:=JLString.create(arr);
 end;
 
-(*
+
 Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
 {
   Converts a UnicodeChar to a AnsiString;
 }
-begin
-  widestringmanager.Unicode2AnsiMoveProc(@c, fpc_UChar_To_AnsiStr, 1);
-end;
-
-
-{$ifndef FPC_STRTOSHORTSTRINGPROC}
-Function fpc_UChar_To_ShortStr(const c : UnicodeChar): ShortString; compilerproc;
-{
-  Converts a UnicodeChar to a ShortString;
-}
 var
-  s: ansistring;
+  u: unicodestring;
 begin
-  widestringmanager.Unicode2AnsiMoveProc(@c, s, 1);
-  fpc_UChar_To_ShortStr:= s;
+  u:=c;
+  result:=u;
 end;
-{$else FPC_STRTOSHORTSTRINGPROC}
-procedure fpc_UChar_To_ShortStr(out res : shortstring;const c : UnicodeChar) compilerproc;
-{
-  Converts a UnicodeChar to a ShortString;
-}
-var
-  s: ansistring;
-begin
-  widestringmanager.Unicode2AnsiMoveProc(@c,s,1);
-  res:=s;
-end;
-{$endif FPC_STRTOSHORTSTRINGPROC}
-
 
+(*
 Function fpc_PChar_To_UnicodeStr(const p : pchar): UnicodeString; compilerproc;
 Var
   L : SizeInt;
@@ -425,8 +381,7 @@ begin
   result:=JLString.create(arr,0,i);
 end;
 
-
-Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc;
+Function real_widechararray_to_unicodestr(const arr: array of widechar; zerobased: boolean): Unicodestring;
 var
   i  : SizeInt;
   foundnull  : boolean;
@@ -448,106 +403,23 @@ begin
   result:=JLString.create(arr,0,i);
 end;
 
-(*
-{ due to their names, the following procedures should be in wstrings.inc,
-  however, the compiler generates code using this functions on all platforms }
-{$ifndef FPC_STRTOSHORTSTRINGPROC}
-function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring;[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR']; compilerproc;
-var
-  l: longint;
- index: longint;
- len: byte;
- temp: ansistring;
+Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc;
 begin
-  l := high(arr)+1;
-  if l>=256 then
-    l:=255
-  else if l<0 then
-    l:=0;
-  if zerobased then
-    begin
-      index:=IndexWord(arr[0],l,0);
-      if (index < 0) then
-        len := l
-      else
-        len := index;
-    end
-  else
-    len := l;
-  widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,len);
-  fpc_WideCharArray_To_ShortStr := temp;
+  result:=real_widechararray_to_unicodestr(arr,zerobased);
 end;
-{$else FPC_STRTOSHORTSTRINGPROC}
+
+{ due to their names, the following procedures should be in wstrings.inc,
+  however, the compiler generates code using this functions on all platforms }
 procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true);[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR']; compilerproc;
-var
-  l: longint;
-  index: ptrint;
-  len: byte;
-  temp: ansistring;
 begin
-  l := high(arr)+1;
-  if l>=high(res)+1 then
-    l:=high(res)
-  else if l<0 then
-    l:=0;
-  if zerobased then
-    begin
-      index:=IndexWord(arr[0],l,0);
-      if index<0 then
-        len:=l
-      else
-        len:=index;
-    end
-  else
-    len:=l;
-  widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,len);
-  res:=temp;
-end;
-{$endif FPC_STRTOSHORTSTRINGPROC}
-*)
-Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
-{$ifdef nounsupported}
-var
-  i  : SizeInt;
-{$endif}
-begin
-{$ifdef nounsupported}
-  if (zerobased) then
-    begin
-      i:=IndexWord(arr,high(arr)+1,0);
-      if i = -1 then
-        i := high(arr)+1;
-    end
-  else
-    i := high(arr)+1;
-  SetLength(fpc_WideCharArray_To_AnsiStr,i);
-  widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),fpc_WideCharArray_To_AnsiStr,i);
-{$endif}
+  res:=real_widechararray_to_unicodestr(arr,zerobased);
 end;
 
-Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
-var
-  i  : SizeInt;
-  foundnull  : boolean;
+Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
 begin
-  if (zerobased) then
-    begin
-      foundnull:=false;
-      for i:=low(arr) to high(arr) do
-        if arr[i]=#0 then
-          begin
-            foundnull:=true;
-            break;
-          end;
-      if not foundnull then
-        i := high(arr)+1;
-    end
-  else
-    i := high(arr)+1;
-  result:=JLString.create(arr,0,i);
+  result:=real_widechararray_to_unicodestr(arr,zerobased);
 end;
 
-
 procedure fpc_unicodestr_to_chararray(out res: array of AnsiChar; const src: UnicodeString); compilerproc;
 var
   i, len: SizeInt;
@@ -591,7 +463,6 @@ begin
 end;
 
 
-(*
 procedure fpc_ansistr_to_unicodechararray(out res: array of unicodechar; const src: AnsiString); compilerproc;
 var
   len: SizeInt;
@@ -600,84 +471,68 @@ begin
   len := length(src);
   { make sure we don't dereference src if it can be nil (JM) }
   if len > 0 then
-    widestringmanager.ansi2unicodemoveproc(pchar(@src[1]),temp,len);
+    temp:=src;
   len := length(temp);
   if len > length(res) then
     len := length(res);
 
-{$r-}
-  move(temp[1],res[0],len*sizeof(unicodechar));
-  fillchar(res[len],(length(res)-len)*SizeOf(UnicodeChar),0);
-{$ifdef RangeCheckWasOn}
-{$r+}
-{$endif}
+  JLString(temp).getChars(0,len,res,0);
+  JUArrays.fill(res,len,high(res),#0);
 end;
 
+(*
 procedure fpc_shortstr_to_unicodechararray(out res: array of unicodechar; const src: ShortString); compilerproc;
 var
   len: longint;
   temp : unicodestring;
 begin
   len := length(src);
-  { make sure we don't access char 1 if length is 0 (JM) }
+  { temp is initialized with an empty string, so no need to convert src in case
+    it's also empty}
   if len > 0 then
-    widestringmanager.ansi2unicodemoveproc(pchar(@src[1]),temp,len);
+    temp:=src;
   len := length(temp);
-  if len > length(res) then
-    len := length(res);
-{$r-}
-  move(temp[1],res[0],len*sizeof(unicodechar));
-  fillchar(res[len],(length(res)-len)*SizeOf(UnicodeChar),0);
-{$ifdef RangeCheckWasOn}
-{$r+}
-{$endif}
+  if len > high(res)+1 then
+    len := high(res)+1;
+
+  JLString(temp).getChars(0,len,res,0);
+  JUArrays.fill(res,len,high(res),#0);
 end;
 *)
 procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
-{$ifdef nounsupported}
 var
   len: SizeInt;
   temp: widestring;
-{$endif}
 begin
-{$ifdef nounsupported}
   len := length(src);
   { make sure we don't dereference src if it can be nil (JM) }
   if len > 0 then
-    widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
+    temp:=src;
   len := length(temp);
-  if len > length(res) then
-    len := length(res);
+  if len > high(res)+1 then
+    len := high(res)+1;
 
-{$r-}
-  move(temp[1],res[0],len*sizeof(widechar));
-  fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
-{$ifdef RangeCheckWasOn}
-{$r+}
-{$endif}
-{$endif}
+  JLString(temp).getChars(0,len,res,0);
+  JUArrays.fill(res,len,high(res),#0);
 end;
-(*
+
 procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
 var
   len: longint;
-  temp : widestring;
+  temp : unicodestring;
 begin
   len := length(src);
-  { make sure we don't access char 1 if length is 0 (JM) }
+  { temp is initialized with an empty string, so no need to convert src in case
+    it's also empty}
   if len > 0 then
-    widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
+    temp:=src;
   len := length(temp);
-  if len > length(res) then
-    len := length(res);
-{$r-}
-  move(temp[1],res[0],len*sizeof(widechar));
-  fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
-{$ifdef RangeCheckWasOn}
-{$r+}
-{$endif}
+  if len > high(res)+1 then
+    len := high(res)+1;
+
+  JLString(temp).getChars(0,len,res,0);
+  JUArrays.fill(res,len,high(res),#0);
 end;
-*)
 
 procedure fpc_unicodestr_to_widechararray(out res: array of widechar; const src: UnicodeString); compilerproc;
 var
@@ -686,8 +541,7 @@ begin
   len := length(src);
   if len > length(res) then
     len := length(res);
-  for i:=0 to len-1 do
-    res[i]:=src[i+1];
+  JLString(src).getChars(0,len,res,0);
 end;