+ unicodestring support for the JVM target (except for multiple adds

    in a single statement, to be added later)
   o the unicodestrings are internally simply java.lang.String instances
   o at the language level, the unicodestrings are assignment-compatible
     with java.lang.String
   o constant strings can be implicitly converted to java.lang.String
   o since java.lang.String is immutable, in particular changing a
     single character in a string is extremely inefficient. This could
     be solved by letting unicodestring map to java.lang.StringBuilder,
     but that would make integration with plain Java code harder

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

.gitattributes

@@ -7359,6 +7359,8 @@ rtl/java/objpas.pp svneol=native#text/plain
 rtl/java/rtl.cfg svneol=native#text/plain
 rtl/java/rtti.inc svneol=native#text/plain
 rtl/java/system.pp svneol=native#text/plain
+rtl/java/ustringh.inc svneol=native#text/plain
+rtl/java/ustrings.inc svneol=native#text/plain
 rtl/jvm/makefile.cpu svneol=native#text/plain
 rtl/linux/Makefile svneol=native#text/plain
 rtl/linux/Makefile.fpc svneol=native#text/plain

compiler/defcmp.pas

@@ -200,6 +200,12 @@ implementation
             exit;
           end;
 
+         { resolve anonymous external definitions }
+         if def_from.typ=objectdef then
+           def_from:=find_real_class_definition(tobjectdef(def_from),false);
+         if def_to.typ=objectdef then
+           def_to:=find_real_class_definition(tobjectdef(def_to),false);
+
          { same def? then we've an exact match }
          if def_from=def_to then
           begin
@@ -523,7 +529,13 @@ implementation
                       begin
                         doconv:=tc_intf_2_string;
                         eq:=te_convert_l1;
-                      end;
+                      end
+                     else if (def_from=java_jlstring) and
+                         is_wide_or_unicode_string(def_to) then
+                       begin
+                         doconv:=tc_equal;
+                         eq:=te_equal;
+                       end
                    end;
                end;
              end;
@@ -1267,23 +1279,24 @@ implementation
 
            objectdef :
              begin
-               { Objective-C/Java classes (handle anonymous externals) }
-               if (def_from.typ=objectdef) and
-                  (find_real_class_definition(tobjectdef(def_from),false) =
-                   find_real_class_definition(tobjectdef(def_to),false)) then
-                 begin
-                   doconv:=tc_equal;
-                   { exact, not equal, because can change between interface
-                     and implementation }
-                   eq:=te_exact;
-                 end
                { object pascal objects }
-               else if (def_from.typ=objectdef) and
+               if (def_from.typ=objectdef) and
                   (tobjectdef(def_from).is_related(tobjectdef(def_to))) then
                 begin
                   doconv:=tc_equal;
                   eq:=te_convert_l1;
                 end
+               { java.lang.string -> unicodestring }
+               else if (def_to=java_jlstring) and
+                       (is_wide_or_unicode_string(def_from) or
+                        (fromtreetype=stringconstn)) then
+                 begin
+                   doconv:=tc_equal;
+                   if is_wide_or_unicode_string(def_from) then
+                     eq:=te_equal
+                   else
+                     eq:=te_convert_l2;
+                 end
                else
                { specific to implicit pointer object types }
                 if is_implicit_pointer_object_type(def_to) then

compiler/jvm/njvmadd.pas

@@ -34,8 +34,9 @@ interface
        { tjvmaddnode }
 
        tjvmaddnode = class(tcgaddnode)
-       protected
           function pass_1: tnode;override;
+       protected
+          function first_addstring: tnode; override;
 
           function cmpnode2signedtopcmp: TOpCmp;
 
@@ -54,12 +55,13 @@ interface
 
     uses
       systems,
-      cutils,verbose,
+      cutils,verbose,constexp,
+      symtable,symdef,
       paramgr,procinfo,
       aasmtai,aasmdata,aasmcpu,defutil,
       hlcgobj,hlcgcpu,cgutils,
       cpupara,
-      ncon,nset,nadd,
+      ncon,nset,nadd,ncal,
       cgobj;
 
 {*****************************************************************************
@@ -74,6 +76,62 @@ interface
       end;
 
 
+    function tjvmaddnode.first_addstring: tnode;
+      var
+        cmpfuncname: string;
+      begin
+        { when we get here, we are sure that both the left and the right }
+        { node are both strings of the same stringtype (JM)              }
+        case nodetype of
+          addn:
+            begin
+              if (left.nodetype=stringconstn) and (tstringconstnode(left).len=0) then
+                begin
+                  result:=right;
+                  left.free;
+                  left:=nil;
+                  right:=nil;
+                  exit;
+                end;
+              if (right.nodetype=stringconstn) and (tstringconstnode(right).len=0) then
+                begin
+                  result:=left;
+                  left:=nil;
+                  right.free;
+                  right:=nil;
+                  exit;
+                end;
+
+              { create the call to the concat routine both strings as arguments }
+              result:=ccallnode.createintern('fpc_'+
+                tstringdef(resultdef).stringtypname+'_concat',
+                ccallparanode.create(right,
+                ccallparanode.create(left,nil)));
+              { we reused the arguments }
+              left := nil;
+              right := nil;
+            end;
+          ltn,lten,gtn,gten,equaln,unequaln :
+            begin
+              { call compare routine }
+              cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare';
+              { for equality checks use optimized version }
+              if nodetype in [equaln,unequaln] then
+                cmpfuncname := cmpfuncname + '_equal';
+
+              result := ccallnode.createintern(cmpfuncname,
+                ccallparanode.create(right,ccallparanode.create(left,nil)));
+              { and compare its result with 0 according to the original operator }
+              result := caddnode.create(nodetype,result,
+                cordconstnode.create(0,s32inttype,false));
+              left := nil;
+              right := nil;
+            end;
+          else
+            internalerror(2011031401);
+        end;
+      end;
+
     function tjvmaddnode.cmpnode2signedtopcmp: TOpCmp;
       begin
         case nodetype of

compiler/jvm/njvmcnv.pas

@@ -31,6 +31,7 @@ interface
     type
        tjvmtypeconvnode = class(tcgtypeconvnode)
           function typecheck_dynarray_to_openarray: tnode; override;
+          function typecheck_string_to_chararray: tnode; override;
 
           procedure second_int_to_int;override;
          { procedure second_string_to_string;override; }
@@ -99,6 +100,34 @@ implementation
      end;
 
 
+   function tjvmtypeconvnode.typecheck_string_to_chararray: tnode;
+     var
+       newblock: tblocknode;
+       newstat: tstatementnode;
+       restemp: ttempcreatenode;
+       chartype: string;
+     begin
+       if (left.nodetype = stringconstn) and
+          (tstringconstnode(left).cst_type=cst_conststring) then
+         inserttypeconv(left,cunicodestringtype);
+       { even constant strings have to be handled via a helper }
+       if is_widechar(tarraydef(resultdef).elementdef) then
+         chartype:='widechar'
+       else
+         chartype:='char';
+       newblock:=internalstatements(newstat);
+       restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
+       addstatement(newstat,restemp);
+       addstatement(newstat,ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+
+         '_to_'+chartype+'array',ccallparanode.create(left,ccallparanode.create(
+         ctemprefnode.create(restemp),nil))));
+       addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
+       addstatement(newstat,ctemprefnode.create(restemp));
+       result:=newblock;
+       left:=nil;
+     end;
+
+
 {*****************************************************************************
                              FirstTypeConv
 *****************************************************************************}

compiler/jvm/njvminl.pas

@@ -37,6 +37,7 @@ interface
           function typecheck_new(var handled: boolean): tnode;
 
           function first_setlength_array: tnode;
+          function first_setlength_string: tnode;
          public
           { typecheck override to intercept handling }
           function pass_typecheck: tnode; override;
@@ -55,6 +56,7 @@ interface
 *)
           function first_new: tnode; override;
           function first_setlength: tnode; override;
+          function first_length: tnode; override;
 
           procedure second_length; override;
 (*
@@ -93,7 +95,8 @@ implementation
       begin
         typecheckpass(left);
         if is_dynamic_array(left.resultdef) or
-           is_open_array(left.resultdef) then
+           is_open_array(left.resultdef) or
+           is_wide_or_unicode_string(left.resultdef) then
           begin
             resultdef:=s32inttype;
             result:=nil;
@@ -334,6 +337,44 @@ implementation
       end;
 
 
+    function tjvminlinenode.first_setlength_string: tnode;
+      var
+        newblock: tblocknode;
+        newstatement: tstatementnode;
+        lefttemp: ttempcreatenode;
+        assignmenttarget: tnode;
+      begin
+        if is_wide_or_unicode_string(left.resultdef) then
+          begin
+            { store left into a temp in case it may contain a function call
+              (which must not be evaluated twice) }
+            lefttemp:=maybereplacewithtempref(tcallparanode(left).left,tcallparanode(left).left.resultdef.size,false);
+            if assigned(lefttemp) then
+              begin
+                newblock:=internalstatements(newstatement);
+                addstatement(newstatement,lefttemp);
+                assignmenttarget:=ctemprefnode.create(lefttemp);
+                typecheckpass(tnode(assignmenttarget));
+              end
+            else
+              assignmenttarget:=tcallparanode(left).left.getcopy;
+            { back to original order for the call }
+            left:=reverseparameters(tcallparanode(left));
+            result:=cassignmentnode.create(assignmenttarget,
+              ccallnode.createintern('fpc_unicodestr_setlength',left));
+            if assigned(lefttemp) then
+              begin
+                addstatement(newstatement,result);
+                addstatement(newstatement,ctempdeletenode.create(lefttemp));
+                result:=newblock;
+              end;
+            left:=nil;
+          end
+        else
+          internalerror(2011031405);
+      end;
+
+
     function tjvminlinenode.first_setlength: tnode;
 
       begin
@@ -351,12 +392,64 @@ implementation
         case left.resultdef.typ of
           arraydef:
             result:=first_setlength_array;
+          stringdef:
+            result:=first_setlength_string;
           else
             internalerror(2011031204);
         end;
       end;
 
 
+    function tjvminlinenode.first_length: tnode;
+      var
+        newblock: tblocknode;
+        newstatement: tstatementnode;
+        lentemp: ttempcreatenode;
+        ifcond,
+        stringnonnull,
+        stringnull: tnode;
+        psym: tsym;
+      begin
+        if is_wide_or_unicode_string(left.resultdef) then
+          begin
+            { if assigned(JLString(left)) then
+                lentemp:=JLString(left).length()
+              else
+                lentemp:=0;
+              --> return lentemp
+            }
+            newblock:=internalstatements(newstatement);
+            lentemp:=ctempcreatenode.create(s32inttype,s32inttype.size,tt_persistent,true);
+            addstatement(newstatement,lentemp);
+            { if-condition }
+            ifcond:=cinlinenode.create(in_assigned_x,false,
+              ccallparanode.create(ctypeconvnode.create_explicit(left.getcopy,java_jlstring),nil));
+            { then-path (reuse left, since last use) }
+            psym:=search_struct_member(java_jlstring,'LENGTH');
+            if not assigned(psym) or
+               (psym.typ<>procsym) then
+              internalerror(2011031403);
+            stringnonnull:=cassignmentnode.create(
+              ctemprefnode.create(lentemp),
+              ccallnode.create(nil,tprocsym(psym),psym.owner,
+                ctypeconvnode.create_explicit(left,java_jlstring),[]));
+            left:=nil;
+            { else-path}
+            stringnull:=cassignmentnode.create(
+              ctemprefnode.create(lentemp),
+              genintconstnode(0));
+            { complete if-statement }
+            addstatement(newstatement,cifnode.create(ifcond,stringnonnull,stringnull));
+            { return temp }
+            addstatement(newstatement,ctempdeletenode.create_normal_temp(lentemp));
+            addstatement(newstatement,ctemprefnode.create(lentemp));
+            result:=newblock;
+          end
+       else
+         result:=inherited first_length;
+      end;
+
+
     procedure tjvminlinenode.second_length;
       begin
         if is_dynamic_array(left.resultdef) or
@@ -497,6 +590,7 @@ implementation
       var
         target: tnode;
         lenpara: tnode;
+        emptystr: ansichar;
       begin
         target:=tcallparanode(left).left;
         lenpara:=tcallparanode(tcallparanode(left).right).left;
@@ -506,7 +600,13 @@ implementation
           internalerror(2011031801);
 
         secondpass(target);
-        if is_dynamic_array(target.resultdef) then
+        if is_wide_or_unicode_string(target.resultdef) then
+          begin
+            emptystr:=#0;
+            current_asmdata.CurrAsmList.concat(taicpu.op_string(a_ldc,0,@emptystr));
+            thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
+          end
+        else if is_dynamic_array(target.resultdef) then
           begin
             thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,0,R_INTREGISTER);
             thlcgjvm(hlcg).g_newarray(current_asmdata.CurrAsmList,target.resultdef,1);

compiler/jvm/njvmld.pas

@@ -36,6 +36,10 @@ type
     function is_addr_param_load: boolean; override;
   end;
 
+  tjvmassignmentnode  = class(tcgassignmentnode)
+    function pass_1: tnode; override;
+  end;
+
   tjvmarrayconstructornode = class(tcgarrayconstructornode)
    protected
     procedure makearrayref(var ref: treference; eledef: tdef); override;
@@ -47,10 +51,42 @@ implementation
 uses
   verbose,
   aasmdata,
-  nld,
-  symsym,symdef,jvmdef,
+  nbas,nld,ncal,nmem,ncnv,
+  symsym,symdef,defutil,jvmdef,
   cgbase,hlcgobj;
 
+{ tjvmassignmentnode }
+
+function tjvmassignmentnode.pass_1: tnode;
+  var
+    target: tnode;
+  begin
+    { intercept writes to string elements, because Java strings are immutable
+      -> detour via StringBuilder
+    }
+    target:=left.actualtargetnode;
+    if (target.nodetype=vecn) and
+       is_wide_or_unicode_string(tvecnode(target).left.resultdef) then
+      begin
+        { prevent errors in case of an expression such as
+            word(str[x]):=1234;
+        }
+        inserttypeconv_explicit(right,cwidechartype);
+        result:=ccallnode.createintern('fpc_unicodestr_setchar',
+          ccallparanode.create(right,
+            ccallparanode.create(tvecnode(target).right,
+              ccallparanode.create(tvecnode(target).left.getcopy,nil))));
+        result:=cassignmentnode.create(tvecnode(target).left,result);
+        right:=nil;
+        tvecnode(target).left:=nil;
+        tvecnode(target).right:=nil;
+        exit;
+      end
+    else
+      result:=inherited;
+  end;
+
+
 function tjvmloadnode.is_addr_param_load: boolean;
   begin
     result:=
@@ -82,6 +118,7 @@ procedure tjvmarrayconstructornode.advancearrayoffset(var ref: treference; elesi
 
 begin
   cloadnode:=tjvmloadnode;
+  cassignmentnode:=tjvmassignmentnode;
   carrayconstructornode:=tjvmarrayconstructornode;
 end.
 

compiler/jvm/njvmmem.pas

@@ -32,6 +32,7 @@ interface
 
     type
        tjvmvecnode = class(tcgvecnode)
+         function pass_1: tnode; override;
          procedure pass_generate_code;override;
        end;
 
@@ -39,8 +40,9 @@ implementation
 
     uses
       systems,
-      cutils,verbose,
-      symdef,defutil,
+      cutils,verbose,constexp,
+      symconst,symtype,symtable,symsym,symdef,defutil,
+      nadd,ncal,ncnv,ncon,
       aasmdata,pass_2,
       cgutils,hlcgobj,hlcgcpu;
 
@@ -48,6 +50,29 @@ implementation
                              TJVMVECNODE
 *****************************************************************************}
 
+    function tjvmvecnode.pass_1: tnode;
+      var
+        psym: tsym;
+      begin
+        if is_wide_or_unicode_string(left.resultdef) then
+          begin
+            psym:=search_struct_member(java_jlstring,'CHARAT');
+            if not assigned(psym) or
+               (psym.typ<>procsym) then
+              internalerror(2011031501);
+            { Pascal strings are 1-based, Java strings 0-based }
+            result:=ccallnode.create(ccallparanode.create(
+              caddnode.create(subn,right,genintconstnode(1)),nil),tprocsym(psym),
+              psym.owner,ctypeconvnode.create_explicit(left,java_jlstring),[]);
+            left:=nil;
+            right:=nil;
+            exit;
+          end
+        else
+          result:=inherited;
+      end;
+
+
     procedure tjvmvecnode.pass_generate_code;
       var
         newsize: tcgsize;

compiler/jvmdef.pas

@@ -86,8 +86,9 @@ implementation
           stringdef :
             begin
               case tstringdef(def).stringtype of
-                { translated into Java.Lang.String }
-                st_widestring:
+                { translated into java.lang.String }
+                st_widestring,
+                st_unicodestring:
                   encodedstr:=encodedstr+'Ljava/lang/String;';
                 else
                   { May be handled via wrapping later  }

compiler/ninl.pas

@@ -70,6 +70,7 @@ interface
             nodes are not generated by the parser. It's however used internally
             by the JVM backend to create new dynamic arrays. }
           function first_new: tnode; virtual;
+          function first_length: tnode; virtual;
         private
           function handle_str: tnode;
           function handle_reset_rewrite_typed: tnode;
@@ -2898,13 +2899,7 @@ implementation
 
           in_length_x:
             begin
-               if is_shortstring(left.resultdef) then
-                expectloc:=left.expectloc
-               else
-                begin
-                  { ansi/wide string }
-                  expectloc:=LOC_REGISTER;
-                end;
+               result:=first_length;
             end;
 
           in_typeinfo_x:
@@ -3428,6 +3423,18 @@ implementation
          result:=nil;
        end;
 
+     function tinlinenode.first_length: tnode;
+       begin
+         result:=nil;
+         if is_shortstring(left.resultdef) then
+          expectloc:=left.expectloc
+         else
+          begin
+            { ansi/wide string }
+            expectloc:=LOC_REGISTER;
+          end;
+       end;
+
      function tinlinenode.first_pack_unpack: tnode;
        var
          loopstatement    : tstatementnode;

compiler/pdecobj.pas

@@ -1293,6 +1293,8 @@ implementation
                         java_jlthrowable:=current_objectdef;
                       if (current_objectdef.objname^='FPCBASERECORDTYPE') then
                         java_fpcbaserecordtype:=current_objectdef;
+                      if (current_objectdef.objname^='JLSTRING') then
+                        java_jlstring:=current_objectdef;
                     end;
                 end;
               end;

compiler/symdef.pas

@@ -783,6 +783,8 @@ interface
        java_jlthrowable          : tobjectdef;
        { FPC base type for records }
        java_fpcbaserecordtype    : tobjectdef;
+       { java.lang.String }
+       java_jlstring             : tobjectdef;
 
     const
 {$ifdef i386}
@@ -4703,6 +4705,8 @@ implementation
                java_jlthrowable:=self;
              if (objname^='FPCBASERECORDTYPE') then
                java_fpcbaserecordtype:=self;
+             if (objname^='JLSTRING') then
+               java_jlstring:=self;
            end;
          writing_class_record_dbginfo:=false;
        end;

compiler/x86/nx86add.pas

@@ -43,7 +43,7 @@ unit nx86add;
         procedure second_addfloatsse;
       public
         procedure second_addfloat;override;
-        procedure second_addsmallset;override;
+//        procedure second_addsmallset;override;
         procedure second_add64bit;override;
         procedure second_cmpfloat;override;
         procedure second_cmpsmallset;override;
@@ -330,7 +330,7 @@ unit nx86add;
 {*****************************************************************************
                                 AddSmallSet
 *****************************************************************************}
-
+(*
     procedure tx86addnode.second_addsmallset;
       var
         setbase : aint;
@@ -433,7 +433,7 @@ unit nx86add;
         if opsize<>int_cgsize(resultdef.size) then
           location_force_reg(current_asmdata.CurrAsmList,location,int_cgsize(resultdef.size),false);
       end;
-
+*)
 
     procedure tx86addnode.second_cmpsmallset;
       var

rtl/java/compproc.inc

@@ -21,6 +21,579 @@
 
  **********************************************************************}
 
+{ some dummy types necessary to have generic resulttypes for certain compilerprocs }
+type
+  { normally the array should be maxlongint big, but that will confuse
+    the debugger. The compiler will set the correct size of the array
+    internally. It's now set to 0..0 because when compiling with -gt,
+    the entire array will be trashed, so it must not be defined larger
+    than the minimal size (otherwise we can trash other memory) }
+  fpc_big_chararray = array[0..0] of AnsiChar;
+  fpc_big_widechararray = array[0..0] of widechar;
+  fpc_big_unicodechararray = array[0..0] of unicodechar;
+  fpc_small_set = bitpacked array[0..31] of 0..1;
+  fpc_normal_set = bitpacked array[0..255] of 0..1;
+  fpc_normal_set_byte = array[0..31] of byte;
+  fpc_normal_set_long = array[0..7] of longint;
+
+(*
+procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+{$ifndef STR_CONCAT_PROCS}
+function fpc_shortstr_concat(const s1,s2:shortstring): shortstring; compilerproc;
+{$else STR_CONCAT_PROCS}
+procedure fpc_shortstr_concat(var dests:shortstring;const s1,s2:shortstring);compilerproc;
+procedure fpc_shortstr_concat_multi(var dests:shortstring;const sarr:array of pshortstring);compilerproc;
+{$endif STR_CONCAT_PROCS}
+procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc;
+function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc;
+function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
+
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+function fpc_pchar_length(p:pchar):longint; compilerproc;
+function fpc_pwidechar_length(p:pwidechar):longint; compilerproc;
+
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+function fpc_chararray_to_shortstr(const arr: array of AnsiChar; zerobased: boolean = true):shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of AnsiChar; zerobased: boolean = true); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+{$ifndef FPC_STRTOCHARARRAYPROC}
+function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray; compilerproc;
+{$else ndef FPC_STRTOCHARARRAYPROC}
+procedure fpc_shortstr_to_chararray(out res: array of AnsiChar; const src: ShortString); compilerproc;
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+
+Function  fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
+function  fpc_char_copy(c:AnsiChar;index : SizeInt;count : SizeInt): shortstring;compilerproc;
+*)
+(*
+{ Str() support }
+procedure fpc_ShortStr_sint(v : valsint;len : SizeInt;out s : shortstring); compilerproc;
+procedure fpc_shortstr_uint(v : valuint;len : SizeInt;out s : shortstring); compilerproc;
+{$ifndef FPUNONE}
+procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : shortstring); compilerproc;
+{$endif}
+procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);compilerproc;
+procedure fpc_shortstr_bool(b : boolean;len:sizeint;out s:shortstring);compilerproc;
+procedure fpc_ShortStr_Currency(c : currency; len,f : SizeInt; out s : shortstring); compilerproc;
+
+procedure fpc_chararray_sint(v : valsint;len : SizeInt;out a : array of AnsiChar); compilerproc;
+procedure fpc_chararray_uint(v : valuint;len : SizeInt;out a : array of AnsiChar); compilerproc;
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+procedure fpc_AnsiStr_sint(v : valsint; Len : SizeInt; out S : AnsiString); compilerproc;
+procedure fpc_AnsiStr_uint(v : valuint;Len : SizeInt; out S : AnsiString); compilerproc;
+{$ifndef FPUNONE}
+procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : ansistring); compilerproc;
+{$endif}
+procedure fpc_ansistr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:ansistring); compilerproc;
+procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:ansistring); compilerproc;
+{$ifdef FPC_HAS_STR_CURRENCY}
+procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring); compilerproc;
+{$endif FPC_HAS_STR_CURRENCY}
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+  {$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+  procedure fpc_WideStr_sint(v : valsint; Len : SizeInt; out S : WideString); compilerproc;
+  procedure fpc_WideStr_uint(v : valuint;Len : SizeInt; out S : WideString); compilerproc;
+  {$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+  {$ifndef VER2_2}
+  procedure fpc_UnicodeStr_sint(v : valsint; Len : SizeInt; out S : UnicodeString); compilerproc;
+  procedure fpc_UnicodeStr_uint(v : valuint;Len : SizeInt; out S : UnicodeString); compilerproc;
+  {$endif VER2_2}
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
+{$ifndef CPU64}
+  procedure fpc_shortstr_qword(v : qword;len : SizeInt;out s : shortstring); compilerproc;
+  procedure fpc_shortstr_int64(v : int64;len : SizeInt;out s : shortstring); compilerproc;
+  procedure fpc_chararray_qword(v : qword;len : SizeInt;out a : array of AnsiChar); compilerproc;
+  procedure fpc_chararray_int64(v : int64;len : SizeInt;out a : array of AnsiChar); compilerproc;
+  {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+  procedure fpc_ansistr_qword(v : qword;len : SizeInt;out s : ansistring); compilerproc;
+  procedure fpc_ansistr_int64(v : int64;len : SizeInt;out s : ansistring); compilerproc;
+  {$endif FPC_HAS_FEATURE_ANSISTRINGS}
+
+  {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+    {$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+    procedure fpc_widestr_qword(v : qword;len : SizeInt;out s : widestring); compilerproc;
+    procedure fpc_widestr_int64(v : int64;len : SizeInt;out s : widestring); compilerproc;
+    {$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+    {$ifndef VER2_2}
+    procedure fpc_UnicodeStr_qword(v : qword;len : SizeInt;out s : UnicodeString); compilerproc;
+    procedure fpc_UnicodeStr_int64(v : int64;len : SizeInt;out s : UnicodeString); compilerproc;
+    {$endif VER2_2}
+  {$endif FPC_HAS_FEATURE_WIDESTRINGS}
+{$endif CPU64}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+  {$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+    {$ifndef FPUNONE}
+    procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : WideString); compilerproc;
+    {$endif}
+    procedure fpc_widestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:widestring);compilerproc;
+    procedure fpc_widestr_bool(b : boolean;len:sizeint;out s:widestring);compilerproc;
+    {$ifdef FPC_HAS_STR_CURRENCY}
+    procedure fpc_WideStr_Currency(c : Currency;len,fr : SizeInt;out s : WideString);compilerproc;
+    {$endif FPC_HAS_STR_CURRENCY}
+  {$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+  {$ifndef VER2_2}
+    {$ifndef FPUNONE}
+    procedure fpc_UnicodeStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : UnicodeString); compilerproc;
+    {$endif}
+    procedure fpc_unicodestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:unicodestring);compilerproc;
+    procedure fpc_unicodestr_bool(b : boolean;len:sizeint;out s:unicodestring);compilerproc;
+    {$ifdef FPC_HAS_STR_CURRENCY}
+    procedure fpc_UnicodeStr_Currency(c : Currency;len,fr : SizeInt;out s : UnicodeString);compilerproc;
+    {$endif FPC_HAS_STR_CURRENCY}
+  {$endif VER2_2}
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
+{$ifndef FPUNONE}
+procedure fpc_chararray_Float(d : ValReal;len,fr,rt : SizeInt;out a : array of AnsiChar); compilerproc;
+{$endif}
+procedure fpc_chararray_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out a : array of AnsiChar);compilerproc;
+procedure fpc_chararray_bool(b : boolean;len:sizeint;out a : array of AnsiChar);compilerproc;
+{$ifdef FPC_HAS_STR_CURRENCY}
+procedure fpc_chararray_Currency(c : Currency;len,fr : SizeInt;out a : array of AnsiChar);compilerproc;
+{$endif FPC_HAS_STR_CURRENCY}
+
+{ Val() support }
+{$ifndef FPUNONE}
+Function fpc_Val_Real_ShortStr(const s : shortstring; out code : ValSInt): ValReal; compilerproc;
+{$endif}
+Function fpc_Val_SInt_ShortStr(DestSize: SizeInt; Const S: ShortString; out Code: ValSInt): ValSInt; compilerproc;
+Function fpc_Val_UInt_Shortstr(Const S: ShortString; out Code: ValSInt): ValUInt; compilerproc;
+function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code:valsint):longint; compilerproc;
+Function fpc_Val_Currency_ShortStr(const s : shortstring; out Code : ValSInt): currency; compilerproc;
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifndef FPUNONE}
+Function fpc_Val_Real_AnsiStr(Const S : AnsiString; out Code : ValSInt): ValReal; compilerproc;
+{$endif}
+Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; out Code : ValSInt): ValUInt; compilerproc;
+Function fpc_Val_SInt_AnsiStr (DestSize: SizeInt; Const S : AnsiString; out Code : ValSInt): ValSInt; compilerproc;
+Function fpc_Val_Currency_AnsiStr(Const S : AnsiString; out Code : ValSInt): Currency; compilerproc;
+function fpc_Val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:valsint):longint; compilerproc;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+  {$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+  {$ifndef FPUNONE}
+  Function fpc_Val_Real_WideStr(Const S : WideString; out Code : ValSInt): ValReal; compilerproc;
+  {$endif}
+  Function fpc_Val_SInt_WideStr (DestSize: SizeInt; Const S : WideString; out Code : ValSInt): ValSInt; compilerproc;
+  Function fpc_Val_UInt_WideStr (Const S : WideString; out Code : ValSInt): ValUInt; compilerproc;
+  function fpc_val_Enum_WideStr (str2ordindex:pointer;const s:WideString;out code:valsint):longint;compilerproc;
+  Function fpc_Val_Currency_WideStr(Const S : WideString; out Code : ValSInt): Currency; compilerproc;
+  {$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+  {$ifndef VER2_2}
+  {$ifndef FPUNONE}
+  Function fpc_Val_Real_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): ValReal; compilerproc;
+  {$endif}
+  Function fpc_Val_SInt_UnicodeStr (DestSize: SizeInt; Const S : UnicodeString; out Code : ValSInt): ValSInt; compilerproc;
+  Function fpc_Val_UInt_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): ValUInt; compilerproc;
+  function fpc_val_Enum_UnicodeStr(str2ordindex:pointer;const s:UnicodeString;out code:valsint):longint;compilerproc;
+  Function fpc_Val_Currency_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): Currency; compilerproc;
+  {$endif VER2_2}
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
+{$ifndef CPU64}
+Function fpc_val_int64_shortstr(Const S: ShortString; out Code: ValSInt): Int64; compilerproc;
+Function fpc_val_qword_shortstr(Const S: ShortString; out Code: ValSInt): QWord; compilerproc;
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+Function fpc_Val_qword_AnsiStr (Const S : AnsiString; out Code : ValSInt): qword;compilerproc;
+Function fpc_Val_int64_AnsiStr (Const S : AnsiString; out Code : ValSInt): Int64; compilerproc;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+{$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+Function fpc_Val_qword_WideStr (Const S : WideString; out Code : ValSInt): qword; compilerproc;
+Function fpc_Val_int64_WideStr (Const S : WideString; out Code : ValSInt): Int64; compilerproc;
+{$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
+{$ifndef VER2_2}
+Function fpc_Val_qword_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): qword; compilerproc;
+Function fpc_Val_int64_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): Int64; compilerproc;
+{$endif VER2_2}
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
+{$endif CPU64}
+
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+Procedure fpc_ansistr_decr_ref (Var S : Pointer); compilerproc;
+Procedure fpc_ansistr_incr_ref (S : Pointer); compilerproc;
+Procedure fpc_AnsiStr_Assign (Var DestS : Pointer;S2 : Pointer); compilerproc;
+{$ifdef STR_CONCAT_PROCS}
+Procedure fpc_AnsiStr_Concat (Var DestS : Ansistring;const S1,S2 : AnsiString); compilerproc;
+Procedure fpc_AnsiStr_Concat_multi (Var DestS : Ansistring;const sarr:array of Ansistring); compilerproc;
+{$else STR_CONCAT_PROCS}
+function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): AnsiString; compilerproc;
+function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring; compilerproc;
+{$endif STR_CONCAT_PROCS}
+Procedure fpc_ansistr_append_char(Var S : AnsiString;c : AnsiChar); compilerproc;
+Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;const Str : ShortString); compilerproc;
+Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;const Str : AnsiString); compilerproc;
+{$ifdef EXTRAANSISHORT}
+Procedure fpc_AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString); compilerproc;
+{$endif EXTRAANSISHORT}
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_AnsiStr_To_ShortStr (out res : shortstring;const S2 : Ansistring); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
+Function fpc_Char_To_AnsiStr(const c : AnsiChar): AnsiString; compilerproc;
+
+Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
+Function fpc_CharArray_To_AnsiStr(const arr: array of AnsiChar; zerobased: boolean = true): ansistring; compilerproc;
+{$ifndef FPC_STRTOCHARARRAYPROC}
+function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; compilerproc;
+{$else ndef FPC_STRTOCHARARRAYPROC}
+procedure fpc_ansistr_to_chararray(out res: array of AnsiChar; const src: ansistring)compilerproc;
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt; compilerproc;
+Function fpc_AnsiStr_Compare_equal(const S1,S2 : AnsiString): SizeInt; compilerproc;
+Procedure fpc_AnsiStr_CheckZero(p : pointer); compilerproc;
+Procedure fpc_AnsiStr_CheckRange(len,index : SizeInt); compilerproc;
+Procedure fpc_AnsiStr_SetLength (Var S : AnsiString; l : SizeInt); compilerproc;
+Function  fpc_ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;compilerproc;
+{$ifdef EXTRAANSISHORT}
+Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): SizeInt; compilerproc;
+{$endif EXTRAANSISHORT}
+{ pointer argument because otherwise when calling this, we get
+  an endless loop since a 'var s: ansistring' must be made
+  unique as well                                               }
+Function fpc_ansistr_Unique(Var S : Pointer): Pointer; compilerproc;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+*)
+
+{*****************************************************************************
+                        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_UnicodeStr_To_AnsiStr (const S2 : UnicodeString): AnsiString; compilerproc;
+Function fpc_AnsiStr_To_UnicodeStr (Const S2 : AnsiString): UnicodeString; compilerproc;
+*)
+Function fpc_UnicodeStr_To_WideStr (const S2 : UnicodeString): WideString; compilerproc;
+Function fpc_WideStr_To_UnicodeStr (Const S2 : WideString): UnicodeString; compilerproc;
+Function fpc_UnicodeStr_Concat (const S1,S2 : UnicodeString) : UnicodeString; compilerproc;
+function fpc_UnicodeStr_Concat_multi (const sarr:array of Unicodestring): unicodestring; compilerproc;
+Function fpc_Char_To_UnicodeStr(const c : AnsiChar): UnicodeString; compilerproc;
+Function fpc_CharArray_To_UnicodeStr(const arr: array of AnsiChar; zerobased: boolean = true): UnicodeString; compilerproc;
+
+procedure fpc_unicodestr_to_chararray(out res: array of AnsiChar; const src: UnicodeString); compilerproc;
+//procedure fpc_shortstr_to_unicodechararray(out res: array of unicodechar; const src: ShortString); compilerproc;
+//procedure fpc_ansistr_to_unicodechararray(out res: array of unicodechar; const src: AnsiString); compilerproc;
+procedure fpc_unicodestr_to_unicodechararray(out res: array of unicodechar; const src: UnicodeString); compilerproc;
+
+function fpc_unicodestr_setchar(const s: UnicodeString; const index: longint; const ch: unicodechar): UnicodeString; compilerproc;
+
+(*
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+Function fpc_UnicodeCharArray_To_ShortStr(const arr: array of unicodechar; zerobased: boolean = true): shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_UnicodeCharArray_To_ShortStr(out res : shortstring;const arr: array of unicodechar; zerobased: boolean = true); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; zerobased: boolean = true): AnsiString; compilerproc;
+*)
+Function fpc_UnicodeCharArray_To_UnicodeStr(const arr: array of unicodechar; zerobased: boolean = true): UnicodeString; compilerproc;
+(*
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
+*)
+Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
+Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc;
+(*
+{$ifndef FPC_STRTOCHARARRAYPROC}
+Function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray; compilerproc;
+Function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray; compilerproc;
+{$else ndef FPC_STRTOCHARARRAYPROC}
+procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
+procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
+*)
+procedure fpc_unicodestr_to_widechararray(out res: array of widechar; const src: UnicodeString); compilerproc;
+(*
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+*)
+Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt; compilerproc;
+Function fpc_UnicodeStr_Compare_equal(const S1,S2 : UnicodeString): SizeInt; compilerproc;
+(*
+Procedure fpc_UnicodeStr_CheckZero(p : pointer); compilerproc;
+Procedure fpc_UnicodeStr_CheckRange(len,index : SizeInt); compilerproc;
+*)
+Function fpc_UnicodeStr_SetLength (const S : UnicodeString; l : SizeInt): UnicodeString; compilerproc;
+Function  fpc_unicodestr_Copy (Const S : UnicodeString; Index,Size : SizeInt) : UnicodeString;compilerproc;
+//function fpc_unicodestr_Unique(Var S : Pointer): Pointer; compilerproc;
+Function fpc_Char_To_UChar(const c : AnsiChar): UnicodeChar; compilerproc;
+Function fpc_UChar_To_Char(const c : UnicodeChar): AnsiChar; compilerproc;
+Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
+Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc;
+(*
+Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar): ansistring; compilerproc;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+Function fpc_PUnicodeChar_To_UnicodeStr(const p : punicodechar): unicodestring; compilerproc;
+Function fpc_PWideChar_To_UnicodeStr(const p : pwidechar): unicodestring; compilerproc;
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+Function fpc_PUnicodeChar_To_ShortStr(const p : punicodechar): shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_PUnicodeChar_To_ShortStr(out res : shortstring;const p : punicodechar); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+*)
+
+(*
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_PWideChar_To_ShortStr(out res : shortstring;const p : pwidechar); compilerproc;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+*)
+
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+Function fpc_Char_To_WChar(const c : AnsiChar): WideChar; compilerproc;
+Function fpc_WChar_To_Char(const c : WideChar): AnsiChar; compilerproc;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
+{$ifdef FPC_HAS_FEATURE_TEXTIO}
+{ from text.inc }
+Function fpc_get_input:PText;compilerproc;
+Function fpc_get_output:PText;compilerproc;
+Procedure fpc_Write_End(var f:Text); compilerproc;
+Procedure fpc_Writeln_End(var f:Text); compilerproc;
+Procedure fpc_Write_Text_ShortStr(Len : Longint;var f : Text;const s : String); compilerproc;
+Procedure fpc_Write_Text_ShortStr_Iso(Len : Longint;var f : Text;const s : String); compilerproc;
+Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of AnsiChar; zerobased: boolean = true); compilerproc;
+Procedure fpc_Write_Text_Pchar_as_Array_Iso(Len : Longint;var f : Text;const s : array of AnsiChar; zerobased: boolean = true); compilerproc;
+Procedure fpc_Write_Text_PChar_As_Pointer(Len : Longint;var f : Text;p : PChar); compilerproc;
+Procedure fpc_Write_Text_AnsiStr (Len : Longint; Var f : Text; const S : AnsiString); compilerproc;
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+Procedure fpc_Write_Text_WideStr (Len : Longint; Var f : Text; const S : WideString); compilerproc;
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+Procedure fpc_Write_Text_UnicodeStr (Len : Longint; Var f : Text; const S : UnicodeString); compilerproc;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+Procedure fpc_Write_Text_SInt(Len : Longint;var t : Text;l : ValSInt); compilerproc;
+Procedure fpc_Write_Text_UInt(Len : Longint;var t : Text;l : ValUInt); compilerproc;
+Procedure fpc_Write_Text_SInt_Iso(Len : Longint;var t : Text;l : ValSInt); compilerproc;
+Procedure fpc_Write_Text_UInt_Iso(Len : Longint;var t : Text;l : ValUInt); compilerproc;
+{$ifndef CPU64}
+procedure fpc_write_text_qword(len : longint;var t : text;q : qword); compilerproc;
+procedure fpc_write_text_int64(len : longint;var t : text;i : int64); compilerproc;
+procedure fpc_write_text_qword_iso(len : longint;var t : text;q : qword); compilerproc;
+procedure fpc_write_text_int64_iso(len : longint;var t : text;i : int64); compilerproc;
+{$endif CPU64}
+{$ifndef FPUNONE}
+Procedure fpc_Write_Text_Float(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); compilerproc;
+Procedure fpc_Write_Text_Float_Iso(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); compilerproc;
+{$endif}
+procedure fpc_write_text_enum(typinfo,ord2strindex:pointer;len:sizeint;var t:text;ordinal:longint); compilerproc;
+{$ifdef FPC_HAS_STR_CURRENCY}
+Procedure fpc_Write_Text_Currency(fixkomma,Len : Longint;var t : Text;c : Currency); compilerproc;
+{$endif FPC_HAS_STR_CURRENCY}
+Procedure fpc_Write_Text_Boolean(Len : Longint;var t : Text;b : Boolean); compilerproc;
+Procedure fpc_Write_Text_Boolean_Iso(Len : Longint;var t : Text;b : Boolean); compilerproc;
+Procedure fpc_Write_Text_Char(Len : Longint;var t : Text;c : AnsiChar); compilerproc;
+Procedure fpc_Write_Text_Char_Iso(Len : Longint;var t : Text;c : AnsiChar); compilerproc;
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); compilerproc;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
+function fpc_SetupWriteStr_Shortstr(out s: shortstring): PText; compilerproc;
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+function fpc_SetupWriteStr_Ansistr(out s: ansistring): PText; compilerproc;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+function fpc_SetupWriteStr_Unicodestr(out s: unicodestring): PText; compilerproc;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+function fpc_SetupWriteStr_Widestr(out s: widestring): PText; compilerproc;
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+
+function fpc_SetupReadStr_Shortstr(const s: shortstring): PText; compilerproc;
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+function fpc_SetupReadStr_Ansistr(const s: ansistring): PText; compilerproc;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+function fpc_SetupReadStr_Unicodestr(const s: unicodestring): PText; compilerproc;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+function fpc_SetupReadStr_Widestr(const s: widestring): PText; compilerproc;
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+{$endif FPC_HAS_FEATURE_TEXTIO}
+
+{$ifdef FPC_HAS_FEATURE_VARIANTS}
+procedure fpc_variant_copy(d,s : pointer);compilerproc;
+procedure fpc_variant_copy_overwrite(source, dest : pointer);compilerproc;
+procedure fpc_write_text_variant(Len : Longint;var f : Text;const v : variant); compilerproc;
+function fpc_variant_to_dynarray(const v : variant;typeinfo : pointer) : pointer;compilerproc;
+function fpc_dynarray_to_variant(dynarr : pointer;typeinfo : pointer) : variant;compilerproc;
+function fpc_variant_to_interface(const v : variant) : iinterface;compilerproc;
+function fpc_interface_to_variant(const i : iinterface) : variant;compilerproc;
+function fpc_variant_to_idispatch(const v : variant) : idispatch;compilerproc;
+function fpc_idispatch_to_variant(const i : idispatch) : variant;compilerproc;
+procedure fpc_vararray_get(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
+procedure fpc_vararray_put(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
+procedure fpc_dispinvoke_variant(dest : pvardata;const source : tvardata;  calldesc : pcalldesc;params : pointer);compilerproc;
+{$endif FPC_HAS_FEATURE_VARIANTS}
+
+{$ifdef FPC_HAS_FEATURE_TEXTIO}
+Procedure fpc_Read_End(var f:Text); compilerproc;
+Procedure fpc_ReadLn_End(var f : Text); compilerproc;
+Procedure fpc_ReadLn_End_Iso(var f : Text); compilerproc;
+Procedure fpc_Read_Text_ShortStr(var f : Text;out s : String); compilerproc;
+Procedure fpc_Read_Text_PChar_As_Pointer(var f : Text; const s : PChar); compilerproc;
+Procedure fpc_Read_Text_PChar_As_Array(var f : Text;out s : array of AnsiChar; zerobased: boolean = false); compilerproc;
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+Procedure fpc_Read_Text_AnsiStr(var f : Text;out s : AnsiString); compilerproc;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+Procedure fpc_Read_Text_UnicodeStr(var f : Text;out us : UnicodeString); compilerproc;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+Procedure fpc_Read_Text_WideStr(var f : Text;out ws : WideString); compilerproc;
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+Procedure fpc_Read_Text_Char(var f : Text; out c : AnsiChar); compilerproc;
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+procedure fpc_Read_Text_WideChar(var f : Text; out wc: widechar); compilerproc;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+Procedure fpc_Read_Text_Char_Iso(var f : Text; out c : AnsiChar); compilerproc;
+Procedure fpc_Read_Text_SInt(var f : Text; out l :ValSInt); compilerproc;
+Procedure fpc_Read_Text_UInt(var f : Text; out u :ValUInt); compilerproc;
+{$ifndef FPUNONE}
+Procedure fpc_Read_Text_Float(var f : Text; out v :ValReal); compilerproc;
+{$endif}
+procedure fpc_read_text_enum(str2ordindex:pointer;var t:text;out ordinal:longint); compilerproc;
+procedure fpc_Read_Text_Currency(var f : Text; out v : Currency); compilerproc;
+{$ifndef CPU64}
+Procedure fpc_Read_Text_QWord(var f : text; out q : qword); compilerproc;
+Procedure fpc_Read_Text_Int64(var f : text; out i : int64); compilerproc;
+{$endif CPU64}
+{$endif FPC_HAS_FEATURE_TEXTIO}
+
+{$ifdef FPC_INCLUDE_SOFTWARE_MOD_DIV}
+function fpc_div_dword(n,z : dword) : dword; compilerproc;
+function fpc_mod_dword(n,z : dword) : dword; compilerproc;
+function fpc_div_longint(n,z : longint) : longint; compilerproc;
+function fpc_mod_longint(n,z : longint) : longint; compilerproc;
+{$endif FPC_INCLUDE_SOFTWARE_MOD_DIV}
+(*
+{ from int64.inc }
+function fpc_div_qword(n,z : qword) : qword; compilerproc;
+function fpc_mod_qword(n,z : qword) : qword; compilerproc;
+function fpc_div_int64(n,z : int64) : int64; compilerproc;
+function fpc_mod_int64(n,z : int64) : int64; compilerproc;
+function fpc_mul_qword(f1,f2 : qword;checkoverflow : longbool) : qword; compilerproc;
+function fpc_mul_int64(f1,f2 : int64;checkoverflow : longbool) : int64; compilerproc;
+*)
+
+{$ifdef FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
+function fpc_shl_qword(value,shift : qword) : qword; compilerproc;
+function fpc_shr_qword(value,shift : qword) : qword; compilerproc;
+function fpc_shl_int64(value,shift : int64) : int64; compilerproc;
+function fpc_shr_int64(value,shift : int64) : int64; compilerproc;
+{$endif  FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
+(*
+{$ifndef FPUNONE}
+function fpc_abs_real(d : ValReal) : ValReal;compilerproc;
+function fpc_arctan_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_cos_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_exp_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_frac_real(d : ValReal) : ValReal;compilerproc;
+function fpc_int_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_ln_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_pi_real : ValReal;compilerproc;
+function fpc_sin_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_sqr_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_sqrt_real(d : ValReal) : ValReal;compilerproc;
+function fpc_round_real(d : ValReal) : int64;compilerproc;
+function fpc_trunc_real(d : ValReal) : int64;compilerproc;
+{$endif}
+*)
+{$ifdef FPC_HAS_FEATURE_CLASSES}
+function fpc_do_is(aclass : tclass;aobject : tobject) : boolean; compilerproc;
+function fpc_do_as(aclass : tclass;aobject : tobject): tobject; compilerproc;
+procedure fpc_intf_decr_ref(var i: pointer); compilerproc;
+procedure fpc_intf_incr_ref(i: pointer); compilerproc;
+procedure fpc_intf_assign(var D: pointer; const S: pointer); compilerproc;
+//procedure fpc_intf_assign_by_iid(var D: pointer; const S: pointer; const iid: TGUID); compilerproc;
+function fpc_intf_is(const S: pointer; const iid: TGUID): Boolean; compilerproc;
+function fpc_intf_is_class(const S: pointer; const aclass: tclass): Boolean; compilerproc;
+function fpc_class_is_intf(const S: pointer; const iid: TGUID): Boolean; compilerproc;
+function fpc_class_is_corbaintf(const S: pointer; const iid: Shortstring): Boolean; compilerproc;
+function fpc_intf_cast(const S: pointer; const iid: TGUID): IInterface; compilerproc;
+function fpc_intf_cast_class(const S: pointer; const aclass: tclass): pointer; compilerproc;
+function fpc_class_cast_intf(const S: pointer; const iid: TGUID): IInterface; compilerproc;
+function fpc_class_cast_corbaintf(const S: pointer; const iid: Shortstring): Pointer; compilerproc;
+function fpc_intf_as(const S: pointer; const iid: TGUID): IInterface; compilerproc;
+function fpc_intf_as_class(const S: pointer; const aclass: tclass): pointer; compilerproc;
+function fpc_class_as_intf(const S: pointer; const iid: TGUID): IInterface; compilerproc;
+function fpc_class_as_corbaintf(const S: pointer; const iid: Shortstring): Pointer; compilerproc;
+{$ifdef FPC_HAS_FEATURE_VARIANTS}
+procedure fpc_dispatch_by_id(Result: Pointer; const Dispatch: pointer;DispDesc: Pointer; Params: Pointer); compilerproc;
+{$endif FPC_HAS_FEATURE_VARIANTS}
+{$endif FPC_HAS_FEATURE_CLASSES}
+
+
+{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
+Function fpc_PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ; compilerproc;
+Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); compilerproc;
+Function fpc_Raiseexception (Obj : TObject; AnAddr,AFrame : Pointer) : TObject; compilerproc;
+Procedure fpc_PopAddrStack; compilerproc;
+function fpc_PopObjectStack : TObject; compilerproc;
+function fpc_PopSecondObjectStack : TObject; compilerproc;
+Procedure fpc_ReRaise; compilerproc;
+Function fpc_Catches(Objtype : TClass) : TObject; compilerproc;
+Procedure fpc_DestroyException(o : TObject); compilerproc;
+function fpc_GetExceptionAddr : Pointer; compilerproc;
+{$endif FPC_HAS_FEATURE_EXCEPTIONS}
+
+
+{$ifdef FPC_HAS_FEATURE_OBJECTS}
+function fpc_help_constructor(_self:pointer;var _vmt:pointer;_vmt_pos:cardinal):pointer;compilerproc;
+procedure fpc_help_destructor(_self,_vmt:pointer;vmt_pos:cardinal);compilerproc;
+procedure fpc_help_fail(_self:pointer;var _vmt:pointer;vmt_pos:cardinal);compilerproc;
+{$endif FPC_HAS_FEATURE_OBJECTS}
+
+
+{$ifdef dummy}
+procedure fpc_check_object(obj:pointer); compilerproc;
+procedure fpc_check_object_ext(vmt,expvmt:pointer);compilerproc;
+{$endif dummy}
+
+
 {$ifdef FPC_HAS_FEATURE_RTTI}
 Procedure fpc_Initialize (Data,TypeInfo : pointer); compilerproc;
 Procedure fpc_finalize (Data,TypeInfo: Pointer); compilerproc;
@@ -33,6 +606,17 @@ procedure fpc_decref_array(data,typeinfo: pointer; count: sizeint); compilerproc
 Function fpc_Copy (Src, Dest, TypeInfo : Pointer) : SizeInt; compilerproc;
 Procedure fpc_Copy_proc (Src, Dest, TypeInfo : Pointer); compilerproc; inline;
 {$endif FPC_HAS_FEATURE_RTTI}
+{ array initialisation helpers (for open array "out" parameters whose elements
+  are normally refcounted) }
+{ open array of unicodestring. normalarrdim contains the number of dimensions
+  a regular array, if any, that contains these unicodestrings. E.g.:
+   type
+     tarr = array[1..10,2..9] of unicodestring;
+
+   procedure test(out arr: array of tarr);
+    -> normalarrdim will be 2
+}
+procedure fpc_initialize_array_unicodestring(arr: TJObjectArray; normalarrdim: longint);compilerproc;
 { normalarrdim contains the number of dimensions
   a regular array, if any, that contains these unicodestrings. E.g.:
    type
@@ -54,3 +638,68 @@ Procedure fpc_Copy_proc (Src, Dest, TypeInfo : Pointer); compilerproc; inline;
 procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint);compilerproc;
 procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseRecordType);compilerproc;
 
+(*
+{$ifdef FPC_SETBASE_USED}
+procedure fpc_varset_load(const l;sourcesize : longint;var dest;size,srcminusdstbase : ptrint); compilerproc;
+{$else}
+procedure fpc_varset_load(const l;sourcesize : longint;var dest;size : ptrint); compilerproc;
+{$endif}
+procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc;
+procedure fpc_varset_set(const source;var dest; b,size : ptrint); compilerproc;
+procedure fpc_varset_unset(const source;var dest; b,size : ptrint); compilerproc;
+procedure fpc_varset_set_range(const orgset; var dest;l,h,size : ptrint); compilerproc;
+procedure fpc_varset_add_sets(const set1,set2; var dest;size : ptrint); compilerproc;
+procedure fpc_varset_mul_sets(const set1,set2; var dest;size : ptrint); compilerproc;
+procedure fpc_varset_sub_sets(const set1,set2; var dest;size : ptrint); compilerproc;
+procedure fpc_varset_symdif_sets(const set1,set2; var dest;size : ptrint); compilerproc;
+function fpc_varset_comp_sets(const set1,set2;size : ptrint):boolean; compilerproc;
+function fpc_varset_contains_sets(const set1,set2;size : ptrint):boolean; compilerproc;
+
+{$ifdef LARGESETS}
+procedure fpc_largeset_set_word(p : pointer;b : word); compilerproc;
+procedure fpc_largeset_in_word(p : pointer;b : word); compilerproc;
+procedure fpc_largeset_add_sets(set1,set2,dest : pointer;size : longint); compilerproc;
+procedure fpc_largeset_sets(set1,set2,dest : pointer;size : longint); compilerproc;
+procedure fpc_largeset_sub_sets(set1,set2,dest : pointer;size : longint); compilerproc;
+procedure fpc_largeset_symdif_sets(set1,set2,dest : pointer;size : longint); compilerproc;
+procedure fpc_largeset_comp_sets(set1,set2 : pointer;size : longint); compilerproc;
+procedure fpc_largeset_contains_sets(set1,set2 : pointer; size: longint); compilerproc;
+{$endif LARGESETS}
+
+procedure fpc_rangeerror; compilerproc;
+procedure fpc_divbyzero; compilerproc;
+procedure fpc_overflow; compilerproc;
+procedure fpc_iocheck; compilerproc;
+
+procedure fpc_InitializeUnits; compilerproc;
+// not generated by compiler, called directly in system unit
+// procedure fpc_FinalizeUnits; compilerproc;
+
+{
+Procedure fpc_do_exit; compilerproc;
+Procedure fpc_lib_exit; compilerproc;
+Procedure fpc_HandleErrorAddrFrame (Errno : longint;addr,frame : pointer); compilerproc;
+Procedure fpc_HandleError (Errno : longint); compilerproc;
+}
+
+procedure fpc_AbstractErrorIntern;compilerproc;
+procedure fpc_assert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer); compilerproc;
+*)
+
+{$ifdef FPC_HAS_FEATURE_FILEIO}
+Procedure fpc_reset_typed(var f : TypedFile;Size : Longint); compilerproc;
+Procedure fpc_rewrite_typed(var f : TypedFile;Size : Longint); compilerproc;
+Procedure fpc_reset_typed_iso(var f : TypedFile;Size : Longint); compilerproc;
+Procedure fpc_rewrite_typed_iso(var f : TypedFile;Size : Longint); compilerproc;
+Procedure fpc_typed_write(TypeSize : Longint;var f : TypedFile;const Buf); compilerproc;
+Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;out Buf); compilerproc;
+{$endif FPC_HAS_FEATURE_FILEIO}
+
+{$ifdef FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
+function fpc_int64_to_double(i: int64): double; compilerproc;
+function fpc_qword_to_double(q: qword): double; compilerproc;
+{$endif FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
+(*
+function fpc_setjmp(var s : jmp_buf) : longint; compilerproc;
+procedure fpc_longjmp(var s : jmp_buf; value : longint); compilerproc;
+*)

rtl/java/jdynarrh.inc

@@ -25,6 +25,7 @@ type
   TJDoubleArray = array of jdouble;
   TJObjectArray = array of JLObject;
   TJRecordArray = array of FpcBaseRecordType;
+  TJStringArray = array of unicodestring;
 
 const
   FPCJDynArrTypeJByte   = 'B';

rtl/java/rtti.inc

@@ -12,6 +12,25 @@
 
  **********************************************************************}
 
+procedure fpc_initialize_array_jstring_intern(arr: TJObjectArray; normalarrdim: longint); external name 'fpc_initialize_array_unicodestring';
+
+procedure fpc_initialize_array_unicodestring(arr: TJObjectArray; normalarrdim: longint);compilerproc;
+  var
+    i: longint;
+  begin
+    if normalarrdim > 0 then
+      begin
+        for i:=low(arr) to high(arr) do
+          fpc_initialize_array_jstring_intern(TJObjectArray(arr[i]),normalarrdim-1);
+      end
+    else
+      begin
+        for i:=low(arr) to high(arr) do
+          unicodestring(arr[i]):='';
+      end;
+  end;
+
+
 procedure fpc_initialize_array_dynarr_intern(arr: TJObjectArray; normalarrdim: longint); external name 'fpc_initialize_array_dynarr';
 
 procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint);compilerproc;

rtl/java/system.pp

@@ -28,7 +28,15 @@ Unit system;
 {$implicitexceptions off}
 {$mode objfpc}
 
+{$undef FPC_HAS_FEATURE_ANSISTRINGS}
+{$undef FPC_HAS_FEATURE_TEXTIO}
+{$undef FPC_HAS_FEATURE_VARIANTS}
+{$undef FPC_HAS_FEATURE_CLASSES}
+{$undef FPC_HAS_FEATURE_EXCEPTIONS}
+{$undef FPC_HAS_FEATURE_OBJECTS}
 {$undef FPC_HAS_FEATURE_RTTI}
+{$undef FPC_HAS_FEATURE_FILEIO}
+{$undef FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
 
 Type
   { The compiler has all integer types defined internally. Here
@@ -37,9 +45,16 @@ Type
   Cardinal = LongWord;
   Integer  = SmallInt;
   UInt64   = QWord;
-  
+  SizeInt  = Longint;
+  SizeUInt = Longint;
+  PtrInt   = Longint;
+  PtrUInt  = Longint;
+
   ValReal = Double;
-  
+
+  AnsiChar    = Char;
+  UnicodeChar = WideChar;
+
   { map comp to int64, }
   Comp = Int64;
 
@@ -109,8 +124,62 @@ type
 {$i jrech.inc}
 {$i jdynarrh.inc}
 
+Function  lo(i : Integer) : byte;  [INTERNPROC: fpc_in_lo_Word];
+Function  lo(w : Word) : byte;     [INTERNPROC: fpc_in_lo_Word];
+Function  lo(l : Longint) : Word;  [INTERNPROC: fpc_in_lo_long];
+Function  lo(l : DWord) : Word;    [INTERNPROC: fpc_in_lo_long];
+Function  lo(i : Int64) : DWord;   [INTERNPROC: fpc_in_lo_qword];
+Function  lo(q : QWord) : DWord;   [INTERNPROC: fpc_in_lo_qword];
+Function  hi(i : Integer) : byte;  [INTERNPROC: fpc_in_hi_Word];
+Function  hi(w : Word) : byte;     [INTERNPROC: fpc_in_hi_Word];
+Function  hi(l : Longint) : Word;  [INTERNPROC: fpc_in_hi_long];
+Function  hi(l : DWord) : Word;    [INTERNPROC: fpc_in_hi_long];
+Function  hi(i : Int64) : DWord;   [INTERNPROC: fpc_in_hi_qword];
+Function  hi(q : QWord) : DWord;   [INTERNPROC: fpc_in_hi_qword];
+
+Function chr(b : byte) : AnsiChar;      [INTERNPROC: fpc_in_chr_byte];
+
+function RorByte(Const AValue : Byte): Byte;[internproc:fpc_in_ror_x];
+function RorByte(Const AValue : Byte;Dist : Byte): Byte;[internproc:fpc_in_ror_x_x];
+
+function RolByte(Const AValue : Byte): Byte;[internproc:fpc_in_rol_x];
+function RolByte(Const AValue : Byte;Dist : Byte): Byte;[internproc:fpc_in_rol_x_x];
+
+function RorWord(Const AValue : Word): Word;[internproc:fpc_in_ror_x];
+function RorWord(Const AValue : Word;Dist : Byte): Word;[internproc:fpc_in_ror_x_x];
+
+function RolWord(Const AValue : Word): Word;[internproc:fpc_in_rol_x];
+function RolWord(Const AValue : Word;Dist : Byte): Word;[internproc:fpc_in_rol_x_x];
+
+function RorDWord(Const AValue : DWord): DWord;[internproc:fpc_in_ror_x];
+function RorDWord(Const AValue : DWord;Dist : Byte): DWord;[internproc:fpc_in_ror_x_x];
+
+function RolDWord(Const AValue : DWord): DWord;[internproc:fpc_in_rol_x];
+function RolDWord(Const AValue : DWord;Dist : Byte): DWord;[internproc:fpc_in_rol_x_x];
+
+function RorQWord(Const AValue : QWord): QWord;[internproc:fpc_in_ror_x];
+function RorQWord(Const AValue : QWord;Dist : Byte): QWord;[internproc:fpc_in_ror_x_x];
+
+function RolQWord(Const AValue : QWord): QWord;[internproc:fpc_in_rol_x];
+function RolQWord(Const AValue : QWord;Dist : Byte): QWord;[internproc:fpc_in_rol_x_x];
+
+function SarShortint(Const AValue : Shortint): Shortint;[internproc:fpc_in_sar_x];
+function SarShortint(Const AValue : Shortint;Shift : Byte): Shortint;[internproc:fpc_in_sar_x_y];
+
+function SarSmallint(Const AValue : Smallint): Smallint;[internproc:fpc_in_sar_x];
+function SarSmallint(Const AValue : Smallint;Shift : Byte): Smallint;[internproc:fpc_in_sar_x_y];
+
+function SarLongint(Const AValue : Longint): Longint;[internproc:fpc_in_sar_x];
+function SarLongint(Const AValue : Longint;Shift : Byte): Longint;[internproc:fpc_in_sar_x_y];
+
+function SarInt64(Const AValue : Int64): Int64;[internproc:fpc_in_sar_x];
+function SarInt64(Const AValue : Int64;Shift : Byte): Int64;[internproc:fpc_in_sar_x_y];
+
+
 {$i compproc.inc}
 
+{$i ustringh.inc}
+
 {*****************************************************************************}
                                  implementation
 {*****************************************************************************}
@@ -133,6 +202,7 @@ type
  **********************************************************************
 }
 
+{$i ustrings.inc}
 {$i rtti.inc}
 {$i jrec.inc}
 
@@ -482,3 +552,4 @@ function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: bool
 *****************************************************************************}
 
 end.
+

rtl/java/ustringh.inc

@@ -0,0 +1,81 @@
+{
+    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 UnicodeStrings with FPC
+
+    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.
+
+ **********************************************************************}
+
+
+Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt;
+Function Pos (c : Char; Const s : UnicodeString) : SizeInt;
+Function Pos (c : UnicodeChar; Const s : UnicodeString) : 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 UpCase(const s : UnicodeString) : UnicodeString;
+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);
+
+Type
+  { hooks for internationalization
+    please add new procedures at the end, it makes it easier to detect new procedures }
+  TUnicodeStringManager = class
+    collator: JTCollator;
+    constructor create;
+  end;
+
+var
+  widestringmanager : TUnicodeStringManager;
+
+//function UnicodeToUtf8(Dest: PChar; Source: PUnicodeChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+//function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PUnicodeChar; SourceChars: SizeUInt): SizeUInt;
+//function Utf8ToUnicode(Dest: PUnicodeChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+//function Utf8ToUnicode(Dest: PUnicodeChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
+//function UTF8Encode(const s : Ansistring) : UTF8String; inline;
+//function UTF8Encode(const s : UnicodeString) : UTF8String;
+//function UTF8Decode(const s : UTF8String): UnicodeString;
+//function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
+//function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
+//function UnicodeStringToUCS4String(const s : UnicodeString) : UCS4String;
+//function UCS4StringToUnicodeString(const s : UCS4String) : UnicodeString;
+//function WideStringToUCS4String(const s : WideString) : UCS4String;
+//function UCS4StringToWideString(const s : UCS4String) : WideString;
+
+//Procedure GetWideStringManager (Var Manager : TUnicodeStringManager);
+//Procedure SetWideStringManager (Const New : TUnicodeStringManager);
+//Procedure SetWideStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
+
+//Procedure GetUnicodeStringManager (Var Manager : TUnicodeStringManager);
+//Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager);
+//Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
+
+

rtl/java/ustrings.inc

@@ -0,0 +1,1843 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2005 by Florian Klaempfl,
+    Copyright (c) 2011 by Jonas Maebe,
+    members of the Free Pascal development team.
+
+    This file implements support routines for UTF-8 strings with FPC
+
+    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.
+
+ **********************************************************************}
+
+{$i wustrings.inc}
+
+{
+  This file contains the implementation of the UnicodeString type,
+  which on the Java platforms is an alias for java.lang.String
+}
+
+
+Function NewUnicodeString(Len : SizeInt) : JLString;
+{
+  Allocate a new UnicodeString on the heap.
+  initialize it to zero length and reference count 1.
+}
+var
+  data: array of jchar;
+begin
+  setlength(data,len);
+  result:=JLString.create(data);
+end;
+
+(*
+procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); [Public, alias: 'FPC_UNICODESTR_TO_SHORTSTR'];compilerproc;
+{
+  Converts a UnicodeString to a ShortString;
+}
+Var
+  Size : SizeInt;
+  temp : ansistring;
+begin
+  res:='';
+  Size:=Length(S2);
+  if Size>0 then
+    begin
+      If Size>high(res) then
+        Size:=high(res);
+      widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(S2),temp,Size);
+      res:=temp;
+    end;
+end;
+
+
+Function fpc_ShortStr_To_UnicodeStr (Const S2 : ShortString): UnicodeString;compilerproc;
+{
+  Converts a ShortString to a UnicodeString;
+}
+Var
+  Size : SizeInt;
+begin
+  result:='';
+  Size:=Length(S2);
+  if Size>0 then
+    begin
+      widestringmanager.Ansi2UnicodeMoveProc(PChar(@S2[1]),result,Size);
+      { Terminating Zero }
+      PUnicodeChar(Pointer(fpc_ShortStr_To_UnicodeStr)+Size*sizeof(UnicodeChar))^:=#0;
+    end;
+end;
+
+
+Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString): AnsiString; compilerproc;
+{
+  Converts a UnicodeString to an AnsiString
+}
+Var
+  Size : SizeInt;
+begin
+  result:='';
+  Size:=Length(S2);
+  if Size>0 then
+    widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Pointer(S2)),result,Size);
+end;
+
+
+Function fpc_AnsiStr_To_UnicodeStr (Const S2 : AnsiString): UnicodeString; compilerproc;
+{
+  Converts an AnsiString to a UnicodeString;
+}
+Var
+  Size : SizeInt;
+begin
+  result:='';
+  Size:=Length(S2);
+  if Size>0 then
+    widestringmanager.Ansi2UnicodeMoveProc(PChar(S2),result,Size);
+end;
+*)
+
+Function fpc_UnicodeStr_To_WideStr (const S2 : UnicodeString): WideString; compilerproc;
+  begin
+    result:=s2;
+  end;
+
+
+Function fpc_WideStr_To_UnicodeStr (Const S2 : WideString): UnicodeString; compilerproc;
+  begin
+    result:=s2;
+  end;
+
+function fpc_UnicodeStr_Concat (const S1,S2 : UnicodeString): UnicodeString; compilerproc;
+Var
+  sb: JLStringBuilder;
+begin
+  { only assign if s1 or s2 is empty }
+  if (length(S1)=0) then
+    begin
+      result:=s2;
+      exit;
+    end;
+  if (length(S2)=0) then
+    begin
+      result:=s1;
+      exit;
+    end;
+  sb:=JLStringBuilder.create(S1);
+  sb.append(s2);
+  result:=sb.toString;
+end;
+
+
+function fpc_UnicodeStr_Concat_multi (const sarr:array of Unicodestring): unicodestring; compilerproc;
+Var
+  i  : Longint;
+  Size,NewSize : SizeInt;
+  sb: JLStringBuilder;
+begin
+  { First calculate size of the result so we can allocate a StringBuilder of
+    the right size }
+  NewSize:=0;
+  for i:=low(sarr) to high(sarr) do
+    inc(Newsize,length(sarr[i]));
+  sb:=JLStringBuilder.create(NewSize);
+  for i:=low(sarr) to high(sarr) do
+    begin
+      if length(sarr[i])>0 then
+        sb.append(sarr[i]);
+    end;
+  result:=sb.toString;
+end;
+
+
+Function fpc_Char_To_UChar(const c : AnsiChar): UnicodeChar; compilerproc;
+var
+  str: JLString;
+  arr: array of jbyte;
+begin
+  setlength(arr,1);
+  arr[0]:=ord(c);
+  result:=JLString.create(arr,0,1).charAt(0);
+end;
+
+
+
+Function fpc_Char_To_UnicodeStr(const c : AnsiChar): UnicodeString; compilerproc;
+{
+  Converts a AnsiChar to a UnicodeString;
+}
+var
+  str: JLString;
+  arr: array of jbyte;
+begin
+  setlength(arr,1);
+  arr[0]:=ord(c);
+  result:=JLString.create(arr,0,1);
+end;
+
+
+Function fpc_UChar_To_Char(const c : UnicodeChar): AnsiChar; compilerproc;
+{
+  Converts a UnicodeChar to a AnsiChar;
+}
+var
+  arrb: array of jbyte;
+  arrw: array of jchar;
+  str: JLString;
+begin
+  setlength(arrw,1);
+  arrw[0]:=c;
+  str:=JLString.create(arrw);
+  arrb:=str.getbytes();
+  result:=chr(arrb[0]);
+end;
+
+
+Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc;
+{
+  Converts a WideChar to a UnicodeString;
+}
+var
+  arrw: array of jchar;
+begin
+  setlength(arrw,1);
+  arrw[0]:=c;
+  result:=JLString.create(arrw);
+end;
+
+
+Function fpc_Char_To_WChar(const c : AnsiChar): WideChar; compilerproc;
+{
+  Converts a AnsiChar to a WideChar;
+}
+var
+  str: JLString;
+  arr: array of jbyte;
+begin
+  setlength(arr,1);
+  arr[0]:=ord(c);
+  result:=JLString.create(arr,0,1).charAt(0);
+end;
+
+
+Function fpc_WChar_To_Char(const c : WideChar): AnsiChar; compilerproc;
+{
+  Converts a WideChar to a AnsiChar;
+}
+var
+  arrb: array of jbyte;
+  arrw: array of jchar;
+begin
+  setlength(arrw,1);
+  arrw[0]:=c;
+  arrb:=JLString.create(arrw).getbytes();
+  result:=chr(arrb[0]);
+end;
+
+(*
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
+{
+  Converts a WideChar to a ShortString;
+}
+var
+  s: ansistring;
+begin
+  widestringmanager.Wide2AnsiMoveProc(@c, s, 1);
+  fpc_WChar_To_ShortStr:= s;
+end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
+{
+  Converts a WideChar to a ShortString;
+}
+var
+  s: ansistring;
+begin
+  widestringmanager.Wide2AnsiMoveProc(@c,s,1);
+  res:=s;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+*)
+
+Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
+{
+  Converts a UnicodeChar to a UnicodeString;
+}
+var
+  arr: array of UnicodeChar;
+begin
+  setlength(arr,1);
+  arr[0]:=c;
+  result:=JLString.create(arr);
+end;
+
+(*
+Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
+{
+  Converts a UnicodeChar to a AnsiString;
+}
+begin
+  widestringmanager.Unicode2AnsiMoveProc(@c, fpc_UChar_To_AnsiStr, 1);
+end;
+
+
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+Function fpc_UChar_To_ShortStr(const c : UnicodeChar): ShortString; compilerproc;
+{
+  Converts a UnicodeChar to a ShortString;
+}
+var
+  s: ansistring;
+begin
+  widestringmanager.Unicode2AnsiMoveProc(@c, s, 1);
+  fpc_UChar_To_ShortStr:= s;
+end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_UChar_To_ShortStr(out res : shortstring;const c : UnicodeChar) compilerproc;
+{
+  Converts a UnicodeChar to a ShortString;
+}
+var
+  s: ansistring;
+begin
+  widestringmanager.Unicode2AnsiMoveProc(@c,s,1);
+  res:=s;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+
+Function fpc_PChar_To_UnicodeStr(const p : pchar): UnicodeString; compilerproc;
+Var
+  L : SizeInt;
+begin
+  if (not assigned(p)) or (p[0]=#0) Then
+  begin
+    fpc_pchar_to_unicodestr := '';
+    exit;
+  end;
+  l:=IndexChar(p^,-1,#0);
+  widestringmanager.Ansi2UnicodeMoveProc(P,fpc_PChar_To_UnicodeStr,l);
+end;
+*)
+
+Function fpc_CharArray_To_UnicodeStr(const arr: array of ansichar; zerobased: boolean = true): UnicodeString; compilerproc;
+var
+  i,j  : SizeInt;
+  localarr: array of jbyte;
+  foundnull: boolean;
+begin
+  if (zerobased) then
+    begin
+      if (arr[0]=#0) Then
+      begin
+        fpc_chararray_to_unicodestr := '';
+        exit;
+      end;
+      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;
+  setlength(localarr,i);
+  for j:=0 to i-1 do
+    localarr[j]:=ord(arr[j]);
+  result:=JLString.create(localarr,0,i);
+end;
+
+(*
+function fpc_UnicodeCharArray_To_ShortStr(const arr: array of unicodechar; zerobased: boolean = true): shortstring;[public,alias:'FPC_UNICODECHARARRAY_TO_SHORTSTR']; compilerproc;
+var
+  l: longint;
+ index: longint;
+ len: byte;
+ temp: ansistring;
+ foundnull: boolean;
+begin
+  l := high(arr)+1;
+  if l>=256 then
+    l:=255
+  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;
+  result:=JLString.create(arr,0,l);
+end;
+
+
+Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; zerobased: boolean = true): AnsiString; compilerproc;
+var
+  i  : SizeInt;
+begin
+  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_UnicodeCharArray_To_AnsiStr,i);
+  widestringmanager.Unicode2AnsiMoveProc (punicodechar(@arr),fpc_UnicodeCharArray_To_AnsiStr,i);
+end;
+*)
+
+Function fpc_UnicodeCharArray_To_UnicodeStr(const arr: array of unicodechar; zerobased: boolean = true): UnicodeString; compilerproc;
+var
+  i  : SizeInt;
+  foundnull  : boolean;
+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);
+end;
+
+
+Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc;
+var
+  i  : SizeInt;
+  foundnull  : boolean;
+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);
+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;
+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;
+end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true);[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR']; compilerproc;
+var
+  l: longint;
+  index: ptrint;
+  len: byte;
+  temp: ansistring;
+begin
+  l := high(arr)+1;
+  if l>=high(res)+1 then
+    l:=high(res)
+  else if l<0 then
+    l:=0;
+  if zerobased then
+    begin
+      index:=IndexWord(arr[0],l,0);
+      if index<0 then
+        len:=l
+      else
+        len:=index;
+    end
+  else
+    len:=l;
+  widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,len);
+  res:=temp;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
+var
+  i  : SizeInt;
+begin
+  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);
+end;
+*)
+
+Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
+var
+  i  : SizeInt;
+  foundnull  : boolean;
+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);
+end;
+
+
+procedure fpc_unicodestr_to_chararray(out res: array of AnsiChar; const src: UnicodeString); compilerproc;
+var
+  i, len: SizeInt;
+  temp: array of jbyte;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    begin
+      temp:=JLString(src).getBytes;
+      if len > length(temp) then
+        len := length(temp);
+      for i := 0 to len-1 do
+        res[i] := chr(temp[i]);
+    end;
+end;
+
+
+procedure fpc_unicodestr_to_unicodechararray(out res: array of unicodechar; const src: UnicodeString); compilerproc;
+var
+  len: SizeInt;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    begin
+      if len > high(res)+1 then
+        len := high(res)+1;
+      JLString(src).getChars(0,len,res,0);
+    end;
+end;
+
+function fpc_unicodestr_setchar(const s: UnicodeString; const index: longint; const ch: unicodechar): UnicodeString; compilerproc;
+var
+  sb: JLStringBuilder;
+begin
+  sb:=JLStringBuilder.create(s);
+  { string indexes are 1-based in Pascal, 0-based in Java }
+  sb.setCharAt(index-1,ch);
+  result:=sb.toString();
+end;
+
+
+(*
+procedure fpc_ansistr_to_unicodechararray(out res: array of unicodechar; const src: AnsiString); compilerproc;
+var
+  len: SizeInt;
+  temp: unicodestring;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    widestringmanager.ansi2unicodemoveproc(pchar(@src[1]),temp,len);
+  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}
+end;
+
+procedure fpc_shortstr_to_unicodechararray(out res: array of unicodechar; const src: ShortString); compilerproc;
+var
+  len: longint;
+  temp : unicodestring;
+begin
+  len := length(src);
+  { make sure we don't access char 1 if length is 0 (JM) }
+  if len > 0 then
+    widestringmanager.ansi2unicodemoveproc(pchar(@src[1]),temp,len);
+  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}
+end;
+
+procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
+var
+  len: SizeInt;
+  temp: widestring;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
+  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}
+end;
+
+procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
+var
+  len: longint;
+  temp : widestring;
+begin
+  len := length(src);
+  { make sure we don't access char 1 if length is 0 (JM) }
+  if len > 0 then
+    widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
+  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}
+end;
+*)
+
+procedure fpc_unicodestr_to_widechararray(out res: array of widechar; const src: UnicodeString); compilerproc;
+var
+  i, len: SizeInt;
+begin
+  len := length(src);
+  if len > length(res) then
+    len := length(res);
+  for i:=0 to len-1 do
+    res[i]:=src[i+1];
+end;
+
+
+Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt; compilerproc;
+{
+  Compares 2 UnicodeStrings;
+  The result is
+   <0 if S1<S2
+   0 if S1=S2
+   >0 if S1>S2
+}
+Var
+  MaxI,Temp : SizeInt;
+begin
+  if JLObject(S1)=JLObject(S2) then
+   begin
+     result:=0;
+     exit;
+   end;
+  result:=JLString(S1).compareTo(S2);
+end;
+
+Function fpc_UnicodeStr_Compare_Equal(const S1,S2 : UnicodeString): SizeInt; compilerproc;
+{
+  Compares 2 UnicodeStrings for equality only;
+  The result is
+   0 if S1=S2
+   <>0 if S1<>S2
+}
+Var
+  MaxI : SizeInt;
+begin
+  result:=ord(JLString(S1).equals(JLString(S2)));
+end;
+
+function fpc_UnicodeStr_SetLength(const S : UnicodeString; l : SizeInt): UnicodeString; compilerproc;
+{
+  Sets The length of string S to L.
+  Makes sure S is unique, and contains enough room.
+  Returns new val
+}
+Var
+  movelen: SizeInt;
+  chars: array of widechar;
+  strlen: SizeInt;
+begin
+   if (l>0) then
+    begin
+      if JLObject(S)=nil then
+       begin
+         { Need a completely new string...}
+         result:=NewUnicodeString(l);
+       end
+      { no need to create a new string, since Java strings are immutable }
+      else
+        begin
+          strlen:=length(s);
+          if l=strlen then
+            result:=s
+          else if (l<strlen) then
+            result:=JLString(s).substring(0,l)
+          else
+            begin
+              setlength(chars,l);
+              JLString(s).getChars(0,strlen,chars,0);
+              result:=JLString.create(chars,0,l)
+            end;
+        end
+    end
+  else
+    begin
+      result:='';
+    end;
+end;
+
+{*****************************************************************************
+                     Public functions, In interface.
+*****************************************************************************}
+(*
+function UnicodeCharToString(S : PUnicodeChar) : AnsiString;
+  begin
+     result:=UnicodeCharLenToString(s,Length(UnicodeString(s)));
+  end;
+
+function StringToUnicodeChar(const Src : AnsiString;Dest : PUnicodeChar;DestSize : SizeInt) : PUnicodeChar;
+  var
+    temp:unicodestring;
+  begin
+     widestringmanager.Ansi2UnicodeMoveProc(PChar(Src),temp,Length(Src));
+     if Length(temp)<DestSize then
+       move(temp[1],Dest^,Length(temp)*SizeOf(UnicodeChar))
+     else
+       move(temp[1],Dest^,(DestSize-1)*SizeOf(UnicodeChar));
+
+     Dest[DestSize-1]:=#0;
+
+     result:=Dest;
+
+  end;
+
+
+function WideCharToString(S : PWideChar) : AnsiString;
+  begin
+     result:=WideCharLenToString(s,Length(WideString(s)));
+  end;
+
+
+function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
+  var
+    temp:widestring;
+  begin
+     widestringmanager.Ansi2WideMoveProc(PChar(Src),temp,Length(Src));
+     if Length(temp)<DestSize then
+       move(temp[1],Dest^,Length(temp)*SizeOf(WideChar))
+     else
+       move(temp[1],Dest^,(DestSize-1)*SizeOf(WideChar));
+
+     Dest[DestSize-1]:=#0;
+
+     result:=Dest;
+
+  end;
+
+
+function UnicodeCharLenToString(S : PUnicodeChar;Len : SizeInt) : AnsiString;
+  begin
+     //SetLength(result,Len);
+     widestringmanager.Unicode2AnsiMoveproc(S,result,Len);
+  end;
+
+
+procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : AnsiString);
+  begin
+     Dest:=UnicodeCharLenToString(Src,Len);
+  end;
+
+
+procedure UnicodeCharToStrVar(S : PUnicodeChar;out Dest : AnsiString);
+  begin
+     Dest:=UnicodeCharToString(S);
+  end;
+
+
+function WideCharLenToString(S : PWideChar;Len : SizeInt) : AnsiString;
+  begin
+     //SetLength(result,Len);
+     widestringmanager.Wide2AnsiMoveproc(S,result,Len);
+  end;
+
+
+procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;out Dest : AnsiString);
+  begin
+     Dest:=WideCharLenToString(Src,Len);
+  end;
+
+
+procedure WideCharToStrVar(S : PWideChar;out Dest : AnsiString);
+  begin
+     Dest:=WideCharToString(S);
+  end;
+*)
+
+Function fpc_unicodestr_Unique(const S : JLObject): JLObject; compilerproc;
+begin
+  result:=s;
+end;
+
+
+Function Fpc_UnicodeStr_Copy (Const S : UnicodeString; Index,Size : SizeInt) : UnicodeString;compilerproc;
+begin
+  dec(index);
+  if Index < 0 then
+    Index := 0;
+  { Check Size. Accounts for Zero-length S, the double check is needed because
+    Size can be maxint and will get <0 when adding index }
+  if (Size>Length(S)) or
+     (Index+Size>Length(S)) then
+   Size:=Length(S)-Index;
+  If Size>0 then
+    result:=JLString(s).subString(Index,Size)
+  else
+    result:='';
+end;
+
+
+Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt;
+begin
+  Pos:=0;
+  if Length(SubStr)>0 then
+    Pos:=JLString(Source).indexOf(SubStr)+1;
+end;
+
+
+{ Faster version for a unicodechar alone }
+Function Pos (c : UnicodeChar; Const s : UnicodeString) : SizeInt;
+begin
+  Pos:=0;
+  if length(S)>0 then
+    Pos:=JLString(s).indexOf(ord(c))+1;
+end;
+
+(*
+Function Pos (c : AnsiString; Const s : UnicodeString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    result:=Pos(UnicodeString(c),s);
+  end;
+
+
+Function Pos (c : ShortString; Const s : UnicodeString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    result:=Pos(UnicodeString(c),s);
+  end;
+
+
+Function Pos (c : UnicodeString; Const s : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    result:=Pos(c,UnicodeString(s));
+  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 : UnicodeString) : SizeInt;
+var
+  i: SizeInt;
+  wc : unicodechar;
+begin
+  wc:=c;
+  result:=Pos(wc,s);
+end;
+
+
+(*
+Procedure Delete (Var S : UnicodeString; Index,Size: SizeInt);
+Var
+  LS : SizeInt;
+begin
+  LS:=Length(S);
+  if (Index>LS) or (Index<=0) or (Size<=0) then
+    exit;
+
+  UniqueString (S);
+  { (Size+Index) will overflow if Size=MaxInt. }
+  if Size>LS-Index then
+    Size:=LS-Index+1;
+  if Size<=LS-Index then
+  begin
+    Dec(Index);
+    Move(PUnicodeChar(S)[Index+Size],PUnicodeChar(S)[Index],(LS-Index-Size+1)*sizeof(UnicodeChar));
+  end;
+  Setlength(s,LS-Size);
+end;
+
+
+Procedure Insert (Const Source : UnicodeString; Var S : UnicodeString; Index : SizeInt);
+var
+  Temp : UnicodeString;
+  LS : SizeInt;
+begin
+  If Length(Source)=0 then
+   exit;
+  if index <= 0 then
+   index := 1;
+  Ls:=Length(S);
+  if index > LS then
+   index := LS+1;
+  Dec(Index);
+  Pointer(Temp) := NewUnicodeString(Length(Source)+LS);
+  SetLength(Temp,Length(Source)+LS);
+  If Index>0 then
+    move (PUnicodeChar(S)^,PUnicodeChar(Temp)^,Index*sizeof(UnicodeChar));
+  Move (PUnicodeChar(Source)^,PUnicodeChar(Temp)[Index],Length(Source)*sizeof(UnicodeChar));
+  If (LS-Index)>0 then
+    Move(PUnicodeChar(S)[Index],PUnicodeChar(temp)[Length(Source)+index],(LS-Index)*sizeof(UnicodeChar));
+  S:=Temp;
+end;
+*)
+
+Function  UpCase(c:UnicodeChar):UnicodeChar;
+begin
+  result:=JLCharacter.toUpperCase(c);
+end;
+
+
+function UpCase(const s : UnicodeString) : UnicodeString;
+begin
+  result:=JLString(s).toUpperCase;
+end;
+
+(*
+Procedure SetString (Out S : UnicodeString; Buf : PUnicodeChar; Len : SizeInt);
+begin
+  SetLength(S,Len);
+  If (Buf<>Nil) and (Len>0) then
+    Move (Buf[0],S[1],Len*sizeof(UnicodeChar));
+end;
+
+
+Procedure SetString (Out S : UnicodeString; Buf : PChar; Len : SizeInt);
+var
+  BufLen: SizeInt;
+begin
+  SetLength(S,Len);
+  If (Buf<>Nil) and (Len>0) then
+    widestringmanager.Ansi2UnicodeMoveProc(Buf,S,Len);
+end;
+
+{$ifndef FPUNONE}
+Function fpc_Val_Real_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_UNICODESTR']; compilerproc;
+Var
+  SS : String;
+begin
+  fpc_Val_Real_UnicodeStr := 0;
+  if length(S) > 255 then
+    code := 256
+  else
+    begin
+      SS := S;
+      Val(SS,fpc_Val_Real_UnicodeStr,code);
+    end;
+end;
+{$endif}
+
+function fpc_val_enum_unicodestr(str2ordindex:pointer;const s:unicodestring;out code:valsint):longint;compilerproc;
+
+var ss:shortstring;
+
+begin
+  if length(s)>255 then
+    code:=256
+  else
+    begin
+      ss:=s;
+      val(ss,fpc_val_enum_unicodestr,code);
+    end;
+end;
+
+Function fpc_Val_Currency_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): Currency; [public, alias:'FPC_VAL_CURRENCY_UNICODESTR']; compilerproc;
+Var
+  SS : String;
+begin
+  if length(S) > 255 then
+    begin
+      fpc_Val_Currency_UnicodeStr:=0;
+      code := 256;
+    end
+  else
+    begin
+      SS := S;
+      Val(SS,fpc_Val_Currency_UnicodeStr,code);
+    end;
+end;
+
+
+Function fpc_Val_UInt_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_UNICODESTR']; compilerproc;
+Var
+  SS : ShortString;
+begin
+  fpc_Val_UInt_UnicodeStr := 0;
+  if length(S) > 255 then
+    code := 256
+  else
+    begin
+      SS := S;
+      Val(SS,fpc_Val_UInt_UnicodeStr,code);
+    end;
+end;
+
+
+Function fpc_Val_SInt_UnicodeStr (DestSize: SizeInt; Const S : UnicodeString; out Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_UNICODESTR']; compilerproc;
+Var
+  SS : ShortString;
+begin
+  fpc_Val_SInt_UnicodeStr:=0;
+  if length(S)>255 then
+    code:=256
+  else
+    begin
+      SS := S;
+      fpc_Val_SInt_UnicodeStr := int_Val_SInt_ShortStr(DestSize,SS,Code);
+    end;
+end;
+
+
+{$ifndef CPU64}
+
+Function fpc_Val_qword_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_UNICODESTR']; compilerproc;
+Var
+  SS : ShortString;
+begin
+  fpc_Val_qword_UnicodeStr:=0;
+  if length(S)>255 then
+    code:=256
+  else
+    begin
+       SS := S;
+       Val(SS,fpc_Val_qword_UnicodeStr,Code);
+    end;
+end;
+
+
+Function fpc_Val_int64_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_UNICODESTR']; compilerproc;
+Var
+  SS : ShortString;
+begin
+  fpc_Val_int64_UnicodeStr:=0;
+  if length(S)>255 then
+    code:=256
+  else
+    begin
+       SS := S;
+       Val(SS,fpc_Val_int64_UnicodeStr,Code);
+    end;
+end;
+
+{$endif CPU64}
+
+
+{$ifndef FPUNONE}
+procedure fpc_UnicodeStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : UnicodeString);compilerproc;
+var
+  ss : shortstring;
+begin
+  str_real(len,fr,d,treal_type(rt),ss);
+  s:=ss;
+end;
+{$endif}
+
+procedure fpc_unicodestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:unicodestring);compilerproc;
+
+var ss:shortstring;
+
+begin
+  fpc_shortstr_enum(ordinal,len,typinfo,ord2strindex,ss);
+  s:=ss;
+end;
+
+procedure fpc_unicodestr_bool(b : boolean;len:sizeint;out s:unicodestring);compilerproc;
+
+var ss:shortstring;
+
+begin
+  fpc_shortstr_bool(b,len,ss);
+  s:=ss;
+end;
+
+{$ifdef FPC_HAS_STR_CURRENCY}
+procedure fpc_UnicodeStr_Currency(c : Currency;len,fr : SizeInt;out s : UnicodeString);compilerproc;
+var
+  ss : shortstring;
+begin
+  str(c:len:fr,ss);
+  s:=ss;
+end;
+{$endif FPC_HAS_STR_CURRENCY}
+
+Procedure fpc_UnicodeStr_SInt(v : ValSint; Len : SizeInt; out S : UnicodeString);compilerproc;
+Var
+  SS : ShortString;
+begin
+  Str (v:Len,SS);
+  S:=SS;
+end;
+
+
+Procedure fpc_UnicodeStr_UInt(v : ValUInt;Len : SizeInt; out S : UnicodeString);compilerproc;
+Var
+  SS : ShortString;
+begin
+  str(v:Len,SS);
+  S:=SS;
+end;
+
+
+{$ifndef CPU64}
+
+Procedure fpc_UnicodeStr_Int64(v : Int64; Len : SizeInt; out S : UnicodeString);compilerproc;
+Var
+  SS : ShortString;
+begin
+  Str (v:Len,SS);
+  S:=SS;
+end;
+
+
+Procedure fpc_UnicodeStr_Qword(v : Qword;Len : SizeInt; out S : UnicodeString);compilerproc;
+Var
+  SS : ShortString;
+begin
+  str(v:Len,SS);
+  S:=SS;
+end;
+
+{$endif CPU64}
+*)
+
+(*
+{ converts an utf-16 code point or surrogate pair to utf-32 }
+function utf16toutf32(const S: UnicodeString; const index: SizeInt; out len: longint): UCS4Char; [public, alias: 'FPC_UTF16TOUTF32'];
+var
+  w: unicodechar;
+begin
+  { UTF-16 points in the range #$0-#$D7FF and #$E000-#$FFFF }
+  { are the same in UTF-32                                  }
+  w:=s[index];
+  if (w<=#$d7ff) or
+     (w>=#$e000) then
+    begin
+      result:=UCS4Char(w);
+      len:=1;
+    end
+  { valid surrogate pair? }
+  else if (w<=#$dbff) and
+          { w>=#$d7ff check not needed, checked above }
+          (index<length(s)) and
+          (s[index+1]>=#$dc00) and
+          (s[index+1]<=#$dfff) then
+      { convert the surrogate pair to UTF-32 }
+    begin
+      result:=(UCS4Char(w)-$d800) shl 10 + (UCS4Char(s[index+1])-$dc00) + $10000;
+      len:=2;
+    end
+  else
+    { invalid surrogate -> do nothing }
+    begin
+      result:=UCS4Char(w);
+      len:=1;
+    end;
+end;
+
+
+function UnicodeToUtf8(Dest: PChar; Source: PUnicodeChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    if assigned(Source) then
+      Result:=UnicodeToUtf8(Dest,MaxBytes,Source,IndexWord(Source^,-1,0))
+    else
+      Result:=0;
+  end;
+
+
+function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PUnicodeChar; SourceChars: SizeUInt): SizeUInt;
+  var
+    i,j : SizeUInt;
+    w : word;
+    lw : longword;
+    len : longint;
+  begin
+    result:=0;
+    if source=nil then
+      exit;
+    i:=0;
+    j:=0;
+    if assigned(Dest) then
+      begin
+        while (i<SourceChars) and (j<MaxDestBytes) do
+          begin
+            w:=word(Source[i]);
+            case w of
+              0..$7f:
+                begin
+                  Dest[j]:=char(w);
+                  inc(j);
+                end;
+              $80..$7ff:
+                begin
+                  if j+1>=MaxDestBytes then
+                    break;
+                  Dest[j]:=char($c0 or (w shr 6));
+                  Dest[j+1]:=char($80 or (w and $3f));
+                  inc(j,2);
+                end;
+              $800..$d7ff,$e000..$ffff:
+                begin
+                  if j+2>=MaxDestBytes then
+                    break;
+                  Dest[j]:=char($e0 or (w shr 12));
+                  Dest[j+1]:=char($80 or ((w shr 6) and $3f));
+                  Dest[j+2]:=char($80 or (w and $3f));
+                  inc(j,3);
+                end;
+              $d800..$dbff:
+                {High Surrogates}
+                begin
+                  if j+3>=MaxDestBytes then
+                    break;
+                  if (i<sourcechars-1) and
+                     (word(Source[i+1]) >= $dc00) and
+                     (word(Source[i+1]) <= $dfff) then
+                    begin
+                      lw:=longword(utf16toutf32(Source[i] + Source[i+1], 1, len));
+                      Dest[j]:=char($f0 or (lw shr 18));
+                      Dest[j+1]:=char($80 or ((lw shr 12) and $3f));
+                      Dest[j+2]:=char($80 or ((lw shr 6) and $3f));
+                      Dest[j+3]:=char($80 or (lw and $3f));
+                      inc(j,4);
+                      inc(i);
+                    end;
+                end;
+              end;
+            inc(i);
+          end;
+
+        if j>SizeUInt(MaxDestBytes-1) then
+          j:=MaxDestBytes-1;
+
+        Dest[j]:=#0;
+      end
+    else
+      begin
+        while i<SourceChars do
+          begin
+            case word(Source[i]) of
+              $0..$7f:
+                inc(j);
+              $80..$7ff:
+                inc(j,2);
+              $800..$d7ff,$e000..$ffff:
+                inc(j,3);
+              $d800..$dbff:
+                begin
+                  if (i<sourcechars-1) and
+                     (word(Source[i+1]) >= $dc00) and
+                     (word(Source[i+1]) <= $dfff) then
+                    begin
+                      inc(j,4);
+                      inc(i);
+                    end;
+                end;
+            end;
+            inc(i);
+          end;
+      end;
+    result:=j+1;
+  end;
+
+
+function Utf8ToUnicode(Dest: PUnicodeChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    if assigned(Source) then
+      Result:=Utf8ToUnicode(Dest,MaxChars,Source,strlen(Source))
+    else
+      Result:=0;
+  end;
+
+
+function UTF8ToUnicode(Dest: PUnicodeChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
+  const
+    UNICODE_INVALID=63;
+  var
+    InputUTF8: SizeUInt;
+    IBYTE: BYTE;
+    OutputUnicode: SizeUInt;
+    PRECHAR: SizeUInt;
+    TempBYTE: BYTE;
+    CharLen: SizeUint;
+    LookAhead: SizeUInt;
+    UC: SizeUInt;
+  begin
+    if not assigned(Source) then
+      begin
+        result:=0;
+        exit;
+      end;
+    result:=SizeUInt(-1);
+    InputUTF8:=0;
+    OutputUnicode:=0;
+    PreChar:=0;
+    if Assigned(Dest) Then
+      begin
+        while (OutputUnicode<MaxDestChars) and (InputUTF8<SourceBytes) do
+          begin
+            IBYTE:=byte(Source[InputUTF8]);
+            if (IBYTE and $80) = 0 then
+              begin
+                //One character US-ASCII, convert it to unicode
+                if IBYTE = 10 then
+                  begin
+                    If (PreChar<>13) and FALSE then
+                      begin
+                        //Expand to crlf, conform UTF-8.
+                        //This procedure will break the memory alocation by
+                        //FPC for the widestring, so never use it. Condition never true due the "and FALSE".
+                        if OutputUnicode+1<MaxDestChars then
+                          begin
+                            Dest[OutputUnicode]:=WideChar(13);
+                            inc(OutputUnicode);
+                            Dest[OutputUnicode]:=WideChar(10);
+                            inc(OutputUnicode);
+                            PreChar:=10;
+                          end
+                        else
+                          begin
+                            Dest[OutputUnicode]:=WideChar(13);
+                            inc(OutputUnicode);
+                          end;
+                      end
+                    else
+                      begin
+                        Dest[OutputUnicode]:=WideChar(IBYTE);
+                        inc(OutputUnicode);
+                        PreChar:=IBYTE;
+                      end;
+                  end
+                else
+                  begin
+                    Dest[OutputUnicode]:=WideChar(IBYTE);
+                    inc(OutputUnicode);
+                    PreChar:=IBYTE;
+                  end;
+                inc(InputUTF8);
+              end
+            else
+              begin
+                TempByte:=IBYTE;
+                CharLen:=0;
+                while (TempBYTE and $80)<>0 do
+                  begin
+                    TempBYTE:=(TempBYTE shl 1) and $FE;
+                    inc(CharLen);
+                  end;
+                //Test for the "CharLen" conforms UTF-8 string
+                //This means the 10xxxxxx pattern.
+                if SizeUInt(InputUTF8+CharLen-1)>SourceBytes then
+                  begin
+                    //Insuficient chars in string to decode
+                    //UTF-8 array. Fallback to single char.
+                    CharLen:= 1;
+                  end;
+                for LookAhead := 1 to CharLen-1 do
+                  begin
+                    if ((byte(Source[InputUTF8+LookAhead]) and $80)<>$80) or
+                       ((byte(Source[InputUTF8+LookAhead]) and $40)<>$00) then
+                      begin
+                        //Invalid UTF-8 sequence, fallback.
+                        CharLen:= LookAhead;
+                        break;
+                      end;
+                  end;
+                UC:=$FFFF;
+                case CharLen of
+                  1:  begin
+                        //Not valid UTF-8 sequence
+                        UC:=UNICODE_INVALID;
+                      end;
+                  2:  begin
+                        //Two bytes UTF, convert it
+                        UC:=(byte(Source[InputUTF8]) and $1F) shl 6;
+                        UC:=UC or (byte(Source[InputUTF8+1]) and $3F);
+                        if UC <= $7F then
+                          begin
+                            //Invalid UTF sequence.
+                            UC:=UNICODE_INVALID;
+                          end;
+                      end;
+                  3:  begin
+                        //Three bytes, convert it to unicode
+                        UC:= (byte(Source[InputUTF8]) and $0F) shl 12;
+                        UC:= UC or ((byte(Source[InputUTF8+1]) and $3F) shl 6);
+                        UC:= UC or ((byte(Source[InputUTF8+2]) and $3F));
+                        if (UC <= $7FF) or (UC >= $FFFE) or ((UC >= $D800) and (UC <= $DFFF)) then
+                          begin
+                            //Invalid UTF-8 sequence
+                            UC:= UNICODE_INVALID;
+                          End;
+                      end;
+                  4:  begin
+                        //Four bytes, convert it to two unicode characters
+                        UC:= (byte(Source[InputUTF8]) and $07) shl 18;
+                        UC:= UC or ((byte(Source[InputUTF8+1]) and $3F) shl 12);
+                        UC:= UC or ((byte(Source[InputUTF8+2]) and $3F) shl 6);
+                        UC:= UC or ((byte(Source[InputUTF8+3]) and $3F));
+                        if (UC < $10000) or (UC > $10FFFF) then
+                          begin
+                            UC:= UNICODE_INVALID;
+                          end
+                        else
+                          begin
+                            { only store pair if room }
+                            dec(UC,$10000);
+                            if (OutputUnicode<MaxDestChars-1) then
+                              begin
+                                Dest[OutputUnicode]:=WideChar(UC shr 10 + $D800);
+                                inc(OutputUnicode);
+                                UC:=(UC and $3ff) + $DC00;
+                              end
+                            else
+                              begin
+                                InputUTF8:= InputUTF8 + CharLen;
+                                { don't store anything }
+                                CharLen:=0;
+                              end;
+                          end;
+                      end;
+                  5,6,7:  begin
+                            //Invalid UTF8 to unicode conversion,
+                            //mask it as invalid UNICODE too.
+                            UC:=UNICODE_INVALID;
+                          end;
+                end;
+                if CharLen > 0 then
+                  begin
+                    PreChar:=UC;
+                    Dest[OutputUnicode]:=WideChar(UC);
+                    inc(OutputUnicode);
+                  end;
+                InputUTF8:= InputUTF8 + CharLen;
+              end;
+          end;
+        Result:=OutputUnicode+1;
+      end
+    else
+      begin
+        while (InputUTF8<SourceBytes) do
+          begin
+            IBYTE:=byte(Source[InputUTF8]);
+            if (IBYTE and $80) = 0 then
+              begin
+                //One character US-ASCII, convert it to unicode
+                if IBYTE = 10 then
+                  begin
+                    if (PreChar<>13) and FALSE then
+                      begin
+                        //Expand to crlf, conform UTF-8.
+                        //This procedure will break the memory alocation by
+                        //FPC for the widestring, so never use it. Condition never true due the "and FALSE".
+                        inc(OutputUnicode,2);
+                        PreChar:=10;
+                      end
+                    else
+                      begin
+                        inc(OutputUnicode);
+                        PreChar:=IBYTE;
+                      end;
+                  end
+                else
+                  begin
+                    inc(OutputUnicode);
+                    PreChar:=IBYTE;
+                  end;
+                inc(InputUTF8);
+              end
+            else
+              begin
+                TempByte:=IBYTE;
+                CharLen:=0;
+                while (TempBYTE and $80)<>0 do
+                  begin
+                    TempBYTE:=(TempBYTE shl 1) and $FE;
+                    inc(CharLen);
+                  end;
+                //Test for the "CharLen" conforms UTF-8 string
+                //This means the 10xxxxxx pattern.
+                if SizeUInt(InputUTF8+CharLen-1)>SourceBytes then
+                  begin
+                    //Insuficient chars in string to decode
+                    //UTF-8 array. Fallback to single char.
+                    CharLen:= 1;
+                  end;
+                for LookAhead := 1 to CharLen-1 do
+                  begin
+                    if ((byte(Source[InputUTF8+LookAhead]) and $80)<>$80) or
+                       ((byte(Source[InputUTF8+LookAhead]) and $40)<>$00) then
+                      begin
+                        //Invalid UTF-8 sequence, fallback.
+                        CharLen:= LookAhead;
+                        break;
+                      end;
+                  end;
+                UC:=$FFFF;
+                case CharLen of
+                  1:  begin
+                        //Not valid UTF-8 sequence
+                        UC:=UNICODE_INVALID;
+                      end;
+                  2:  begin
+                        //Two bytes UTF, convert it
+                        UC:=(byte(Source[InputUTF8]) and $1F) shl 6;
+                        UC:=UC or (byte(Source[InputUTF8+1]) and $3F);
+                        if UC <= $7F then
+                          begin
+                            //Invalid UTF sequence.
+                            UC:=UNICODE_INVALID;
+                          end;
+                      end;
+                  3:  begin
+                        //Three bytes, convert it to unicode
+                        UC:= (byte(Source[InputUTF8]) and $0F) shl 12;
+                        UC:= UC or ((byte(Source[InputUTF8+1]) and $3F) shl 6);
+                        UC:= UC or ((byte(Source[InputUTF8+2]) and $3F));
+                        If (UC <= $7FF) or (UC >= $FFFE) or ((UC >= $D800) and (UC <= $DFFF)) then
+                          begin
+                            //Invalid UTF-8 sequence
+                            UC:= UNICODE_INVALID;
+                          end;
+                      end;
+                  4:  begin
+                        //Four bytes, convert it to two unicode characters
+                        UC:= (byte(Source[InputUTF8]) and $07) shl 18;
+                        UC:= UC or ((byte(Source[InputUTF8+1]) and $3F) shl 12);
+                        UC:= UC or ((byte(Source[InputUTF8+2]) and $3F) shl 6);
+                        UC:= UC or ((byte(Source[InputUTF8+3]) and $3F));
+                        if (UC < $10000) or (UC > $10FFFF) then
+                          UC:= UNICODE_INVALID
+                        else
+                          { extra character character }
+                          inc(OutputUnicode);
+                      end;
+                  5,6,7:  begin
+                            //Invalid UTF8 to unicode conversion,
+                            //mask it as invalid UNICODE too.
+                            UC:=UNICODE_INVALID;
+                          end;
+                end;
+                if CharLen > 0 then
+                  begin
+                    PreChar:=UC;
+                    inc(OutputUnicode);
+                  end;
+                InputUTF8:= InputUTF8 + CharLen;
+              end;
+          end;
+        Result:=OutputUnicode+1;
+      end;
+  end;
+
+
+function UTF8Encode(const s : Ansistring) : UTF8String; inline;
+  begin
+    Result:=UTF8Encode(UnicodeString(s));
+  end;
+
+
+function UTF8Encode(const s : UnicodeString) : UTF8String;
+  var
+    i : SizeInt;
+    hs : UTF8String;
+  begin
+    result:='';
+    if s='' then
+      exit;
+    SetLength(hs,length(s)*3);
+    i:=UnicodeToUtf8(pchar(hs),length(hs)+1,PUnicodeChar(s),length(s));
+    if i>0 then
+      begin
+        SetLength(hs,i-1);
+        result:=hs;
+      end;
+  end;
+
+
+function UTF8Decode(const s : UTF8String): UnicodeString;
+  var
+    i : SizeInt;
+    hs : UnicodeString;
+  begin
+    result:='';
+    if s='' then
+      exit;
+    SetLength(hs,length(s));
+    i:=Utf8ToUnicode(PUnicodeChar(hs),length(hs)+1,pchar(s),length(s));
+    if i>0 then
+      begin
+        SetLength(hs,i-1);
+        result:=hs;
+      end;
+  end;
+
+
+function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    Result:=Utf8Encode(s);
+  end;
+
+
+function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    Result:=Utf8Decode(s);
+  end;
+
+
+function UnicodeStringToUCS4String(const s : UnicodeString) : UCS4String;
+  var
+    i, slen,
+    destindex : SizeInt;
+    len       : longint;
+  begin
+    slen:=length(s);
+    setlength(result,slen+1);
+    i:=1;
+    destindex:=0;
+    while (i<=slen) do
+      begin
+        result[destindex]:=utf16toutf32(s,i,len);
+        inc(destindex);
+        inc(i,len);
+      end;
+    { destindex <= slen (surrogate pairs may have been merged) }
+    { destindex+1 for terminating #0 (dynamic arrays are       }
+    { implicitely filled with zero)                            }
+    setlength(result,destindex+1);
+  end;
+
+
+{ concatenates an utf-32 char to a unicodestring. S *must* be unique when entering. }
+procedure ConcatUTF32ToUnicodeStr(const nc: UCS4Char; var S: UnicodeString; var index: SizeInt);
+var
+  p : PUnicodeChar;
+begin
+  { if nc > $ffff, we need two places }
+  if (index+ord(nc > $ffff)>length(s)) then
+    if (length(s) < 10*256) then
+      setlength(s,length(s)+10)
+    else
+      setlength(s,length(s)+length(s) shr 8);
+  { we know that s is unique -> avoid uniquestring calls}
+  p:=@s[index];
+  if (nc<$ffff) then
+    begin
+      p^:=unicodechar(nc);
+      inc(index);
+    end
+  else if (dword(nc)<=$10ffff) then
+    begin
+      p^:=unicodechar((nc - $10000) shr 10 + $d800);
+      (p+1)^:=unicodechar((nc - $10000) and $3ff + $dc00);
+      inc(index,2);
+    end
+  else
+    { invalid code point }
+    begin
+      p^:='?';
+      inc(index);
+    end;
+end;
+
+
+function UCS4StringToUnicodeString(const s : UCS4String) : UnicodeString;
+  var
+    i        : SizeInt;
+    resindex : SizeInt;
+  begin
+    { skip terminating #0 }
+    SetLength(result,length(s)-1);
+    resindex:=1;
+    for i:=0 to high(s)-1 do
+      ConcatUTF32ToUnicodeStr(s[i],result,resindex);
+    { adjust result length (may be too big due to growing }
+    { for surrogate pairs)                                }
+    setlength(result,resindex-1);
+  end;
+
+
+function WideStringToUCS4String(const s : WideString) : UCS4String;
+  var
+    i, slen,
+    destindex : SizeInt;
+    len       : longint;
+  begin
+    slen:=length(s);
+    setlength(result,slen+1);
+    i:=1;
+    destindex:=0;
+    while (i<=slen) do
+      begin
+        result[destindex]:=utf16toutf32(s,i,len);
+        inc(destindex);
+        inc(i,len);
+      end;
+    { destindex <= slen (surrogate pairs may have been merged) }
+    { destindex+1 for terminating #0 (dynamic arrays are       }
+    { implicitely filled with zero)                            }
+    setlength(result,destindex+1);
+  end;
+
+
+{ concatenates an utf-32 char to a widestring. S *must* be unique when entering. }
+procedure ConcatUTF32ToWideStr(const nc: UCS4Char; var S: WideString; var index: SizeInt);
+var
+  p : PWideChar;
+begin
+  { if nc > $ffff, we need two places }
+  if (index+ord(nc > $ffff)>length(s)) then
+    if (length(s) < 10*256) then
+      setlength(s,length(s)+10)
+    else
+      setlength(s,length(s)+length(s) shr 8);
+  { we know that s is unique -> avoid uniquestring calls}
+  p:=@s[index];
+  if (nc<$ffff) then
+    begin
+      p^:=widechar(nc);
+      inc(index);
+    end
+  else if (dword(nc)<=$10ffff) then
+    begin
+      p^:=widechar((nc - $10000) shr 10 + $d800);
+      (p+1)^:=widechar((nc - $10000) and $3ff + $dc00);
+      inc(index,2);
+    end
+  else
+    { invalid code point }
+    begin
+      p^:='?';
+      inc(index);
+    end;
+end;
+
+
+function UCS4StringToWideString(const s : UCS4String) : WideString;
+  var
+    i        : SizeInt;
+    resindex : SizeInt;
+  begin
+    { skip terminating #0 }
+    SetLength(result,length(s)-1);
+    resindex:=1;
+    for i:=0 to high(s)-1 do
+      ConcatUTF32ToWideStr(s[i],result,resindex);
+    { adjust result length (may be too big due to growing }
+    { for surrogate pairs)                                }
+    setlength(result,resindex-1);
+  end;
+
+
+const
+  SNoUnicodestrings = 'This binary has no unicodestrings support compiled in.';
+  SRecompileWithUnicodestrings = 'Recompile the application with a unicodestrings-manager in the program uses clause.';
+*)
+
+function CompareUnicodeString(const s1, s2 : UnicodeString) : PtrInt;
+  begin
+    widestringmanager.collator.setStrength(JTCollator.IDENTICAL);
+    result:=widestringmanager.collator.compare(s1,s2);
+  end;
+
+
+function CompareTextUnicodeString(const s1, s2 : UnicodeString): PtrInt;
+  begin
+    widestringmanager.collator.setStrength(JTCollator.TERTIARY);
+    result:=widestringmanager.collator.compare(s1,s2);
+  end;
+
+constructor TUnicodeStringManager.create;
+  begin
+  end;
+
+
+procedure initunicodestringmanager;
+  begin
+    widestringmanager:=TUnicodeStringManager.create;
+    widestringmanager.collator:=JTCollator.getInstance;
+  end;
+