Browse Source

+ shortstring support for the JVM target (including accessing character 0 as
the "length byte")

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

Jonas Maebe 14 years ago
parent
commit
6857dde33e

+ 2 - 0
.gitattributes

@@ -7364,6 +7364,8 @@ rtl/java/jrech.inc svneol=native#text/plain
 rtl/java/objpas.pp svneol=native#text/plain
 rtl/java/objpas.pp svneol=native#text/plain
 rtl/java/rtl.cfg svneol=native#text/plain
 rtl/java/rtl.cfg svneol=native#text/plain
 rtl/java/rtti.inc 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/system.pp svneol=native#text/plain
 rtl/java/ustringh.inc svneol=native#text/plain
 rtl/java/ustringh.inc svneol=native#text/plain
 rtl/java/ustrings.inc svneol=native#text/plain
 rtl/java/ustrings.inc svneol=native#text/plain

+ 60 - 8
compiler/jvm/hlcgcpu.pas

@@ -76,6 +76,7 @@ uses
       procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
       procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
 
 
       procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);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_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;
       procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override;
@@ -186,6 +187,7 @@ uses
       { concatcopy helpers }
       { concatcopy helpers }
       procedure concatcopy_normal_array(list: TAsmList; size: tdef; const source, dest: treference);
       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_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 }
       { generate a call to a routine in the system unit }
       procedure g_call_system_proc(list: TAsmList; const procname: string);
       procedure g_call_system_proc(list: TAsmList; const procname: string);
@@ -256,6 +258,9 @@ implementation
             result:=R_INTREGISTER
             result:=R_INTREGISTER
           else
           else
             result:=R_ADDRESSREGISTER;
             result:=R_ADDRESSREGISTER;
+        { shortstrings are implemented via classes }
+        else if is_shortstring(def) then
+          result:=R_ADDRESSREGISTER
         else
         else
           result:=inherited;
           result:=inherited;
       end;
       end;
@@ -636,20 +641,29 @@ implementation
       { all dimensions are removed from the stack, an array reference is
       { all dimensions are removed from the stack, an array reference is
         added }
         added }
       decstack(list,initdim-1);
       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;
       elemdef:=tarraydef(arrdef).elementdef;
       for i:=1 to pred(initdim) do
       for i:=1 to pred(initdim) do
         elemdef:=tarraydef(elemdef).elementdef;
         elemdef:=tarraydef(elemdef).elementdef;
-      if elemdef.typ=recorddef then
+      if (elemdef.typ=recorddef) or
+         is_shortstring(elemdef) then
         begin
         begin
           { duplicate array reference }
           { duplicate array reference }
           list.concat(taicpu.op_none(a_dup));
           list.concat(taicpu.op_none(a_dup));
           incstack(list,1);
           incstack(list,1);
           a_load_const_stack(list,s32inttype,initdim-1,R_INTREGISTER);
           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);
           decstack(list,3);
         end;
         end;
     end;
     end;
@@ -1120,9 +1134,13 @@ implementation
           end;
           end;
         recorddef:
         recorddef:
           procname:='FPC_COPY_JRECORD_ARRAY';
           procname:='FPC_COPY_JRECORD_ARRAY';
-        floatdef,
-        stringdef:
+        floatdef:
           procname:='FPC_COPY_SHALLOW_ARRAY';
           procname:='FPC_COPY_SHALLOW_ARRAY';
+        stringdef:
+          if is_shortstring(eledef) then
+            procname:='FPC_COPY_JSHORTSTRING_ARRAY'
+          else
+            procname:='FPC_COPY_SHALLOW_ARRAY';
         setdef,
         setdef,
         variantdef:
         variantdef:
           begin
           begin
@@ -1179,6 +1197,27 @@ implementation
       end;
       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);
   procedure thlcgjvm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
     var
     var
       handled: boolean;
       handled: boolean;
@@ -1198,11 +1237,24 @@ implementation
             concatcopy_record(list,size,source,dest);
             concatcopy_record(list,size,source,dest);
             handled:=true;
             handled:=true;
           end;
           end;
+        stringdef:
+          begin
+            if is_shortstring(size) then
+              begin
+                concatcopy_shortstring(list,size,source,dest);
+                handled:=true;
+              end;
+          end;
       end;
       end;
       if not handled then
       if not handled then
         inherited;
         inherited;
     end;
     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);
   procedure thlcgjvm.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1, ref2: treference);
     var
     var
       dstack_slots: longint;
       dstack_slots: longint;

+ 5 - 7
compiler/jvm/njvmadd.pas

@@ -86,14 +86,15 @@ interface
         case nodetype of
         case nodetype of
           addn:
           addn:
             begin
             begin
-{$ifndef nounsupported}
                if is_shortstring(resultdef) then
                if is_shortstring(resultdef) then
                  begin
                  begin
-                   result:=left;
-                   left:=nil;
+                   result:=inherited;
                    exit;
                    exit;
                  end;
                  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
               if (left.nodetype=stringconstn) and (tstringconstnode(left).len=0) then
                 begin
                 begin
                   result:=right;
                   result:=right;
@@ -122,9 +123,6 @@ interface
             end;
             end;
           ltn,lten,gtn,gten,equaln,unequaln :
           ltn,lten,gtn,gten,equaln,unequaln :
             begin
             begin
-{$ifndef nounsupported}
-             left.resultdef:=cunicodestringtype;
-{$endif nounsupported}
               { call compare routine }
               { call compare routine }
               cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare';
               cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare';
               { for equality checks use optimized version }
               { for equality checks use optimized version }

+ 33 - 1
compiler/jvm/njvmcnv.pas

@@ -717,6 +717,21 @@ implementation
             exit;
             exit;
           end;
           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}
 {$ifndef nounsupported}
         { generated in nmem; replace voidpointertype with java_jlobject }
         { generated in nmem; replace voidpointertype with java_jlobject }
         if nf_load_procvar in flags then
         if nf_load_procvar in flags then
@@ -780,6 +795,13 @@ implementation
             (def=java_ansistring);
             (def=java_ansistring);
         end;
         end;
 
 
+      function shortstrcompatible(def: tdef): boolean;
+        begin
+           result:=
+             (def=java_jlobject) or
+             (def=java_shortstring);
+        end;
+
       begin
       begin
         if is_wide_or_unicode_string(todef) then
         if is_wide_or_unicode_string(todef) then
           begin
           begin
@@ -797,6 +819,14 @@ implementation
           begin
           begin
             result:=ansistrcompatible(todef);
             result:=ansistrcompatible(todef);
           end
           end
+        else if is_shortstring(todef) then
+          begin
+            result:=shortstrcompatible(fromdef)
+          end
+        else if is_shortstring(fromdef) then
+          begin
+            result:=shortstrcompatible(todef)
+          end
         else
         else
           result:=false;
           result:=false;
       end;
       end;
@@ -972,7 +1002,9 @@ implementation
       else if is_wide_or_unicode_string(checkdef) then
       else if is_wide_or_unicode_string(checkdef) then
         checkdef:=java_jlstring
         checkdef:=java_jlstring
       else if is_ansistring(checkdef) then
       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
       if checkdef.typ in [objectdef,recorddef] then
         current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcode,current_asmdata.RefAsmSymbol(tabstractrecorddef(checkdef).jvm_full_typename(true))))
         current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcode,current_asmdata.RefAsmSymbol(tabstractrecorddef(checkdef).jvm_full_typename(true))))
       else if checkdef.typ=classrefdef then
       else if checkdef.typ=classrefdef then

+ 14 - 4
compiler/jvm/njvmcon.pas

@@ -68,7 +68,7 @@ implementation
 
 
     function tjvmstringconstnode.pass_1: tnode;
     function tjvmstringconstnode.pass_1: tnode;
       var
       var
-        astrclass: tobjectdef;
+        strclass: tobjectdef;
         psym: tsym;
         psym: tsym;
         pw: pcompilerwidestring;
         pw: pcompilerwidestring;
       begin
       begin
@@ -89,11 +89,21 @@ implementation
         ascii2unicode(value_str,len,pw,false);
         ascii2unicode(value_str,len,pw,false);
         ansistringdispose(value_str,len);
         ansistringdispose(value_str,len);
         pcompilerwidestring(value_str):=pw;
         pcompilerwidestring(value_str):=pw;
-        cst_type:=cst_unicodestring;
         { and now add a node to convert the data into ansistring format at
         { and now add a node to convert the data into ansistring format at
           run time }
           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
         if not assigned(psym) or
            (psym.typ<>procsym) then
            (psym.typ<>procsym) then
           internalerror(2011052001);
           internalerror(2011052001);

+ 42 - 39
compiler/jvm/njvminl.pas

@@ -100,9 +100,8 @@ implementation
     function tjvminlinenode.typecheck_length(var handled: boolean): tnode;
     function tjvminlinenode.typecheck_length(var handled: boolean): tnode;
       begin
       begin
         typecheckpass(left);
         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
           begin
             resultdef:=s32inttype;
             resultdef:=s32inttype;
             result:=nil;
             result:=nil;
@@ -391,17 +390,25 @@ implementation
           end
           end
         else
         else
           begin
           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;
           end;
           end;
         tcallparanode(newparas).left:=ctypeconvnode.create_explicit(tcallparanode(newparas).left,objarraydef);
         tcallparanode(newparas).left:=ctypeconvnode.create_explicit(tcallparanode(newparas).left,objarraydef);
@@ -476,22 +483,21 @@ implementation
               end;
               end;
             left:=nil;
             left:=nil;
           end
           end
-{$ifndef nounsupported}
-        else if left.resultdef.typ=stringdef then
-          begin
-            result:=cnothingnode.create;
-          end
-{$endif}
         else
         else
           internalerror(2011031405);
           internalerror(2011031405);
       end;
       end;
 
 
 
 
     function tjvminlinenode.first_setlength: tnode;
     function tjvminlinenode.first_setlength: tnode;
-
       begin
       begin
         { reverse the parameter order so we can process them more easily }
         { reverse the parameter order so we can process them more easily }
         left:=reverseparameters(tcallparanode(left));
         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 }
         { treat setlength(x,0) specially: used to init uninitialised locations }
         if not assigned(tcallparanode(tcallparanode(left).right).right) and
         if not assigned(tcallparanode(tcallparanode(left).right).right) and
            is_constintnode(tcallparanode(tcallparanode(left).right).left) and
            is_constintnode(tcallparanode(tcallparanode(left).right).left) and
@@ -563,12 +569,21 @@ implementation
             addstatement(newstatement,ctemprefnode.create(lentemp));
             addstatement(newstatement,ctemprefnode.create(lentemp));
             result:=newblock;
             result:=newblock;
           end
           end
-{$ifndef nounsupported}
-        else if left.resultdef.typ=stringdef then
+        else if is_shortstring(left.resultdef) then
           begin
           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
           end
-{$endif}
+        { should be no other string types }
+        else if left.resultdef.typ=stringdef then
+          internalerror(2011052403)
        else
        else
          result:=inherited first_length;
          result:=inherited first_length;
       end;
       end;
@@ -585,14 +600,6 @@ implementation
             thlcgjvm(hlcg).g_getarraylen(current_asmdata.CurrAsmList,left.location);
             thlcgjvm(hlcg).g_getarraylen(current_asmdata.CurrAsmList,left.location);
             thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
             thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
           end
           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
         else
           internalerror(2011012004);
           internalerror(2011012004);
       end;
       end;
@@ -738,17 +745,13 @@ implementation
             current_asmdata.CurrAsmList.concat(taicpu.op_string(a_ldc,0,@emptystr));
             current_asmdata.CurrAsmList.concat(taicpu.op_string(a_ldc,0,@emptystr));
             thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
             thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
           end
           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
         else if is_dynamic_array(target.resultdef) then
           begin
           begin
             thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,0,R_INTREGISTER);
             thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,0,R_INTREGISTER);
             thlcgjvm(hlcg).g_newarray(current_asmdata.CurrAsmList,target.resultdef,1);
             thlcgjvm(hlcg).g_newarray(current_asmdata.CurrAsmList,target.resultdef,1);
           end
           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
         else
           internalerror(2011031401);
           internalerror(2011031401);
         thlcgjvm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,target.resultdef,target.location);
         thlcgjvm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,target.resultdef,target.location);

+ 25 - 1
compiler/jvm/njvmld.pas

@@ -53,7 +53,7 @@ uses
   verbose,
   verbose,
   aasmdata,
   aasmdata,
   nbas,nld,ncal,nmem,ncnv,
   nbas,nld,ncal,nmem,ncnv,
-  symconst,symsym,symdef,defutil,jvmdef,
+  symconst,symsym,symdef,symtable,defutil,jvmdef,
   paramgr,
   paramgr,
   cgbase,hlcgobj;
   cgbase,hlcgobj;
 
 
@@ -62,6 +62,7 @@ uses
 function tjvmassignmentnode.pass_1: tnode;
 function tjvmassignmentnode.pass_1: tnode;
   var
   var
     target: tnode;
     target: tnode;
+    psym: tsym;
   begin
   begin
     { intercept writes to string elements, because Java strings are immutable
     { intercept writes to string elements, because Java strings are immutable
       -> detour via StringBuilder
       -> detour via StringBuilder
@@ -85,6 +86,29 @@ function tjvmassignmentnode.pass_1: tnode;
         tvecnode(target).right:=nil;
         tvecnode(target).right:=nil;
         exit;
         exit;
       end
       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
     else
       result:=inherited;
       result:=inherited;
   end;
   end;

+ 12 - 6
compiler/jvm/njvmmem.pas

@@ -165,13 +165,19 @@ implementation
         psym: tsym;
         psym: tsym;
         stringclass: tdef;
         stringclass: tdef;
       begin
       begin
-        if is_wide_or_unicode_string(left.resultdef) or
-           is_ansistring(left.resultdef) then
+        if (left.resultdef.typ=stringdef) then
           begin
           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');
             psym:=search_struct_member(tabstractrecorddef(stringclass),'CHARAT');
             if not assigned(psym) or
             if not assigned(psym) or
                (psym.typ<>procsym) then
                (psym.typ<>procsym) then

+ 16 - 5
compiler/jvm/tgcpu.pas

@@ -133,13 +133,24 @@ unit tgcpu;
             begin
             begin
               if is_shortstring(def) then
               if is_shortstring(def) then
                 begin
                 begin
-{$ifndef nounsupported}
                   gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
                   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;
                   result:=true;
-{$else}
-                  internalerror(2011051701);
-{$endif}
-
                 end;
                 end;
             end;
             end;
         end;
         end;

+ 4 - 4
compiler/jvmdef.pas

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

+ 0 - 7
compiler/ncgcnv.pas

@@ -361,13 +361,6 @@ interface
 
 
     procedure tcgtypeconvnode.second_char_to_string;
     procedure tcgtypeconvnode.second_char_to_string;
       begin
       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);
          location_reset_ref(location,LOC_REFERENCE,OS_NO,2);
          case tstringdef(resultdef).stringtype of
          case tstringdef(resultdef).stringtype of
            st_shortstring :
            st_shortstring :

+ 12 - 15
compiler/ncnv.pas

@@ -1091,9 +1091,10 @@ implementation
               result:=hp;
               result:=hp;
            end
            end
          else
          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
            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
              begin
                if (tstringdef(resultdef).stringtype <> st_shortstring) then
                if (tstringdef(resultdef).stringtype <> st_shortstring) then
                  begin
                  begin
@@ -1115,7 +1116,11 @@ implementation
                    newblock:=internalstatements(newstat);
                    newblock:=internalstatements(newstat);
                    restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
                    restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
                    addstatement(newstat,restemp);
                    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))));
                      ctemprefnode.create(restemp),nil))));
                    addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
                    addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
                    addstatement(newstat,ctemprefnode.create(restemp));
                    addstatement(newstat,ctemprefnode.create(restemp));
@@ -2240,7 +2245,10 @@ implementation
                              { perform target-specific explicit typecast
                              { perform target-specific explicit typecast
                                checks }
                                checks }
                              if target_specific_explicit_typeconv then
                              if target_specific_explicit_typeconv then
-                               exit;
+                               begin
+                                 result:=simplify(false);
+                                 exit;
+                               end;
                            end;
                            end;
                        end;
                        end;
                    end
                    end
@@ -3115,17 +3123,6 @@ implementation
         newstat  : tstatementnode;
         newstat  : tstatementnode;
         restemp  : ttempcreatenode;
         restemp  : ttempcreatenode;
       begin
       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 }
         { get the correct procedure name }
         procname := 'fpc_'+tstringdef(left.resultdef).stringtypname+
         procname := 'fpc_'+tstringdef(left.resultdef).stringtypname+
                     '_to_'+tstringdef(resultdef).stringtypname;
                     '_to_'+tstringdef(resultdef).stringtypname;

+ 3 - 2
compiler/nld.pas

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

+ 4 - 0
compiler/nopt.pas

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

+ 13 - 11
compiler/pdecobj.pas

@@ -1275,8 +1275,8 @@ implementation
                   odt_javaclass:
                   odt_javaclass:
                     begin
                     begin
                       if (current_structdef.objname^='TOBJECT') then
                       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
                         begin
                           java_jlobject:=current_objectdef;
                           java_jlobject:=current_objectdef;
                           { the methodpointer type is normally created in
                           { the methodpointer type is normally created in
@@ -1288,15 +1288,17 @@ implementation
                           hrecst.addfield(fsym,vis_hidden);
                           hrecst.addfield(fsym,vis_hidden);
                           methodpointertype:=trecorddef.create('',hrecst);
                           methodpointertype:=trecorddef.create('',hrecst);
                           systemunit.insert(ttypesym.create('$methodpointer',methodpointertype));
                           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;
                 end;
               end;
               end;

+ 18 - 11
compiler/symdef.pas

@@ -800,6 +800,8 @@ interface
        java_jlstring             : tobjectdef;
        java_jlstring             : tobjectdef;
        { FPC java implementation of ansistrings }
        { FPC java implementation of ansistrings }
        java_ansistring           : tobjectdef;
        java_ansistring           : tobjectdef;
+       { FPC java implementation of shortstrings }
+       java_shortstring          : tobjectdef;
 
 
     const
     const
 {$ifdef i386}
 {$ifdef i386}
@@ -1613,8 +1615,11 @@ implementation
             ((d=java_jlobject) or
             ((d=java_jlobject) or
              (d=java_jlstring))) or
              (d=java_jlstring))) or
            ((stringtype=st_ansistring) and
            ((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;
       end;
 
 
 
 
@@ -4830,15 +4835,17 @@ implementation
             not(oo_is_formal in objectoptions) then
             not(oo_is_formal in objectoptions) then
            begin
            begin
              if (objname^='JLOBJECT') then
              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;
            end;
          writing_class_record_dbginfo:=false;
          writing_class_record_dbginfo:=false;
        end;
        end;

+ 2 - 1
rtl/java/astringh.inc

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

+ 27 - 58
rtl/java/astrings.inc

@@ -50,6 +50,12 @@ begin
 end;
 end;
 
 
 
 
+constructor AnsistringClass.Create(const s: shortstring);
+begin
+  Create(ShortstringClass(s).fdata);
+end;
+
+
 constructor AnsistringClass.Create(ch: ansichar);
 constructor AnsistringClass.Create(ch: ansichar);
 begin
 begin
   setlength(fdata,1);
   setlength(fdata,1);
@@ -91,6 +97,12 @@ begin
 end;
 end;
 
 
 
 
+function AnsistringClass.toShortstring(maxlen: byte): shortstring;
+begin
+  result:=shortstring(ShortstringClass.Create(ansistring(self),maxlen));
+end;
+
+
 function AnsistringClass.toString: JLString;
 function AnsistringClass.toString: JLString;
 begin
 begin
   result:=JLString.Create(TJByteArray(fdata));
   result:=JLString.Create(TJByteArray(fdata));
@@ -191,75 +203,37 @@ procedure fpc_AnsiStr_Concat_multi (var DestS:Ansistring;const sarr:array of Ans
 end;
 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;
   Converts a AnsiString to a ShortString;
 }
 }
 Var
 Var
   Size : SizeInt;
   Size : SizeInt;
 begin
 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
   if S2='' then
    res:=''
    res:=''
   else
   else
    begin
    begin
      Size:=Length(S2);
      Size:=Length(S2);
      If Size>high(res) then
      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;
-*)
 end;
 end;
-(*
-{$endif FPC_STRTOSHORTSTRINGPROC}
-*)
+
 
 
 Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
 Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
 {
 {
   Converts a ShortString to a AnsiString;
   Converts a ShortString to a AnsiString;
 }
 }
-(*
 Var
 Var
   Size : SizeInt;
   Size : SizeInt;
-*)
 begin
 begin
-(*
   Size:=Length(S2);
   Size:=Length(S2);
-  Setlength (fpc_ShortStr_To_AnsiStr,Size);
+  Setlength (result,Size);
   if Size>0 then
   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;
 end;
 
 
 
 
@@ -320,8 +294,8 @@ begin
       exit;
       exit;
     end;
     end;
   res:=AnsistringClass.Create;
   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);
   result:=Ansistring(res);
 end;
 end;
 
 
@@ -409,12 +383,12 @@ function fpc_AnsiStr_SetLength (S : AnsiString; l : SizeInt): Ansistring; compil
   Sets The length of string S to L.
   Sets The length of string S to L.
   Makes sure S is unique, and contains enough room.
   Makes sure S is unique, and contains enough room.
 }
 }
-Var
-  lens, lena,
-  movelen : SizeInt;
 begin
 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;
 end;
 
 
 {*****************************************************************************
 {*****************************************************************************
@@ -465,20 +439,15 @@ begin
 end;
 end;
 
 
 Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); compilerproc;
 Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); compilerproc;
-(*
 var
 var
    ofs : SizeInt;
    ofs : SizeInt;
-*)
 begin
 begin
-(*
    if Str='' then
    if Str='' then
      exit;
      exit;
    ofs:=Length(S);
    ofs:=Length(S);
    SetLength(S,ofs+length(Str));
    SetLength(S,ofs+length(Str));
    { the pbyte cast avoids an unique call which isn't necessary because SetLength was just called }
    { 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;
 end;
 
 
 Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc;
 Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc;

+ 8 - 38
rtl/java/compproc.inc

@@ -36,24 +36,16 @@ type
   fpc_normal_set_byte = array[0..31] of byte;
   fpc_normal_set_byte = array[0..31] of byte;
   fpc_normal_set_long = array[0..7] of longint;
   fpc_normal_set_long = array[0..7] of longint;
 
 
-(*
 procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
 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;
 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(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;
 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(const left,right:shortstring) : longint; compilerproc;
 function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
 function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
 
 
+(*
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
 function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
 {$else FPC_STRTOSHORTSTRINGPROC}
 {$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_pchar_length(p:pchar):longint; compilerproc;
 function fpc_pwidechar_length(p:pwidechar):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;
 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;
 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_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
 function  fpc_char_copy(c:AnsiChar;index : SizeInt;count : SizeInt): shortstring;compilerproc;
 function  fpc_char_copy(c:AnsiChar;index : SizeInt;count : SizeInt): shortstring;compilerproc;
-*)
+
 (*
 (*
 { Str() support }
 { Str() support }
 procedure fpc_ShortStr_sint(v : valsint;len : SizeInt;out s : shortstring); compilerproc;
 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
                         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;
 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_UnicodeStr_To_AnsiStr (const S2 : UnicodeString): AnsiString; compilerproc;
 Function fpc_AnsiStr_To_UnicodeStr (Const S2 : AnsiString): UnicodeString; compilerproc;
 Function fpc_AnsiStr_To_UnicodeStr (Const S2 : AnsiString): UnicodeString; compilerproc;
 Function fpc_UnicodeStr_To_WideStr (const S2 : UnicodeString): WideString; 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_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;
 Function fpc_UnicodeCharArray_To_UnicodeStr(const arr: array of unicodechar; zerobased: boolean = true): UnicodeString; compilerproc;
-(*
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
 Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
 {$else FPC_STRTOSHORTSTRINGPROC}
 {$else FPC_STRTOSHORTSTRINGPROC}
 procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true); compilerproc;
 procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true); compilerproc;
 {$endif FPC_STRTOSHORTSTRINGPROC}
 {$endif FPC_STRTOSHORTSTRINGPROC}
-*)
 {$ifndef nounsupported}
 {$ifndef nounsupported}
 Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
 Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
 {$endif}
 {$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;
 Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc;
-(*
 {$ifndef FPC_STRTOCHARARRAYPROC}
 {$ifndef FPC_STRTOCHARARRAYPROC}
 Function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray; compilerproc;
 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;
 Function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray; compilerproc;
 {$else ndef FPC_STRTOCHARARRAYPROC}
 {$else ndef FPC_STRTOCHARARRAYPROC}
 procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
 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;
 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;
 procedure fpc_unicodestr_to_widechararray(out res: array of widechar; const src: UnicodeString); compilerproc;
-(*
 {$endif ndef FPC_STRTOCHARARRAYPROC}
 {$endif ndef FPC_STRTOCHARARRAYPROC}
-*)
 Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt; compilerproc;
 Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt; compilerproc;
 Function fpc_UnicodeStr_Compare_equal(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_Char(const c : UnicodeChar): AnsiChar; compilerproc;
 Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
 Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
 Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc;
 Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc;
-(*
 Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
 Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
 Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
 {$else FPC_STRTOSHORTSTRINGPROC}
 {$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;
 procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
 {$endif FPC_STRTOSHORTSTRINGPROC}
 {$endif FPC_STRTOSHORTSTRINGPROC}
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
 {$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;
 procedure fpc_PUnicodeChar_To_ShortStr(out res : shortstring;const p : punicodechar); compilerproc;
 {$endif FPC_STRTOSHORTSTRINGPROC}
 {$endif FPC_STRTOSHORTSTRINGPROC}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
-*)
 
 
 (*
 (*
 {$ifdef 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) }
   level elements types of the array) }
 procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint);compilerproc;
 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_record(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseRecordType);compilerproc;
+procedure fpc_initialize_array_shortstring(arr: TJObjectArray; normalarrdim: longint; maxlen: byte);compilerproc;
 
 
 (*
 (*
 {$ifdef FPC_SETBASE_USED}
 {$ifdef FPC_SETBASE_USED}

+ 4 - 0
rtl/java/jdynarrh.inc

@@ -25,6 +25,7 @@ type
   TJDoubleArray = array of jdouble;
   TJDoubleArray = array of jdouble;
   TJObjectArray = array of JLObject;
   TJObjectArray = array of JLObject;
   TJRecordArray = array of FpcBaseRecordType;
   TJRecordArray = array of FpcBaseRecordType;
+  TShortstringArray = array of ShortstringClass;
   TJStringArray = array of unicodestring;
   TJStringArray = array of unicodestring;
 
 
 const
 const
@@ -37,6 +38,7 @@ const
   FPCJDynArrTypeJDouble = 'D';
   FPCJDynArrTypeJDouble = 'D';
   FPCJDynArrTypeJObject = 'A';
   FPCJDynArrTypeJObject = 'A';
   FPCJDynArrTypeRecord  = 'R';
   FPCJDynArrTypeRecord  = 'R';
+  FPCJDynArrTypeShortstring  = 'T';
 
 
 { 1-dimensional setlength routines
 { 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_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_jrecord(aorg, anew: TJRecordArray; deepcopy: boolean): TJRecordArray;
+function fpc_setlength_dynarr_jshortstring(aorg, anew: TShortstringArray; deepcopy: boolean): TShortstringArray;
 
 
 { array copying helpers }
 { array copying helpers }
 
 
 procedure fpc_copy_shallow_array(src, dst: JLObject; srcstart: jint = -1; srccopylen: jint = -1);
 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_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
 { 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
   of arrays, so that's the same for all array kinds. Only the type of the final

+ 19 - 0
rtl/java/rtti.inc

@@ -86,3 +86,22 @@ procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint;
       end;
       end;
   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;
+

+ 108 - 0
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);
+
+

+ 507 - 0
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;
+
+

+ 53 - 8
rtl/java/system.pp

@@ -24,7 +24,7 @@ Unit system;
 
 
 {$define FPC_IS_SYSTEM}
 {$define FPC_IS_SYSTEM}
 
 
-{$I-,Q-,H-,R-,V-}
+{$I-,Q-,H-,R-,V-,P+}
 {$implicitexceptions off}
 {$implicitexceptions off}
 {$mode objfpc}
 {$mode objfpc}
 
 
@@ -122,6 +122,7 @@ type
 {$i innr.inc}
 {$i innr.inc}
 {$i jmathh.inc}
 {$i jmathh.inc}
 {$i jrech.inc}
 {$i jrech.inc}
+{$i sstringh.inc}
 {$i jdynarrh.inc}
 {$i jdynarrh.inc}
 {$i astringh.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;
 function min(a,b : longint) : longint;
   begin
   begin
@@ -280,6 +274,14 @@ function min(a,b : longint) : longint;
        min:=b;
        min:=b;
   end;
   end;
 
 
+
+{$i sstrings.inc}
+{$i astrings.inc}
+{$i ustrings.inc}
+{$i rtti.inc}
+{$i jrec.inc}
+{$i jint64.inc}
+
 { copying helpers }
 { copying helpers }
 
 
 procedure fpc_copy_shallow_array(src, dst: JLObject; srcstart: jint = -1; srccopylen: jint = -1);
 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;
   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 }
 { 1-dimensional setlength routines }
 
 
 function fpc_setlength_dynarr_generic(aorg, anew: JLObject; deepcopy: boolean; docopy: boolean = true): JLObject;
 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;
   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 }
 { multi-dimensional setlength routine }
 function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: boolean; ndim: longint; eletype: jchar): TJObjectArray;
 function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: boolean; ndim: longint; eletype: jchar): TJObjectArray;
   var
   var
@@ -408,6 +444,13 @@ function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: bool
               for i:=succ(partdone) to high(result) do
               for i:=succ(partdone) to high(result) do
                 result[i]:=JLObject(fpc_setlength_dynarr_jrecord(nil,TJRecordArray(anew[i]),deepcopy));
                 result[i]:=JLObject(fpc_setlength_dynarr_jrecord(nil,TJRecordArray(anew[i]),deepcopy));
             end;
             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
           else
             begin
             begin
               for i:=low(result) to partdone do
               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
         case eletype of
           FPCJDynArrTypeRecord:
           FPCJDynArrTypeRecord:
             fpc_copy_jrecord_array(TJRecordArray(src),TJRecordArray(result),start,len);
             fpc_copy_jrecord_array(TJRecordArray(src),TJRecordArray(result),start,len);
+          FPCJDynArrTypeShortstring:
+            fpc_copy_jshortstring_array(TShortstringArray(src),TShortstringArray(result),start,len);
           else
           else
             fpc_copy_shallow_array(src,result,start,len);
             fpc_copy_shallow_array(src,result,start,len);
         end
         end

+ 48 - 194
rtl/java/ustrings.inc

@@ -35,7 +35,7 @@ begin
   result:=JLString.create(data);
   result:=JLString.create(data);
 end;
 end;
 
 
-(*
+
 procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); [Public, alias: 'FPC_UNICODESTR_TO_SHORTSTR'];compilerproc;
 procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); [Public, alias: 'FPC_UNICODESTR_TO_SHORTSTR'];compilerproc;
 {
 {
   Converts a UnicodeString to a ShortString;
   Converts a UnicodeString to a ShortString;
@@ -48,9 +48,7 @@ begin
   Size:=Length(S2);
   Size:=Length(S2);
   if Size>0 then
   if Size>0 then
     begin
     begin
-      If Size>high(res) then
-        Size:=high(res);
-      widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(S2),temp,Size);
+      temp:=s2;
       res:=temp;
       res:=temp;
     end;
     end;
 end;
 end;
@@ -66,13 +64,8 @@ begin
   result:='';
   result:='';
   Size:=Length(S2);
   Size:=Length(S2);
   if Size>0 then
   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;
 end;
-*)
 
 
 Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString): AnsiString; compilerproc;
 Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString): AnsiString; compilerproc;
 {
 {
@@ -235,31 +228,16 @@ begin
   result:=chr(arrb[0]);
   result:=chr(arrb[0]);
 end;
 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;
 procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
 {
 {
   Converts a WideChar to a ShortString;
   Converts a WideChar to a ShortString;
 }
 }
 var
 var
-  s: ansistring;
+  u: unicodestring;
 begin
 begin
-  widestringmanager.Wide2AnsiMoveProc(@c,s,1);
-  res:=s;
+  u:=c;
+  res:=u;
 end;
 end;
-{$endif FPC_STRTOSHORTSTRINGPROC}
-*)
 
 
 Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
 Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
 {
 {
@@ -272,41 +250,19 @@ begin
   result:=JLString.create(arr);
   result:=JLString.create(arr);
 end;
 end;
 
 
-(*
+
 Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
 Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
 {
 {
   Converts a UnicodeChar to a AnsiString;
   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
 var
-  s: ansistring;
+  u: unicodestring;
 begin
 begin
-  widestringmanager.Unicode2AnsiMoveProc(@c, s, 1);
-  fpc_UChar_To_ShortStr:= s;
+  u:=c;
+  result:=u;
 end;
 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;
 Function fpc_PChar_To_UnicodeStr(const p : pchar): UnicodeString; compilerproc;
 Var
 Var
   L : SizeInt;
   L : SizeInt;
@@ -425,8 +381,7 @@ begin
   result:=JLString.create(arr,0,i);
   result:=JLString.create(arr,0,i);
 end;
 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
 var
   i  : SizeInt;
   i  : SizeInt;
   foundnull  : boolean;
   foundnull  : boolean;
@@ -448,106 +403,23 @@ begin
   result:=JLString.create(arr,0,i);
   result:=JLString.create(arr,0,i);
 end;
 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
 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;
 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;
 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
 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;
 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
 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;
 end;
 
 
-
 procedure fpc_unicodestr_to_chararray(out res: array of AnsiChar; const src: UnicodeString); compilerproc;
 procedure fpc_unicodestr_to_chararray(out res: array of AnsiChar; const src: UnicodeString); compilerproc;
 var
 var
   i, len: SizeInt;
   i, len: SizeInt;
@@ -591,7 +463,6 @@ begin
 end;
 end;
 
 
 
 
-(*
 procedure fpc_ansistr_to_unicodechararray(out res: array of unicodechar; const src: AnsiString); compilerproc;
 procedure fpc_ansistr_to_unicodechararray(out res: array of unicodechar; const src: AnsiString); compilerproc;
 var
 var
   len: SizeInt;
   len: SizeInt;
@@ -600,84 +471,68 @@ begin
   len := length(src);
   len := length(src);
   { make sure we don't dereference src if it can be nil (JM) }
   { make sure we don't dereference src if it can be nil (JM) }
   if len > 0 then
   if len > 0 then
-    widestringmanager.ansi2unicodemoveproc(pchar(@src[1]),temp,len);
+    temp:=src;
   len := length(temp);
   len := length(temp);
   if len > length(res) then
   if len > length(res) then
     len := length(res);
     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;
 end;
 
 
+(*
 procedure fpc_shortstr_to_unicodechararray(out res: array of unicodechar; const src: ShortString); compilerproc;
 procedure fpc_shortstr_to_unicodechararray(out res: array of unicodechar; const src: ShortString); compilerproc;
 var
 var
   len: longint;
   len: longint;
   temp : unicodestring;
   temp : unicodestring;
 begin
 begin
   len := length(src);
   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
   if len > 0 then
-    widestringmanager.ansi2unicodemoveproc(pchar(@src[1]),temp,len);
+    temp:=src;
   len := length(temp);
   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;
 end;
 *)
 *)
 procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
 procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
-{$ifdef nounsupported}
 var
 var
   len: SizeInt;
   len: SizeInt;
   temp: widestring;
   temp: widestring;
-{$endif}
 begin
 begin
-{$ifdef nounsupported}
   len := length(src);
   len := length(src);
   { make sure we don't dereference src if it can be nil (JM) }
   { make sure we don't dereference src if it can be nil (JM) }
   if len > 0 then
   if len > 0 then
-    widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
+    temp:=src;
   len := length(temp);
   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;
 end;
-(*
+
 procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
 procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
 var
 var
   len: longint;
   len: longint;
-  temp : widestring;
+  temp : unicodestring;
 begin
 begin
   len := length(src);
   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
   if len > 0 then
-    widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
+    temp:=src;
   len := length(temp);
   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;
 end;
-*)
 
 
 procedure fpc_unicodestr_to_widechararray(out res: array of widechar; const src: UnicodeString); compilerproc;
 procedure fpc_unicodestr_to_widechararray(out res: array of widechar; const src: UnicodeString); compilerproc;
 var
 var
@@ -686,8 +541,7 @@ begin
   len := length(src);
   len := length(src);
   if len > length(res) then
   if len > length(res) then
     len := length(res);
     len := length(res);
-  for i:=0 to len-1 do
-    res[i]:=src[i+1];
+  JLString(src).getChars(0,len,res,0);
 end;
 end;