Merged revisions 11665-11738 via svnmerge from

http://svn.freepascal.org/svn/fpc/branches/unicodestring

........
  r11665 | florian | 2008-08-30 13:30:17 +0200 (Sat, 30 Aug 2008) | 1 line
  
  * continued to work on unicodestring type support
........
  r11666 | florian | 2008-08-30 19:02:26 +0200 (Sat, 30 Aug 2008) | 2 lines
  
  * expectloc for wide/ansi/unicode strings is LOC_CONSTANT or LOC_REGISTER now
........
  r11667 | florian | 2008-08-30 20:42:37 +0200 (Sat, 30 Aug 2008) | 1 line
  
  * more unicodestring stuff fixed, test results on win32 are already good
........
  r11670 | florian | 2008-08-30 23:21:48 +0200 (Sat, 30 Aug 2008) | 2 lines
  
  * first fixes for unix bootstrapping
........
  r11683 | ivost | 2008-09-01 12:46:39 +0200 (Mon, 01 Sep 2008) | 2 lines
  
      * fixed 64bit bug in iconvenc.pas
........
  r11689 | florian | 2008-09-01 23:12:34 +0200 (Mon, 01 Sep 2008) | 1 line
  
  * fixed several errors when building on unix
........
  r11694 | florian | 2008-09-03 20:32:43 +0200 (Wed, 03 Sep 2008) | 1 line
  
  * fixed unix compilation
........
  r11695 | florian | 2008-09-03 21:01:04 +0200 (Wed, 03 Sep 2008) | 1 line
  
  * bootstrapping fix
........
  r11696 | florian | 2008-09-03 21:07:18 +0200 (Wed, 03 Sep 2008) | 1 line
  
  * more bootstrapping fixed
........
  r11698 | florian | 2008-09-03 22:47:54 +0200 (Wed, 03 Sep 2008) | 1 line
  
  + two missing compiler procs exported
........
  r11701 | florian | 2008-09-04 16:42:34 +0200 (Thu, 04 Sep 2008) | 2 lines
  
  + lazarus project for the linux rtl
........
  r11702 | florian | 2008-09-04 16:43:27 +0200 (Thu, 04 Sep 2008) | 2 lines
  
  + set unicode string procedures
........
  r11707 | florian | 2008-09-04 23:23:02 +0200 (Thu, 04 Sep 2008) | 2 lines
  
  * fixed several type casting stuff
........
  r11712 | florian | 2008-09-05 22:46:03 +0200 (Fri, 05 Sep 2008) | 1 line
  
  * fixed unicodestring compilation on windows after recent unix changes
........
  r11713 | florian | 2008-09-05 23:35:12 +0200 (Fri, 05 Sep 2008) | 1 line
  
  + UnicodeString support for Variants
........
  r11715 | florian | 2008-09-06 20:59:54 +0200 (Sat, 06 Sep 2008) | 1 line
  
  * patch by Martin Schreiber for UnicodeString streaming
........
  r11716 | florian | 2008-09-06 22:22:55 +0200 (Sat, 06 Sep 2008) | 2 lines
  
  * fixed test
........
  r11717 | florian | 2008-09-07 10:25:51 +0200 (Sun, 07 Sep 2008) | 1 line
  
  * fixed typo when converting tunicodestring to punicodechar
........
  r11718 | florian | 2008-09-07 11:29:52 +0200 (Sun, 07 Sep 2008) | 3 lines
  
  * fixed writing of UnicodeString properties
  * moved some helper routines to unicode headers
........
  r11734 | florian | 2008-09-09 22:38:55 +0200 (Tue, 09 Sep 2008) | 1 line
  
  * fixed bootstrapping
........
  r11735 | florian | 2008-09-10 11:25:28 +0200 (Wed, 10 Sep 2008) | 2 lines
  
  * first fixes for persisten unicodestrings
........
  r11736 | florian | 2008-09-10 14:31:00 +0200 (Wed, 10 Sep 2008) | 3 lines
  
  Initialized merge tracking via "svnmerge" with revisions "1-11663" from 
  http://svn.freepascal.org/svn/fpc/trunk
........
  r11737 | florian | 2008-09-10 21:06:57 +0200 (Wed, 10 Sep 2008) | 3 lines
  
  * fixed unicodestring <-> variant handling
  * fixed unicodestring property reading
........

git-svn-id: trunk@11739 -

.gitattributes

@@ -106,6 +106,7 @@ compiler/avr/rgcpu.pas svneol=native#text/plain
 compiler/browcol.pas svneol=native#text/plain
 compiler/bsdcompile -text
 compiler/catch.pas svneol=native#text/plain
+compiler/ccharset.pas svneol=native#text/plain
 compiler/cclasses.pas svneol=native#text/plain
 compiler/cfidwarf.pas svneol=native#text/plain
 compiler/cfileutl.pas svneol=native#text/plain
@@ -5383,14 +5384,18 @@ rtl/inc/threadvr.inc svneol=native#text/plain
 rtl/inc/typefile.inc svneol=native#text/plain
 rtl/inc/ucomplex.pp svneol=native#text/plain
 rtl/inc/ufloat128.pp svneol=native#text/plain
+rtl/inc/ustringh.inc svneol=native#text/plain
+rtl/inc/ustrings.inc svneol=native#text/plain
 rtl/inc/varerror.inc svneol=native#text/plain
 rtl/inc/variant.inc svneol=native#text/plain
 rtl/inc/varianth.inc svneol=native#text/plain
 rtl/inc/variants.pp svneol=native#text/plain
 rtl/inc/video.inc svneol=native#text/plain
 rtl/inc/videoh.inc svneol=native#text/plain
+rtl/inc/wstring22h.inc svneol=native#text/plain
 rtl/inc/wstringh.inc svneol=native#text/plain
 rtl/inc/wstrings.inc -text
+rtl/inc/wustring22.inc svneol=native#text/plain
 rtl/inc/wustrings.inc svneol=native#text/plain
 rtl/linux/Makefile svneol=native#text/plain
 rtl/linux/Makefile.fpc svneol=native#text/plain
@@ -5406,6 +5411,8 @@ rtl/linux/arm/syscall.inc svneol=native#text/plain
 rtl/linux/arm/syscallh.inc svneol=native#text/plain
 rtl/linux/arm/sysnr.inc svneol=native#text/plain
 rtl/linux/arm/ucprt0.as svneol=native#text/plain
+rtl/linux/buildrtl.lpi svneol=native#text/plain
+rtl/linux/buildrtl.pp svneol=native#text/plain
 rtl/linux/bunxsysc.inc svneol=native#text/plain
 rtl/linux/errno.inc svneol=native#text/plain
 rtl/linux/errnostr.inc -text
@@ -7820,6 +7827,7 @@ tests/test/tsetsize.pp svneol=native#text/plain
 tests/test/tstack.pp svneol=native#text/plain
 tests/test/tstprocv.pp svneol=native#text/plain
 tests/test/tstring1.pp svneol=native#text/plain
+tests/test/tstring10.pp svneol=native#text/plain
 tests/test/tstring2.pp svneol=native#text/plain
 tests/test/tstring3.pp svneol=native#text/plain
 tests/test/tstring4.pp svneol=native#text/plain
@@ -7833,6 +7841,12 @@ tests/test/tstrreal2.pp svneol=native#text/plain
 tests/test/tstrreal3.pp -text
 tests/test/tsubdecl.pp svneol=native#text/plain
 tests/test/tunaligned1.pp svneol=native#text/plain
+tests/test/tunistr1.pp svneol=native#text/plain
+tests/test/tunistr2.pp svneol=native#text/plain
+tests/test/tunistr4.pp svneol=native#text/plain
+tests/test/tunistr5.pp svneol=native#text/plain
+tests/test/tunistr6.pp svneol=native#text/plain
+tests/test/tunistr7.pp svneol=native#text/plain
 tests/test/tunit1.pp svneol=native#text/plain
 tests/test/tunit2.pp svneol=native#text/plain
 tests/test/tunit3.pp svneol=native#text/plain

compiler/ccharset.pas

@@ -0,0 +1,254 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2000 by Florian Klaempfl
+    member of the Free Pascal development team.
+
+    This unit implements several classes for charset conversions
+
+    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.
+
+ **********************************************************************}
+
+{ this unit is included temporarily for 2.2 bootstrapping and can be
+  removed after the next release after 2.2.2 }
+{$mode objfpc}
+unit ccharset;
+
+  interface
+
+    type
+       tunicodechar = word;
+       tunicodestring = ^tunicodechar;
+
+       tcsconvert = class
+         // !!!!!!1constructor create;
+       end;
+
+       tunicodecharmappingflag = (umf_noinfo,umf_leadbyte,umf_undefined,
+         umf_unused);
+
+       punicodecharmapping = ^tunicodecharmapping;
+       tunicodecharmapping = record
+          unicode : tunicodechar;
+          flag : tunicodecharmappingflag;
+          reserved : byte;
+       end;
+
+       punicodemap = ^tunicodemap;
+       tunicodemap = record
+          cpname : string[20];
+          map : punicodecharmapping;
+          lastchar : longint;
+          next : punicodemap;
+          internalmap : boolean;
+       end;
+
+       tcp2unicode = class(tcsconvert)
+       end;
+
+    function loadunicodemapping(const cpname,f : string) : punicodemap;
+    procedure registermapping(p : punicodemap);
+    function getmap(const s : string) : punicodemap;
+    function mappingavailable(const s : string) : boolean;
+    function getunicode(c : char;p : punicodemap) : tunicodechar;
+    function getascii(c : tunicodechar;p : punicodemap) : string;
+
+  implementation
+
+    var
+       mappings : punicodemap;
+
+    function loadunicodemapping(const cpname,f : string) : punicodemap;
+
+      var
+         data : punicodecharmapping;
+         datasize : longint;
+         t : text;
+         s,hs : string;
+         scanpos,charpos,unicodevalue : longint;
+         code : word;
+         flag : tunicodecharmappingflag;
+         p : punicodemap;
+         lastchar : longint;
+
+      begin
+         lastchar:=-1;
+         loadunicodemapping:=nil;
+         datasize:=256;
+         getmem(data,sizeof(tunicodecharmapping)*datasize);
+         assign(t,f);
+         {$I-}
+         reset(t);
+         {$I+}
+         if ioresult<>0 then
+           begin
+              freemem(data,sizeof(tunicodecharmapping)*datasize);
+              exit;
+           end;
+         while not(eof(t)) do
+           begin
+              readln(t,s);
+              if (s[1]='0') and (s[2]='x') then
+                begin
+                   flag:=umf_unused;
+                   scanpos:=3;
+                   hs:='$';
+                   while s[scanpos] in ['0'..'9','A'..'F','a'..'f'] do
+                     begin
+                        hs:=hs+s[scanpos];
+                        inc(scanpos);
+                     end;
+                   val(hs,charpos,code);
+                   if code<>0 then
+                     begin
+                        freemem(data,sizeof(tunicodecharmapping)*datasize);
+                        close(t);
+                        exit;
+                     end;
+                   while not(s[scanpos] in ['0','#']) do
+                     inc(scanpos);
+                   if s[scanpos]='#' then
+                     begin
+                        { special char }
+                        unicodevalue:=$ffff;
+                        hs:=copy(s,scanpos,length(s)-scanpos+1);
+                        if hs='#DBCS LEAD BYTE' then
+                          flag:=umf_leadbyte;
+                     end
+                   else
+                     begin
+                        { C hex prefix }
+                        inc(scanpos,2);
+                        hs:='$';
+                        while s[scanpos] in ['0'..'9','A'..'F','a'..'f'] do
+                          begin
+                             hs:=hs+s[scanpos];
+                             inc(scanpos);
+                          end;
+                        val(hs,unicodevalue,code);
+                        if code<>0 then
+                          begin
+                             freemem(data,sizeof(tunicodecharmapping)*datasize);
+                             close(t);
+                             exit;
+                          end;
+                        if charpos>datasize then
+                          begin
+                             { allocate 1024 bytes more because         }
+                             { if we need more than 256 entries it's    }
+                             { probably a mbcs with a lot of            }
+                             { entries                                  }
+                             datasize:=charpos+1024;
+                             reallocmem(data,sizeof(tunicodecharmapping)*datasize);
+                          end;
+                        flag:=umf_noinfo;
+                     end;
+                   data[charpos].flag:=flag;
+                   data[charpos].unicode:=unicodevalue;
+                   if charpos>lastchar then
+                     lastchar:=charpos;
+                end;
+           end;
+         close(t);
+         new(p);
+         p^.lastchar:=lastchar;
+         p^.cpname:=cpname;
+         p^.internalmap:=false;
+         p^.next:=nil;
+         p^.map:=data;
+         loadunicodemapping:=p;
+      end;
+
+    procedure registermapping(p : punicodemap);
+
+      begin
+         p^.next:=mappings;
+         mappings:=p;
+      end;
+
+    function getmap(const s : string) : punicodemap;
+
+      var
+         hp : punicodemap;
+
+      const
+         mapcache : string = '';
+         mapcachep : punicodemap = nil;
+
+      begin
+         if (mapcache=s) and assigned(mapcachep) and (mapcachep^.cpname=s) then
+           begin
+              getmap:=mapcachep;
+              exit;
+           end;
+         hp:=mappings;
+         while assigned(hp) do
+           begin
+              if hp^.cpname=s then
+                begin
+                   getmap:=hp;
+                   mapcache:=s;
+                   mapcachep:=hp;
+                   exit;
+                end;
+              hp:=hp^.next;
+           end;
+         getmap:=nil;
+      end;
+
+    function mappingavailable(const s : string) : boolean;
+
+      begin
+         mappingavailable:=getmap(s)<>nil;
+      end;
+
+    function getunicode(c : char;p : punicodemap) : tunicodechar;
+
+      begin
+         if ord(c)<=p^.lastchar then
+           getunicode:=p^.map[ord(c)].unicode
+         else
+           getunicode:=0;
+      end;
+
+    function getascii(c : tunicodechar;p : punicodemap) : string;
+
+      var
+         i : longint;
+
+      begin
+         { at least map to space }
+         getascii:=#32;
+         for i:=0 to p^.lastchar do
+           if p^.map[i].unicode=c then
+             begin
+                if i<256 then
+                  getascii:=chr(i)
+                else
+                  getascii:=chr(i div 256)+chr(i mod 256);
+                exit;
+             end;
+      end;
+
+  var
+     hp : punicodemap;
+
+initialization
+  mappings:=nil;
+finalization
+  while assigned(mappings) do
+    begin
+       hp:=mappings^.next;
+       if not(mappings^.internalmap) then
+         begin
+            freemem(mappings^.map);
+            dispose(mappings);
+         end;
+       mappings:=hp;
+    end;
+end.

compiler/cgobj.pas

@@ -3112,13 +3112,15 @@ implementation
          paramanager.getintparaloc(pocall_default,1,cgpara1);
          paramanager.getintparaloc(pocall_default,2,cgpara2);
          if is_interfacecom(t) then
-          incrfunc:='FPC_INTF_INCR_REF'
+           incrfunc:='FPC_INTF_INCR_REF'
          else if is_ansistring(t) then
-          incrfunc:='FPC_ANSISTR_INCR_REF'
+           incrfunc:='FPC_ANSISTR_INCR_REF'
          else if is_widestring(t) then
-          incrfunc:='FPC_WIDESTR_INCR_REF'
+           incrfunc:='FPC_WIDESTR_INCR_REF'
+         else if is_unicodestring(t) then
+           incrfunc:='FPC_UNICODESTR_INCR_REF'
          else if is_dynamic_array(t) then
-          incrfunc:='FPC_DYNARRAY_INCR_REF'
+           incrfunc:='FPC_DYNARRAY_INCR_REF'
          else
           incrfunc:='';
          { call the special incr function or the generic addref }
@@ -3174,6 +3176,8 @@ implementation
           decrfunc:='FPC_ANSISTR_DECR_REF'
          else if is_widestring(t) then
           decrfunc:='FPC_WIDESTR_DECR_REF'
+         else if is_unicodestring(t) then
+          decrfunc:='FPC_UNICODESTR_DECR_REF'
          else if is_dynamic_array(t) then
           begin
             decrfunc:='FPC_DYNARRAY_DECR_REF';
@@ -3234,6 +3238,7 @@ implementation
         paramanager.getintparaloc(pocall_default,2,cgpara2);
          if is_ansistring(t) or
             is_widestring(t) or
+            is_unicodestring(t) or
             is_interfacecom(t) or
             is_dynamic_array(t) then
            a_load_const_ref(list,OS_ADDR,0,ref)
@@ -3266,6 +3271,7 @@ implementation
         paramanager.getintparaloc(pocall_default,2,cgpara2);
          if is_ansistring(t) or
             is_widestring(t) or
+            is_unicodestring(t) or
             is_interfacecom(t) then
             begin
               g_decrrefcount(list,t,ref);

compiler/cp1251.pas

@@ -6,7 +6,7 @@ unit cp1251;
   implementation
 
   uses
-     charset;
+     {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/cp437.pas

@@ -6,7 +6,7 @@ unit cp437;
   implementation
 
   uses
-     charset;
+     {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/cp850.pas

@@ -6,7 +6,7 @@ unit cp850;
   implementation
 
   uses
-     charset;
+     {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/cp866.pas

@@ -6,7 +6,7 @@ unit cp866;
   implementation
 
   uses
-     charset;
+     {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/cp8859_1.pas

@@ -6,7 +6,7 @@ unit cp8859_1;
   implementation
 
   uses
-     charset;
+     {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/cp8859_5.pas

@@ -6,7 +6,7 @@ unit cp8859_5;
   implementation
 
   uses
-     charset;
+     {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2};
 
   const
      map : array[0..255] of tunicodecharmapping = (

compiler/defcmp.pas

@@ -413,7 +413,7 @@ implementation
                             else if (cs_ansistrings in current_settings.localswitches) and
                                (tstringdef(def_to).stringtype=st_ansistring) then
                               eq:=te_equal
-                            else if tstringdef(def_to).stringtype=st_widestring then
+                            else if tstringdef(def_to).stringtype in [st_widestring,st_unicodestring] then
                               eq:=te_convert_l3
                             else
                               eq:=te_convert_l1;
@@ -425,7 +425,7 @@ implementation
                             begin
                               if is_ansistring(def_to) then
                                 eq:=te_convert_l1
-                              else if is_widestring(def_to) then
+                              else if is_widestring(def_to) or is_unicodestring(def_to) then
                                 eq:=te_convert_l3
                               else
                                 eq:=te_convert_l2;
@@ -446,7 +446,7 @@ implementation
                                   else
                                     eq:=te_convert_l2;
                                 end
-                              else if is_widestring(def_to) then
+                              else if is_widestring(def_to) or is_unicodestring(def_to) then
                                 eq:=te_convert_l3
                               else
                                 eq:=te_convert_l2;
@@ -458,7 +458,7 @@ implementation
                       if is_widechararray(def_from) or is_open_widechararray(def_from) then
                        begin
                          doconv:=tc_chararray_2_string;
-                         if is_widestring(def_to) then
+                         if is_widestring(def_to) or is_unicodestring(def_to) then
                            eq:=te_convert_l1
                          else
                            { size of widechar array is double due the sizeof a widechar }
@@ -490,7 +490,7 @@ implementation
                           else if is_pwidechar(def_from) then
                            begin
                              doconv:=tc_pwchar_2_string;
-                             if is_widestring(def_to) then
+                             if is_widestring(def_to) or is_unicodestring(def_to)  then
                                eq:=te_convert_l1
                              else
                                eq:=te_convert_l3;
@@ -909,7 +909,7 @@ implementation
                          else
                           { pwidechar(widestring) }
                           if is_pwidechar(def_to) and
-                             is_widestring(def_from) then
+                            is_wide_or_unicode_string(def_from) then
                            begin
                              doconv:=tc_ansistring_2_pchar;
                              eq:=te_convert_l1;

compiler/defutil.pas

@@ -165,6 +165,12 @@ interface
     {# returns true if p is a wide string type }
     function is_widestring(p : tdef) : boolean;
 
+    {# true if p is an unicode string def }
+    function is_unicodestring(p : tdef) : boolean;
+
+    {# returns true if p is a wide or unicode string type }
+    function is_wide_or_unicode_string(p : tdef) : boolean;
+
     {# Returns true if p is a short string type }
     function is_shortstring(p : tdef) : boolean;
 
@@ -577,6 +583,22 @@ implementation
       end;
 
 
+    { true if p is an wide string def }
+    function is_wide_or_unicode_string(p : tdef) : boolean;
+      begin
+         is_wide_or_unicode_string:=(p.typ=stringdef) and
+                        (tstringdef(p).stringtype in [st_widestring,st_unicodestring]);
+      end;
+
+
+    { true if p is an unicode string def }
+    function is_unicodestring(p : tdef) : boolean;
+      begin
+         is_unicodestring:=(p.typ=stringdef) and
+                        (tstringdef(p).stringtype=st_unicodestring);
+      end;
+
+
     { true if p is an short string def }
     function is_shortstring(p : tdef) : boolean;
       begin

compiler/htypechk.pas

@@ -1541,7 +1541,7 @@ implementation
                   ) or
                   (
                    is_widechar(p.resultdef) and
-                   is_widestring(def_to)
+                   (is_widestring(def_to) or is_unicodestring(def_to))
                   ) then
                 eq:=te_equal
             end;
@@ -2238,7 +2238,7 @@ implementation
           (tve_single,tve_dblcurrency,tve_extended,
            tve_dblcurrency,tve_dblcurrency,tve_extended);
         variantstringdef_cl: array[tstringtype] of tvariantequaltype =
-          (tve_sstring,tve_astring,tve_astring,tve_wstring,tve_unicodestring);
+          (tve_sstring,tve_astring,tve_astring,tve_wstring,tve_ustring);
       begin
         case def.typ of
           orddef:
@@ -2437,9 +2437,9 @@ implementation
         else if (currvcl=tve_boolformal) or
                 (bestvcl=tve_boolformal) then
           if (currvcl=tve_boolformal) then
-            result:=ord(bestvcl in [tve_chari64,tve_sstring,tve_astring,tve_wstring])
+            result:=ord(bestvcl in [tve_chari64,tve_sstring,tve_astring,tve_wstring,tve_ustring])
           else
-            result:=-ord(currvcl in [tve_chari64,tve_sstring,tve_astring,tve_wstring])
+            result:=-ord(currvcl in [tve_chari64,tve_sstring,tve_astring,tve_wstring,tve_ustring])
         { byte is better than everything else (we assume both aren't byte, }
         { since there's only one parameter and that one can't be the same) }
         else if (currvcl=tve_byte) or
@@ -2497,7 +2497,11 @@ implementation
         { widestring is better than everything left }
         else if (currvcl=tve_wstring) or
                 (bestvcl=tve_wstring) then
-          result:=1-2*ord(bestvcl=tve_wstring);
+          result:=1-2*ord(bestvcl=tve_wstring)
+        { unicodestring is better than everything left }
+        else if (currvcl=tve_ustring) or
+                (bestvcl=tve_ustring) then
+          result:=1-2*ord(bestvcl=tve_ustring);
 
         { all possibilities should have been checked now }
         if (result=-5) then

compiler/nadd.pas

@@ -546,11 +546,11 @@ implementation
         { stringconstn only                                       }
 
         { widechars are converted above to widestrings too }
-        { this isn't veryy efficient, but I don't think    }
+        { this isn't ver y efficient, but I don't think    }
         { that it does matter that much (FK)               }
         if (lt=stringconstn) and (rt=stringconstn) and
-          (tstringconstnode(left).cst_type=cst_widestring) and
-          (tstringconstnode(right).cst_type=cst_widestring) then
+          (tstringconstnode(left).cst_type in [cst_widestring,cst_unicodestring]) and
+          (tstringconstnode(right).cst_type in [cst_widestring,cst_unicodestring]) then
           begin
              initwidestring(ws1);
              initwidestring(ws2);
@@ -835,6 +835,8 @@ implementation
         if is_constnode(right) and is_constnode(left) and
            (is_widestring(right.resultdef) or
             is_widestring(left.resultdef) or
+            is_unicodestring(right.resultdef) or
+            is_unicodestring(left.resultdef) or
             is_widechar(right.resultdef) or
             is_widechar(left.resultdef)) then
           begin
@@ -1419,8 +1421,13 @@ implementation
           begin
             if (nodetype in [addn,equaln,unequaln,lten,gten,ltn,gtn]) then
               begin
+                { Is there a unicodestring? }
+                if is_unicodestring(rd) or is_unicodestring(ld) then
+                  strtype:= st_unicodestring
+                else
                 { Is there a widestring? }
                 if is_widestring(rd) or is_widestring(ld) or
+                   is_unicodestring(rd) or is_unicodestring(ld) or
                    is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd) or
                    is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld) then
                   strtype:= st_widestring
@@ -1456,6 +1463,13 @@ implementation
                       if not(is_widestring(ld)) then
                         inserttypeconv(left,cwidestringtype);
                     end;
+                  st_unicodestring :
+                    begin
+                      if not(is_unicodestring(rd)) then
+                        inserttypeconv(right,cunicodestringtype);
+                      if not(is_unicodestring(ld)) then
+                        inserttypeconv(left,cunicodestringtype);
+                    end;
                   st_ansistring :
                     begin
                       if not(is_ansistring(rd)) then
@@ -2520,6 +2534,11 @@ implementation
                    { this is only for add, the comparisaion is handled later }
                    expectloc:=LOC_REGISTER;
                 end
+              else if is_unicodestring(ld) then
+                begin
+                   { this is only for add, the comparisaion is handled later }
+                   expectloc:=LOC_REGISTER;
+                end
               else if is_ansistring(ld) then
                 begin
                    { this is only for add, the comparisaion is handled later }

compiler/ncal.pas

@@ -2772,7 +2772,8 @@ implementation
              else
              { ansi/widestrings must be registered, so we can dispose them }
               if is_ansistring(resultdef) or
-                 is_widestring(resultdef) then
+                 is_widestring(resultdef) or
+                 is_unicodestring(resultdef) then
                begin
                  expectloc:=LOC_REFERENCE;
                end

compiler/ncgcnv.pas

@@ -148,6 +148,8 @@ interface
                location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
                cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register);
              end;
+           cst_widestring,
+           cst_unicodestring,
            cst_ansistring :
              begin
                if tstringconstnode(left).len=0 then
@@ -167,20 +169,8 @@ interface
                {!!!!!!!}
                internalerror(8888);
              end;
-           cst_widestring:
-             begin
-               if tstringconstnode(left).len=0 then
-                begin
-                  reference_reset(hr);
-                  hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR');
-                  location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
-                  cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,hr,location.register);
-                end
-               else
-                begin
-                  location_copy(location,left.location);
-                end;
-             end;
+           else
+             internalerror(200808241);
          end;
       end;
 

compiler/ncgcon.pas

@@ -270,7 +270,7 @@ implementation
          pooltype: TConstPoolType;
          pool: THashSet;
          entry: PHashSetItem;
-         
+
       const
         PoolMap: array[tconststringtype] of TConstPoolType = (
           sp_conststr,
@@ -282,7 +282,7 @@ implementation
         );
       begin
          { for empty ansistrings we could return a constant 0 }
-         if (cst_type in [cst_ansistring,cst_widestring]) and (len=0) then
+         if (cst_type in [cst_ansistring,cst_widestring,cst_unicodestring]) and (len=0) then
           begin
             location_reset(location,LOC_CONSTANT,OS_ADDR);
             location.value:=0;
@@ -295,7 +295,7 @@ implementation
               if current_asmdata.ConstPools[pooltype] = nil then
                 current_asmdata.ConstPools[pooltype] := THashSet.Create(64, True, False);
               pool := current_asmdata.ConstPools[pooltype];
-           
+
               if cst_type in [cst_widestring, cst_unicodestring] then
                 entry := pool.FindOrAdd(pcompilerwidestring(value_str)^.data, len*cwidechartype.size)
               else
@@ -311,7 +311,7 @@ implementation
                    entry^.Data := lastlabel;
                    maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
                    if (len=0) or
-                      not(cst_type in [cst_ansistring,cst_widestring]) then
+                      not(cst_type in [cst_ansistring,cst_widestring,cst_unicodestring]) then
                      new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(sizeof(pint)))
                    else
                      new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata,lastlabel.name,const_align(sizeof(pint)));
@@ -321,7 +321,7 @@ implementation
                         begin
                            if len=0 then
                              InternalError(2008032301)   { empty string should be handled above }
-                            else
+                           else
                              begin
                                 current_asmdata.getdatalabel(l1);
                                 current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1));
@@ -342,6 +342,7 @@ implementation
                                 current_asmdata.asmlists[al_typedconsts].concat(Tai_string.Create_pchar(pc,len+1));
                              end;
                         end;
+                      cst_unicodestring,
                       cst_widestring:
                         begin
                            if len=0 then
@@ -353,7 +354,7 @@ implementation
                                 { we use always UTF-16 coding for constants }
                                 { at least for now                          }
                                 { Consts.concat(Tai_const.Create_8bit(2)); }
-                                if tf_winlikewidestring in target_info.flags then
+                                if (cst_type=cst_widestring) and (tf_winlikewidestring in target_info.flags) then
                                   current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(len*cwidechartype.size))
                                 else
                                   begin
@@ -401,7 +402,7 @@ implementation
                    end;
                 end;
            end;
-         if cst_type in [cst_ansistring, cst_widestring] then
+         if cst_type in [cst_ansistring, cst_widestring, cst_unicodestring] then
            begin
              location_reset(location, LOC_REGISTER, OS_ADDR);
              reference_reset_symbol(href, lab_str, 0);

compiler/ncginl.pas

@@ -358,7 +358,7 @@ implementation
                hregister:=cg.makeregsize(current_asmdata.CurrAsmList,left.location.register,OS_INT);
                cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,href,hregister);
              end;
-           if is_widestring(left.resultdef) then
+           if is_widestring(left.resultdef) or is_unicodestring(left.resultdef) then
              cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,1,hregister);
            cg.a_label(current_asmdata.CurrAsmList,lengthlab);
            location_reset(location,LOC_REGISTER,def_cgsize(resultdef));

compiler/ncgld.pas

@@ -1073,7 +1073,7 @@ implementation
                            freetemp:=false;
                          end
                        else
-                        if is_widestring(lt) then
+                        if is_widestring(lt) or is_unicodestring(lt) then
                          begin
                            vtype:=vtWideString;
                            freetemp:=false;

compiler/ncgmem.pas

@@ -642,7 +642,8 @@ implementation
 
          { an ansistring needs to be dereferenced }
          if is_ansistring(left.resultdef) or
-            is_widestring(left.resultdef) then
+            is_widestring(left.resultdef) or
+            is_unicodestring(left.resultdef) then
            begin
               if nf_callunique in flags then
                 internalerror(200304236);
@@ -763,6 +764,7 @@ implementation
                      begin
                        case tstringdef(left.resultdef).stringtype of
                          { it's the same for ansi- and wide strings }
+                         st_unicodestring,
                          st_widestring,
                          st_ansistring:
                            begin
@@ -926,6 +928,7 @@ implementation
                    begin
                       case tstringdef(left.resultdef).stringtype of
                          { it's the same for ansi- and wide strings }
+                         st_unicodestring,
                          st_widestring,
                          st_ansistring:
                            begin

compiler/ncgrtti.pas

@@ -372,6 +372,11 @@ implementation
                  current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkWString));
                  write_rtti_name(def);
               end;
+            st_unicodestring:
+              begin
+                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkUString));
+                 write_rtti_name(def);
+              end;
             st_longstring:
               begin
                  current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkLString));
@@ -976,7 +981,7 @@ implementation
                         current_asmdata.asmlists[al_rtti].concat(cai_align.Create(4));
                       asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
                       if (tf_requires_proper_alignment in target_info.flags) then
-                        current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));	      
+                        current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));	
                       asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
                     end;
                 end;
@@ -1069,7 +1074,7 @@ implementation
                     current_asmdata.asmlists[al_rtti].concat(cai_align.Create(4));
                   asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
                   if (tf_requires_proper_alignment in target_info.flags) then
-                    current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));	      
+                    current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));	
                   asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
                 end;
               asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));

compiler/ncnv.pas

@@ -917,12 +917,12 @@ implementation
          { we can't do widechar to ansichar conversions at compile time, since }
          { this maps all non-ascii chars to '?' -> loses information           }
          if (left.nodetype=ordconstn) and
-            ((tstringdef(resultdef).stringtype=st_widestring) or
+            ((tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) or
              (torddef(left.resultdef).ordtype=uchar) or
              { >=128 is destroyed }
              (tordconstnode(left).value.uvalue<128)) then
            begin
-              if tstringdef(resultdef).stringtype=st_widestring then
+              if tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring] then
                begin
                  initwidestring(ws);
                  if torddef(left.resultdef).ordtype=uwidechar then
@@ -953,7 +953,7 @@ implementation
                    if torddef(left.resultdef).ordtype<>uwidechar then
                      procname := 'fpc_char_to_'
                    else
-                     procname := 'fpc_wchar_to_';
+                     procname := 'fpc_uchar_to_';
                    procname:=procname+tstringdef(resultdef).stringtypname;
 
                    { and the parameter }
@@ -1193,7 +1193,8 @@ implementation
            inserttypeconv(left,cwidestringtype)
          else
            if is_pchar(resultdef) and
-              is_widestring(left.resultdef) then
+              (is_widestring(left.resultdef) or
+               is_unicodestring(left.resultdef)) then
              begin
                inserttypeconv(left,cansistringtype);
                { the second pass of second_cstring_to_pchar expects a  }
@@ -2037,8 +2038,8 @@ implementation
             if (convtype=tc_string_2_string) and
               (
                 ((not is_widechararray(left.resultdef) and
-                  not is_widestring(left.resultdef)) or
-                 (tstringdef(resultdef).stringtype=st_widestring) or
+                  not is_wide_or_unicode_string(left.resultdef)) or
+                 (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) or
                  { non-ascii chars would be replaced with '?' -> loses info }
                  not hasnonasciichars(pcompilerwidestring(tstringconstnode(left).value_str)))
               ) then
@@ -2530,10 +2531,10 @@ implementation
       begin
         if (torddef(resultdef).ordtype=uchar) and
            (torddef(left.resultdef).ordtype=uwidechar) then
-          fname := 'fpc_wchar_to_char'
+          fname := 'fpc_uchar_to_char'
         else if (torddef(resultdef).ordtype=uwidechar) and
            (torddef(left.resultdef).ordtype=uchar) then
-          fname := 'fpc_char_to_wchar'
+          fname := 'fpc_char_to_uchar'
         else
           internalerror(2007081201);
 

compiler/ncon.pas

@@ -866,7 +866,8 @@ implementation
             resultdef:=cshortstringtype;
           cst_ansistring :
             resultdef:=cansistringtype;
-          cst_unicodestring,
+          cst_unicodestring :
+            resultdef:=cunicodestringtype;
           cst_widestring :
             resultdef:=cwidestringtype;
           cst_longstring :
@@ -877,11 +878,15 @@ implementation
     function tstringconstnode.pass_1 : tnode;
       begin
         result:=nil;
-        if (cst_type in [cst_ansistring,cst_widestring,cst_unicodestring]) and
-           (len=0) then
-         expectloc:=LOC_CONSTANT
+        if (cst_type in [cst_ansistring,cst_widestring,cst_unicodestring]) then
+          begin
+            if len=0 then
+              expectloc:=LOC_CONSTANT
+            else
+              expectloc:=LOC_REGISTER
+          end
         else
-         expectloc:=LOC_CREFERENCE;
+          expectloc:=LOC_CREFERENCE;
       end;
 
 
@@ -920,8 +925,8 @@ implementation
         if def.typ<>stringdef then
           internalerror(200510011);
         { convert ascii 2 unicode }
-        if (tstringdef(def).stringtype=st_widestring) and
-           (cst_type<>cst_widestring) then
+        if (tstringdef(def).stringtype in [st_widestring,st_unicodestring]) and
+           not(cst_type in [cst_widestring,cst_unicodestring]) then
           begin
             initwidestring(pw);
             ascii2unicode(value_str,len,pw);
@@ -930,8 +935,8 @@ implementation
           end
         else
           { convert unicode 2 ascii }
-          if (cst_type=cst_widestring) and
-            (tstringdef(def).stringtype<>st_widestring) then
+          if (cst_type in [cst_widestring,cst_unicodestring]) and
+            not(tstringdef(def).stringtype in [st_widestring,st_unicodestring]) then
             begin
               pw:=pcompilerwidestring(value_str);
               getmem(pc,getlengthwidestring(pw)+1);

compiler/ninl.pas

@@ -1676,7 +1676,7 @@ implementation
                             result:=cordconstnode.create(0,u8inttype,false);
                           end
                         else if not is_ansistring(left.resultdef) and
-                                not is_widestring(left.resultdef) then
+                                not is_wide_or_unicode_string(left.resultdef) then
                           result:=cordconstnode.create(tstringdef(left.resultdef).len,u8inttype,true)
                       end;
                   end;
@@ -2040,8 +2040,8 @@ implementation
                         { length)                                 }
                         if (left.nodetype=typeconvn) and
                            (ttypeconvnode(left).left.resultdef.typ=stringdef) and
-                           not(is_widestring(left.resultdef) xor
-                               is_widestring(ttypeconvnode(left).left.resultdef)) then
+                           not(is_wide_or_unicode_string(left.resultdef) xor
+                               is_wide_or_unicode_string(ttypeconvnode(left).left.resultdef)) then
                          begin
                            hp:=ttypeconvnode(left).left;
                            ttypeconvnode(left).left:=nil;
@@ -2334,7 +2334,7 @@ implementation
                               result:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry))
                             end
                            else if is_ansistring(left.resultdef) or
-                                   is_widestring(left.resultdef) then
+                                   is_wide_or_unicode_string(left.resultdef) then
                              CGMessage(type_e_mismatch)
                          end;
                      end;

compiler/nmem.pas

@@ -667,7 +667,7 @@ implementation
            ansi/widestring needs to be valid }
          valid:=is_dynamic_array(left.resultdef) or
                 is_ansistring(left.resultdef) or
-                is_widestring(left.resultdef) or
+                is_wide_or_unicode_string(left.resultdef) or
                 { implicit pointer dereference -> pointer is read }
                 (left.resultdef.typ = pointerdef);
          if valid then
@@ -827,7 +827,8 @@ implementation
 
          if (nf_callunique in flags) and
             (is_ansistring(left.resultdef) or
-             (is_widestring(left.resultdef) and not(tf_winlikewidestring in target_info.flags))) then
+             is_unicodestring(left.resultdef) or
+            (is_widestring(left.resultdef) and not(tf_winlikewidestring in target_info.flags))) then
            begin
              left := ctypeconvnode.create_internal(ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+'_unique',
                ccallparanode.create(

compiler/nutils.pas

@@ -531,7 +531,7 @@ implementation
         if not assigned(p.resultdef) then
           typecheckpass(p);
         if is_ansistring(p.resultdef) or
-           is_widestring(p.resultdef) or
+           is_wide_or_unicode_string(p.resultdef) or
            is_interfacecom(p.resultdef) or
            is_dynamic_array(p.resultdef) then
           begin
@@ -584,6 +584,18 @@ implementation
                cnilnode.create
                ));
           end
+        else if is_unicodestring(p.resultdef) then
+          begin
+            result:=internalstatements(newstatement);
+            addstatement(newstatement,ccallnode.createintern('fpc_unicodestr_decr_ref',
+                  ccallparanode.create(
+                    ctypeconvnode.create_internal(p,voidpointertype),
+                  nil)));
+            addstatement(newstatement,cassignmentnode.create(
+               ctypeconvnode.create_internal(p.getcopy,voidpointertype),
+               cnilnode.create
+               ));
+          end
         else if is_interfacecom(p.resultdef) then
           begin
             result:=internalstatements(newstatement);

compiler/options.pas

@@ -71,7 +71,7 @@ implementation
 
 uses
   widestr,
-  charset,
+  {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2},
   SysUtils,
   version,
   cutils,cmsgs,
@@ -2580,6 +2580,9 @@ begin
   set_system_macro('FPC_PATCH',patch_nr);
   set_system_macro('FPC_FULLVERSION',Format('%d%.02d%.02d',[StrToInt(version_nr),StrToInt(release_nr),StrToInt(patch_nr)]));
 
+  if not(target_info.system in system_windows) then
+    def_system_macro('FPC_WIDESTRING_EQUAL_UNICODESTRING');
+
   for i:=low(tfeature) to high(tfeature) do
     if i in features then
       def_system_macro('FPC_HAS_FEATURE_'+featurestr[i]);

compiler/pdecl.pas

@@ -96,7 +96,7 @@ implementation
              end;
            stringconstn:
              begin
-               if is_widestring(p.resultdef) then
+               if is_wide_or_unicode_string(p.resultdef) then
                  begin
                    initwidestring(pw);
                    copywidestring(pcompilerwidestring(tstringconstnode(p).value_str),pw);

compiler/pinline.pas

@@ -720,6 +720,9 @@ implementation
             is_widechararray(paradef) or
             is_pwidechar(paradef) then
            copynode:=ccallnode.createintern('fpc_widestr_copy',paras)
+        else
+         if is_unicodestring(paradef) then
+           copynode:=ccallnode.createintern('fpc_unicodestr_copy',paras)
         else
          if is_char(paradef) then
            copynode:=ccallnode.createintern('fpc_char_copy',paras)

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 91;
+  CurrentPPUVersion = 92;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/psystem.pas

@@ -157,7 +157,10 @@ implementation
         { should we give a length to the default long and ansi string definition ?? }
         clongstringtype:=tstringdef.createlong(-1);
         cansistringtype:=tstringdef.createansi;
-        cwidestringtype:=tstringdef.createwide;
+        if target_info.system in system_windows then
+          cwidestringtype:=tstringdef.createwide
+        else
+          cwidestringtype:=tstringdef.createunicode;
         cunicodestringtype:=tstringdef.createunicode;
         { length=0 for shortstring is open string (needed for readln(string) }
         openshortstringtype:=tstringdef.createshort(0);
@@ -265,6 +268,7 @@ implementation
         addtype('AnsiString',cansistringtype);
         addtype('WideString',cwidestringtype);
         addtype('UnicodeString',cunicodestringtype);
+
         addtype('OpenString',openshortstringtype);
         addtype('Boolean',booltype);
         addtype('ByteBool',bool8type);

compiler/ptconst.pas

@@ -431,7 +431,7 @@ implementation
                     { convert to widestring stringconstn }
                     inserttypeconv(p,cwidestringtype);
                     if (p.nodetype=stringconstn) and
-                       (tstringconstnode(p).cst_type=cst_widestring) then
+                       (tstringconstnode(p).cst_type in [cst_widestring,cst_unicodestring]) then
                      begin
                        pw:=pcompilerwidestring(tstringconstnode(p).value_str);
                        for i:=0 to tstringconstnode(p).len-1 do
@@ -641,7 +641,7 @@ implementation
         begin
           n:=comp_expr(true);
           { load strval and strlength of the constant tree }
-          if (n.nodetype=stringconstn) or is_widestring(def) or is_constwidecharnode(n) then
+          if (n.nodetype=stringconstn) or is_wide_or_unicode_string(def) or is_constwidecharnode(n) then
             begin
               { convert to the expected string type so that
                 for widestrings strval is a pcompilerwidestring }

compiler/scanner.pas

@@ -962,7 +962,7 @@ In case not, the value returned can be arbitrary.
                                   else
                                     l:=tarraydef(hdef).highrange;
                                 stringdef:
-                                  if is_open_string(hdef) or is_ansistring(hdef) or is_widestring(hdef) then
+                                  if is_open_string(hdef) or is_ansistring(hdef) or is_wide_or_unicode_string(hdef) then
                                     Message(type_e_mismatch)
                                   else
                                     l:=tstringdef(hdef).len;

compiler/symconst.pas

@@ -61,6 +61,8 @@ const
   tkDynArray = 21;
   tkInterfaceCorba = 22;
   tkProcVar  = 23;
+  tkUString  = 24;
+  tkUChar    = 25;
 
   otSByte    = 0;
   otUByte    = 1;
@@ -446,7 +448,7 @@ type
   tvariantequaltype = (
     tve_incompatible,
     tve_chari64,
-    tve_unicodestring,
+    tve_ustring,
     tve_wstring,
     tve_astring,
     tve_sstring,

compiler/widestr.pas

@@ -28,8 +28,7 @@ unit widestr;
   interface
 
     uses
-       charset,globtype
-       ;
+       {$ifdef VER2_2}ccharset{$else VER2_2}charset{$endif VER2_2},globtype;
 
 
     type

packages/iconvenc/src/iconvenc.pas

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
     Copyright (c) 2000 by Marco van de Voort([email protected])
     member of the Free Pascal development team
-    
+
     libiconv header translation + a helper routine  
     http://wiki.freepascal.org/iconvenc
 
@@ -15,7 +15,8 @@
 
 }
 unit iconvenc;
-interface 
+
+interface
 {$mode objfpc}{$H+}
 
 {DEFINE LOADDYNAMIC}
@@ -23,144 +24,150 @@ interface
 uses
   baseunix,
   {$ifdef LOADDYNAMIC}
-  dl, 
+  dl,
   {$endif}
   initc;
 
 const
-  n=1;
+  n = 1;
+
 type
-   Piconv_t = ^iconv_t;
+   piconv_t = ^iconv_t;
    iconv_t = pointer;
-   
-   Ticonv_open = function (__tocode:Pchar; __fromcode:Pchar):iconv_t;cdecl;
-   Ticonv = function (__cd:iconv_t; __inbuf:PPchar; __inbytesleft:Psize_t; __outbuf:PPchar; __outbytesleft:Psize_t):size_t;cdecl;
-   Ticonv_close = function (__cd:iconv_t):longint;cdecl;
+
+   Ticonv_open = function(__tocode: pchar; __fromcode: pchar): iconv_t; cdecl;
+   Ticonv = function(__cd: iconv_t; __inbuf: ppchar; __inbytesleft: psize_t; __outbuf: ppchar; __outbytesleft: psize_t): size_t; cdecl;
+   Ticonv_close = function(__cd: iconv_t): cint; cdecl;
 
 {$IFNDEF LOADDYNAMIC}
 {$ifndef Linux}    // and other OSes with iconv in libc.
 {$linklib iconv}
 {$endif}
-function iconv_open  (__tocode:Pchar; __fromcode:Pchar):iconv_t;cdecl; external;
-function iconv (__cd:iconv_t; __inbuf:PPchar; __inbytesleft:Psize_t; __outbuf:PPchar; __outbytesleft:Psize_t):size_t;cdecl; external;
-function iconv_close (__cd:iconv_t):longint;cdecl; external;
+function iconv_open(__tocode: pchar; __fromcode: pchar): iconv_t; cdecl; external;
+function iconv (__cd: iconv_t; __inbuf: ppchar; __inbytesleft: psize_t; __outbuf: ppchar; __outbytesleft: psize_t): size_t; cdecl; external;
+function iconv_close (__cd: iconv_t): cint; cdecl; external;
 
-var 
-  IconvLibFound: Boolean = False;
+var
+  IconvLibFound: boolean = False;
 
 {$ELSE}
 var
-  iconv_lib: Pointer;
+  iconv_lib: pointer;
   iconv_open: Ticonv_open;
   iconv: Ticonv;
   iconv_close: Ticonv_close;
-  IconvLibFound: Boolean = True;
-function TryLoadLib(LibName:String;var error:string):Boolean; // can be used to load non standard libname
+  IconvLibFound: boolean = true;
+
+function TryLoadLib(LibName: string; var error: string): boolean; // can be used to load non standard libname
 {$endif}
 
-function Iconvert(S:string;var res:string; FromEncoding, ToEncoding: string): cint;
-function InitIconv (Var error:string): Boolean;
+function Iconvert(s: string; var res: string; FromEncoding, ToEncoding: string): cint;
+function InitIconv(var error: string): boolean;
 
 implementation
 
 {$IFDEF LOADDYNAMIC}
-function TryLoadLib(LibName:String;var error:string):Boolean;
-function resolvesymbol (var funcptr; symbol:string):boolean;
+function TryLoadLib(LibName: string; var error: string): boolean;
 
-begin
-  pointer(funcptr):=pointer(dlsym(iconv_lib, pchar(symbol)));
-  result:=assigned(pointer(funcptr));
-  if not result then
-    error:=error+#13#10+dlerror();
-end;
-
-var res:boolean;
+    function resolvesymbol (var funcptr; symbol: string): Boolean;
+    begin
+      pointer(funcptr) := pointer(dlsym(iconv_lib, pchar(symbol)));
+      result := assigned(pointer(funcptr));
+      if not result then
+        error := error+#13#10+dlerror();
+    end;
 
+var
+  res: boolean;
 begin
-  result:=false;
-  Error:=Error+#13#10'Trying '+LibName;
-  iconv_lib:=dlopen(pchar(libname), RTLD_NOW);
+  result := false;
+  Error := Error+#13#10'Trying '+LibName;
+  iconv_lib := dlopen(pchar(libname), RTLD_NOW);
   if Assigned(iconv_lib) then
   begin
-    result:=true;
-    result := result and  resolvesymbol(pointer(iconv),'iconv');
-    result := result and  resolvesymbol(pointer(iconv_open),'iconv_open');   
-    result := result and  resolvesymbol(pointer(iconv_close),'iconv_close');
+    result := true;
+    result := result and resolvesymbol(pointer(iconv),'iconv');
+    result := result and resolvesymbol(pointer(iconv_open),'iconv_open');
+    result := result and resolvesymbol(pointer(iconv_close),'iconv_close');
 //    if not res then
 //      dlclose(iconv_lib);
-  end 
- else
-  error:=error+#13#10+dlerror();
+  end else
+    error:=error+#13#10+dlerror();
 end;
 
 {$ENDIF}
 
-function InitIconv(Var error:string): Boolean;
+function InitIconv(var error: string): boolean;
 begin
-  result:=true;
+  result := true;
   {$ifdef LOADDYNAMIC}
-  error:='';
-  if not TryLoadLib('libc.so.6',error) then
-    if not TryLoadLib('libiconv.so',error) then
-      result:=false; 
+  error := '';
+  if not TryLoadLib('libc.so.6', error) then
+    if not TryLoadLib('libiconv.so', error) then
+      result := false; 
   {$endif}
-  iconvlibfound:=iconvlibfound or result;
+  iconvlibfound := iconvlibfound or result;
 end;
 
-function Iconvert(S:string;var res:string; FromEncoding, ToEncoding: string): cint;
+function Iconvert(S: string; var Res: string; FromEncoding, ToEncoding: string): cint;
 var
   InLen, OutLen, Offset: size_t;
-  Src, Dst: PChar;
+  Src, Dst: pchar;
   H: iconv_t;
   lerr: cint;
-  iconvres : cint;
+  iconvres: size_t;
 begin
-  H:=iconv_open(PChar(ToEncoding), PChar(FromEncoding));
+  H := iconv_open(PChar(ToEncoding), PChar(FromEncoding));
   if not assigned(H) then
-  begin 
-    Res:=S;
-    Exit(-1);
+  begin
+    Res := S;
+    exit(-1);
   end;
+
   try
     SetLength(Res, Length(S));
-    InLen:=Length(S);
-    OutLen:=Length(Res);
-    Src:=PChar(S);
-    Dst:=PChar(Res);
-    while InLen>0 do
+    InLen := Length(S);
+    OutLen := Length(Res);
+    Src := PChar(S);
+    Dst := PChar(Res);
+
+    while InLen > 0 do
     begin
-      iconvres:= iconv(H, @Src, @InLen, @Dst, @OutLen);
-      if iconvres=Cint(-1) then
+      iconvres := iconv(H, @Src, @InLen, @Dst, @OutLen);
+      if iconvres = size_t(-1) then
       begin
-        lerr:=cerrno;
-        if lerr=ESysEILSEQ then // unknown char, skip
-         begin       
-           Dst^:=Src^;
-           Inc(Src);
-           Inc(Dst);
-           Dec(InLen);
-           Dec(OutLen);
-         end
-        else 
-          if lerr=ESysE2BIG then
+        lerr := cerrno;
+        if lerr = ESysEILSEQ then // unknown char, skip
+          begin
+            Dst^ := Src^;
+            Inc(Src);
+            Inc(Dst);
+            Dec(InLen);
+            Dec(OutLen);
+          end
+        else
+          if lerr = ESysE2BIG then
             begin
-              Offset:=Dst-PChar(Res);
+              Offset := Dst - PChar(Res);
               SetLength(Res, Length(Res)+InLen*2+5); // 5 is minimally one utf-8 char
-              Dst:=PChar(Res)+Offset;
-              OutLen:=Length(Res)-Offset;
+              Dst := PChar(Res) + Offset;
+              OutLen := Length(Res) - Offset;
             end
           else
             exit(-1)
       end;
     end;
+
     // iconv has a buffer that needs flushing, specially if the last char is not #0
-    iconvres:=iconv(H, nil, nil, @Dst, @Outlen);
-    
-    SetLength(Res, Length(Res)-outlen);
+    iconv(H, nil, nil, @Dst, @Outlen);
+
+    // trim output buffer
+    SetLength(Res, Length(Res) - Outlen);
   finally
     iconv_close(H);
-   end;
-   result:=0;
+  end;
+
+  Result := 0;
 end;
 
 end.

rtl/inc/compproc.inc

@@ -123,9 +123,16 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring)
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
-procedure fpc_WideStr_sint(v : valsint; Len : SizeInt; out S : WideString); compilerproc;
-procedure fpc_WideStr_uint(v : valuint;Len : SizeInt; out S : WideString); compilerproc;
+  {$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;
@@ -137,17 +144,33 @@ procedure fpc_WideStr_uint(v : valuint;Len : SizeInt; out S : WideString); compi
   {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
   {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
-  procedure fpc_widestr_qword(v : qword;len : SizeInt;out s : widestring); compilerproc;
-  procedure fpc_widestr_int64(v : int64;len : SizeInt;out s : widestring); compilerproc;
+    {$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}
-{$ifndef FPUNONE}
-procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : WideString); compilerproc;
-{$endif}
-{$ifdef FPC_HAS_STR_CURRENCY}
-procedure fpc_WideStr_Currency(c : Currency;len,fr : SizeInt;out s : WideString);compilerproc;
-{$endif FPC_HAS_STR_CURRENCY}
+  {$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}
+    {$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}
+    {$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}
@@ -174,15 +197,28 @@ Function fpc_Val_SInt_AnsiStr (DestSize: SizeInt; Const S : AnsiString; out Code
 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}
-{$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;
+  {$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;
@@ -190,10 +226,18 @@ Function fpc_val_qword_shortstr(Const S: ShortString; out Code: ValSInt): QWord;
 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}
@@ -243,6 +287,11 @@ Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString):
 Function fpc_ansistr_Unique(Var S : Pointer): Pointer; compilerproc;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
+{*****************************************************************************
+                        Widestring support
+*****************************************************************************}
+
+{$if not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
 Procedure fpc_WideStr_Decr_Ref (Var S : Pointer); compilerproc;
 Procedure fpc_WideStr_Incr_Ref (Var S : Pointer); compilerproc;
@@ -267,22 +316,11 @@ Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
 Function fpc_CharArray_To_WideStr(const arr: array of char; zerobased: boolean = true): WideString; compilerproc;
 {$ifndef FPC_STRTOCHARARRAYPROC}
 function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray; compilerproc;
-Function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray; compilerproc;
-Function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray; compilerproc;
 Function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray; compilerproc;
 {$else ndef FPC_STRTOCHARARRAYPROC}
 procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); compilerproc;
-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_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc;
 {$endif ndef FPC_STRTOCHARARRAYPROC}
-{$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_WideStr_Compare(const S1,S2 : WideString): SizeInt; compilerproc;
 Function fpc_WideStr_Compare_equal(const S1,S2 : WideString): SizeInt; compilerproc;
 Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc;
@@ -292,28 +330,131 @@ Function  fpc_widestr_Copy (Const S : WideString; Index,Size : SizeInt) : WideSt
 {$ifndef FPC_WINLIKEWIDESTRING}
 function fpc_widestr_Unique(Var S : Pointer): Pointer; compilerproc;
 {$endif FPC_WINLIKEWIDESTRING}
-Function fpc_Char_To_WChar(const c : Char): WideChar; compilerproc;
-Function fpc_WChar_To_Char(const c : WideChar): Char; compilerproc;
+Function fpc_WChar_To_AnsiStr(const c : WideChar): AnsiString; compilerproc;
+Function fpc_WChar_To_WideStr(const c : WideChar): WideString; compilerproc;
+{$ifndef VER2_2}
+Function fpc_UChar_To_WideStr(const c : WideChar): WideString; compilerproc;
+{$endif VER2_2}
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+Function fpc_PWideChar_To_WideStr(const p : pwidechar): widestring; compilerproc;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+{$endif  defined(WINDOWS) or defined(VER2_2)}
+
+{*****************************************************************************
+                        Unicode string support
+*****************************************************************************}
+
+{$ifndef VER2_2}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+Procedure fpc_UnicodeStr_Decr_Ref (Var S : Pointer); compilerproc;
+Procedure fpc_UnicodeStr_Incr_Ref (S : Pointer); compilerproc;
+{$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;
+Procedure fpc_UnicodeStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc;
+{$ifndef STR_CONCAT_PROCS}
+Function fpc_UnicodeStr_Concat (const S1,S2 : UnicodeString) : UnicodeString; compilerproc;
+function fpc_UnicodeStr_Concat_multi (const sarr:array of Unicodestring): unicodestring; compilerproc;
+{$else STR_CONCAT_PROCS}
+Procedure fpc_UnicodeStr_Concat (Var DestS : Unicodestring;const S1,S2 : UnicodeString); compilerproc;
+Procedure fpc_UnicodeStr_Concat_multi (Var DestS : Unicodestring;const sarr:array of Unicodestring); compilerproc;
+{$endif STR_CONCAT_PROCS}
+Function fpc_Char_To_UnicodeStr(const c : Char): UnicodeString; compilerproc;
+Function fpc_PChar_To_UnicodeStr(const p : pchar): UnicodeString; compilerproc;
+Function fpc_CharArray_To_UnicodeStr(const arr: array of char; zerobased: boolean = true): UnicodeString; compilerproc;
+{$ifndef FPC_STRTOCHARARRAYPROC}
+function fpc_unicodestr_to_chararray(arraysize: SizeInt; const src: UnicodeString): fpc_big_chararray; compilerproc;
+Function fpc_shortstr_to_unicodechararray(arraysize: SizeInt; const src: ShortString): fpc_big_unicodechararray; compilerproc;
+Function fpc_ansistr_to_unicodechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_unicodechararray; compilerproc;
+Function fpc_unicodestr_to_unicodechararray(arraysize: SizeInt; const src: UnicodeString): fpc_big_unicodechararray; compilerproc;
+{$else ndef FPC_STRTOCHARARRAYPROC}
+procedure fpc_unicodestr_to_chararray(out res: array of char; 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;
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+{$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 VER2_2}
+{$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}
+{$endif VER2_2}
+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;
+Procedure fpc_UnicodeStr_SetLength (Var S : UnicodeString; l : SizeInt); 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 : Char): UnicodeChar; compilerproc;
+Function fpc_UChar_To_Char(const c : UnicodeChar): Char; 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}
-Function fpc_WChar_To_AnsiStr(const c : WideChar): AnsiString; compilerproc;
-Function fpc_WChar_To_WideStr(const c : WideChar): WideString; compilerproc;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
+{$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}
-Function fpc_PWideChar_To_WideStr(const p : pwidechar): widestring; compilerproc;
 {$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}
+{$endif VER2_2}
+
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+Function fpc_Char_To_WChar(const c : Char): WideChar; compilerproc;
+Function fpc_WChar_To_Char(const c : WideChar): Char; compilerproc;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
 
 {$ifdef FPC_HAS_FEATURE_TEXTIO}
 { from text.inc }
@@ -325,7 +466,10 @@ Procedure fpc_Write_Text_ShortStr(Len : Longint;var f : Text;const s : String);
 Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of char; 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}
+Procedure fpc_Write_Text_UnicodeStr (Len : Longint; Var f : Text; const S : WideString); compilerproc;
 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;
 {$ifndef CPU64}

rtl/inc/rtti.inc

@@ -40,6 +40,9 @@ Const
        tkInt64         = 19;
        tkQWord         = 20;
        tkDynArray      = 21;
+       tkInterfaceCorba = 22;
+       tkProcVar       = 23;
+       tkUString       = 24;
 
 
 type
@@ -130,7 +133,7 @@ end;
 Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];  compilerproc;
 begin
   case PByte(TypeInfo)^ of
-    tkAstring,tkWstring,tkInterface,tkDynArray:
+    tkAstring,tkWstring,tkUString,tkInterface,tkDynArray:
       PPchar(Data)^:=Nil;
     tkArray:
       arrayrtti(data,typeinfo,@int_initialize);
@@ -151,11 +154,20 @@ begin
         fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
         PPointer(Data)^:=nil;
       end;
+{$ifndef VER2_2}
+    tkUstring :
+      begin
+        fpc_UnicodeStr_Decr_Ref(PPointer(Data)^);
+        PPointer(Data)^:=nil;
+      end;
+{$endif VER2_2}
+{$ifdef WINDOWS}
     tkWstring :
       begin
         fpc_WideStr_Decr_Ref(PPointer(Data)^);
         PPointer(Data)^:=nil;
       end;
+{$endif WINDOWS}
     tkArray :
       arrayrtti(data,typeinfo,@int_finalize);
     tkObject,
@@ -179,8 +191,14 @@ begin
   case PByte(TypeInfo)^ of
     tkAstring :
       fpc_AnsiStr_Incr_Ref(PPointer(Data)^);
+{$ifdef WINDOWS}
     tkWstring :
       fpc_WideStr_Incr_Ref(PPointer(Data)^);
+{$endif WINDOWS}
+{$ifndef VER2_2}
+    tkUstring :
+      fpc_UnicodeStr_Incr_Ref(PPointer(Data)^);
+{$endif VER2_2}
     tkArray :
       arrayrtti(data,typeinfo,@int_addref);
     tkobject,
@@ -206,8 +224,14 @@ begin
     { see AddRef for comment about below construct (JM) }
     tkAstring:
       fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
+{$ifdef WINDOWS}
     tkWstring:
       fpc_WideStr_Decr_Ref(PPointer(Data)^);
+{$endif WINDOWS}
+{$ifndef VER2_2}
+    tkUString:
+      fpc_UnicodeStr_Decr_Ref(PPointer(Data)^);
+{$endif VER2_2}
     tkArray:
       arrayrtti(data,typeinfo,@fpc_systemDecRef);
     tkobject,
@@ -245,8 +269,14 @@ begin
         fpc_AnsiStr_Decr_Ref(PPointer(Dest)^);
         PPointer(Dest)^:=PPointer(Src)^;
       end;
+{$ifdef WINDOWS}
     tkWstring:
       fpc_WideStr_Assign(PPointer(Dest)^,PPointer(Src)^);
+{$endif WINDOWS}
+{$ifndef VER2_2}
+    tkUstring:
+      fpc_UnicodeStr_Assign(PPointer(Dest)^,PPointer(Src)^);
+{$endif VER2_2}
     tkArray:
       begin
         Temp:=PByte(TypeInfo);

rtl/inc/system.inc

@@ -331,7 +331,15 @@ function aligntoptr(p : pointer) : pointer;inline;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
-{$i wstrings.inc}
+{ this is for bootstrappung with 2.2.x }
+{$ifdef VER2_2}
+{$i wustring22.inc}
+{$else VER2_2}
+  {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+    {$i wstrings.inc}
+  {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+  {$i ustrings.inc}
+{$endif VER2_2}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 
 {$i aliases.inc}

rtl/inc/systemh.inc

@@ -345,6 +345,14 @@ Type
   PUCS2Char           = PWideChar;
   PWideString         = ^WideString;
 
+  UnicodeChar         = type WideChar;
+  PUnicodeChar        = ^UnicodeChar;
+{$ifdef VER2_2}
+  { this is only to avoid too much ifdefs in the code }
+  UnicodeString       = type WideString;
+{$endif VER2_2}
+  PUnicodeString      = ^UnicodeString;
+
   { Needed for fpc_get_output }
   PText               = ^Text;
 
@@ -761,7 +769,14 @@ function  lowercase(const s : ansistring) : ansistring;
 ****************************************************************************}
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
-{$i wstringh.inc}
+{$ifdef VER2_2}
+{$i wstring22h.inc}
+{$else VER2_2}
+  {$i ustringh.inc}
+  {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+    {$i wstringh.inc}
+  {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+{$endif VER2_2}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 
 

rtl/inc/text.inc

@@ -617,6 +617,32 @@ begin
 end;
 
 
+Procedure fpc_Write_Text_UnicodeStr (Len : Longint; Var f : Text; const S : WideString); iocheck; [Public,alias:'FPC_WRITE_TEXT_UNICODESTR']; compilerproc;
+{
+ Writes a UnicodeString to the Text file T
+}
+var
+  SLen : longint;
+  a: ansistring;
+begin
+  If (pointer(S)=nil) or (InOutRes<>0) then
+   exit;
+  case TextRec(f).mode of
+    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
+      begin
+        SLen:=Length(s);
+        If Len>SLen Then
+          fpc_WriteBlanks(f,Len-SLen);
+        a:=s;
+        { length(a) can be > slen, e.g. after utf-16 -> utf-8 }
+        fpc_WriteBuffer(f,pchar(a)^,length(a));
+      end;
+    fmInput: InOutRes:=105
+    else InOutRes:=103;
+  end;
+end;
+
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
 Procedure fpc_Write_Text_WideStr (Len : Longint; Var f : Text; const S : WideString); iocheck; [Public,alias:'FPC_WRITE_TEXT_WIDESTR']; compilerproc;
 {
  Writes a WideString to the Text file T
@@ -641,7 +667,7 @@ begin
     else InOutRes:=103;
   end;
 end;
-
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
 
 Procedure fpc_Write_Text_SInt(Len : Longint;var t : Text;l : ValSInt); iocheck; [Public,Alias:'FPC_WRITE_TEXT_SINT']; compilerproc;
 var

rtl/inc/ustringh.inc

@@ -0,0 +1,119 @@
+{
+    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.
+
+ **********************************************************************}
+
+
+Procedure UniqueString (Var S : UnicodeString);external name 'FPC_UNICODESTR_UNIQUE';
+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;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Pos (c : UnicodeString; Const s : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Pos (c : ShortString; Const s : UnicodeString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+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 = record
+    Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;len:SizeInt);
+    Ansi2WideMoveProc : procedure(source:pchar;var dest:widestring;len:SizeInt);
+
+//    UpperUTF8 : procedure(p:PUTF8String);
+
+    UpperWideStringProc : function(const S: WideString): WideString;
+//    UpperUCS4 : procedure(p:PUCS4Char);
+//    LowerUTF8 : procedure(p:PUTF8String);
+    LowerWideStringProc : function(const S: WideString): WideString;
+//    LowerUCS4 : procedure(p:PUCS4Char);
+{
+    CompUTF8 : function(p1,p2:PUTF8String) : shortint;
+    CompUCS2 : function(p1,p2:PUCS2Char) : shortint;
+    CompUCS4 : function(p1,p2:PUC42Char) : shortint;
+}
+    CompareWideStringProc : function(const s1, s2 : WideString) : PtrInt;
+    CompareTextWideStringProc : function(const s1, s2 : WideString): PtrInt;
+    CharLengthPCharProc : function(const Str: PChar): PtrInt;
+
+    UpperAnsiStringProc : function(const s : ansistring) : ansistring;
+    LowerAnsiStringProc : function(const s : ansistring) : ansistring;
+    CompareStrAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
+    CompareTextAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
+    StrCompAnsiStringProc : function(S1, S2: PChar): PtrInt;
+    StrICompAnsiStringProc : function(S1, S2: PChar): PtrInt;
+    StrLCompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+    StrLICompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+    StrLowerAnsiStringProc : function(Str: PChar): PChar;
+    StrUpperAnsiStringProc : function(Str: PChar): PChar;
+    ThreadInitProc : procedure;
+    ThreadFiniProc : procedure;
+
+    { this is only different on windows }
+    Unicode2AnsiMoveProc : procedure(source:punicodechar;var dest:ansistring;len:SizeInt);
+    Ansi2UnicodeMoveProc : procedure(source:pchar;var dest:unicodestring;len:SizeInt);
+    UpperUnicodeStringProc : function(const S: UnicodeString): UnicodeString;
+    LowerUnicodeStringProc : function(const S: UnicodeString): UnicodeString;
+    CompareUnicodeStringProc : function(const s1, s2 : UnicodeString) : PtrInt;
+    CompareTextUnicodeStringProc : function(const s1, s2 : UnicodeString): PtrInt;
+  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/inc/ustrings.inc

@@ -0,0 +1,2325 @@
+{
+    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 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,
+  and all things that are needed for it.
+  UnicodeString is defined as a 'silent' punicodechar :
+  a punicodechar that points to :
+
+  @-8  : SizeInt for reference count;
+  @-4  : SizeInt for size; size=number of bytes, not the number of chars. Divide or multiply
+         with sizeof(UnicodeChar) to convert. This is needed to be compatible with Delphi and
+         Windows COM BSTR.
+  @    : String + Terminating #0;
+  Punicodechar(Unicodestring) is a valid typecast.
+  So WS[i] is converted to the address @WS+i-1.
+
+  Constants should be assigned a reference count of -1
+  Meaning that they can't be disposed of.
+}
+
+Type
+  PUnicodeRec = ^TUnicodeRec;
+  TUnicodeRec = Packed Record
+    Ref : SizeInt;
+    Len : SizeInt;
+    First : UnicodeChar;
+  end;
+
+Const
+  UnicodeRecLen = SizeOf(TUnicodeRec);
+  UnicodeFirstOff = SizeOf(TUnicodeRec)-sizeof(UnicodeChar);
+
+{
+  Default UnicodeChar <-> Char conversion is to only convert the
+  lower 127 chars, all others are translated to spaces.
+
+  These routines can be overwritten for the Current Locale
+}
+
+procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
+var
+  i : SizeInt;
+begin
+  setlength(dest,len);
+  for i:=1 to len do
+    begin
+      if word(source^)<256 then
+        dest[i]:=char(word(source^))
+      else
+        dest[i]:='?';
+      inc(source);
+    end;
+end;
+
+
+procedure DefaultAnsi2UnicodeMove(source:pchar;var dest:unicodestring;len:SizeInt);
+var
+  i : SizeInt;
+begin
+  setlength(dest,len);
+  for i:=1 to len do
+    begin
+      dest[i]:=unicodechar(byte(source^));
+      inc(source);
+    end;
+end;
+
+
+Procedure GetUnicodeStringManager (Var Manager : TUnicodeStringManager);
+begin
+  manager:=widestringmanager;
+end;
+
+
+Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
+begin
+  Old:=widestringmanager;
+  widestringmanager:=New;
+end;
+
+
+Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager);
+begin
+  widestringmanager:=New;
+end;
+
+
+Procedure GetWideStringManager (Var Manager : TUnicodeStringManager);
+begin
+  manager:=widestringmanager;
+end;
+
+
+Procedure SetWideStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
+begin
+  Old:=widestringmanager;
+  widestringmanager:=New;
+end;
+
+
+Procedure SetWideStringManager (Const New : TUnicodeStringManager);
+begin
+  widestringmanager:=New;
+end;
+         {****************************************************************************
+                    Internal functions, not in interface.
+****************************************************************************}
+
+
+procedure UnicodeStringError;
+  begin
+    HandleErrorFrame(204,get_frame);
+  end;
+
+
+{$ifdef UnicodeStrDebug}
+Procedure DumpUnicodeRec(S : Pointer);
+begin
+  If S=Nil then
+    Writeln ('String is nil')
+  Else
+    Begin
+      With PUnicodeRec(S-UnicodeFirstOff)^ do
+       begin
+         Write   ('(Len:',len);
+         Writeln (' Ref: ',ref,')');
+       end;
+    end;
+end;
+{$endif}
+
+
+Function NewUnicodeString(Len : SizeInt) : Pointer;
+{
+  Allocate a new UnicodeString on the heap.
+  initialize it to zero length and reference count 1.
+}
+Var
+  P : Pointer;
+begin
+  GetMem(P,Len*sizeof(UnicodeChar)+UnicodeRecLen);
+  If P<>Nil then
+    begin
+     PUnicodeRec(P)^.Len:=Len*2;     { Initial length }
+     PUnicodeRec(P)^.Ref:=1;         { Initial Refcount }
+     PUnicodeRec(P)^.First:=#0;      { Terminating #0 }
+     inc(p,UnicodeFirstOff);         { Points to string now }
+    end
+  else
+    UnicodeStringError;
+  NewUnicodeString:=P;
+end;
+
+
+Procedure DisposeUnicodeString(Var S : Pointer);
+{
+  Deallocates a UnicodeString From the heap.
+}
+begin
+  If S=Nil then
+    exit;
+  Dec (S,UnicodeFirstOff);
+  Freemem(S);
+  S:=Nil;
+end;
+
+
+Procedure fpc_UnicodeStr_Decr_Ref (Var S : Pointer);[Public,Alias:'FPC_UNICODESTR_DECR_REF']; compilerproc;
+{
+  Decreases the ReferenceCount of a non constant unicodestring;
+  If the reference count is zero, deallocate the string;
+}
+Type
+  pSizeInt = ^SizeInt;
+Var
+  l : pSizeInt;
+Begin
+  { Zero string }
+  if S=Nil then
+    exit;
+  { check for constant strings ...}
+  l:=@PUnicodeRec(S-UnicodeFirstOff)^.Ref;
+  if l^<0 then
+    exit;
+
+  { declocked does a MT safe dec and returns true, if the counter is 0 }
+  if declocked(l^) then
+    { Ref count dropped to zero ...
+      ... remove }
+  DisposeUnicodeString(S);
+end;
+
+{ alias for internal use }
+Procedure fpc_UnicodeStr_Decr_Ref (Var S : Pointer);[external name 'FPC_UNICODESTR_DECR_REF'];
+
+Procedure fpc_UnicodeStr_Incr_Ref(S : Pointer);[Public,Alias:'FPC_UNICODESTR_INCR_REF']; compilerproc;
+  Begin
+    If S=Nil then
+      exit;
+    { constant string ? }
+    If PUnicodeRec(S-UnicodeFirstOff)^.Ref<0 then
+      exit;
+    inclocked(PUnicodeRec(S-UnicodeFirstOff)^.Ref);
+  end;
+
+{ alias for internal use }
+Procedure fpc_UnicodeStr_Incr_Ref (S : Pointer);[external name 'FPC_UNICODESTR_INCR_REF'];
+
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+function fpc_UnicodeStr_To_ShortStr (high_of_res: SizeInt;const S2 : UnicodeString): shortstring;[Public, alias: 'FPC_UNICODESTR_TO_SHORTSTR'];  compilerproc;
+{
+  Converts a UnicodeString to a ShortString;
+}
+Var
+  Size : SizeInt;
+  temp : ansistring;
+begin
+  result:='';
+  Size:=Length(S2);
+  if Size>0 then
+    begin
+      If Size>high_of_res then
+        Size:=high_of_res;
+      widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(S2),temp,Size);
+      result:=temp;
+    end;
+end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+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;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+
+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
+    SetLength(Result,Length(S2));
+    Move(pointer(S2)^,Pointer(Result)^,Length(S2)*sizeof(WideChar));
+  end;
+
+
+Function fpc_WideStr_To_UnicodeStr (Const S2 : WideString): UnicodeString; compilerproc;
+  begin
+    SetLength(Result,Length(S2));
+    Move(pointer(S2)^,Pointer(Result)^,Length(S2)*sizeof(WideChar));
+  end;
+
+
+Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar): ansistring; compilerproc;
+var
+  Size : SizeInt;
+begin
+  result:='';
+  if p=nil then
+    exit;
+  Size := IndexWord(p^, -1, 0);
+  if Size>0 then
+    widestringmanager.Unicode2AnsiMoveProc(P,result,Size);
+end;
+
+
+Function fpc_PUnicodeChar_To_UnicodeStr(const p : punicodechar): unicodestring; compilerproc;
+var
+  Size : SizeInt;
+begin
+  result:='';
+  if p=nil then
+    exit;
+  Size := IndexWord(p^, -1, 0);
+  Setlength(result,Size);
+  if Size>0 then
+   begin
+      Move(p^,PUnicodeChar(Pointer(result))^,Size*sizeof(UnicodeChar));
+      { Terminating Zero }
+      PUnicodeChar(Pointer(result)+Size*sizeof(UnicodeChar))^:=#0;
+   end;
+end;
+
+
+Function fpc_PWideChar_To_UnicodeStr(const p : pwidechar): unicodestring; compilerproc;
+var
+  Size : SizeInt;
+begin
+  result:='';
+  if p=nil then
+    exit;
+  Size := IndexWord(p^, -1, 0);
+  Setlength(result,Size);
+  if Size>0 then
+   begin
+      Move(p^,PUnicodeChar(Pointer(result))^,Size*sizeof(UnicodeChar));
+      { Terminating Zero }
+      PUnicodeChar(Pointer(result)+Size*sizeof(UnicodeChar))^:=#0;
+   end;
+end;
+
+
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+Function fpc_PUnicodeChar_To_ShortStr(const p : punicodechar): shortstring; compilerproc;
+var
+  Size : SizeInt;
+  temp: ansistring;
+begin
+  result:='';
+  if p=nil then
+    exit;
+  Size := IndexWord(p^, $7fffffff, 0);
+  if Size>0 then
+    begin
+      widestringmanager.Unicode2AnsiMoveProc(p,temp,Size);
+      result:=temp;
+    end;
+end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_PUnicodeChar_To_ShortStr(out res : shortstring;const p : punicodechar); compilerproc;
+var
+  Size : SizeInt;
+  temp: ansistring;
+begin
+  res:='';
+  if p=nil then
+    exit;
+  Size:=IndexWord(p^, high(PtrInt), 0);
+  if Size>0 then
+    begin
+      widestringmanager.Unicode2AnsiMoveProc(p,temp,Size);
+      res:=temp;
+    end;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+
+Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
+var
+  Size : SizeInt;
+begin
+  result:='';
+  if p=nil then
+    exit;
+  Size := IndexWord(p^, -1, 0);
+  if Size>0 then
+    widestringmanager.Wide2AnsiMoveProc(P,result,Size);
+end;
+
+
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;
+var
+  Size : SizeInt;
+  temp: ansistring;
+begin
+  result:='';
+  if p=nil then
+    exit;
+  Size := IndexWord(p^, $7fffffff, 0);
+  if Size>0 then
+    begin
+      widestringmanager.Wide2AnsiMoveProc(p,temp,Size);
+      result:=temp;
+    end;
+end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_PWideChar_To_ShortStr(out res : shortstring;const p : pwidechar); compilerproc;
+var
+  Size : SizeInt;
+  temp: ansistring;
+begin
+  res:='';
+  if p=nil then
+    exit;
+  Size:=IndexWord(p^, high(PtrInt), 0);
+  if Size>0 then
+    begin
+      widestringmanager.Wide2AnsiMoveProc(p,temp,Size);
+      res:=temp;
+    end;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+
+{ checked against the ansistring routine, 2001-05-27 (FK) }
+Procedure fpc_UnicodeStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_UNICODESTR_ASSIGN']; compilerproc;
+{
+  Assigns S2 to S1 (S1:=S2), taking in account reference counts.
+}
+begin
+  If S2<>nil then
+    If PUnicodeRec(S2-UnicodeFirstOff)^.Ref>0 then
+      inclocked(PUnicodeRec(S2-UnicodeFirstOff)^.ref);
+  { Decrease the reference count on the old S1 }
+  fpc_unicodestr_decr_ref (S1);
+  s1:=s2;
+end;
+
+
+{ alias for internal use }
+Procedure fpc_UnicodeStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_UNICODESTR_ASSIGN'];
+
+{$ifndef STR_CONCAT_PROCS}
+
+function fpc_UnicodeStr_Concat (const S1,S2 : UnicodeString): UnicodeString; compilerproc;
+Var
+  Size,Location : SizeInt;
+  pc : punicodechar;
+begin
+  { only assign if s1 or s2 is empty }
+  if (S1='') then
+    begin
+      result:=s2;
+      exit;
+    end;
+  if (S2='') then
+    begin
+      result:=s1;
+      exit;
+    end;
+  Location:=Length(S1);
+  Size:=length(S2);
+  SetLength(result,Size+Location);
+  pc:=punicodechar(result);
+  Move(S1[1],pc^,Location*sizeof(UnicodeChar));
+  inc(pc,location);
+  Move(S2[1],pc^,(Size+1)*sizeof(UnicodeChar));
+end;
+
+
+function fpc_UnicodeStr_Concat_multi (const sarr:array of Unicodestring): unicodestring; compilerproc;
+Var
+  i  : Longint;
+  p  : pointer;
+  pc : punicodechar;
+  Size,NewSize : SizeInt;
+begin
+  { First calculate size of the result so we can do
+    a single call to SetLength() }
+  NewSize:=0;
+  for i:=low(sarr) to high(sarr) do
+    inc(Newsize,length(sarr[i]));
+  SetLength(result,NewSize);
+  pc:=punicodechar(result);
+  for i:=low(sarr) to high(sarr) do
+    begin
+      p:=pointer(sarr[i]);
+      if assigned(p) then
+        begin
+          Size:=length(unicodestring(p));
+          Move(punicodechar(p)^,pc^,(Size+1)*sizeof(UnicodeChar));
+          inc(pc,size);
+        end;
+    end;
+end;
+
+{$else STR_CONCAT_PROCS}
+
+procedure fpc_UnicodeStr_Concat (var DestS:Unicodestring;const S1,S2 : UnicodeString); compilerproc;
+Var
+  Size,Location : SizeInt;
+  same : boolean;
+begin
+  { only assign if s1 or s2 is empty }
+  if (S1='') then
+    begin
+      DestS:=s2;
+      exit;
+    end;
+  if (S2='') then
+    begin
+      DestS:=s1;
+      exit;
+    end;
+  Location:=Length(S1);
+  Size:=length(S2);
+  { Use Pointer() typecasts to prevent extra conversion code }
+  if Pointer(DestS)=Pointer(S1) then
+    begin
+      same:=Pointer(S1)=Pointer(S2);
+      SetLength(DestS,Size+Location);
+      if same then
+        Move(Pointer(DestS)^,(Pointer(DestS)+Location*sizeof(UnicodeChar))^,(Size)*sizeof(UnicodeChar))
+      else
+        Move(Pointer(S2)^,(Pointer(DestS)+Location*sizeof(UnicodeChar))^,(Size+1)*sizeof(UnicodeChar));
+    end
+  else if Pointer(DestS)=Pointer(S2) then
+    begin
+      SetLength(DestS,Size+Location);
+      Move(Pointer(DestS)^,(Pointer(DestS)+Location*sizeof(UnicodeChar))^,(Size+1)*sizeof(UnicodeChar));
+      Move(Pointer(S1)^,Pointer(DestS)^,Location*sizeof(UnicodeChar));
+    end
+  else
+    begin
+      DestS:='';
+      SetLength(DestS,Size+Location);
+      Move(Pointer(S1)^,Pointer(DestS)^,Location*sizeof(UnicodeChar));
+      Move(Pointer(S2)^,(Pointer(DestS)+Location*sizeof(UnicodeChar))^,(Size+1)*sizeof(UnicodeChar));
+    end;
+end;
+
+
+procedure fpc_UnicodeStr_Concat_multi (var DestS:Unicodestring;const sarr:array of Unicodestring); compilerproc;
+Var
+  i           : Longint;
+  p,pc        : pointer;
+  Size,NewLen : SizeInt;
+  lowstart    : longint;
+  destcopy    : pointer;
+  OldDestLen  : SizeInt;
+begin
+  if high(sarr)=0 then
+    begin
+      DestS:='';
+      exit;
+    end;
+  destcopy:=nil;
+  lowstart:=low(sarr);
+  if Pointer(DestS)=Pointer(sarr[lowstart]) then
+    inc(lowstart);
+  { Check for another reuse, then we can't use
+    the append optimization }
+  for i:=lowstart to high(sarr) do
+    begin
+      if Pointer(DestS)=Pointer(sarr[i]) then
+        begin
+          { if DestS is used somewhere in the middle of the expression,
+            we need to make sure the original string still exists after
+            we empty/modify DestS.
+            This trick only works with reference counted strings. Therefor
+            this optimization is disabled for WINLIKEUNICODESTRING }
+          destcopy:=pointer(dests);
+          fpc_UnicodeStr_Incr_Ref(destcopy);
+          lowstart:=low(sarr);
+          break;
+        end;
+    end;
+  { Start with empty DestS if we start with concatting
+    the first array element }
+  if lowstart=low(sarr) then
+    DestS:='';
+  OldDestLen:=length(DestS);
+  { Calculate size of the result so we can do
+    a single call to SetLength() }
+  NewLen:=0;
+  for i:=low(sarr) to high(sarr) do
+    inc(NewLen,length(sarr[i]));
+  SetLength(DestS,NewLen);
+  { Concat all strings, except the string we already
+    copied in DestS }
+  pc:=Pointer(DestS)+OldDestLen*sizeof(UnicodeChar);
+  for i:=lowstart to high(sarr) do
+    begin
+      p:=pointer(sarr[i]);
+      if assigned(p) then
+        begin
+          Size:=length(unicodestring(p));
+          Move(p^,pc^,(Size+1)*sizeof(UnicodeChar));
+          inc(pc,size*sizeof(UnicodeChar));
+        end;
+    end;
+  fpc_UnicodeStr_Decr_Ref(destcopy);
+end;
+
+{$endif STR_CONCAT_PROCS}
+
+Function fpc_Char_To_UChar(const c : Char): UnicodeChar; compilerproc;
+var
+  w: unicodestring;
+begin
+  widestringmanager.Ansi2UnicodeMoveProc(@c, w, 1);
+  fpc_Char_To_UChar:= w[1];
+end;
+
+
+
+Function fpc_Char_To_UnicodeStr(const c : Char): UnicodeString; compilerproc;
+{
+  Converts a Char to a UnicodeString;
+}
+begin
+  Setlength(fpc_Char_To_UnicodeStr,1);
+  fpc_Char_To_UnicodeStr[1]:=c;
+  { Terminating Zero }
+  PUnicodeChar(Pointer(fpc_Char_To_UnicodeStr)+sizeof(UnicodeChar))^:=#0;
+end;
+
+
+Function fpc_UChar_To_Char(const c : UnicodeChar): Char; compilerproc;
+{
+  Converts a UnicodeChar to a Char;
+}
+var
+  s: ansistring;
+begin
+  widestringmanager.Unicode2AnsiMoveProc(@c, s, 1);
+  if length(s)=1 then
+    fpc_UChar_To_Char:= s[1]
+  else
+    fpc_UChar_To_Char:='?';
+end;
+
+
+Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc;
+{
+  Converts a WideChar to a UnicodeString;
+}
+begin
+  Setlength (Result,1);
+  Result[1]:= c;
+end;
+
+
+Function fpc_Char_To_WChar(const c : Char): WideChar; compilerproc;
+var
+  w: widestring;
+begin
+  widestringmanager.Ansi2WideMoveProc(@c, w, 1);
+  fpc_Char_To_WChar:= w[1];
+end;
+
+
+Function fpc_WChar_To_Char(const c : WideChar): Char; compilerproc;
+{
+  Converts a WideChar to a Char;
+}
+var
+  s: ansistring;
+begin
+  widestringmanager.Wide2AnsiMoveProc(@c, s, 1);
+  if length(s)=1 then
+    fpc_WChar_To_Char:= s[1]
+  else
+    fpc_WChar_To_Char:='?';
+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;
+}
+begin
+  Setlength (fpc_UChar_To_UnicodeStr,1);
+  fpc_UChar_To_UnicodeStr[1]:= c;
+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 char; zerobased: boolean = true): UnicodeString; compilerproc;
+var
+  i  : SizeInt;
+begin
+  if (zerobased) then
+    begin
+      if (arr[0]=#0) Then
+      begin
+        fpc_chararray_to_unicodestr := '';
+        exit;
+      end;
+      i:=IndexChar(arr,high(arr)+1,#0);
+      if i = -1 then
+        i := high(arr)+1;
+    end
+  else
+    i := high(arr)+1;
+  SetLength(fpc_CharArray_To_UnicodeStr,i);
+  widestringmanager.Ansi2UnicodeMoveProc (pchar(@arr),fpc_CharArray_To_UnicodeStr,i);
+end;
+
+
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+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;
+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.Unicode2AnsiMoveProc (punicodechar(@arr),temp,len);
+  fpc_UnicodeCharArray_To_ShortStr := temp;
+end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_UnicodeCharArray_To_ShortStr(out res : shortstring;const arr: array of unicodechar; zerobased: boolean = true);[public,alias:'FPC_UNICODECHARARRAY_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.Unicode2AnsiMoveProc (punicodechar(@arr),temp,len);
+  res:=temp;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+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;
+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_UnicodeStr,i);
+  Move(arr[0], Pointer(fpc_UnicodeCharArray_To_UnicodeStr)^,i*sizeof(UnicodeChar));
+end;
+
+
+Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; 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_UnicodeStr,i);
+  Move(arr[0], Pointer(fpc_WideCharArray_To_UnicodeStr)^,i*sizeof(WideChar));
+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;
+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_WideStr,i);
+  Move(arr[0], Pointer(fpc_WideCharArray_To_WideStr)^,i*sizeof(WideChar));
+end;
+
+{$ifndef FPC_STRTOCHARARRAYPROC}
+
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ chararray we're converting to (JM)                                    }
+function fpc_unicodestr_to_chararray(arraysize: SizeInt; const src: UnicodeString): fpc_big_chararray;[public,alias: 'FPC_UNICODESTR_TO_CHARARRAY']; compilerproc;
+var
+  len: SizeInt;
+  temp: ansistring;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    widestringmanager.unicode2ansimoveproc(punicodechar(@src[1]),temp,len);
+  len := length(temp);
+  if len > arraysize then
+    len := arraysize;
+{$r-}
+  move(temp[1],fpc_unicodestr_to_chararray[0],len);
+  fillchar(fpc_unicodestr_to_chararray[len],arraysize-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ unicodechararray we're converting to (JM)                                }
+function fpc_unicodestr_to_unicodechararray(arraysize: SizeInt; const src: UnicodeString): fpc_big_unicodechararray;[public,alias: 'FPC_UNICODESTR_TO_UNICODECHARARRAY']; compilerproc;
+var
+  len: SizeInt;
+begin
+  len := length(src);
+  if len > arraysize then
+    len := arraysize;
+{$r-}
+  { make sure we don't try to access element 1 of the ansistring if it's nil }
+  if len > 0 then
+    move(src[1],fpc_unicodestr_to_unicodechararray[0],len*SizeOf(UnicodeChar));
+  fillchar(fpc_unicodestr_to_unicodechararray[len],(arraysize-len)*SizeOf(UnicodeChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ chararray we're converting to (JM)                                    }
+function fpc_ansistr_to_unicodechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_unicodechararray;[public,alias: 'FPC_ANSISTR_TO_UNICODECHARARRAY']; 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 > arraysize then
+    len := arraysize;
+
+{$r-}
+  move(temp[1],fpc_ansistr_to_unicodechararray[0],len*sizeof(unicodechar));
+  fillchar(fpc_ansistr_to_unicodechararray[len],(arraysize-len)*SizeOf(UnicodeChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+function fpc_shortstr_to_unicodechararray(arraysize: SizeInt; const src: ShortString): fpc_big_unicodechararray;[public,alias: 'FPC_SHORTSTR_TO_UNICODECHARARRAY']; 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 > arraysize then
+    len := arraysize;
+{$r-}
+  move(temp[1],fpc_shortstr_to_unicodechararray[0],len*sizeof(unicodechar));
+  fillchar(fpc_shortstr_to_unicodechararray[len],(arraysize-len)*SizeOf(UnicodeChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+{$else ndef FPC_STRTOCHARARRAYPROC}
+
+procedure fpc_unicodestr_to_chararray(out res: array of char; const src: UnicodeString); compilerproc;
+var
+  len: SizeInt;
+  temp: ansistring;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    widestringmanager.unicode2ansimoveproc(punicodechar(@src[1]),temp,len);
+  len := length(temp);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  move(temp[1],res[0],len);
+  fillchar(res[len],length(res)-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+procedure fpc_unicodestr_to_unicodechararray(out res: array of unicodechar; const src: UnicodeString); compilerproc;
+var
+  len: SizeInt;
+begin
+  len := length(src);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  { make sure we don't try to access element 1 of the ansistring if it's nil }
+  if len > 0 then
+    move(src[1],res[0],len*SizeOf(UnicodeChar));
+  fillchar(res[len],(length(res)-len)*SizeOf(UnicodeChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+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
+  len: SizeInt;
+begin
+  len := length(src);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  { make sure we don't try to access element 1 of the widestring if it's nil }
+  if len > 0 then
+    move(src[1],res[0],len*SizeOf(WideChar));
+  fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+
+Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt;[Public,Alias : 'FPC_UNICODESTR_COMPARE']; 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 pointer(S1)=pointer(S2) then
+   begin
+     fpc_UnicodeStr_Compare:=0;
+     exit;
+   end;
+  Maxi:=Length(S1);
+  temp:=Length(S2);
+  If MaxI>Temp then
+   MaxI:=Temp;
+  Temp:=CompareWord(S1[1],S2[1],MaxI);
+  if temp=0 then
+   temp:=Length(S1)-Length(S2);
+  fpc_UnicodeStr_Compare:=Temp;
+end;
+
+Function fpc_UnicodeStr_Compare_Equal(const S1,S2 : UnicodeString): SizeInt;[Public,Alias : 'FPC_UNICODESTR_COMPARE_EQUAL']; compilerproc;
+{
+  Compares 2 UnicodeStrings for equality only;
+  The result is
+   0 if S1=S2
+   <>0 if S1<>S2
+}
+Var
+  MaxI : SizeInt;
+begin
+  if pointer(S1)=pointer(S2) then
+    exit(0);
+  Maxi:=Length(S1);
+  If MaxI<>Length(S2) then
+    exit(-1)
+  else
+    exit(CompareWord(S1[1],S2[1],MaxI));
+end;
+
+Procedure fpc_UnicodeStr_CheckZero(p : pointer);[Public,Alias : 'FPC_UNICODESTR_CHECKZERO']; compilerproc;
+begin
+  if p=nil then
+    HandleErrorFrame(201,get_frame);
+end;
+
+
+Procedure fpc_UnicodeStr_CheckRange(len,index : SizeInt);[Public,Alias : 'FPC_UNICODESTR_RANGECHECK']; compilerproc;
+begin
+  if (index>len div 2) or (Index<1) then
+    HandleErrorFrame(201,get_frame);
+end;
+
+Procedure fpc_UnicodeStr_SetLength(Var S : UnicodeString; l : SizeInt);[Public,Alias : 'FPC_UNICODESTR_SETLENGTH']; compilerproc;
+{
+  Sets The length of string S to L.
+  Makes sure S is unique, and contains enough room.
+}
+Var
+  Temp : Pointer;
+  movelen: SizeInt;
+begin
+   if (l>0) then
+    begin
+      if Pointer(S)=nil then
+       begin
+         { Need a complete new string...}
+         Pointer(s):=NewUnicodeString(l);
+       end
+      { windows doesn't support reallocing unicodestrings, this code
+        is anyways subject to be removed because unicodestrings shouldn't be
+        ref. counted anymore (FK) }
+      else
+        if (PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.Ref = 1) then
+        begin
+          Dec(Pointer(S),UnicodeFirstOff);
+          if SizeUInt(L*sizeof(UnicodeChar)+UnicodeRecLen)>MemSize(Pointer(S)) then
+              reallocmem(pointer(S), L*sizeof(UnicodeChar)+UnicodeRecLen);
+          Inc(Pointer(S), UnicodeFirstOff);
+        end
+      else
+        begin
+          { Reallocation is needed... }
+          Temp:=Pointer(NewUnicodeString(L));
+          if Length(S)>0 then
+            begin
+              if l < succ(length(s)) then
+                movelen := l
+              { also move terminating null }
+              else
+                movelen := succ(length(s));
+              Move(Pointer(S)^,Temp^,movelen * Sizeof(UnicodeChar));
+            end;
+          fpc_unicodestr_decr_ref(Pointer(S));
+          Pointer(S):=Temp;
+        end;
+      { Force nil termination in case it gets shorter }
+      PWord(Pointer(S)+l*sizeof(UnicodeChar))^:=0;
+      PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.Len:=l*sizeof(UnicodeChar);
+    end
+  else
+    begin
+      { Length=0 }
+      if Pointer(S)<>nil then
+        fpc_unicodestr_decr_ref (Pointer(S));
+      Pointer(S):=Nil;
+    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(Var S : Pointer): Pointer; [Public,Alias : 'FPC_UNICODESTR_UNIQUE']; compilerproc;
+{
+  Make sure reference count of S is 1,
+  using copy-on-write semantics.
+}
+Var
+  SNew : Pointer;
+  L    : SizeInt;
+begin
+  pointer(result) := pointer(s);
+  If Pointer(S)=Nil then
+    exit;
+  if PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.Ref<>1 then
+   begin
+     L:=PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.len div sizeof(UnicodeChar);
+     SNew:=NewUnicodeString (L);
+     Move (PUnicodeChar(S)^,SNew^,(L+1)*sizeof(UnicodeChar));
+     PUnicodeRec(SNew-UnicodeFirstOff)^.len:=L * sizeof(UnicodeChar);
+     fpc_unicodestr_decr_ref (Pointer(S));  { Thread safe }
+     pointer(S):=SNew;
+     pointer(result):=SNew;
+   end;
+end;
+
+
+Function Fpc_UnicodeStr_Copy (Const S : UnicodeString; Index,Size : SizeInt) : UnicodeString;compilerproc;
+var
+  ResultAddress : Pointer;
+begin
+  ResultAddress:=Nil;
+  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
+   begin
+     If Index<0 Then
+      Index:=0;
+     ResultAddress:=Pointer(NewUnicodeString (Size));
+     if ResultAddress<>Nil then
+      begin
+        Move (PUnicodeChar(S)[Index],ResultAddress^,Size*sizeof(UnicodeChar));
+        PUnicodeRec(ResultAddress-UnicodeFirstOff)^.Len:=Size*sizeof(UnicodeChar);
+        PUnicodeChar(ResultAddress+Size*sizeof(UnicodeChar))^:=#0;
+      end;
+   end;
+  fpc_unicodestr_decr_ref(Pointer(fpc_unicodestr_copy));
+  Pointer(fpc_unicodestr_Copy):=ResultAddress;
+end;
+
+
+Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt;
+var
+  i,MaxLen : SizeInt;
+  pc : punicodechar;
+begin
+  Pos:=0;
+  if Length(SubStr)>0 then
+   begin
+     MaxLen:=Length(source)-Length(SubStr);
+     i:=0;
+     pc:=@source[1];
+     while (i<=MaxLen) do
+      begin
+        inc(i);
+        if (SubStr[1]=pc^) and
+           (CompareWord(Substr[1],pc^,Length(SubStr))=0) then
+         begin
+           Pos:=i;
+           exit;
+         end;
+        inc(pc);
+      end;
+   end;
+end;
+
+
+{ Faster version for a unicodechar alone }
+Function Pos (c : UnicodeChar; Const s : UnicodeString) : SizeInt;
+var
+  i: SizeInt;
+  pc : punicodechar;
+begin
+  pc:=@s[1];
+  for i:=1 to length(s) do
+   begin
+     if pc^=c then
+      begin
+        pos:=i;
+        exit;
+      end;
+     inc(pc);
+   end;
+  pos:=0;
+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 : Char; Const s : UnicodeString) : SizeInt;
+var
+  i: SizeInt;
+  wc : unicodechar;
+  pc : punicodechar;
+begin
+  wc:=c;
+  pc:=@s[1];
+  for i:=1 to length(s) do
+   begin
+     if pc^=wc then
+      begin
+        pos:=i;
+        exit;
+      end;
+     inc(pc);
+   end;
+  pos:=0;
+end;
+
+
+
+Procedure Delete (Var S : UnicodeString; Index,Size: SizeInt);
+Var
+  LS : SizeInt;
+begin
+  If Length(S)=0 then
+   exit;
+  if index<=0 then
+   exit;
+  LS:=PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.Len div sizeof(UnicodeChar);
+  if (Index<=LS) and (Size>0) then
+   begin
+     UniqueString (S);
+     if Size+Index>LS then
+      Size:=LS-Index+1;
+     if Index+Size<=LS then
+      begin
+        Dec(Index);
+        Move(PUnicodeChar(S)[Index+Size],PUnicodeChar(S)[Index],(LS-Index-Size+1)*sizeof(UnicodeChar));
+      end;
+     Setlength(s,LS-Size);
+   end;
+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;
+var
+  s : UnicodeString;
+begin
+  s:=c;
+  result:=widestringmanager.UpperUnicodeStringProc(s)[1];
+end;
+
+
+function UpCase(const s : UnicodeString) : UnicodeString;
+begin
+  result:=widestringmanager.UpperUnicodeStringProc(s);
+end;
+
+
+Procedure SetString (Out S : UnicodeString; Buf : PUnicodeChar; Len : SizeInt);
+var
+  BufLen: SizeInt;
+begin
+  SetLength(S,Len);
+  If (Buf<>Nil) and (Len>0) then
+    begin
+      BufLen := IndexWord(Buf^, Len+1, 0);
+      If (BufLen>0) and (BufLen < Len) then
+        Len := BufLen;
+      Move (Buf[0],S[1],Len*sizeof(UnicodeChar));
+      PUnicodeChar(Pointer(S)+Len*sizeof(UnicodeChar))^:=#0;
+    end;
+end;
+
+
+Procedure SetString (Out S : UnicodeString; Buf : PChar; Len : SizeInt);
+var
+  BufLen: SizeInt;
+begin
+  SetLength(S,Len);
+  If (Buf<>Nil) and (Len>0) then
+    begin
+      BufLen := IndexByte(Buf^, Len+1, 0);
+      If (BufLen>0) and (BufLen < Len) then
+        Len := BufLen;
+      widestringmanager.Ansi2UnicodeMoveProc(Buf,S,Len);
+      //PUnicodeChar(Pointer(S)+Len*sizeof(UnicodeChar))^:=#0;
+    end;
+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;
+
+{$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}
+
+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;
+  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;
+              else
+                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;
+            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);
+              else
+                inc(j,3);
+            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;
+
+var
+  i,j : SizeUInt;
+  w: SizeUInt;
+  b : byte;
+begin
+  if not assigned(Source) then
+  begin
+    result:=0;
+    exit;
+  end;
+  result:=SizeUInt(-1);
+  i:=0;
+  j:=0;
+  if assigned(Dest) then
+    begin
+      while (j<MaxDestChars) and (i<SourceBytes) do
+        begin
+          b:=byte(Source[i]);
+          w:=b;
+          inc(i);
+          // 2 or 3 bytes?
+          if b>=$80 then
+            begin
+              w:=b and $3f;
+              if i>=SourceBytes then
+                exit;
+              // 3 bytes?
+              if (b and $20)<>0 then
+                begin
+                  b:=byte(Source[i]);
+                  inc(i);
+                  if i>=SourceBytes then
+                    exit;
+                  if (b and $c0)<>$80 then
+                    exit;
+                  w:=(w shl 6) or (b and $3f);
+                end;
+              b:=byte(Source[i]);
+              w:=(w shl 6) or (b and $3f);
+              if (b and $c0)<>$80 then
+                exit;
+              inc(i);
+            end;
+          Dest[j]:=UnicodeChar(w);
+          inc(j);
+        end;
+      if j>=MaxDestChars then j:=MaxDestChars-1;
+      Dest[j]:=#0;
+    end
+  else
+    begin
+      while i<SourceBytes do
+        begin
+          b:=byte(Source[i]);
+          inc(i);
+          // 2 or 3 bytes?
+          if b>=$80 then
+            begin
+              if i>=SourceBytes then
+                exit;
+              // 3 bytes?
+              b := b and $3f;
+              if (b and $20)<>0 then
+                begin
+                  b:=byte(Source[i]);
+                  inc(i);
+                  if i>=SourceBytes then
+                    exit;
+                  if (b and $c0)<>$80 then
+                    exit;
+                end;
+              if (byte(Source[i]) and $c0)<>$80 then
+                exit;
+              inc(i);
+            end;
+          inc(j);
+        end;
+    end;
+  result:=j+1;
+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;
+
+
+{ 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 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.';
+
+procedure unimplementedunicodestring;
+  begin
+{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
+    If IsConsole then
+      begin
+      Writeln(StdErr,SNoUnicodestrings);
+      Writeln(StdErr,SRecompileWithUnicodestrings);
+      end;
+{$endif FPC_HAS_FEATURE_CONSOLEIO}
+    HandleErrorFrame(233,get_frame);
+  end;
+
+{$warnings off}
+function GenericUnicodeCase(const s : UnicodeString) : UnicodeString;
+  begin
+    unimplementedunicodestring;
+  end;
+
+
+function CompareUnicodeString(const s1, s2 : UnicodeString) : PtrInt;
+  begin
+    unimplementedunicodestring;
+  end;
+
+
+function CompareTextUnicodeString(const s1, s2 : UnicodeString): PtrInt;
+  begin
+    unimplementedunicodestring;
+  end;
+
+
+function CharLengthPChar(const Str: PChar): PtrInt;
+  begin
+    unimplementedunicodestring;
+  end;
+
+{$warnings on}
+
+procedure initunicodestringmanager;
+  begin
+{$ifndef HAS_WIDESTRINGMANAGER}
+    widestringmanager.Unicode2AnsiMoveProc:=@defaultUnicode2AnsiMove;
+    widestringmanager.Ansi2UnicodeMoveProc:=@defaultAnsi2UnicodeMove;
+    widestringmanager.UpperUnicodeStringProc:=@GenericUnicodeCase;
+    widestringmanager.LowerUnicodeStringProc:=@GenericUnicodeCase;
+{$endif HAS_WIDESTRINGMANAGER}
+    widestringmanager.CompareUnicodeStringProc:=@CompareUnicodeString;
+    widestringmanager.CompareTextUnicodeStringProc:=@CompareTextUnicodeString;
+
+{$ifdef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+{$ifndef HAS_WIDESTRINGMANAGER}
+    widestringmanager.Wide2AnsiMoveProc:=@defaultUnicode2AnsiMove;
+    widestringmanager.Ansi2WideMoveProc:=@defaultAnsi2UnicodeMove;
+    widestringmanager.UpperWideStringProc:=@GenericUnicodeCase;
+    widestringmanager.LowerWideStringProc:=@GenericUnicodeCase;
+{$endif HAS_WIDESTRINGMANAGER}
+    widestringmanager.CompareWideStringProc:=@CompareUnicodeString;
+    widestringmanager.CompareTextWideStringProc:=@CompareTextUnicodeString;
+    widestringmanager.CharLengthPCharProc:=@CharLengthPChar;
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+  end;
+

rtl/inc/variant.inc

@@ -225,24 +225,29 @@ end;
 { Strings }
 
 operator :=(const source : shortstring) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
-
 begin
   VariantManager.VarFromPStr(Dest,Source);
 end;
 
 
 operator :=(const source : ansistring) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
-
 begin
   VariantManager.VarFromLStr(Dest,Source);
 end;
 
 
 operator :=(const source : widestring) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+  VariantManager.VarFromWStr(Dest,Source);
+end;
 
+
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+operator :=(const source : UnicodeString) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
   VariantManager.VarFromWStr(Dest,Source);
 end;
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
 
 { Floats }
 
@@ -412,23 +417,34 @@ end;
 { Strings }
 
 operator :=(const source : variant) dest : shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
-
 begin
   VariantManager.VarToPStr(Dest,Source);
 end;
 
-operator :=(const source : variant) dest : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
 
+operator :=(const source : variant) dest : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
   VariantManager.vartolstr(dest,source);
 end;
 
-operator :=(const source : variant) dest : widestring;{$ifdef SYSTEMINLINE}inline;{$endif}
 
+operator :=(const source : variant) dest : widestring;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
   variantmanager.vartowstr(dest,source);
 end;
 
+
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+operator :=(const source : variant) dest : UnicodeString;{$ifdef SYSTEMINLINE}inline;{$endif}
+var
+  res : WideString;
+begin
+  variantmanager.vartowstr(res,source);
+  dest:=res;
+end;
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+
+
 { Floats }
 
 {$ifdef SUPPORT_SINGLE}
@@ -623,7 +639,7 @@ procedure VarArrayRedim(var A: Variant; HighBound: SizeInt);
 
 procedure VarArrayPut(var A: Variant; const Value: Variant; const Indices: array of SizeInt);
   begin
-    if Length(Indices)>0 then 
+    if Length(Indices)>0 then
       variantmanager.vararrayput(A, Value, Length(Indices), @Indices[0])
     else
       variantmanager.vararrayput(A, Value, 0, nil);
@@ -632,13 +648,13 @@ procedure VarArrayPut(var A: Variant; const Value: Variant; const Indices: array
 
 function VarArrayGet(const A: Variant; const Indices: array of SizeInt): Variant;
   begin
-    if Length(Indices)>0 then 
+    if Length(Indices)>0 then
       Result:=variantmanager.vararrayget(A, Length(Indices), @Indices[0])
-    else 
+    else
       Result:=variantmanager.vararrayget(A, 0, nil);
   end;
-  
- 
+
+
 procedure VarCast(var dest : variant;const source : variant;vartype : longint);
 
   begin
@@ -763,6 +779,16 @@ operator :=(const source : olevariant) dest : widestring;{$ifdef SYSTEMINLINE}in
   end;
 
 
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+operator :=(const source : olevariant) dest : UnicodeString;{$ifdef SYSTEMINLINE}inline;{$endif}
+  var
+    res : WideString;
+  begin
+    variantmanager.vartowstr(res,variant(tvardata(source)));
+    dest:=res;
+  end;
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+
 { Floats }
 {$ifdef SUPPORT_SINGLE}
 operator :=(const source : olevariant) dest : single;{$ifdef SYSTEMINLINE}inline;{$endif}
@@ -931,6 +957,14 @@ operator :=(const source : widestring) dest : olevariant;{$ifdef SYSTEMINLINE}in
   end;
 
 
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+operator :=(const source : UnicodeString) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    variantmanager.varfromwstr(variant(tvardata(dest)),source);
+  end;
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+
+
 { Floats }
 {$ifdef SUPPORT_SINGLE}
 operator :=(const source : single) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
@@ -1050,6 +1084,14 @@ Function Pos (w : WideString; Const v : Variant) : SizeInt;{$ifdef SYSTEMINLINE}
   end;
 
 
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+Function Pos (w : UnicodeString; Const v : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    Result:=Pos(w,UnicodeString(v));
+  end;
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+
+
 Function Pos (v : Variant; Const c : Char) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
     Result:=Pos(ShortString(v),c);
@@ -1074,6 +1116,14 @@ Function Pos (v : Variant; Const w : WideString) : SizeInt;{$ifdef SYSTEMINLINE}
   end;
 
 
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+Function Pos (v : Variant; Const w : UnicodeString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    Result:=Pos(UnicodeString(v),w);
+  end;
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
+
+
 Function Pos (v1 : Variant; Const v2 : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
     Result:=Pos(WideString(v1),WideString(v2));

rtl/inc/varianth.inc

@@ -243,6 +243,9 @@ operator :=(const source : widechar) dest : variant;{$ifdef SYSTEMINLINE}inline;
 operator :=(const source : shortstring) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator :=(const source : ansistring) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator :=(const source : widestring) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+operator :=(const source : UnicodeString) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
 
 { Floats }
 {$ifdef SUPPORT_SINGLE}
@@ -297,6 +300,9 @@ operator :=(const source : variant) dest : widechar;{$ifdef SYSTEMINLINE}inline;
 operator :=(const source : variant) dest : shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator :=(const source : variant) dest : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator :=(const source : variant) dest : widestring;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+operator :=(const source : variant) dest : unicodestring;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
 
 { Floats }
 {$ifdef SUPPORT_SINGLE}
@@ -388,6 +394,9 @@ operator :=(const source : olevariant) dest : widechar;{$ifdef SYSTEMINLINE}inli
 operator :=(const source : olevariant) dest : shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator :=(const source : olevariant) dest : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator :=(const source : olevariant) dest : widestring;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+operator :=(const source : olevariant) dest : UnicodeString;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
 
 { Floats }
 {$ifdef SUPPORT_SINGLE}
@@ -442,6 +451,9 @@ operator :=(const source : widechar) dest : olevariant;{$ifdef SYSTEMINLINE}inli
 operator :=(const source : shortstring) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator :=(const source : ansistring) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator :=(const source : widestring) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+operator :=(const source : UnicodeString) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
 
 { Floats }
 {$ifdef SUPPORT_SINGLE}
@@ -474,10 +486,16 @@ Function Pos (c : Char; Const v : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline
 Function Pos (s : ShortString; Const v : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
 Function Pos (a : AnsiString; Const v : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
 Function Pos (w : WideString; Const v : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+Function Pos (w : UnicodeString; Const v : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
 Function Pos (v : Variant; Const c : Char) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
 Function Pos (v : Variant; Const s : ShortString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
 Function Pos (v : Variant; Const a : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
 Function Pos (v : Variant; Const w : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
+Function Pos (v : Variant; Const w : UnicodeString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
 Function Pos (v1 : Variant; Const v2 : Variant) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
 
 {**********************************************************************

rtl/inc/wstring22h.inc

@@ -0,0 +1,108 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2005 by Florian Klaempfl,
+    member of the Free Pascal development team.
+
+    This file implements support routines for WideStrings with FPC 2.2
+
+    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.
+
+ **********************************************************************}
+
+{ this file can be removed when the 2.2.x series is outdated }
+
+Procedure UniqueString (Var S : WideString);external name 'FPC_WIDESTR_UNIQUE';
+Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
+Function Pos (c : Char; Const s : WideString) : SizeInt;
+Function Pos (c : WideChar; Const s : WideString) : SizeInt;
+Function Pos (c : WideChar; Const s : AnsiString) : SizeInt;
+Function Pos (c : AnsiString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Pos (c : WideString; Const s : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Pos (c : ShortString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+Function UpCase(const s : WideString) : WideString;
+
+Procedure Insert (Const Source : WideString; Var S : WideString; Index : SizeInt);
+Procedure Delete (Var S : WideString; Index,Size: SizeInt);
+Procedure SetString (Out S : WideString; Buf : PWideChar; Len : SizeInt);
+Procedure SetString (Out S : WideString; 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);
+
+procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
+procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
+
+Type
+  { hooks for internationalization
+    please add new procedures at the end, it makes it easier to detect new procedures }
+  TWideStringManager = record
+    Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;len:SizeInt);
+    Ansi2WideMoveProc : procedure(source:pchar;var dest:widestring;len:SizeInt);
+
+//    UpperUTF8 : procedure(p:PUTF8String);
+
+    UpperWideStringProc : function(const S: WideString): WideString;
+//    UpperUCS4 : procedure(p:PUCS4Char);
+//    LowerUTF8 : procedure(p:PUTF8String);
+    LowerWideStringProc : function(const S: WideString): WideString;
+//    LowerUCS4 : procedure(p:PUCS4Char);
+{
+    CompUTF8 : function(p1,p2:PUTF8String) : shortint;
+    CompUCS2 : function(p1,p2:PUCS2Char) : shortint;
+    CompUCS4 : function(p1,p2:PUC42Char) : shortint;
+}
+    CompareWideStringProc : function(const s1, s2 : WideString) : PtrInt;
+    CompareTextWideStringProc : function(const s1, s2 : WideString): PtrInt;
+    CharLengthPCharProc : function(const Str: PChar): PtrInt;
+
+    UpperAnsiStringProc : function(const s : ansistring) : ansistring;
+    LowerAnsiStringProc : function(const s : ansistring) : ansistring;
+    CompareStrAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
+    CompareTextAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
+    StrCompAnsiStringProc : function(S1, S2: PChar): PtrInt;
+    StrICompAnsiStringProc : function(S1, S2: PChar): PtrInt;
+    StrLCompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+    StrLICompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+    StrLowerAnsiStringProc : function(Str: PChar): PChar;
+    StrUpperAnsiStringProc : function(Str: PChar): PChar;
+    ThreadInitProc : procedure;
+    ThreadFiniProc : procedure;
+  end;
+  TUnicodeStringManager = TWideStringManager;
+
+function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PWideChar; SourceChars: SizeUInt): SizeUInt;
+function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
+function UTF8Encode(const s : WideString) : UTF8String;
+function UTF8Decode(const s : UTF8String): WideString;
+function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
+function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
+function WideStringToUCS4String(const s : WideString) : UCS4String;
+function UCS4StringToWideString(const s : UCS4String) : WideString;
+
+{$ifdef MSWINDOWS}
+const
+  winwidestringalloc : boolean = true;
+{$endif MSWINDOWS}
+
+var
+  widestringmanager : TWideStringManager;
+
+Procedure GetWideStringManager (Var Manager : TWideStringManager);
+Procedure SetWideStringManager (Const New : TWideStringManager);
+Procedure SetWideStringManager (Const New : TWideStringManager; Var Old: TWideStringManager);
+
+Procedure GetUnicodeStringManager (Var Manager : TUnicodeStringManager);
+Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager);
+Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
+

rtl/inc/wstringh.inc

@@ -31,73 +31,20 @@ Procedure Delete (Var S : WideString; Index,Size: SizeInt);
 Procedure SetString (Out S : WideString; Buf : PWideChar; Len : SizeInt);
 Procedure SetString (Out S : WideString; 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);
-
 procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
 procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
 
-Type
-  { hooks for internationalization
-    please add new procedures at the end, it makes it easier to detect new procedures }
-  TWideStringManager = record
-    Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;len:SizeInt);
-    Ansi2WideMoveProc : procedure(source:pchar;var dest:widestring;len:SizeInt);
-
-//    UpperUTF8 : procedure(p:PUTF8String);
-
-    UpperWideStringProc : function(const S: WideString): WideString;
-//    UpperUCS4 : procedure(p:PUCS4Char);
-//    LowerUTF8 : procedure(p:PUTF8String);
-    LowerWideStringProc : function(const S: WideString): WideString;
-//    LowerUCS4 : procedure(p:PUCS4Char);
-{
-    CompUTF8 : function(p1,p2:PUTF8String) : shortint;
-    CompUCS2 : function(p1,p2:PUCS2Char) : shortint;
-    CompUCS4 : function(p1,p2:PUC42Char) : shortint;
-}
-    CompareWideStringProc : function(const s1, s2 : WideString) : PtrInt;
-    CompareTextWideStringProc : function(const s1, s2 : WideString): PtrInt;
-    CharLengthPCharProc : function(const Str: PChar): PtrInt;
-
-    UpperAnsiStringProc : function(const s : ansistring) : ansistring;
-    LowerAnsiStringProc : function(const s : ansistring) : ansistring;
-    CompareStrAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
-    CompareTextAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
-    StrCompAnsiStringProc : function(S1, S2: PChar): PtrInt;
-    StrICompAnsiStringProc : function(S1, S2: PChar): PtrInt;
-    StrLCompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
-    StrLICompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
-    StrLowerAnsiStringProc : function(Str: PChar): PChar;
-    StrUpperAnsiStringProc : function(Str: PChar): PChar;
-    ThreadInitProc : procedure;
-    ThreadFiniProc : procedure;
-  end;
-
+type
+  TWideStringManager = TUnicodeStringManager;
 
 function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
 function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PWideChar; SourceChars: SizeUInt): SizeUInt;
 function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
 function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
 function UTF8Encode(const s : WideString) : UTF8String;
-function UTF8Decode(const s : UTF8String): WideString;
-function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
-function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
-function WideStringToUCS4String(const s : WideString) : UCS4String;
-function UCS4StringToWideString(const s : UCS4String) : WideString;
 
 {$ifdef MSWINDOWS}
 const
   winwidestringalloc : boolean = true;
 {$endif MSWINDOWS}
 
-var
-  widestringmanager : TWideStringManager;
-
-Procedure GetWideStringManager (Var Manager : TWideStringManager);
-Procedure SetWideStringManager (Const New : TWideStringManager);
-Procedure SetWideStringManager (Const New : TWideStringManager; Var Old: TWideStringManager);
-

rtl/inc/wstrings.inc

@@ -1,17 +1,1501 @@
-{
-    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 WideStrings 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 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 WideStrings 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.
+
+ **********************************************************************}
+
+{
+  This file contains the implementation of the WideString type,
+  and all things that are needed for it.
+  WideString is defined as a 'silent' pwidechar :
+  a pwidechar that points to :
+
+  @-8  : SizeInt for reference count;
+  @-4  : SizeInt for size; size=number of bytes, not the number of chars. Divide or multiply
+         with sizeof(WideChar) to convert. This is needed to be compatible with Delphi and
+         Windows COM BSTR.
+  @    : String + Terminating #0;
+  Pwidechar(Widestring) is a valid typecast.
+  So WS[i] is converted to the address @WS+i-1.
+
+  Constants should be assigned a reference count of -1
+  Meaning that they can't be disposed of.
+}
+
+Type
+  PWideRec = ^TWideRec;
+  TWideRec = Packed Record
+    Len   : DWord;
+    First : WideChar;
+  end;
+
+Const
+  WideRecLen = SizeOf(TWideRec);
+  WideFirstOff = SizeOf(TWideRec)-sizeof(WideChar);
+
+{
+  Default WideChar <-> Char conversion is to only convert the
+  lower 127 chars, all others are translated to spaces.
+
+  These routines can be overwritten for the Current Locale
+}
+
+procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
+var
+  i : SizeInt;
+begin
+  setlength(dest,len);
+  for i:=1 to len do
+    begin
+      if word(source^)<256 then
+        dest[i]:=char(word(source^))
+      else
+        dest[i]:='?';
+      inc(source);
+    end;
+end;
+
+
+procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
+var
+  i : SizeInt;
+begin
+  setlength(dest,len);
+  for i:=1 to len do
+    begin
+      dest[i]:=widechar(byte(source^));
+      inc(source);
+    end;
+end;
+
+
+(*
+Procedure UniqueWideString(Var S : WideString); [Public,Alias : 'FPC_WIDESTR_UNIQUE'];
+{
+  Make sure reference count of S is 1,
+  using copy-on-write semantics.
+}
+
+begin
+end;
+*)
+
+
+{****************************************************************************
+                    Internal functions, not in interface.
+****************************************************************************}
+
+
+procedure WideStringError;
+  begin
+    HandleErrorFrame(204,get_frame);
+  end;
+
+
+{$ifdef WideStrDebug}
+Procedure DumpWideRec(S : Pointer);
+begin
+  If S=Nil then
+    Writeln ('String is nil')
+  Else
+    Begin
+      With PWideRec(S-WideFirstOff)^ do
+       begin
+         Write   ('(Len:',len);
+         Writeln (' Ref: ',ref,')');
+       end;
+    end;
+end;
+{$endif}
+
+
+Function NewWideString(Len : SizeInt) : Pointer;
+{
+  Allocate a new WideString on the heap.
+  initialize it to zero length and reference count 1.
+}
+Var
+  P : Pointer;
+begin
+{$ifdef MSWINDOWS}
+  if winwidestringalloc then
+    begin
+      P:=SysAllocStringLen(nil,Len);
+      if P=nil then
+        WideStringError;
+    end
+  else
+{$endif MSWINDOWS}
+    begin
+      GetMem(P,Len*sizeof(WideChar)+WideRecLen);
+      If P<>Nil then
+        begin
+         PWideRec(P)^.Len:=Len*2;     { Initial length }
+         PWideRec(P)^.First:=#0;      { Terminating #0 }
+         inc(p,WideFirstOff);         { Points to string now }
+        end
+      else
+        WideStringError;
+    end;
+  NewWideString:=P;
+end;
+
+
+Procedure DisposeWideString(Var S : Pointer);
+{
+  Deallocates a WideString From the heap.
+}
+begin
+  If S=Nil then
+    exit;
+{$ifndef MSWINDOWS}
+  Dec (S,WideFirstOff);
+  Freemem(S);
+{$else MSWINDOWS}
+  if winwidestringalloc then
+    SysFreeString(S)
+  else
+    begin
+      Dec (S,WideFirstOff);
+      Freemem(S);
+    end;
+{$endif MSWINDOWS}
+  S:=Nil;
+end;
+
+var
+  __data_start: byte; external name '__data_start__';
+  __data_end: byte; external name '__data_end__';
+
+function IsWideStringConstant(S: pointer): boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
+{
+  Returns True if widestring is constant (located in .data section);
+}
+begin
+  Result:=(S>=@__data_start) and (S<@__data_end);
+end;
+
+Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);[Public,Alias:'FPC_WIDESTR_DECR_REF']; compilerproc;
+{
+  Decreases the ReferenceCount of a non constant widestring;
+  If the reference count is zero, deallocate the string;
+}
+Type
+  pSizeInt = ^SizeInt;
+Begin
+  { Zero string }
+  if S=Nil then
+    exit;
+  if not IsWideStringConstant(S) then
+    DisposeWideString(S);
+end;
+
+{ alias for internal use }
+Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);[external name 'FPC_WIDESTR_DECR_REF'];
+
+Procedure fpc_WideStr_Incr_Ref(Var S : Pointer);[Public,Alias:'FPC_WIDESTR_INCR_REF']; compilerproc;
+  var
+    p : pointer;
+  Begin
+    If S=Nil then
+      exit;
+    p:=NewWidestring(length(WideString(S)));
+    move(s^,p^,(length(WideString(s))+1)*sizeof(widechar)); // double #0 too
+    s:=p;
+  end;
+
+{ alias for internal use }
+Procedure fpc_WideStr_Incr_Ref (Var S : Pointer);[external name 'FPC_WIDESTR_INCR_REF'];
+
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): shortstring;[Public, alias: 'FPC_WIDESTR_TO_SHORTSTR'];  compilerproc;
+{
+  Converts a WideString to a ShortString;
+}
+Var
+  Size : SizeInt;
+  temp : ansistring;
+begin
+  result:='';
+  Size:=Length(S2);
+  if Size>0 then
+    begin
+      If Size>high_of_res then
+        Size:=high_of_res;
+      widestringmanager.Wide2AnsiMoveProc(PWideChar(S2),temp,Size);
+      result:=temp;
+    end;
+end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_WideStr_To_ShortStr (out res: ShortString;const S2 : WideString); [Public, alias: 'FPC_WIDESTR_TO_SHORTSTR'];compilerproc;
+{
+  Converts a WideString 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.Wide2AnsiMoveProc(PWideChar(S2),temp,Size);
+      res:=temp;
+    end;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+
+Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString;compilerproc;
+{
+  Converts a ShortString to a WideString;
+}
+Var
+  Size : SizeInt;
+begin
+  result:='';
+  Size:=Length(S2);
+  if Size>0 then
+    begin
+      widestringmanager.Ansi2WideMoveProc(PChar(@S2[1]),result,Size);
+      { Terminating Zero }
+      PWideChar(Pointer(fpc_ShortStr_To_WideStr)+Size*sizeof(WideChar))^:=#0;
+    end;
+end;
+
+
+Function fpc_WideStr_To_AnsiStr (const S2 : WideString): AnsiString; compilerproc;
+{
+  Converts a WideString to an AnsiString
+}
+Var
+  Size : SizeInt;
+begin
+  result:='';
+  Size:=Length(S2);
+  if Size>0 then
+    widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),result,Size);
+end;
+
+
+Function fpc_AnsiStr_To_WideStr (Const S2 : AnsiString): WideString; compilerproc;
+{
+  Converts an AnsiString to a WideString;
+}
+Var
+  Size : SizeInt;
+begin
+  result:='';
+  Size:=Length(S2);
+  if Size>0 then
+    widestringmanager.Ansi2WideMoveProc(PChar(S2),result,Size);
+end;
+
+
+Function fpc_PWideChar_To_WideStr(const p : pwidechar): widestring; compilerproc;
+var
+  Size : SizeInt;
+begin
+  result:='';
+  if p=nil then
+    exit;
+  Size := IndexWord(p^, -1, 0);
+  Setlength(result,Size);
+  if Size>0 then
+   begin
+      Move(p^,PWideChar(Pointer(result))^,Size*sizeof(WideChar));
+      { Terminating Zero }
+      PWideChar(Pointer(result)+Size*sizeof(WideChar))^:=#0;
+   end;
+end;
+
+
+{ checked against the ansistring routine, 2001-05-27 (FK) }
+Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_WIDESTR_ASSIGN']; compilerproc;
+{
+  Assigns S2 to S1 (S1:=S2), taking in account reference counts.
+}
+begin
+  if S1=S2 then exit;
+  if S2<>nil then
+    begin
+      if IsWideStringConstant(S1) then
+        begin
+          S1:=NewWidestring(length(WideString(S2)));
+          move(s2^,s1^,(length(WideString(s1))+1)*sizeof(widechar));
+        end
+      else
+{$ifdef MSWINDOWS}
+        if winwidestringalloc then
+          begin
+            if SysReAllocStringLen(S1, S2, Length(WideString(S2))) = 0 then
+              WideStringError;
+          end
+        else
+{$endif MSWINDOWS}
+          begin
+            SetLength(WideString(S1),length(WideString(S2)));
+            move(s2^,s1^,(length(WideString(s1))+1)*sizeof(widechar));
+          end;
+    end
+  else
+    begin
+      { Free S1 }
+      fpc_widestr_decr_ref (S1);
+      S1:=nil;
+    end;
+end;
+
+
+{ alias for internal use }
+Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_WIDESTR_ASSIGN'];
+
+{$ifndef STR_CONCAT_PROCS}
+
+function fpc_WideStr_Concat (const S1,S2 : WideString): WideString; compilerproc;
+Var
+  Size,Location : SizeInt;
+  pc : pwidechar;
+begin
+  { only assign if s1 or s2 is empty }
+  if (S1='') then
+    begin
+      result:=s2;
+      exit;
+    end;
+  if (S2='') then
+    begin
+      result:=s1;
+      exit;
+    end;
+  Location:=Length(S1);
+  Size:=length(S2);
+  SetLength(result,Size+Location);
+  pc:=pwidechar(result);
+  Move(S1[1],pc^,Location*sizeof(WideChar));
+  inc(pc,location);
+  Move(S2[1],pc^,(Size+1)*sizeof(WideChar));
+end;
+
+
+function fpc_WideStr_Concat_multi (const sarr:array of Widestring): widestring; compilerproc;
+Var
+  i  : Longint;
+  p  : pointer;
+  pc : pwidechar;
+  Size,NewSize : SizeInt;
+begin
+  { First calculate size of the result so we can do
+    a single call to SetLength() }
+  NewSize:=0;
+  for i:=low(sarr) to high(sarr) do
+    inc(Newsize,length(sarr[i]));
+  SetLength(result,NewSize);
+  pc:=pwidechar(result);
+  for i:=low(sarr) to high(sarr) do
+    begin
+      p:=pointer(sarr[i]);
+      if assigned(p) then
+        begin
+          Size:=length(widestring(p));
+          Move(pwidechar(p)^,pc^,(Size+1)*sizeof(WideChar));
+          inc(pc,size);
+        end;
+    end;
+end;
+
+{$else STR_CONCAT_PROCS}
+
+procedure fpc_WideStr_Concat (var DestS:Widestring;const S1,S2 : WideString); compilerproc;
+Var
+  Size,Location : SizeInt;
+  same : boolean;
+begin
+  { only assign if s1 or s2 is empty }
+  if (S1='') then
+    begin
+      DestS:=s2;
+      exit;
+    end;
+  if (S2='') then
+    begin
+      DestS:=s1;
+      exit;
+    end;
+  Location:=Length(S1);
+  Size:=length(S2);
+  { Use Pointer() typecasts to prevent extra conversion code }
+  if Pointer(DestS)=Pointer(S1) then
+    begin
+      same:=Pointer(S1)=Pointer(S2);
+      SetLength(DestS,Size+Location);
+      if same then
+        Move(Pointer(DestS)^,(Pointer(DestS)+Location*sizeof(WideChar))^,(Size)*sizeof(WideChar))
+      else
+        Move(Pointer(S2)^,(Pointer(DestS)+Location*sizeof(WideChar))^,(Size+1)*sizeof(WideChar));
+    end
+  else if Pointer(DestS)=Pointer(S2) then
+    begin
+      SetLength(DestS,Size+Location);
+      Move(Pointer(DestS)^,(Pointer(DestS)+Location*sizeof(WideChar))^,(Size+1)*sizeof(WideChar));
+      Move(Pointer(S1)^,Pointer(DestS)^,Location*sizeof(WideChar));
+    end
+  else
+    begin
+      DestS:='';
+      SetLength(DestS,Size+Location);
+      Move(Pointer(S1)^,Pointer(DestS)^,Location*sizeof(WideChar));
+      Move(Pointer(S2)^,(Pointer(DestS)+Location*sizeof(WideChar))^,(Size+1)*sizeof(WideChar));
+    end;
+end;
+
+
+procedure fpc_WideStr_Concat_multi (var DestS:Widestring;const sarr:array of Widestring); compilerproc;
+Var
+  i           : Longint;
+  p,pc        : pointer;
+  Size,NewLen : SizeInt;
+  DestTmp     : Widestring;
+begin
+  if high(sarr)=0 then
+    begin
+      DestS:='';
+      exit;
+    end;
+  { First calculate size of the result so we can do
+    a single call to SetLength() }
+  NewLen:=0;
+  for i:=low(sarr) to high(sarr) do
+    inc(NewLen,length(sarr[i]));
+  SetLength(DestTmp,NewLen);
+  pc:=pwidechar(DestTmp);
+  for i:=low(sarr) to high(sarr) do
+    begin
+      p:=pointer(sarr[i]);
+      if assigned(p) then
+        begin
+          Size:=length(widestring(p));
+          Move(p^,pc^,(Size+1)*sizeof(WideChar));
+          inc(pc,size*sizeof(WideChar));
+        end;
+    end;
+  DestS:=DestTmp;
+end;
+
+{$endif STR_CONCAT_PROCS}
+
+
+Function fpc_Char_To_WideStr(const c : Char): WideString; compilerproc;
+{
+  Converts a Char to a WideString;
+}
+begin
+  Setlength(fpc_Char_To_WideStr,1);
+  fpc_Char_To_WideStr[1]:=c;
+  { Terminating Zero }
+  PWideChar(Pointer(fpc_Char_To_WideStr)+sizeof(WideChar))^:=#0;
+end;
+
+
+Function fpc_WChar_To_WideStr(const c : WideChar): WideString; compilerproc;
+{
+  Converts a WideChar to a WideString;
+}
+begin
+  Setlength (fpc_WChar_To_WideStr,1);
+  fpc_WChar_To_WideStr[1]:= c;
+end;
+
+
+Function fpc_WChar_To_AnsiStr(const c : WideChar): AnsiString; compilerproc;
+{
+  Converts a WideChar to a AnsiString;
+}
+begin
+  widestringmanager.Wide2AnsiMoveProc(@c, fpc_WChar_To_AnsiStr, 1);
+end;
+
+
+Function fpc_UChar_To_WideStr(const c : WideChar): WideString; compilerproc;
+{
+  Converts a WideChar to a WideString;
+}
+begin
+  Setlength (fpc_UChar_To_WideStr,1);
+  fpc_UChar_To_WideStr[1]:= c;
+end;
+
+
+Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
+Var
+  L : SizeInt;
+begin
+  if (not assigned(p)) or (p[0]=#0) Then
+  begin
+    fpc_pchar_to_widestr := '';
+    exit;
+  end;
+  l:=IndexChar(p^,-1,#0);
+  widestringmanager.Ansi2WideMoveProc(P,fpc_PChar_To_WideStr,l);
+end;
+
+
+Function fpc_CharArray_To_WideStr(const arr: array of char; zerobased: boolean = true): WideString; compilerproc;
+var
+  i  : SizeInt;
+begin
+  if (zerobased) then
+    begin
+      if (arr[0]=#0) Then
+      begin
+        fpc_chararray_to_widestr := '';
+        exit;
+      end;
+      i:=IndexChar(arr,high(arr)+1,#0);
+      if i = -1 then
+        i := high(arr)+1;
+    end
+  else
+    i := high(arr)+1;
+  SetLength(fpc_CharArray_To_WideStr,i);
+  widestringmanager.Ansi2WideMoveProc (pchar(@arr),fpc_CharArray_To_WideStr,i);
+end;
+
+
+{$ifndef FPC_STRTOCHARARRAYPROC}
+
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ chararray we're converting to (JM)                                    }
+function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray;[public,alias: 'FPC_WIDESTR_TO_CHARARRAY']; compilerproc;
+var
+  len: SizeInt;
+  temp: ansistring;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),temp,len);
+  len := length(temp);
+  if len > arraysize then
+    len := arraysize;
+{$r-}
+  move(temp[1],fpc_widestr_to_chararray[0],len);
+  fillchar(fpc_widestr_to_chararray[len],arraysize-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ widechararray we're converting to (JM)                                }
+function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray;[public,alias: 'FPC_WIDESTR_TO_WIDECHARARRAY']; compilerproc;
+var
+  len: SizeInt;
+begin
+  len := length(src);
+  if len > arraysize then
+    len := arraysize;
+{$r-}
+  { make sure we don't try to access element 1 of the ansistring if it's nil }
+  if len > 0 then
+    move(src[1],fpc_widestr_to_widechararray[0],len*SizeOf(WideChar));
+  fillchar(fpc_widestr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ chararray we're converting to (JM)                                    }
+function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray;[public,alias: 'FPC_ANSISTR_TO_WIDECHARARRAY']; 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 > arraysize then
+    len := arraysize;
+
+{$r-}
+  move(temp[1],fpc_ansistr_to_widechararray[0],len*sizeof(widechar));
+  fillchar(fpc_ansistr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray;[public,alias: 'FPC_SHORTSTR_TO_WIDECHARARRAY']; 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 > arraysize then
+    len := arraysize;
+{$r-}
+  move(temp[1],fpc_shortstr_to_widechararray[0],len*sizeof(widechar));
+  fillchar(fpc_shortstr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+{$else ndef FPC_STRTOCHARARRAYPROC}
+
+procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); compilerproc;
+var
+  len: SizeInt;
+  temp: ansistring;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),temp,len);
+  len := length(temp);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  move(temp[1],res[0],len);
+  fillchar(res[len],length(res)-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc;
+var
+  len: SizeInt;
+begin
+  len := length(src);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  { make sure we don't try to access element 1 of the ansistring if it's nil }
+  if len > 0 then
+    move(src[1],res[0],len*SizeOf(WideChar));
+  fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+
+Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE']; compilerproc;
+{
+  Compares 2 WideStrings;
+  The result is
+   <0 if S1<S2
+   0 if S1=S2
+   >0 if S1>S2
+}
+Var
+  MaxI,Temp : SizeInt;
+begin
+  if pointer(S1)=pointer(S2) then
+   begin
+     fpc_WideStr_Compare:=0;
+     exit;
+   end;
+  Maxi:=Length(S1);
+  temp:=Length(S2);
+  If MaxI>Temp then
+   MaxI:=Temp;
+  Temp:=CompareWord(S1[1],S2[1],MaxI);
+  if temp=0 then
+   temp:=Length(S1)-Length(S2);
+  fpc_WideStr_Compare:=Temp;
+end;
+
+Function fpc_WideStr_Compare_Equal(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE_EQUAL']; compilerproc;
+{
+  Compares 2 WideStrings for equality only;
+  The result is
+   0 if S1=S2
+   <>0 if S1<>S2
+}
+Var
+  MaxI : SizeInt;
+begin
+  if pointer(S1)=pointer(S2) then
+    exit(0);
+  Maxi:=Length(S1);
+  If MaxI<>Length(S2) then
+    exit(-1)
+  else
+    exit(CompareWord(S1[1],S2[1],MaxI));
+end;
+
+Procedure fpc_WideStr_CheckZero(p : pointer);[Public,Alias : 'FPC_WIDESTR_CHECKZERO']; compilerproc;
+begin
+  if p=nil then
+    HandleErrorFrame(201,get_frame);
+end;
+
+
+Procedure fpc_WideStr_CheckRange(len,index : SizeInt);[Public,Alias : 'FPC_WIDESTR_RANGECHECK']; compilerproc;
+begin
+  if (index>len div 2) or (Index<1) then
+    HandleErrorFrame(201,get_frame);
+end;
+
+Procedure fpc_WideStr_SetLength(Var S : WideString; l : SizeInt);[Public,Alias : 'FPC_WIDESTR_SETLENGTH']; compilerproc;
+{
+  Sets The length of string S to L.
+  Makes sure S is unique, and contains enough room.
+}
+Var
+  Temp : Pointer;
+  movelen: SizeInt;
+begin
+   if (l>0) then
+    begin
+      if Pointer(S)=nil then
+       begin
+         { Need a complete new string...}
+         Pointer(s):=NewWideString(l);
+       end
+      { windows doesn't support reallocing widestrings, this code
+        is anyways subject to be removed because widestrings shouldn't be
+        ref. counted anymore (FK) }
+      else
+        if
+{$ifdef MSWINDOWS}
+              not winwidestringalloc and
+{$endif MSWINDOWS}
+              not IsWideStringConstant(pointer(S))
+              then
+        begin
+          Dec(Pointer(S),WideFirstOff);
+          if SizeUInt(L*sizeof(WideChar)+WideRecLen)>MemSize(Pointer(S)) then
+              reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
+          Inc(Pointer(S), WideFirstOff);
+        end
+      else
+        begin
+          { Reallocation is needed... }
+          Temp:=Pointer(NewWideString(L));
+          if Length(S)>0 then
+            begin
+              if l < succ(length(s)) then
+                movelen := l
+              { also move terminating null }
+              else
+                movelen := succ(length(s));
+              Move(Pointer(S)^,Temp^,movelen * Sizeof(WideChar));
+            end;
+          fpc_widestr_decr_ref(Pointer(S));
+          Pointer(S):=Temp;
+        end;
+      { Force nil termination in case it gets shorter }
+      PWord(Pointer(S)+l*sizeof(WideChar))^:=0;
+{$ifdef MSWINDOWS}
+      if not winwidestringalloc then
+{$endif MSWINDOWS}
+        PWideRec(Pointer(S)-WideFirstOff)^.Len:=l*sizeof(WideChar);
+    end
+  else
+    begin
+      { Length=0 }
+      if Pointer(S)<>nil then
+        fpc_widestr_decr_ref (Pointer(S));
+      Pointer(S):=Nil;
+    end;
+end;
+
+{*****************************************************************************
+                     Public functions, In interface.
+*****************************************************************************}
+
+Function fpc_widestr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_WIDESTR_UNIQUE']; compilerproc;
+  begin
+    pointer(result) := pointer(s);
+  end;
+
+
+Function Fpc_WideStr_Copy (Const S : WideString; Index,Size : SizeInt) : WideString;compilerproc;
+var
+  ResultAddress : Pointer;
+begin
+  ResultAddress:=Nil;
+  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
+   begin
+     If Index<0 Then
+      Index:=0;
+     ResultAddress:=Pointer(NewWideString (Size));
+     if ResultAddress<>Nil then
+      begin
+        Move (PWideChar(S)[Index],ResultAddress^,Size*sizeof(WideChar));
+        PWideRec(ResultAddress-WideFirstOff)^.Len:=Size*sizeof(WideChar);
+        PWideChar(ResultAddress+Size*sizeof(WideChar))^:=#0;
+      end;
+   end;
+  fpc_widestr_decr_ref(Pointer(fpc_widestr_copy));
+  Pointer(fpc_widestr_Copy):=ResultAddress;
+end;
+
+
+Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
+var
+  i,MaxLen : SizeInt;
+  pc : pwidechar;
+begin
+  Pos:=0;
+  if Length(SubStr)>0 then
+   begin
+     MaxLen:=Length(source)-Length(SubStr);
+     i:=0;
+     pc:=@source[1];
+     while (i<=MaxLen) do
+      begin
+        inc(i);
+        if (SubStr[1]=pc^) and
+           (CompareWord(Substr[1],pc^,Length(SubStr))=0) then
+         begin
+           Pos:=i;
+           exit;
+         end;
+        inc(pc);
+      end;
+   end;
+end;
+
+
+{ Faster version for a widechar alone }
+Function Pos (c : WideChar; Const s : WideString) : SizeInt;
+var
+  i: SizeInt;
+  pc : pwidechar;
+begin
+  pc:=@s[1];
+  for i:=1 to length(s) do
+   begin
+     if pc^=c then
+      begin
+        pos:=i;
+        exit;
+      end;
+     inc(pc);
+   end;
+  pos:=0;
+end;
+
+
+Function Pos (c : WideChar; Const s : AnsiString) : SizeInt;
+  begin
+    result:=Pos(c,WideString(s));
+  end;
+
+
+Function Pos (c : AnsiString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    result:=Pos(WideString(c),s);
+  end;
+
+
+Function Pos (c : ShortString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    result:=Pos(WideString(c),s);
+  end;
+
+
+Function Pos (c : WideString; Const s : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    result:=Pos(c,WideString(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 : Char; Const s : WideString) : SizeInt;
+var
+  i: SizeInt;
+  wc : widechar;
+  pc : pwidechar;
+begin
+  wc:=c;
+  pc:=@s[1];
+  for i:=1 to length(s) do
+   begin
+     if pc^=wc then
+      begin
+        pos:=i;
+        exit;
+      end;
+     inc(pc);
+   end;
+  pos:=0;
+end;
+
+
+
+Procedure Delete (Var S : WideString; Index,Size: SizeInt);
+Var
+  LS : SizeInt;
+begin
+  If Length(S)=0 then
+   exit;
+  if index<=0 then
+   exit;
+  LS:=PWideRec(Pointer(S)-WideFirstOff)^.Len div sizeof(WideChar);
+  if (Index<=LS) and (Size>0) then
+   begin
+     UniqueString (S);
+     if Size+Index>LS then
+      Size:=LS-Index+1;
+     if Index+Size<=LS then
+      begin
+        Dec(Index);
+        Move(PWideChar(S)[Index+Size],PWideChar(S)[Index],(LS-Index-Size+1)*sizeof(WideChar));
+      end;
+     Setlength(s,LS-Size);
+   end;
+end;
+
+
+Procedure Insert (Const Source : WideString; Var S : WideString; Index : SizeInt);
+var
+  Temp : WideString;
+  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) := NewWideString(Length(Source)+LS);
+  SetLength(Temp,Length(Source)+LS);
+  If Index>0 then
+    move (PWideChar(S)^,PWideChar(Temp)^,Index*sizeof(WideChar));
+  Move (PWideChar(Source)^,PWideChar(Temp)[Index],Length(Source)*sizeof(WideChar));
+  If (LS-Index)>0 then
+    Move(PWideChar(S)[Index],PWideChar(temp)[Length(Source)+index],(LS-Index)*sizeof(WideChar));
+  S:=Temp;
+end;
+
+
+function UpCase(const s : WideString) : WideString;
+begin
+  result:=widestringmanager.UpperWideStringProc(s);
+end;
+
+
+Procedure SetString (Out S : WideString; Buf : PWideChar; Len : SizeInt);
+var
+  BufLen: SizeInt;
+begin
+  SetLength(S,Len);
+  If (Buf<>Nil) and (Len>0) then
+    begin
+      BufLen := IndexWord(Buf^, Len+1, 0);
+      If (BufLen>0) and (BufLen < Len) then
+        Len := BufLen;
+      Move (Buf[0],S[1],Len*sizeof(WideChar));
+      PWideChar(Pointer(S)+Len*sizeof(WideChar))^:=#0;
+    end;
+end;
+
+
+Procedure SetString (Out S : WideString; Buf : PChar; Len : SizeInt);
+var
+  BufLen: SizeInt;
+begin
+  SetLength(S,Len);
+  If (Buf<>Nil) and (Len>0) then
+    begin
+      BufLen := IndexByte(Buf^, Len+1, 0);
+      If (BufLen>0) and (BufLen < Len) then
+        Len := BufLen;
+      widestringmanager.Ansi2WideMoveProc(Buf,S,Len);
+      //PWideChar(Pointer(S)+Len*sizeof(WideChar))^:=#0;
+    end;
+end;
+
+
+{$ifndef FPUNONE}
+Function fpc_Val_Real_WideStr(Const S : WideString; out Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_WIDESTR']; compilerproc;
+Var
+  SS : String;
+begin
+  fpc_Val_Real_WideStr := 0;
+  if length(S) > 255 then
+    code := 256
+  else
+    begin
+      SS := S;
+      Val(SS,fpc_Val_Real_WideStr,code);
+    end;
+end;
+{$endif}
+
+function fpc_val_enum_widestr(str2ordindex:pointer;const s:widestring;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_widestr,code);
+    end;
+end;
+
+Function fpc_Val_Currency_WideStr(Const S : WideString; out Code : ValSInt): Currency; [public, alias:'FPC_VAL_CURRENCY_WIDESTR']; compilerproc;
+Var
+  SS : String;
+begin
+  if length(S) > 255 then
+    begin
+      fpc_Val_Currency_WideStr:=0;
+      code := 256;
+    end
+  else
+    begin
+      SS := S;
+      Val(SS,fpc_Val_Currency_WideStr,code);
+    end;
+end;
+
+
+Function fpc_Val_UInt_WideStr (Const S : WideString; out Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_WIDESTR']; compilerproc;
+Var
+  SS : ShortString;
+begin
+  fpc_Val_UInt_WideStr := 0;
+  if length(S) > 255 then
+    code := 256
+  else
+    begin
+      SS := S;
+      Val(SS,fpc_Val_UInt_WideStr,code);
+    end;
+end;
+
+
+Function fpc_Val_SInt_WideStr (DestSize: SizeInt; Const S : WideString; out Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_WIDESTR']; compilerproc;
+Var
+  SS : ShortString;
+begin
+  fpc_Val_SInt_WideStr:=0;
+  if length(S)>255 then
+    code:=256
+  else
+    begin
+      SS := S;
+      fpc_Val_SInt_WideStr := int_Val_SInt_ShortStr(DestSize,SS,Code);
+    end;
+end;
+
+
+{$ifndef CPU64}
+
+Function fpc_Val_qword_WideStr (Const S : WideString; out Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_WIDESTR']; compilerproc;
+Var
+  SS : ShortString;
+begin
+  fpc_Val_qword_WideStr:=0;
+  if length(S)>255 then
+    code:=256
+  else
+    begin
+       SS := S;
+       Val(SS,fpc_Val_qword_WideStr,Code);
+    end;
+end;
+
+
+Function fpc_Val_int64_WideStr (Const S : WideString; out Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_WIDESTR']; compilerproc;
+Var
+  SS : ShortString;
+begin
+  fpc_Val_int64_WideStr:=0;
+  if length(S)>255 then
+    code:=256
+  else
+    begin
+       SS := S;
+       Val(SS,fpc_Val_int64_WideStr,Code);
+    end;
+end;
+
+{$endif CPU64}
+
+
+{$ifndef FPUNONE}
+procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : WideString);compilerproc;
+var
+  ss : shortstring;
+begin
+  str_real(len,fr,d,treal_type(rt),ss);
+  s:=ss;
+end;
+{$endif}
+
+procedure fpc_widestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:widestring);compilerproc;
+
+var ss:shortstring;
+
+begin
+  fpc_shortstr_enum(ordinal,len,typinfo,ord2strindex,ss);
+  s:=ss;
+end;
+
+{$ifdef FPC_HAS_STR_CURRENCY}
+procedure fpc_WideStr_Currency(c : Currency;len,fr : SizeInt;out s : WideString);compilerproc;
+var
+  ss : shortstring;
+begin
+  str(c:len:fr,ss);
+  s:=ss;
+end;
+{$endif FPC_HAS_STR_CURRENCY}
+
+Procedure fpc_WideStr_SInt(v : ValSint; Len : SizeInt; out S : WideString);compilerproc;
+Var
+  SS : ShortString;
+begin
+  Str (v:Len,SS);
+  S:=SS;
+end;
+
+
+Procedure fpc_WideStr_UInt(v : ValUInt;Len : SizeInt; out S : WideString);compilerproc;
+Var
+  SS : ShortString;
+begin
+  str(v:Len,SS);
+  S:=SS;
+end;
+
+
+{$ifndef CPU64}
+
+Procedure fpc_WideStr_Int64(v : Int64; Len : SizeInt; out S : WideString);compilerproc;
+Var
+  SS : ShortString;
+begin
+  Str (v:Len,SS);
+  S:=SS;
+end;
+
+
+Procedure fpc_WideStr_Qword(v : Qword;Len : SizeInt; out S : WideString);compilerproc;
+Var
+  SS : ShortString;
+begin
+  str(v:Len,SS);
+  S:=SS;
+end;
+
+{$endif CPU64}
+
+function UnicodeToUtf8(Dest: PChar; Source: PWideChar; 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: PWideChar; SourceChars: SizeUInt): SizeUInt;
+  var
+    i,j : SizeUInt;
+    w : word;
+  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;
+              else
+                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;
+            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);
+              else
+                inc(j,3);
+            end;
+            inc(i);
+          end;
+      end;
+    result:=j+1;
+  end;
+
+
+function Utf8ToUnicode(Dest: PWideChar; 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: PWideChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
+
+var
+  i,j : SizeUInt;
+  w: SizeUInt;
+  b : byte;
+begin
+  if not assigned(Source) then
+  begin
+    result:=0;
+    exit;
+  end;
+  result:=SizeUInt(-1);
+  i:=0;
+  j:=0;
+  if assigned(Dest) then
+    begin
+      while (j<MaxDestChars) and (i<SourceBytes) do
+        begin
+          b:=byte(Source[i]);
+          w:=b;
+          inc(i);
+          // 2 or 3 bytes?
+          if b>=$80 then
+            begin
+              w:=b and $3f;
+              if i>=SourceBytes then
+                exit;
+              // 3 bytes?
+              if (b and $20)<>0 then
+                begin
+                  b:=byte(Source[i]);
+                  inc(i);
+                  if i>=SourceBytes then
+                    exit;
+                  if (b and $c0)<>$80 then
+                    exit;
+                  w:=(w shl 6) or (b and $3f);
+                end;
+              b:=byte(Source[i]);
+              w:=(w shl 6) or (b and $3f);
+              if (b and $c0)<>$80 then
+                exit;
+              inc(i);
+            end;
+          Dest[j]:=WideChar(w);
+          inc(j);
+        end;
+      if j>=MaxDestChars then j:=MaxDestChars-1;
+      Dest[j]:=#0;
+    end
+  else
+    begin
+      while i<SourceBytes do
+        begin
+          b:=byte(Source[i]);
+          inc(i);
+          // 2 or 3 bytes?
+          if b>=$80 then
+            begin
+              if i>=SourceBytes then
+                exit;
+              // 3 bytes?
+              b := b and $3f;
+              if (b and $20)<>0 then
+                begin
+                  b:=byte(Source[i]);
+                  inc(i);
+                  if i>=SourceBytes then
+                    exit;
+                  if (b and $c0)<>$80 then
+                    exit;
+                end;
+              if (byte(Source[i]) and $c0)<>$80 then
+                exit;
+              inc(i);
+            end;
+          inc(j);
+        end;
+    end;
+  result:=j+1;
+end;
+
+
+function UTF8Encode(const s : WideString) : UTF8String;
+  var
+    i : SizeInt;
+    hs : UTF8String;
+  begin
+    result:='';
+    if s='' then
+      exit;
+    SetLength(hs,length(s)*3);
+    i:=UnicodeToUtf8(pchar(hs),length(hs)+1,PWideChar(s),length(s));
+    if i>0 then
+      begin
+        SetLength(hs,i-1);
+        result:=hs;
+      end;
+  end;
+
+
+{ converts an utf-16 code point or surrogate pair to utf-32 }
+function utf16toutf32(const S: WideString; const index: SizeInt; out len: longint): UCS4Char; [public, alias: 'FPC_WIDETOUTF32'];
+var
+  w: widechar;
+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;
+
+
+const
+  SNoWidestrings = 'This binary has no widestrings support compiled in.';
+  SRecompileWithWidestrings = 'Recompile the application with a widestrings-manager in the program uses clause.';
+
+procedure unimplementedwidestring;
+  begin
+{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
+    If IsConsole then
+      begin
+      Writeln(StdErr,SNoWidestrings);
+      Writeln(StdErr,SRecompileWithWidestrings);
+      end;
+{$endif FPC_HAS_FEATURE_CONSOLEIO}
+    HandleErrorFrame(233,get_frame);
+  end;
+
+{$warnings off}
+function GenericWideCase(const s : WideString) : WideString;
+  begin
+    unimplementedwidestring;
+  end;
+
+
+function CompareWideString(const s1, s2 : WideString) : PtrInt;
+  begin
+    unimplementedwidestring;
+  end;
+
+
+function CompareTextWideString(const s1, s2 : WideString): PtrInt;
+  begin
+    unimplementedwidestring;
+  end;
+
+{$warnings on}
+
+function CharLengthPChar(const Str: PChar): PtrInt;forward;
+
+
+procedure initwidestringmanager;
+  begin
+    fillchar(widestringmanager,sizeof(widestringmanager),0);
+{$ifndef HAS_WIDESTRINGMANAGER}
+    widestringmanager.Wide2AnsiMoveProc:=@defaultWide2AnsiMove;
+    widestringmanager.Ansi2WideMoveProc:=@defaultAnsi2WideMove;
+    widestringmanager.UpperWideStringProc:=@GenericWideCase;
+    widestringmanager.LowerWideStringProc:=@GenericWideCase;
+{$endif HAS_WIDESTRINGMANAGER}
+    widestringmanager.CompareWideStringProc:=@CompareWideString;
+    widestringmanager.CompareTextWideStringProc:=@CompareTextWideString;
+    widestringmanager.CharLengthPCharProc:=@CharLengthPChar;
+  end;

rtl/inc/wustring22.inc

@@ -0,0 +1,2021 @@
+{
+    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 WideStrings/Unicode 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.
+
+ **********************************************************************}
+
+{
+  This file contains the implementation of the WideString type,
+  and all things that are needed for it.
+  WideString is defined as a 'silent' pwidechar :
+  a pwidechar that points to :
+
+  @-8  : SizeInt for reference count;
+  @-4  : SizeInt for size; size=number of bytes, not the number of chars. Divide or multiply
+         with sizeof(WideChar) to convert. This is needed to be compatible with Delphi and
+         Windows COM BSTR.
+  @    : String + Terminating #0;
+  Pwidechar(Widestring) is a valid typecast.
+  So WS[i] is converted to the address @WS+i-1.
+
+  Constants should be assigned a reference count of -1
+  Meaning that they can't be disposed of.
+}
+
+Type
+  PWideRec = ^TWideRec;
+  TWideRec = Packed Record
+{$ifdef FPC_WINLIKEWIDESTRING}
+    Len   : DWord;
+{$else FPC_WINLIKEWIDESTRING}
+    Ref : SizeInt;
+    Len : SizeInt;
+{$endif FPC_WINLIKEWIDESTRING}
+    First : WideChar;
+  end;
+
+Const
+  WideRecLen = SizeOf(TWideRec);
+  WideFirstOff = SizeOf(TWideRec)-sizeof(WideChar);
+
+{
+  Default WideChar <-> Char conversion is to only convert the
+  lower 127 chars, all others are translated to spaces.
+
+  These routines can be overwritten for the Current Locale
+}
+
+procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
+var
+  i : SizeInt;
+begin
+  setlength(dest,len);
+  for i:=1 to len do
+    begin
+      if word(source^)<256 then
+        dest[i]:=char(word(source^))
+      else
+        dest[i]:='?';
+      inc(source);
+    end;
+end;
+
+
+procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
+var
+  i : SizeInt;
+begin
+  setlength(dest,len);
+  for i:=1 to len do
+    begin
+      dest[i]:=widechar(byte(source^));
+      inc(source);
+    end;
+end;
+
+
+Procedure GetUnicodeStringManager (Var Manager : TUnicodeStringManager);
+begin
+  manager:=widestringmanager;
+end;
+
+
+Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
+begin
+  Old:=widestringmanager;
+  widestringmanager:=New;
+end;
+
+
+Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager);
+begin
+  widestringmanager:=New;
+end;
+
+
+Procedure GetWideStringManager (Var Manager : TWideStringManager);
+begin
+  manager:=widestringmanager;
+end;
+
+
+Procedure SetWideStringManager (Const New : TWideStringManager; Var Old: TWideStringManager);
+begin
+  Old:=widestringmanager;
+  widestringmanager:=New;
+end;
+
+
+Procedure SetWideStringManager (Const New : TWideStringManager);
+begin
+  widestringmanager:=New;
+end;
+
+(*
+Procedure UniqueWideString(Var S : WideString); [Public,Alias : 'FPC_WIDESTR_UNIQUE'];
+{
+  Make sure reference count of S is 1,
+  using copy-on-write semantics.
+}
+
+begin
+end;
+*)
+
+
+{****************************************************************************
+                    Internal functions, not in interface.
+****************************************************************************}
+
+
+procedure WideStringError;
+  begin
+    HandleErrorFrame(204,get_frame);
+  end;
+
+
+{$ifdef WideStrDebug}
+Procedure DumpWideRec(S : Pointer);
+begin
+  If S=Nil then
+    Writeln ('String is nil')
+  Else
+    Begin
+      With PWideRec(S-WideFirstOff)^ do
+       begin
+         Write   ('(Len:',len);
+         Writeln (' Ref: ',ref,')');
+       end;
+    end;
+end;
+{$endif}
+
+
+Function NewWideString(Len : SizeInt) : Pointer;
+{
+  Allocate a new WideString on the heap.
+  initialize it to zero length and reference count 1.
+}
+Var
+  P : Pointer;
+begin
+{$ifdef MSWINDOWS}
+  if winwidestringalloc then
+    begin
+      P:=SysAllocStringLen(nil,Len);
+      if P=nil then
+        WideStringError;
+    end
+  else
+{$endif MSWINDOWS}
+    begin
+      GetMem(P,Len*sizeof(WideChar)+WideRecLen);
+      If P<>Nil then
+        begin
+         PWideRec(P)^.Len:=Len*2;     { Initial length }
+{$ifndef FPC_WINLIKEWIDESTRING}
+         PWideRec(P)^.Ref:=1;         { Initial Refcount }
+{$endif FPC_WINLIKEWIDESTRING}
+         PWideRec(P)^.First:=#0;      { Terminating #0 }
+         inc(p,WideFirstOff);         { Points to string now }
+        end
+      else
+        WideStringError;
+    end;
+  NewWideString:=P;
+end;
+
+
+Procedure DisposeWideString(Var S : Pointer);
+{
+  Deallocates a WideString From the heap.
+}
+begin
+  If S=Nil then
+    exit;
+{$ifndef MSWINDOWS}
+  Dec (S,WideFirstOff);
+  Freemem(S);
+{$else MSWINDOWS}
+  if winwidestringalloc then
+    SysFreeString(S)
+  else
+    begin
+      Dec (S,WideFirstOff);
+      Freemem(S);
+    end;
+{$endif MSWINDOWS}
+  S:=Nil;
+end;
+
+{$ifdef FPC_WINLIKEWIDESTRING}
+var
+  __data_start: byte; external name '__data_start__';
+  __data_end: byte; external name '__data_end__';
+
+function IsWideStringConstant(S: pointer): boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
+{
+  Returns True if widestring is constant (located in .data section);
+}
+begin
+  Result:=(S>=@__data_start) and (S<@__data_end);
+end;
+{$endif FPC_WINLIKEWIDESTRING}
+
+Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);[Public,Alias:'FPC_WIDESTR_DECR_REF']; compilerproc;
+{
+  Decreases the ReferenceCount of a non constant widestring;
+  If the reference count is zero, deallocate the string;
+}
+Type
+  pSizeInt = ^SizeInt;
+{$ifndef FPC_WINLIKEWIDESTRING}
+Var
+  l : pSizeInt;
+{$endif FPC_WINLIKEWIDESTRING}
+Begin
+  { Zero string }
+  if S=Nil then
+    exit;
+{$ifndef FPC_WINLIKEWIDESTRING}
+  { check for constant strings ...}
+  l:=@PWideRec(S-WideFirstOff)^.Ref;
+  if l^<0 then
+    exit;
+
+  { declocked does a MT safe dec and returns true, if the counter is 0 }
+  if declocked(l^) then
+    { Ref count dropped to zero ...
+      ... remove }
+{$else}
+  if not IsWideStringConstant(S) then
+{$endif FPC_WINLIKEWIDESTRING}
+    DisposeWideString(S);
+end;
+
+{ alias for internal use }
+Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);[external name 'FPC_WIDESTR_DECR_REF'];
+
+Procedure fpc_WideStr_Incr_Ref(Var S : Pointer);[Public,Alias:'FPC_WIDESTR_INCR_REF']; compilerproc;
+{$ifdef FPC_WINLIKEWIDESTRING}
+  var
+    p : pointer;
+{$endif FPC_WINLIKEWIDESTRING}
+  Begin
+    If S=Nil then
+      exit;
+{$ifdef FPC_WINLIKEWIDESTRING}
+    p:=NewWidestring(length(WideString(S)));
+    move(s^,p^,(length(WideString(s))+1)*sizeof(widechar)); // double #0 too
+    s:=p;
+{$else FPC_WINLIKEWIDESTRING}
+    { Let's be paranoid : Constant string ??}
+    If PWideRec(S-WideFirstOff)^.Ref<0 then
+      exit;
+    inclocked(PWideRec(S-WideFirstOff)^.Ref);
+{$endif FPC_WINLIKEWIDESTRING}
+  end;
+
+{ alias for internal use }
+Procedure fpc_WideStr_Incr_Ref (Var S : Pointer);[external name 'FPC_WIDESTR_INCR_REF'];
+
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): shortstring;[Public, alias: 'FPC_WIDESTR_TO_SHORTSTR'];  compilerproc;
+{
+  Converts a WideString to a ShortString;
+}
+Var
+  Size : SizeInt;
+  temp : ansistring;
+begin
+  result:='';
+  Size:=Length(S2);
+  if Size>0 then
+    begin
+      If Size>high_of_res then
+        Size:=high_of_res;
+      widestringmanager.Wide2AnsiMoveProc(PWideChar(S2),temp,Size);
+      result:=temp;
+    end;
+end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_WideStr_To_ShortStr (out res: ShortString;const S2 : WideString); [Public, alias: 'FPC_WIDESTR_TO_SHORTSTR'];compilerproc;
+{
+  Converts a WideString 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.Wide2AnsiMoveProc(PWideChar(S2),temp,Size);
+      res:=temp;
+    end;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+
+Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString;compilerproc;
+{
+  Converts a ShortString to a WideString;
+}
+Var
+  Size : SizeInt;
+begin
+  result:='';
+  Size:=Length(S2);
+  if Size>0 then
+    begin
+      widestringmanager.Ansi2WideMoveProc(PChar(@S2[1]),result,Size);
+      { Terminating Zero }
+      PWideChar(Pointer(fpc_ShortStr_To_WideStr)+Size*sizeof(WideChar))^:=#0;
+    end;
+end;
+
+
+Function fpc_WideStr_To_AnsiStr (const S2 : WideString): AnsiString; compilerproc;
+{
+  Converts a WideString to an AnsiString
+}
+Var
+  Size : SizeInt;
+begin
+  result:='';
+  Size:=Length(S2);
+  if Size>0 then
+    widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),result,Size);
+end;
+
+
+Function fpc_AnsiStr_To_WideStr (Const S2 : AnsiString): WideString; compilerproc;
+{
+  Converts an AnsiString to a WideString;
+}
+Var
+  Size : SizeInt;
+begin
+  result:='';
+  Size:=Length(S2);
+  if Size>0 then
+    widestringmanager.Ansi2WideMoveProc(PChar(S2),result,Size);
+end;
+
+
+Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
+var
+  Size : SizeInt;
+begin
+  result:='';
+  if p=nil then
+    exit;
+  Size := IndexWord(p^, -1, 0);
+  if Size>0 then
+    widestringmanager.Wide2AnsiMoveProc(P,result,Size);
+end;
+
+
+Function fpc_PWideChar_To_WideStr(const p : pwidechar): widestring; compilerproc;
+var
+  Size : SizeInt;
+begin
+  result:='';
+  if p=nil then
+    exit;
+  Size := IndexWord(p^, -1, 0);
+  Setlength(result,Size);
+  if Size>0 then
+   begin
+      Move(p^,PWideChar(Pointer(result))^,Size*sizeof(WideChar));
+      { Terminating Zero }
+      PWideChar(Pointer(result)+Size*sizeof(WideChar))^:=#0;
+   end;
+end;
+
+
+{$ifndef FPC_STRTOSHORTSTRINGPROC}
+Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;
+var
+  Size : SizeInt;
+  temp: ansistring;
+begin
+  result:='';
+  if p=nil then
+    exit;
+  Size := IndexWord(p^, $7fffffff, 0);
+  if Size>0 then
+    begin
+      widestringmanager.Wide2AnsiMoveProc(p,temp,Size);
+      result:=temp;
+    end;
+end;
+{$else FPC_STRTOSHORTSTRINGPROC}
+procedure fpc_PWideChar_To_ShortStr(out res : shortstring;const p : pwidechar); compilerproc;
+var
+  Size : SizeInt;
+  temp: ansistring;
+begin
+  res:='';
+  if p=nil then
+    exit;
+  Size:=IndexWord(p^, high(PtrInt), 0);
+  if Size>0 then
+    begin
+      widestringmanager.Wide2AnsiMoveProc(p,temp,Size);
+      res:=temp;
+    end;
+end;
+{$endif FPC_STRTOSHORTSTRINGPROC}
+
+
+{ checked against the ansistring routine, 2001-05-27 (FK) }
+Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_WIDESTR_ASSIGN']; compilerproc;
+{
+  Assigns S2 to S1 (S1:=S2), taking in account reference counts.
+}
+begin
+{$ifdef FPC_WINLIKEWIDESTRING}
+  if S1=S2 then exit;
+  if S2<>nil then
+    begin
+      if IsWideStringConstant(S1) then
+        begin
+          S1:=NewWidestring(length(WideString(S2)));
+          move(s2^,s1^,(length(WideString(s1))+1)*sizeof(widechar));
+        end
+      else
+{$ifdef MSWINDOWS}
+        if winwidestringalloc then
+          begin
+            if SysReAllocStringLen(S1, S2, Length(WideString(S2))) = 0 then
+              WideStringError;
+          end
+        else
+{$endif MSWINDOWS}
+          begin
+            SetLength(WideString(S1),length(WideString(S2)));
+            move(s2^,s1^,(length(WideString(s1))+1)*sizeof(widechar));
+          end;
+    end
+  else
+    begin
+      { Free S1 }
+      fpc_widestr_decr_ref (S1);
+      S1:=nil;
+    end;
+{$else FPC_WINLIKEWIDESTRING}
+  If S2<>nil then
+    If PWideRec(S2-WideFirstOff)^.Ref>0 then
+      inclocked(PWideRec(S2-WideFirstOff)^.ref);
+  { Decrease the reference count on the old S1 }
+  fpc_widestr_decr_ref (S1);
+  s1:=s2;
+{$endif FPC_WINLIKEWIDESTRING}
+end;
+
+
+{ alias for internal use }
+Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_WIDESTR_ASSIGN'];
+
+{$ifndef STR_CONCAT_PROCS}
+
+function fpc_WideStr_Concat (const S1,S2 : WideString): WideString; compilerproc;
+Var
+  Size,Location : SizeInt;
+  pc : pwidechar;
+begin
+  { only assign if s1 or s2 is empty }
+  if (S1='') then
+    begin
+      result:=s2;
+      exit;
+    end;
+  if (S2='') then
+    begin
+      result:=s1;
+      exit;
+    end;
+  Location:=Length(S1);
+  Size:=length(S2);
+  SetLength(result,Size+Location);
+  pc:=pwidechar(result);
+  Move(S1[1],pc^,Location*sizeof(WideChar));
+  inc(pc,location);
+  Move(S2[1],pc^,(Size+1)*sizeof(WideChar));
+end;
+
+
+function fpc_WideStr_Concat_multi (const sarr:array of Widestring): widestring; compilerproc;
+Var
+  i  : Longint;
+  p  : pointer;
+  pc : pwidechar;
+  Size,NewSize : SizeInt;
+begin
+  { First calculate size of the result so we can do
+    a single call to SetLength() }
+  NewSize:=0;
+  for i:=low(sarr) to high(sarr) do
+    inc(Newsize,length(sarr[i]));
+  SetLength(result,NewSize);
+  pc:=pwidechar(result);
+  for i:=low(sarr) to high(sarr) do
+    begin
+      p:=pointer(sarr[i]);
+      if assigned(p) then
+        begin
+          Size:=length(widestring(p));
+          Move(pwidechar(p)^,pc^,(Size+1)*sizeof(WideChar));
+          inc(pc,size);
+        end;
+    end;
+end;
+
+{$else STR_CONCAT_PROCS}
+
+procedure fpc_WideStr_Concat (var DestS:Widestring;const S1,S2 : WideString); compilerproc;
+Var
+  Size,Location : SizeInt;
+  same : boolean;
+begin
+  { only assign if s1 or s2 is empty }
+  if (S1='') then
+    begin
+      DestS:=s2;
+      exit;
+    end;
+  if (S2='') then
+    begin
+      DestS:=s1;
+      exit;
+    end;
+  Location:=Length(S1);
+  Size:=length(S2);
+  { Use Pointer() typecasts to prevent extra conversion code }
+  if Pointer(DestS)=Pointer(S1) then
+    begin
+      same:=Pointer(S1)=Pointer(S2);
+      SetLength(DestS,Size+Location);
+      if same then
+        Move(Pointer(DestS)^,(Pointer(DestS)+Location*sizeof(WideChar))^,(Size)*sizeof(WideChar))
+      else
+        Move(Pointer(S2)^,(Pointer(DestS)+Location*sizeof(WideChar))^,(Size+1)*sizeof(WideChar));
+    end
+  else if Pointer(DestS)=Pointer(S2) then
+    begin
+      SetLength(DestS,Size+Location);
+      Move(Pointer(DestS)^,(Pointer(DestS)+Location*sizeof(WideChar))^,(Size+1)*sizeof(WideChar));
+      Move(Pointer(S1)^,Pointer(DestS)^,Location*sizeof(WideChar));
+    end
+  else
+    begin
+      DestS:='';
+      SetLength(DestS,Size+Location);
+      Move(Pointer(S1)^,Pointer(DestS)^,Location*sizeof(WideChar));
+      Move(Pointer(S2)^,(Pointer(DestS)+Location*sizeof(WideChar))^,(Size+1)*sizeof(WideChar));
+    end;
+end;
+
+
+procedure fpc_WideStr_Concat_multi (var DestS:Widestring;const sarr:array of Widestring); compilerproc;
+Var
+  i           : Longint;
+  p,pc        : pointer;
+  Size,NewLen : SizeInt;
+{$ifndef FPC_WINLIKEWIDESTRING}
+  lowstart    : longint;
+  destcopy    : pointer;
+  OldDestLen  : SizeInt;
+{$else FPC_WINLIKEWIDESTRING}
+  DestTmp     : Widestring;
+{$endif FPC_WINLIKEWIDESTRING}
+begin
+  if high(sarr)=0 then
+    begin
+      DestS:='';
+      exit;
+    end;
+{$ifndef FPC_WINLIKEWIDESTRING}
+  destcopy:=nil;
+  lowstart:=low(sarr);
+  if Pointer(DestS)=Pointer(sarr[lowstart]) then
+    inc(lowstart);
+  { Check for another reuse, then we can't use
+    the append optimization }
+  for i:=lowstart to high(sarr) do
+    begin
+      if Pointer(DestS)=Pointer(sarr[i]) then
+        begin
+          { if DestS is used somewhere in the middle of the expression,
+            we need to make sure the original string still exists after
+            we empty/modify DestS.
+            This trick only works with reference counted strings. Therefor
+            this optimization is disabled for WINLIKEWIDESTRING }
+          destcopy:=pointer(dests);
+          fpc_WideStr_Incr_Ref(destcopy);
+          lowstart:=low(sarr);
+          break;
+        end;
+    end;
+  { Start with empty DestS if we start with concatting
+    the first array element }
+  if lowstart=low(sarr) then
+    DestS:='';
+  OldDestLen:=length(DestS);
+  { Calculate size of the result so we can do
+    a single call to SetLength() }
+  NewLen:=0;
+  for i:=low(sarr) to high(sarr) do
+    inc(NewLen,length(sarr[i]));
+  SetLength(DestS,NewLen);
+  { Concat all strings, except the string we already
+    copied in DestS }
+  pc:=Pointer(DestS)+OldDestLen*sizeof(WideChar);
+  for i:=lowstart to high(sarr) do
+    begin
+      p:=pointer(sarr[i]);
+      if assigned(p) then
+        begin
+          Size:=length(widestring(p));
+          Move(p^,pc^,(Size+1)*sizeof(WideChar));
+          inc(pc,size*sizeof(WideChar));
+        end;
+    end;
+  fpc_WideStr_Decr_Ref(destcopy);
+{$else FPC_WINLIKEWIDESTRING}
+  { First calculate size of the result so we can do
+    a single call to SetLength() }
+  NewLen:=0;
+  for i:=low(sarr) to high(sarr) do
+    inc(NewLen,length(sarr[i]));
+  SetLength(DestTmp,NewLen);
+  pc:=pwidechar(DestTmp);
+  for i:=low(sarr) to high(sarr) do
+    begin
+      p:=pointer(sarr[i]);
+      if assigned(p) then
+        begin
+          Size:=length(widestring(p));
+          Move(p^,pc^,(Size+1)*sizeof(WideChar));
+          inc(pc,size*sizeof(WideChar));
+        end;
+    end;
+  DestS:=DestTmp;
+{$endif FPC_WINLIKEWIDESTRING}
+end;
+
+{$endif STR_CONCAT_PROCS}
+
+Function fpc_Char_To_WChar(const c : Char): WideChar; compilerproc;
+var
+  w: widestring;
+begin
+  widestringmanager.Ansi2WideMoveProc(@c, w, 1);
+  fpc_Char_To_WChar:= w[1];
+end;
+
+
+
+Function fpc_Char_To_WideStr(const c : Char): WideString; compilerproc;
+{
+  Converts a Char to a WideString;
+}
+begin
+  Setlength(fpc_Char_To_WideStr,1);
+  fpc_Char_To_WideStr[1]:=c;
+  { Terminating Zero }
+  PWideChar(Pointer(fpc_Char_To_WideStr)+sizeof(WideChar))^:=#0;
+end;
+
+
+Function fpc_WChar_To_Char(const c : WideChar): Char; compilerproc;
+{
+  Converts a WideChar to a Char;
+}
+var
+  s: ansistring;
+begin
+  widestringmanager.Wide2AnsiMoveProc(@c, s, 1);
+  if length(s)=1 then
+    fpc_WChar_To_Char:= s[1]
+  else
+    fpc_WChar_To_Char:='?';
+end;
+
+
+Function fpc_WChar_To_WideStr(const c : WideChar): WideString; compilerproc;
+{
+  Converts a WideChar to a WideString;
+}
+begin
+  Setlength (fpc_WChar_To_WideStr,1);
+  fpc_WChar_To_WideStr[1]:= c;
+end;
+
+
+Function fpc_WChar_To_AnsiStr(const c : WideChar): AnsiString; compilerproc;
+{
+  Converts a WideChar to a AnsiString;
+}
+begin
+  widestringmanager.Wide2AnsiMoveProc(@c, fpc_WChar_To_AnsiStr, 1);
+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_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
+Var
+  L : SizeInt;
+begin
+  if (not assigned(p)) or (p[0]=#0) Then
+  begin
+    fpc_pchar_to_widestr := '';
+    exit;
+  end;
+  l:=IndexChar(p^,-1,#0);
+  widestringmanager.Ansi2WideMoveProc(P,fpc_PChar_To_WideStr,l);
+end;
+
+
+Function fpc_CharArray_To_WideStr(const arr: array of char; zerobased: boolean = true): WideString; compilerproc;
+var
+  i  : SizeInt;
+begin
+  if (zerobased) then
+    begin
+      if (arr[0]=#0) Then
+      begin
+        fpc_chararray_to_widestr := '';
+        exit;
+      end;
+      i:=IndexChar(arr,high(arr)+1,#0);
+      if i = -1 then
+        i := high(arr)+1;
+    end
+  else
+    i := high(arr)+1;
+  SetLength(fpc_CharArray_To_WideStr,i);
+  widestringmanager.Ansi2WideMoveProc (pchar(@arr),fpc_CharArray_To_WideStr,i);
+end;
+
+
+{$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;
+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_WideStr,i);
+  Move(arr[0], Pointer(fpc_WideCharArray_To_WideStr)^,i*sizeof(WideChar));
+end;
+
+{$ifndef FPC_STRTOCHARARRAYPROC}
+
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ chararray we're converting to (JM)                                    }
+function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray;[public,alias: 'FPC_WIDESTR_TO_CHARARRAY']; compilerproc;
+var
+  len: SizeInt;
+  temp: ansistring;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),temp,len);
+  len := length(temp);
+  if len > arraysize then
+    len := arraysize;
+{$r-}
+  move(temp[1],fpc_widestr_to_chararray[0],len);
+  fillchar(fpc_widestr_to_chararray[len],arraysize-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ widechararray we're converting to (JM)                                }
+function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray;[public,alias: 'FPC_WIDESTR_TO_WIDECHARARRAY']; compilerproc;
+var
+  len: SizeInt;
+begin
+  len := length(src);
+  if len > arraysize then
+    len := arraysize;
+{$r-}
+  { make sure we don't try to access element 1 of the ansistring if it's nil }
+  if len > 0 then
+    move(src[1],fpc_widestr_to_widechararray[0],len*SizeOf(WideChar));
+  fillchar(fpc_widestr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ chararray we're converting to (JM)                                    }
+function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray;[public,alias: 'FPC_ANSISTR_TO_WIDECHARARRAY']; 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 > arraysize then
+    len := arraysize;
+
+{$r-}
+  move(temp[1],fpc_ansistr_to_widechararray[0],len*sizeof(widechar));
+  fillchar(fpc_ansistr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray;[public,alias: 'FPC_SHORTSTR_TO_WIDECHARARRAY']; 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 > arraysize then
+    len := arraysize;
+{$r-}
+  move(temp[1],fpc_shortstr_to_widechararray[0],len*sizeof(widechar));
+  fillchar(fpc_shortstr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+{$else ndef FPC_STRTOCHARARRAYPROC}
+
+procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); compilerproc;
+var
+  len: SizeInt;
+  temp: ansistring;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),temp,len);
+  len := length(temp);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  move(temp[1],res[0],len);
+  fillchar(res[len],length(res)-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc;
+var
+  len: SizeInt;
+begin
+  len := length(src);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  { make sure we don't try to access element 1 of the ansistring if it's nil }
+  if len > 0 then
+    move(src[1],res[0],len*SizeOf(WideChar));
+  fillchar(res[len],(length(res)-len)*SizeOf(WideChar),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;
+
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+
+Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE']; compilerproc;
+{
+  Compares 2 WideStrings;
+  The result is
+   <0 if S1<S2
+   0 if S1=S2
+   >0 if S1>S2
+}
+Var
+  MaxI,Temp : SizeInt;
+begin
+  if pointer(S1)=pointer(S2) then
+   begin
+     fpc_WideStr_Compare:=0;
+     exit;
+   end;
+  Maxi:=Length(S1);
+  temp:=Length(S2);
+  If MaxI>Temp then
+   MaxI:=Temp;
+  Temp:=CompareWord(S1[1],S2[1],MaxI);
+  if temp=0 then
+   temp:=Length(S1)-Length(S2);
+  fpc_WideStr_Compare:=Temp;
+end;
+
+Function fpc_WideStr_Compare_Equal(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE_EQUAL']; compilerproc;
+{
+  Compares 2 WideStrings for equality only;
+  The result is
+   0 if S1=S2
+   <>0 if S1<>S2
+}
+Var
+  MaxI : SizeInt;
+begin
+  if pointer(S1)=pointer(S2) then
+    exit(0);
+  Maxi:=Length(S1);
+  If MaxI<>Length(S2) then
+    exit(-1)
+  else
+    exit(CompareWord(S1[1],S2[1],MaxI));
+end;
+
+Procedure fpc_WideStr_CheckZero(p : pointer);[Public,Alias : 'FPC_WIDESTR_CHECKZERO']; compilerproc;
+begin
+  if p=nil then
+    HandleErrorFrame(201,get_frame);
+end;
+
+
+Procedure fpc_WideStr_CheckRange(len,index : SizeInt);[Public,Alias : 'FPC_WIDESTR_RANGECHECK']; compilerproc;
+begin
+  if (index>len div 2) or (Index<1) then
+    HandleErrorFrame(201,get_frame);
+end;
+
+Procedure fpc_WideStr_SetLength(Var S : WideString; l : SizeInt);[Public,Alias : 'FPC_WIDESTR_SETLENGTH']; compilerproc;
+{
+  Sets The length of string S to L.
+  Makes sure S is unique, and contains enough room.
+}
+Var
+  Temp : Pointer;
+  movelen: SizeInt;
+begin
+   if (l>0) then
+    begin
+      if Pointer(S)=nil then
+       begin
+         { Need a complete new string...}
+         Pointer(s):=NewWideString(l);
+       end
+      { windows doesn't support reallocing widestrings, this code
+        is anyways subject to be removed because widestrings shouldn't be
+        ref. counted anymore (FK) }
+      else
+        if
+{$ifdef MSWINDOWS}
+              not winwidestringalloc and
+{$endif MSWINDOWS}
+{$ifdef FPC_WINLIKEWIDESTRING}
+              not IsWideStringConstant(pointer(S))
+{$else}
+              (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1)
+{$endif FPC_WINLIKEWIDESTRING}
+              then
+        begin
+          Dec(Pointer(S),WideFirstOff);
+          if SizeUInt(L*sizeof(WideChar)+WideRecLen)>MemSize(Pointer(S)) then
+              reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
+          Inc(Pointer(S), WideFirstOff);
+        end
+      else
+        begin
+          { Reallocation is needed... }
+          Temp:=Pointer(NewWideString(L));
+          if Length(S)>0 then
+            begin
+              if l < succ(length(s)) then
+                movelen := l
+              { also move terminating null }
+              else
+                movelen := succ(length(s));
+              Move(Pointer(S)^,Temp^,movelen * Sizeof(WideChar));
+            end;
+          fpc_widestr_decr_ref(Pointer(S));
+          Pointer(S):=Temp;
+        end;
+      { Force nil termination in case it gets shorter }
+      PWord(Pointer(S)+l*sizeof(WideChar))^:=0;
+{$ifdef MSWINDOWS}
+      if not winwidestringalloc then
+{$endif MSWINDOWS}
+        PWideRec(Pointer(S)-WideFirstOff)^.Len:=l*sizeof(WideChar);
+    end
+  else
+    begin
+      { Length=0 }
+      if Pointer(S)<>nil then
+        fpc_widestr_decr_ref (Pointer(S));
+      Pointer(S):=Nil;
+    end;
+end;
+
+{*****************************************************************************
+                     Public functions, In interface.
+*****************************************************************************}
+
+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 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_widestr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_WIDESTR_UNIQUE']; compilerproc;
+{$ifdef FPC_WINLIKEWIDESTRING}
+  begin
+    pointer(result) := pointer(s);
+  end;
+{$else FPC_WINLIKEWIDESTRING}
+{
+  Make sure reference count of S is 1,
+  using copy-on-write semantics.
+}
+Var
+  SNew : Pointer;
+  L    : SizeInt;
+begin
+  pointer(result) := pointer(s);
+  If Pointer(S)=Nil then
+    exit;
+  if PWideRec(Pointer(S)-WideFirstOff)^.Ref<>1 then
+   begin
+     L:=PWideRec(Pointer(S)-WideFirstOff)^.len div sizeof(WideChar);
+     SNew:=NewWideString (L);
+     Move (PWideChar(S)^,SNew^,(L+1)*sizeof(WideChar));
+     PWideRec(SNew-WideFirstOff)^.len:=L * sizeof(WideChar);
+     fpc_widestr_decr_ref (Pointer(S));  { Thread safe }
+     pointer(S):=SNew;
+     pointer(result):=SNew;
+   end;
+end;
+{$endif FPC_WINLIKEWIDESTRING}
+
+
+Function Fpc_WideStr_Copy (Const S : WideString; Index,Size : SizeInt) : WideString;compilerproc;
+var
+  ResultAddress : Pointer;
+begin
+  ResultAddress:=Nil;
+  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
+   begin
+     If Index<0 Then
+      Index:=0;
+     ResultAddress:=Pointer(NewWideString (Size));
+     if ResultAddress<>Nil then
+      begin
+        Move (PWideChar(S)[Index],ResultAddress^,Size*sizeof(WideChar));
+        PWideRec(ResultAddress-WideFirstOff)^.Len:=Size*sizeof(WideChar);
+        PWideChar(ResultAddress+Size*sizeof(WideChar))^:=#0;
+      end;
+   end;
+  fpc_widestr_decr_ref(Pointer(fpc_widestr_copy));
+  Pointer(fpc_widestr_Copy):=ResultAddress;
+end;
+
+
+Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
+var
+  i,MaxLen : SizeInt;
+  pc : pwidechar;
+begin
+  Pos:=0;
+  if Length(SubStr)>0 then
+   begin
+     MaxLen:=Length(source)-Length(SubStr);
+     i:=0;
+     pc:=@source[1];
+     while (i<=MaxLen) do
+      begin
+        inc(i);
+        if (SubStr[1]=pc^) and
+           (CompareWord(Substr[1],pc^,Length(SubStr))=0) then
+         begin
+           Pos:=i;
+           exit;
+         end;
+        inc(pc);
+      end;
+   end;
+end;
+
+
+{ Faster version for a widechar alone }
+Function Pos (c : WideChar; Const s : WideString) : SizeInt;
+var
+  i: SizeInt;
+  pc : pwidechar;
+begin
+  pc:=@s[1];
+  for i:=1 to length(s) do
+   begin
+     if pc^=c then
+      begin
+        pos:=i;
+        exit;
+      end;
+     inc(pc);
+   end;
+  pos:=0;
+end;
+
+
+Function Pos (c : WideChar; Const s : AnsiString) : SizeInt;
+  begin
+    result:=Pos(c,WideString(s));
+  end;
+
+
+Function Pos (c : AnsiString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    result:=Pos(WideString(c),s);
+  end;
+
+
+Function Pos (c : ShortString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    result:=Pos(WideString(c),s);
+  end;
+
+
+Function Pos (c : WideString; Const s : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    result:=Pos(c,WideString(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 : Char; Const s : WideString) : SizeInt;
+var
+  i: SizeInt;
+  wc : widechar;
+  pc : pwidechar;
+begin
+  wc:=c;
+  pc:=@s[1];
+  for i:=1 to length(s) do
+   begin
+     if pc^=wc then
+      begin
+        pos:=i;
+        exit;
+      end;
+     inc(pc);
+   end;
+  pos:=0;
+end;
+
+
+
+Procedure Delete (Var S : WideString; Index,Size: SizeInt);
+Var
+  LS : SizeInt;
+begin
+  If Length(S)=0 then
+   exit;
+  if index<=0 then
+   exit;
+  LS:=PWideRec(Pointer(S)-WideFirstOff)^.Len div sizeof(WideChar);
+  if (Index<=LS) and (Size>0) then
+   begin
+     UniqueString (S);
+     if Size+Index>LS then
+      Size:=LS-Index+1;
+     if Index+Size<=LS then
+      begin
+        Dec(Index);
+        Move(PWideChar(S)[Index+Size],PWideChar(S)[Index],(LS-Index-Size+1)*sizeof(WideChar));
+      end;
+     Setlength(s,LS-Size);
+   end;
+end;
+
+
+Procedure Insert (Const Source : WideString; Var S : WideString; Index : SizeInt);
+var
+  Temp : WideString;
+  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) := NewWideString(Length(Source)+LS);
+  SetLength(Temp,Length(Source)+LS);
+  If Index>0 then
+    move (PWideChar(S)^,PWideChar(Temp)^,Index*sizeof(WideChar));
+  Move (PWideChar(Source)^,PWideChar(Temp)[Index],Length(Source)*sizeof(WideChar));
+  If (LS-Index)>0 then
+    Move(PWideChar(S)[Index],PWideChar(temp)[Length(Source)+index],(LS-Index)*sizeof(WideChar));
+  S:=Temp;
+end;
+
+
+function UpCase(const s : WideString) : WideString;
+begin
+  result:=widestringmanager.UpperWideStringProc(s);
+end;
+
+
+Procedure SetString (Out S : WideString; Buf : PWideChar; Len : SizeInt);
+var
+  BufLen: SizeInt;
+begin
+  SetLength(S,Len);
+  If (Buf<>Nil) and (Len>0) then
+    begin
+      BufLen := IndexWord(Buf^, Len+1, 0);
+      If (BufLen>0) and (BufLen < Len) then
+        Len := BufLen;
+      Move (Buf[0],S[1],Len*sizeof(WideChar));
+      PWideChar(Pointer(S)+Len*sizeof(WideChar))^:=#0;
+    end;
+end;
+
+
+Procedure SetString (Out S : WideString; Buf : PChar; Len : SizeInt);
+var
+  BufLen: SizeInt;
+begin
+  SetLength(S,Len);
+  If (Buf<>Nil) and (Len>0) then
+    begin
+      BufLen := IndexByte(Buf^, Len+1, 0);
+      If (BufLen>0) and (BufLen < Len) then
+        Len := BufLen;
+      widestringmanager.Ansi2WideMoveProc(Buf,S,Len);
+      //PWideChar(Pointer(S)+Len*sizeof(WideChar))^:=#0;
+    end;
+end;
+
+
+{$ifndef FPUNONE}
+Function fpc_Val_Real_WideStr(Const S : WideString; out Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_WIDESTR']; compilerproc;
+Var
+  SS : String;
+begin
+  fpc_Val_Real_WideStr := 0;
+  if length(S) > 255 then
+    code := 256
+  else
+    begin
+      SS := S;
+      Val(SS,fpc_Val_Real_WideStr,code);
+    end;
+end;
+{$endif}
+
+function fpc_val_enum_widestr(str2ordindex:pointer;const s:widestring;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_widestr,code);
+    end;
+end;
+
+Function fpc_Val_Currency_WideStr(Const S : WideString; out Code : ValSInt): Currency; [public, alias:'FPC_VAL_CURRENCY_WIDESTR']; compilerproc;
+Var
+  SS : String;
+begin
+  if length(S) > 255 then
+    begin
+      fpc_Val_Currency_WideStr:=0;
+      code := 256;
+    end
+  else
+    begin
+      SS := S;
+      Val(SS,fpc_Val_Currency_WideStr,code);
+    end;
+end;
+
+
+Function fpc_Val_UInt_WideStr (Const S : WideString; out Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_WIDESTR']; compilerproc;
+Var
+  SS : ShortString;
+begin
+  fpc_Val_UInt_WideStr := 0;
+  if length(S) > 255 then
+    code := 256
+  else
+    begin
+      SS := S;
+      Val(SS,fpc_Val_UInt_WideStr,code);
+    end;
+end;
+
+
+Function fpc_Val_SInt_WideStr (DestSize: SizeInt; Const S : WideString; out Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_WIDESTR']; compilerproc;
+Var
+  SS : ShortString;
+begin
+  fpc_Val_SInt_WideStr:=0;
+  if length(S)>255 then
+    code:=256
+  else
+    begin
+      SS := S;
+      fpc_Val_SInt_WideStr := int_Val_SInt_ShortStr(DestSize,SS,Code);
+    end;
+end;
+
+
+{$ifndef CPU64}
+
+Function fpc_Val_qword_WideStr (Const S : WideString; out Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_WIDESTR']; compilerproc;
+Var
+  SS : ShortString;
+begin
+  fpc_Val_qword_WideStr:=0;
+  if length(S)>255 then
+    code:=256
+  else
+    begin
+       SS := S;
+       Val(SS,fpc_Val_qword_WideStr,Code);
+    end;
+end;
+
+
+Function fpc_Val_int64_WideStr (Const S : WideString; out Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_WIDESTR']; compilerproc;
+Var
+  SS : ShortString;
+begin
+  fpc_Val_int64_WideStr:=0;
+  if length(S)>255 then
+    code:=256
+  else
+    begin
+       SS := S;
+       Val(SS,fpc_Val_int64_WideStr,Code);
+    end;
+end;
+
+{$endif CPU64}
+
+
+{$ifndef FPUNONE}
+procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : WideString);compilerproc;
+var
+  ss : shortstring;
+begin
+  str_real(len,fr,d,treal_type(rt),ss);
+  s:=ss;
+end;
+{$endif}
+
+procedure fpc_widestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:widestring);compilerproc;
+
+var ss:shortstring;
+
+begin
+  fpc_shortstr_enum(ordinal,len,typinfo,ord2strindex,ss);
+  s:=ss;
+end;
+
+{$ifdef FPC_HAS_STR_CURRENCY}
+procedure fpc_WideStr_Currency(c : Currency;len,fr : SizeInt;out s : WideString);compilerproc;
+var
+  ss : shortstring;
+begin
+  str(c:len:fr,ss);
+  s:=ss;
+end;
+{$endif FPC_HAS_STR_CURRENCY}
+
+Procedure fpc_WideStr_SInt(v : ValSint; Len : SizeInt; out S : WideString);compilerproc;
+Var
+  SS : ShortString;
+begin
+  Str (v:Len,SS);
+  S:=SS;
+end;
+
+
+Procedure fpc_WideStr_UInt(v : ValUInt;Len : SizeInt; out S : WideString);compilerproc;
+Var
+  SS : ShortString;
+begin
+  str(v:Len,SS);
+  S:=SS;
+end;
+
+
+{$ifndef CPU64}
+
+Procedure fpc_WideStr_Int64(v : Int64; Len : SizeInt; out S : WideString);compilerproc;
+Var
+  SS : ShortString;
+begin
+  Str (v:Len,SS);
+  S:=SS;
+end;
+
+
+Procedure fpc_WideStr_Qword(v : Qword;Len : SizeInt; out S : WideString);compilerproc;
+Var
+  SS : ShortString;
+begin
+  str(v:Len,SS);
+  S:=SS;
+end;
+
+{$endif CPU64}
+
+function UnicodeToUtf8(Dest: PChar; Source: PWideChar; 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: PWideChar; SourceChars: SizeUInt): SizeUInt;
+  var
+    i,j : SizeUInt;
+    w : word;
+  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;
+              else
+                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;
+            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);
+              else
+                inc(j,3);
+            end;
+            inc(i);
+          end;
+      end;
+    result:=j+1;
+  end;
+
+
+function Utf8ToUnicode(Dest: PWideChar; 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: PWideChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
+
+var
+  i,j : SizeUInt;
+  w: SizeUInt;
+  b : byte;
+begin
+  if not assigned(Source) then
+  begin
+    result:=0;
+    exit;
+  end;
+  result:=SizeUInt(-1);
+  i:=0;
+  j:=0;
+  if assigned(Dest) then
+    begin
+      while (j<MaxDestChars) and (i<SourceBytes) do
+        begin
+          b:=byte(Source[i]);
+          w:=b;
+          inc(i);
+          // 2 or 3 bytes?
+          if b>=$80 then
+            begin
+              w:=b and $3f;
+              if i>=SourceBytes then
+                exit;
+              // 3 bytes?
+              if (b and $20)<>0 then
+                begin
+                  b:=byte(Source[i]);
+                  inc(i);
+                  if i>=SourceBytes then
+                    exit;
+                  if (b and $c0)<>$80 then
+                    exit;
+                  w:=(w shl 6) or (b and $3f);
+                end;
+              b:=byte(Source[i]);
+              w:=(w shl 6) or (b and $3f);
+              if (b and $c0)<>$80 then
+                exit;
+              inc(i);
+            end;
+          Dest[j]:=WideChar(w);
+          inc(j);
+        end;
+      if j>=MaxDestChars then j:=MaxDestChars-1;
+      Dest[j]:=#0;
+    end
+  else
+    begin
+      while i<SourceBytes do
+        begin
+          b:=byte(Source[i]);
+          inc(i);
+          // 2 or 3 bytes?
+          if b>=$80 then
+            begin
+              if i>=SourceBytes then
+                exit;
+              // 3 bytes?
+              b := b and $3f;
+              if (b and $20)<>0 then
+                begin
+                  b:=byte(Source[i]);
+                  inc(i);
+                  if i>=SourceBytes then
+                    exit;
+                  if (b and $c0)<>$80 then
+                    exit;
+                end;
+              if (byte(Source[i]) and $c0)<>$80 then
+                exit;
+              inc(i);
+            end;
+          inc(j);
+        end;
+    end;
+  result:=j+1;
+end;
+
+
+function UTF8Encode(const s : WideString) : UTF8String;
+  var
+    i : SizeInt;
+    hs : UTF8String;
+  begin
+    result:='';
+    if s='' then
+      exit;
+    SetLength(hs,length(s)*3);
+    i:=UnicodeToUtf8(pchar(hs),length(hs)+1,PWideChar(s),length(s));
+    if i>0 then
+      begin
+        SetLength(hs,i-1);
+        result:=hs;
+      end;
+  end;
+
+
+function UTF8Decode(const s : UTF8String): WideString;
+  var
+    i : SizeInt;
+    hs : WideString;
+  begin
+    result:='';
+    if s='' then
+      exit;
+    SetLength(hs,length(s));
+    i:=Utf8ToUnicode(PWideChar(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;
+
+
+{ converts an utf-16 code point or surrogate pair to utf-32 }
+function utf16toutf32(const S: WideString; const index: SizeInt; out len: longint): UCS4Char; [public, alias: 'FPC_UTF16TOUTF32'];
+var
+  w: widechar;
+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 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
+  SNoWidestrings = 'This binary has no widestrings support compiled in.';
+  SRecompileWithWidestrings = 'Recompile the application with a widestrings-manager in the program uses clause.';
+
+procedure unimplementedwidestring;
+  begin
+{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
+    If IsConsole then
+      begin
+      Writeln(StdErr,SNoWidestrings);
+      Writeln(StdErr,SRecompileWithWidestrings);
+      end;
+{$endif FPC_HAS_FEATURE_CONSOLEIO}
+    HandleErrorFrame(233,get_frame);
+  end;
+
+{$warnings off}
+function GenericWideCase(const s : WideString) : WideString;
+  begin
+    unimplementedwidestring;
+  end;
+
+
+function CompareWideString(const s1, s2 : WideString) : PtrInt;
+  begin
+    unimplementedwidestring;
+  end;
+
+
+function CompareTextWideString(const s1, s2 : WideString): PtrInt;
+  begin
+    unimplementedwidestring;
+  end;
+
+
+function CharLengthPChar(const Str: PChar): PtrInt;
+  begin
+    unimplementedwidestring;
+  end;
+{$warnings on}
+
+procedure initwidestringmanager;
+  begin
+    fillchar(widestringmanager,sizeof(widestringmanager),0);
+{$ifndef HAS_WIDESTRINGMANAGER}
+    widestringmanager.Wide2AnsiMoveProc:=@defaultWide2AnsiMove;
+    widestringmanager.Ansi2WideMoveProc:=@defaultAnsi2WideMove;
+    widestringmanager.UpperWideStringProc:=@GenericWideCase;
+    widestringmanager.LowerWideStringProc:=@GenericWideCase;
+{$endif HAS_WIDESTRINGMANAGER}
+    widestringmanager.CompareWideStringProc:=@CompareWideString;
+    widestringmanager.CompareTextWideStringProc:=@CompareTextWideString;
+    widestringmanager.CharLengthPCharProc:=@CharLengthPChar;
+  end;

rtl/inc/wustrings.inc

@@ -14,1989 +14,3 @@
 
  **********************************************************************}
 
-{
-  This file contains the implementation of the WideString type,
-  and all things that are needed for it.
-  WideString is defined as a 'silent' pwidechar :
-  a pwidechar that points to :
-
-  @-8  : SizeInt for reference count;
-  @-4  : SizeInt for size; size=number of bytes, not the number of chars. Divide or multiply
-         with sizeof(WideChar) to convert. This is needed to be compatible with Delphi and
-         Windows COM BSTR.
-  @    : String + Terminating #0;
-  Pwidechar(Widestring) is a valid typecast.
-  So WS[i] is converted to the address @WS+i-1.
-
-  Constants should be assigned a reference count of -1
-  Meaning that they can't be disposed of.
-}
-
-Type
-  PWideRec = ^TWideRec;
-  TWideRec = Packed Record
-{$ifdef FPC_WINLIKEWIDESTRING}
-    Len   : DWord;
-{$else FPC_WINLIKEWIDESTRING}
-    Ref : SizeInt;
-    Len : SizeInt;
-{$endif FPC_WINLIKEWIDESTRING}
-    First : WideChar;
-  end;
-
-Const
-  WideRecLen = SizeOf(TWideRec);
-  WideFirstOff = SizeOf(TWideRec)-sizeof(WideChar);
-
-{
-  Default WideChar <-> Char conversion is to only convert the
-  lower 127 chars, all others are translated to spaces.
-
-  These routines can be overwritten for the Current Locale
-}
-
-procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
-var
-  i : SizeInt;
-begin
-  setlength(dest,len);
-  for i:=1 to len do
-    begin
-      if word(source^)<256 then
-        dest[i]:=char(word(source^))
-      else
-        dest[i]:='?';
-      inc(source);
-    end;
-end;
-
-
-procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
-var
-  i : SizeInt;
-begin
-  setlength(dest,len);
-  for i:=1 to len do
-    begin
-      dest[i]:=widechar(byte(source^));
-      inc(source);
-    end;
-end;
-
-
-Procedure GetWideStringManager (Var Manager : TWideStringManager);
-begin
-  manager:=widestringmanager;
-end;
-
-
-Procedure SetWideStringManager (Const New : TWideStringManager; Var Old: TWideStringManager);
-begin
-  Old:=widestringmanager;
-  widestringmanager:=New;
-end;
-
-
-Procedure SetWideStringManager (Const New : TWideStringManager);
-begin
-  widestringmanager:=New;
-end;
-
-(*
-Procedure UniqueWideString(Var S : WideString); [Public,Alias : 'FPC_WIDESTR_UNIQUE'];
-{
-  Make sure reference count of S is 1,
-  using copy-on-write semantics.
-}
-
-begin
-end;
-*)
-
-
-{****************************************************************************
-                    Internal functions, not in interface.
-****************************************************************************}
-
-
-procedure WideStringError;
-  begin
-    HandleErrorFrame(204,get_frame);
-  end;
-
-
-{$ifdef WideStrDebug}
-Procedure DumpWideRec(S : Pointer);
-begin
-  If S=Nil then
-    Writeln ('String is nil')
-  Else
-    Begin
-      With PWideRec(S-WideFirstOff)^ do
-       begin
-         Write   ('(Len:',len);
-         Writeln (' Ref: ',ref,')');
-       end;
-    end;
-end;
-{$endif}
-
-
-Function NewWideString(Len : SizeInt) : Pointer;
-{
-  Allocate a new WideString on the heap.
-  initialize it to zero length and reference count 1.
-}
-Var
-  P : Pointer;
-begin
-{$ifdef MSWINDOWS}
-  if winwidestringalloc then
-    begin
-      P:=SysAllocStringLen(nil,Len);
-      if P=nil then
-        WideStringError;
-    end
-  else
-{$endif MSWINDOWS}
-    begin
-      GetMem(P,Len*sizeof(WideChar)+WideRecLen);
-      If P<>Nil then
-        begin
-         PWideRec(P)^.Len:=Len*2;     { Initial length }
-{$ifndef FPC_WINLIKEWIDESTRING}
-         PWideRec(P)^.Ref:=1;         { Initial Refcount }
-{$endif FPC_WINLIKEWIDESTRING}
-         PWideRec(P)^.First:=#0;      { Terminating #0 }
-         inc(p,WideFirstOff);         { Points to string now }
-        end
-      else
-        WideStringError;
-    end;
-  NewWideString:=P;
-end;
-
-
-Procedure DisposeWideString(Var S : Pointer);
-{
-  Deallocates a WideString From the heap.
-}
-begin
-  If S=Nil then
-    exit;
-{$ifndef MSWINDOWS}
-  Dec (S,WideFirstOff);
-  Freemem(S);
-{$else MSWINDOWS}
-  if winwidestringalloc then
-    SysFreeString(S)
-  else
-    begin
-      Dec (S,WideFirstOff);
-      Freemem(S);
-    end;
-{$endif MSWINDOWS}
-  S:=Nil;
-end;
-
-{$ifdef FPC_WINLIKEWIDESTRING}
-var
-  __data_start: byte; external name '__data_start__';
-  __data_end: byte; external name '__data_end__';
-
-function IsWideStringConstant(S: pointer): boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
-{
-  Returns True if widestring is constant (located in .data section);
-}
-begin
-  Result:=(S>=@__data_start) and (S<@__data_end);
-end;
-{$endif FPC_WINLIKEWIDESTRING}
-
-Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);[Public,Alias:'FPC_WIDESTR_DECR_REF']; compilerproc;
-{
-  Decreases the ReferenceCount of a non constant widestring;
-  If the reference count is zero, deallocate the string;
-}
-Type
-  pSizeInt = ^SizeInt;
-{$ifndef FPC_WINLIKEWIDESTRING}
-Var
-  l : pSizeInt;
-{$endif FPC_WINLIKEWIDESTRING}
-Begin
-  { Zero string }
-  if S=Nil then
-    exit;
-{$ifndef FPC_WINLIKEWIDESTRING}
-  { check for constant strings ...}
-  l:=@PWideRec(S-WideFirstOff)^.Ref;
-  if l^<0 then
-    exit;
-
-  { declocked does a MT safe dec and returns true, if the counter is 0 }
-  if declocked(l^) then
-    { Ref count dropped to zero ...
-      ... remove }
-{$else}
-  if not IsWideStringConstant(S) then
-{$endif FPC_WINLIKEWIDESTRING}
-    DisposeWideString(S);
-end;
-
-{ alias for internal use }
-Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);[external name 'FPC_WIDESTR_DECR_REF'];
-
-Procedure fpc_WideStr_Incr_Ref(Var S : Pointer);[Public,Alias:'FPC_WIDESTR_INCR_REF']; compilerproc;
-{$ifdef FPC_WINLIKEWIDESTRING}
-  var
-    p : pointer;
-{$endif FPC_WINLIKEWIDESTRING}
-  Begin
-    If S=Nil then
-      exit;
-{$ifdef FPC_WINLIKEWIDESTRING}
-    p:=NewWidestring(length(WideString(S)));
-    move(s^,p^,(length(WideString(s))+1)*sizeof(widechar)); // double #0 too
-    s:=p;
-{$else FPC_WINLIKEWIDESTRING}
-    { Let's be paranoid : Constant string ??}
-    If PWideRec(S-WideFirstOff)^.Ref<0 then
-      exit;
-    inclocked(PWideRec(S-WideFirstOff)^.Ref);
-{$endif FPC_WINLIKEWIDESTRING}
-  end;
-
-{ alias for internal use }
-Procedure fpc_WideStr_Incr_Ref (Var S : Pointer);[external name 'FPC_WIDESTR_INCR_REF'];
-
-{$ifndef FPC_STRTOSHORTSTRINGPROC}
-function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): shortstring;[Public, alias: 'FPC_WIDESTR_TO_SHORTSTR'];  compilerproc;
-{
-  Converts a WideString to a ShortString;
-}
-Var
-  Size : SizeInt;
-  temp : ansistring;
-begin
-  result:='';
-  Size:=Length(S2);
-  if Size>0 then
-    begin
-      If Size>high_of_res then
-        Size:=high_of_res;
-      widestringmanager.Wide2AnsiMoveProc(PWideChar(S2),temp,Size);
-      result:=temp;
-    end;
-end;
-{$else FPC_STRTOSHORTSTRINGPROC}
-procedure fpc_WideStr_To_ShortStr (out res: ShortString;const S2 : WideString); [Public, alias: 'FPC_WIDESTR_TO_SHORTSTR'];compilerproc;
-{
-  Converts a WideString 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.Wide2AnsiMoveProc(PWideChar(S2),temp,Size);
-      res:=temp;
-    end;
-end;
-{$endif FPC_STRTOSHORTSTRINGPROC}
-
-
-Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString;compilerproc;
-{
-  Converts a ShortString to a WideString;
-}
-Var
-  Size : SizeInt;
-begin
-  result:='';
-  Size:=Length(S2);
-  if Size>0 then
-    begin
-      widestringmanager.Ansi2WideMoveProc(PChar(@S2[1]),result,Size);
-      { Terminating Zero }
-      PWideChar(Pointer(fpc_ShortStr_To_WideStr)+Size*sizeof(WideChar))^:=#0;
-    end;
-end;
-
-
-Function fpc_WideStr_To_AnsiStr (const S2 : WideString): AnsiString; compilerproc;
-{
-  Converts a WideString to an AnsiString
-}
-Var
-  Size : SizeInt;
-begin
-  result:='';
-  Size:=Length(S2);
-  if Size>0 then
-    widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),result,Size);
-end;
-
-
-Function fpc_AnsiStr_To_WideStr (Const S2 : AnsiString): WideString; compilerproc;
-{
-  Converts an AnsiString to a WideString;
-}
-Var
-  Size : SizeInt;
-begin
-  result:='';
-  Size:=Length(S2);
-  if Size>0 then
-    widestringmanager.Ansi2WideMoveProc(PChar(S2),result,Size);
-end;
-
-
-Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
-var
-  Size : SizeInt;
-begin
-  result:='';
-  if p=nil then
-    exit;
-  Size := IndexWord(p^, -1, 0);
-  if Size>0 then
-    widestringmanager.Wide2AnsiMoveProc(P,result,Size);
-end;
-
-
-Function fpc_PWideChar_To_WideStr(const p : pwidechar): widestring; compilerproc;
-var
-  Size : SizeInt;
-begin
-  result:='';
-  if p=nil then
-    exit;
-  Size := IndexWord(p^, -1, 0);
-  Setlength(result,Size);
-  if Size>0 then
-   begin
-      Move(p^,PWideChar(Pointer(result))^,Size*sizeof(WideChar));
-      { Terminating Zero }
-      PWideChar(Pointer(result)+Size*sizeof(WideChar))^:=#0;
-   end;
-end;
-
-
-{$ifndef FPC_STRTOSHORTSTRINGPROC}
-Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;
-var
-  Size : SizeInt;
-  temp: ansistring;
-begin
-  result:='';
-  if p=nil then
-    exit;
-  Size := IndexWord(p^, $7fffffff, 0);
-  if Size>0 then
-    begin
-      widestringmanager.Wide2AnsiMoveProc(p,temp,Size);
-      result:=temp;
-    end;
-end;
-{$else FPC_STRTOSHORTSTRINGPROC}
-procedure fpc_PWideChar_To_ShortStr(out res : shortstring;const p : pwidechar); compilerproc;
-var
-  Size : SizeInt;
-  temp: ansistring;
-begin
-  res:='';
-  if p=nil then
-    exit;
-  Size:=IndexWord(p^, high(PtrInt), 0);
-  if Size>0 then
-    begin
-      widestringmanager.Wide2AnsiMoveProc(p,temp,Size);
-      res:=temp;
-    end;
-end;
-{$endif FPC_STRTOSHORTSTRINGPROC}
-
-
-{ checked against the ansistring routine, 2001-05-27 (FK) }
-Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_WIDESTR_ASSIGN']; compilerproc;
-{
-  Assigns S2 to S1 (S1:=S2), taking in account reference counts.
-}
-begin
-{$ifdef FPC_WINLIKEWIDESTRING}
-  if S1=S2 then exit;
-  if S2<>nil then
-    begin
-      if IsWideStringConstant(S1) then
-        begin
-          S1:=NewWidestring(length(WideString(S2)));
-          move(s2^,s1^,(length(WideString(s1))+1)*sizeof(widechar));
-        end
-      else
-{$ifdef MSWINDOWS}
-        if winwidestringalloc then
-          begin
-            if SysReAllocStringLen(S1, S2, Length(WideString(S2))) = 0 then
-              WideStringError;
-          end
-        else
-{$endif MSWINDOWS}
-          begin
-            SetLength(WideString(S1),length(WideString(S2)));
-            move(s2^,s1^,(length(WideString(s1))+1)*sizeof(widechar));
-          end;
-    end
-  else
-    begin
-      { Free S1 }
-      fpc_widestr_decr_ref (S1);
-      S1:=nil;
-    end;
-{$else FPC_WINLIKEWIDESTRING}
-  If S2<>nil then
-    If PWideRec(S2-WideFirstOff)^.Ref>0 then
-      inclocked(PWideRec(S2-WideFirstOff)^.ref);
-  { Decrease the reference count on the old S1 }
-  fpc_widestr_decr_ref (S1);
-  s1:=s2;
-{$endif FPC_WINLIKEWIDESTRING}
-end;
-
-
-{ alias for internal use }
-Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_WIDESTR_ASSIGN'];
-
-{$ifndef STR_CONCAT_PROCS}
-
-function fpc_WideStr_Concat (const S1,S2 : WideString): WideString; compilerproc;
-Var
-  Size,Location : SizeInt;
-  pc : pwidechar;
-begin
-  { only assign if s1 or s2 is empty }
-  if (S1='') then
-    begin
-      result:=s2;
-      exit;
-    end;
-  if (S2='') then
-    begin
-      result:=s1;
-      exit;
-    end;
-  Location:=Length(S1);
-  Size:=length(S2);
-  SetLength(result,Size+Location);
-  pc:=pwidechar(result);
-  Move(S1[1],pc^,Location*sizeof(WideChar));
-  inc(pc,location);
-  Move(S2[1],pc^,(Size+1)*sizeof(WideChar));
-end;
-
-
-function fpc_WideStr_Concat_multi (const sarr:array of Widestring): widestring; compilerproc;
-Var
-  i  : Longint;
-  p  : pointer;
-  pc : pwidechar;
-  Size,NewSize : SizeInt;
-begin
-  { First calculate size of the result so we can do
-    a single call to SetLength() }
-  NewSize:=0;
-  for i:=low(sarr) to high(sarr) do
-    inc(Newsize,length(sarr[i]));
-  SetLength(result,NewSize);
-  pc:=pwidechar(result);
-  for i:=low(sarr) to high(sarr) do
-    begin
-      p:=pointer(sarr[i]);
-      if assigned(p) then
-        begin
-          Size:=length(widestring(p));
-          Move(pwidechar(p)^,pc^,(Size+1)*sizeof(WideChar));
-          inc(pc,size);
-        end;
-    end;
-end;
-
-{$else STR_CONCAT_PROCS}
-
-procedure fpc_WideStr_Concat (var DestS:Widestring;const S1,S2 : WideString); compilerproc;
-Var
-  Size,Location : SizeInt;
-  same : boolean;
-begin
-  { only assign if s1 or s2 is empty }
-  if (S1='') then
-    begin
-      DestS:=s2;
-      exit;
-    end;
-  if (S2='') then
-    begin
-      DestS:=s1;
-      exit;
-    end;
-  Location:=Length(S1);
-  Size:=length(S2);
-  { Use Pointer() typecasts to prevent extra conversion code }
-  if Pointer(DestS)=Pointer(S1) then
-    begin
-      same:=Pointer(S1)=Pointer(S2);
-      SetLength(DestS,Size+Location);
-      if same then
-        Move(Pointer(DestS)^,(Pointer(DestS)+Location*sizeof(WideChar))^,(Size)*sizeof(WideChar))
-      else
-        Move(Pointer(S2)^,(Pointer(DestS)+Location*sizeof(WideChar))^,(Size+1)*sizeof(WideChar));
-    end
-  else if Pointer(DestS)=Pointer(S2) then
-    begin
-      SetLength(DestS,Size+Location);
-      Move(Pointer(DestS)^,(Pointer(DestS)+Location*sizeof(WideChar))^,(Size+1)*sizeof(WideChar));
-      Move(Pointer(S1)^,Pointer(DestS)^,Location*sizeof(WideChar));
-    end
-  else
-    begin
-      DestS:='';
-      SetLength(DestS,Size+Location);
-      Move(Pointer(S1)^,Pointer(DestS)^,Location*sizeof(WideChar));
-      Move(Pointer(S2)^,(Pointer(DestS)+Location*sizeof(WideChar))^,(Size+1)*sizeof(WideChar));
-    end;
-end;
-
-
-procedure fpc_WideStr_Concat_multi (var DestS:Widestring;const sarr:array of Widestring); compilerproc;
-Var
-  i           : Longint;
-  p,pc        : pointer;
-  Size,NewLen : SizeInt;
-{$ifndef FPC_WINLIKEWIDESTRING}
-  lowstart    : longint;
-  destcopy    : pointer;
-  OldDestLen  : SizeInt;
-{$else FPC_WINLIKEWIDESTRING}
-  DestTmp     : Widestring;
-{$endif FPC_WINLIKEWIDESTRING}
-begin
-  if high(sarr)=0 then
-    begin
-      DestS:='';
-      exit;
-    end;
-{$ifndef FPC_WINLIKEWIDESTRING}
-  destcopy:=nil;
-  lowstart:=low(sarr);
-  if Pointer(DestS)=Pointer(sarr[lowstart]) then
-    inc(lowstart);
-  { Check for another reuse, then we can't use
-    the append optimization }
-  for i:=lowstart to high(sarr) do
-    begin
-      if Pointer(DestS)=Pointer(sarr[i]) then
-        begin
-          { if DestS is used somewhere in the middle of the expression,
-            we need to make sure the original string still exists after
-            we empty/modify DestS.
-            This trick only works with reference counted strings. Therefor
-            this optimization is disabled for WINLIKEWIDESTRING }
-          destcopy:=pointer(dests);
-          fpc_WideStr_Incr_Ref(destcopy);
-          lowstart:=low(sarr);
-          break;
-        end;
-    end;
-  { Start with empty DestS if we start with concatting
-    the first array element }
-  if lowstart=low(sarr) then
-    DestS:='';
-  OldDestLen:=length(DestS);
-  { Calculate size of the result so we can do
-    a single call to SetLength() }
-  NewLen:=0;
-  for i:=low(sarr) to high(sarr) do
-    inc(NewLen,length(sarr[i]));
-  SetLength(DestS,NewLen);
-  { Concat all strings, except the string we already
-    copied in DestS }
-  pc:=Pointer(DestS)+OldDestLen*sizeof(WideChar);
-  for i:=lowstart to high(sarr) do
-    begin
-      p:=pointer(sarr[i]);
-      if assigned(p) then
-        begin
-          Size:=length(widestring(p));
-          Move(p^,pc^,(Size+1)*sizeof(WideChar));
-          inc(pc,size*sizeof(WideChar));
-        end;
-    end;
-  fpc_WideStr_Decr_Ref(destcopy);
-{$else FPC_WINLIKEWIDESTRING}
-  { First calculate size of the result so we can do
-    a single call to SetLength() }
-  NewLen:=0;
-  for i:=low(sarr) to high(sarr) do
-    inc(NewLen,length(sarr[i]));
-  SetLength(DestTmp,NewLen);
-  pc:=pwidechar(DestTmp);
-  for i:=low(sarr) to high(sarr) do
-    begin
-      p:=pointer(sarr[i]);
-      if assigned(p) then
-        begin
-          Size:=length(widestring(p));
-          Move(p^,pc^,(Size+1)*sizeof(WideChar));
-          inc(pc,size*sizeof(WideChar));
-        end;
-    end;
-  DestS:=DestTmp;
-{$endif FPC_WINLIKEWIDESTRING}
-end;
-
-{$endif STR_CONCAT_PROCS}
-
-Function fpc_Char_To_WChar(const c : Char): WideChar; compilerproc;
-var
-  w: widestring;
-begin
-  widestringmanager.Ansi2WideMoveProc(@c, w, 1);
-  fpc_Char_To_WChar:= w[1];
-end;
-
-
-
-Function fpc_Char_To_WideStr(const c : Char): WideString; compilerproc;
-{
-  Converts a Char to a WideString;
-}
-begin
-  Setlength(fpc_Char_To_WideStr,1);
-  fpc_Char_To_WideStr[1]:=c;
-  { Terminating Zero }
-  PWideChar(Pointer(fpc_Char_To_WideStr)+sizeof(WideChar))^:=#0;
-end;
-
-
-Function fpc_WChar_To_Char(const c : WideChar): Char; compilerproc;
-{
-  Converts a WideChar to a Char;
-}
-var
-  s: ansistring;
-begin
-  widestringmanager.Wide2AnsiMoveProc(@c, s, 1);
-  if length(s)=1 then
-    fpc_WChar_To_Char:= s[1]
-  else
-    fpc_WChar_To_Char:='?';
-end;
-
-
-Function fpc_WChar_To_WideStr(const c : WideChar): WideString; compilerproc;
-{
-  Converts a WideChar to a WideString;
-}
-begin
-  Setlength (fpc_WChar_To_WideStr,1);
-  fpc_WChar_To_WideStr[1]:= c;
-end;
-
-
-Function fpc_WChar_To_AnsiStr(const c : WideChar): AnsiString; compilerproc;
-{
-  Converts a WideChar to a AnsiString;
-}
-begin
-  widestringmanager.Wide2AnsiMoveProc(@c, fpc_WChar_To_AnsiStr, 1);
-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_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
-Var
-  L : SizeInt;
-begin
-  if (not assigned(p)) or (p[0]=#0) Then
-  begin
-    fpc_pchar_to_widestr := '';
-    exit;
-  end;
-  l:=IndexChar(p^,-1,#0);
-  widestringmanager.Ansi2WideMoveProc(P,fpc_PChar_To_WideStr,l);
-end;
-
-
-Function fpc_CharArray_To_WideStr(const arr: array of char; zerobased: boolean = true): WideString; compilerproc;
-var
-  i  : SizeInt;
-begin
-  if (zerobased) then
-    begin
-      if (arr[0]=#0) Then
-      begin
-        fpc_chararray_to_widestr := '';
-        exit;
-      end;
-      i:=IndexChar(arr,high(arr)+1,#0);
-      if i = -1 then
-        i := high(arr)+1;
-    end
-  else
-    i := high(arr)+1;
-  SetLength(fpc_CharArray_To_WideStr,i);
-  widestringmanager.Ansi2WideMoveProc (pchar(@arr),fpc_CharArray_To_WideStr,i);
-end;
-
-
-{$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;
-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_WideStr,i);
-  Move(arr[0], Pointer(fpc_WideCharArray_To_WideStr)^,i*sizeof(WideChar));
-end;
-
-{$ifndef FPC_STRTOCHARARRAYPROC}
-
-{ inside the compiler, the resulttype is modified to that of the actual }
-{ chararray we're converting to (JM)                                    }
-function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray;[public,alias: 'FPC_WIDESTR_TO_CHARARRAY']; compilerproc;
-var
-  len: SizeInt;
-  temp: ansistring;
-begin
-  len := length(src);
-  { make sure we don't dereference src if it can be nil (JM) }
-  if len > 0 then
-    widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),temp,len);
-  len := length(temp);
-  if len > arraysize then
-    len := arraysize;
-{$r-}
-  move(temp[1],fpc_widestr_to_chararray[0],len);
-  fillchar(fpc_widestr_to_chararray[len],arraysize-len,0);
-{$ifdef RangeCheckWasOn}
-{$r+}
-{$endif}
-end;
-
-
-{ inside the compiler, the resulttype is modified to that of the actual }
-{ widechararray we're converting to (JM)                                }
-function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray;[public,alias: 'FPC_WIDESTR_TO_WIDECHARARRAY']; compilerproc;
-var
-  len: SizeInt;
-begin
-  len := length(src);
-  if len > arraysize then
-    len := arraysize;
-{$r-}
-  { make sure we don't try to access element 1 of the ansistring if it's nil }
-  if len > 0 then
-    move(src[1],fpc_widestr_to_widechararray[0],len*SizeOf(WideChar));
-  fillchar(fpc_widestr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
-{$ifdef RangeCheckWasOn}
-{$r+}
-{$endif}
-end;
-
-
-{ inside the compiler, the resulttype is modified to that of the actual }
-{ chararray we're converting to (JM)                                    }
-function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray;[public,alias: 'FPC_ANSISTR_TO_WIDECHARARRAY']; 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 > arraysize then
-    len := arraysize;
-
-{$r-}
-  move(temp[1],fpc_ansistr_to_widechararray[0],len*sizeof(widechar));
-  fillchar(fpc_ansistr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
-{$ifdef RangeCheckWasOn}
-{$r+}
-{$endif}
-end;
-
-function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray;[public,alias: 'FPC_SHORTSTR_TO_WIDECHARARRAY']; 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 > arraysize then
-    len := arraysize;
-{$r-}
-  move(temp[1],fpc_shortstr_to_widechararray[0],len*sizeof(widechar));
-  fillchar(fpc_shortstr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
-{$ifdef RangeCheckWasOn}
-{$r+}
-{$endif}
-end;
-
-{$else ndef FPC_STRTOCHARARRAYPROC}
-
-procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); compilerproc;
-var
-  len: SizeInt;
-  temp: ansistring;
-begin
-  len := length(src);
-  { make sure we don't dereference src if it can be nil (JM) }
-  if len > 0 then
-    widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),temp,len);
-  len := length(temp);
-  if len > length(res) then
-    len := length(res);
-{$r-}
-  move(temp[1],res[0],len);
-  fillchar(res[len],length(res)-len,0);
-{$ifdef RangeCheckWasOn}
-{$r+}
-{$endif}
-end;
-
-
-procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc;
-var
-  len: SizeInt;
-begin
-  len := length(src);
-  if len > length(res) then
-    len := length(res);
-{$r-}
-  { make sure we don't try to access element 1 of the ansistring if it's nil }
-  if len > 0 then
-    move(src[1],res[0],len*SizeOf(WideChar));
-  fillchar(res[len],(length(res)-len)*SizeOf(WideChar),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;
-
-{$endif ndef FPC_STRTOCHARARRAYPROC}
-
-Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE']; compilerproc;
-{
-  Compares 2 WideStrings;
-  The result is
-   <0 if S1<S2
-   0 if S1=S2
-   >0 if S1>S2
-}
-Var
-  MaxI,Temp : SizeInt;
-begin
-  if pointer(S1)=pointer(S2) then
-   begin
-     fpc_WideStr_Compare:=0;
-     exit;
-   end;
-  Maxi:=Length(S1);
-  temp:=Length(S2);
-  If MaxI>Temp then
-   MaxI:=Temp;
-  Temp:=CompareWord(S1[1],S2[1],MaxI);
-  if temp=0 then
-   temp:=Length(S1)-Length(S2);
-  fpc_WideStr_Compare:=Temp;
-end;
-
-Function fpc_WideStr_Compare_Equal(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE_EQUAL']; compilerproc;
-{
-  Compares 2 WideStrings for equality only;
-  The result is
-   0 if S1=S2
-   <>0 if S1<>S2
-}
-Var
-  MaxI : SizeInt;
-begin
-  if pointer(S1)=pointer(S2) then
-    exit(0);
-  Maxi:=Length(S1);
-  If MaxI<>Length(S2) then
-    exit(-1)
-  else
-    exit(CompareWord(S1[1],S2[1],MaxI));
-end;
-
-Procedure fpc_WideStr_CheckZero(p : pointer);[Public,Alias : 'FPC_WIDESTR_CHECKZERO']; compilerproc;
-begin
-  if p=nil then
-    HandleErrorFrame(201,get_frame);
-end;
-
-
-Procedure fpc_WideStr_CheckRange(len,index : SizeInt);[Public,Alias : 'FPC_WIDESTR_RANGECHECK']; compilerproc;
-begin
-  if (index>len div 2) or (Index<1) then
-    HandleErrorFrame(201,get_frame);
-end;
-
-Procedure fpc_WideStr_SetLength(Var S : WideString; l : SizeInt);[Public,Alias : 'FPC_WIDESTR_SETLENGTH']; compilerproc;
-{
-  Sets The length of string S to L.
-  Makes sure S is unique, and contains enough room.
-}
-Var
-  Temp : Pointer;
-  movelen: SizeInt;
-begin
-   if (l>0) then
-    begin
-      if Pointer(S)=nil then
-       begin
-         { Need a complete new string...}
-         Pointer(s):=NewWideString(l);
-       end
-      { windows doesn't support reallocing widestrings, this code
-        is anyways subject to be removed because widestrings shouldn't be
-        ref. counted anymore (FK) }
-      else
-        if
-{$ifdef MSWINDOWS}
-              not winwidestringalloc and
-{$endif MSWINDOWS}
-{$ifdef FPC_WINLIKEWIDESTRING}
-              not IsWideStringConstant(pointer(S))
-{$else}
-              (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1)
-{$endif FPC_WINLIKEWIDESTRING}
-              then
-        begin
-          Dec(Pointer(S),WideFirstOff);
-          if SizeUInt(L*sizeof(WideChar)+WideRecLen)>MemSize(Pointer(S)) then
-              reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
-          Inc(Pointer(S), WideFirstOff);
-        end
-      else
-        begin
-          { Reallocation is needed... }
-          Temp:=Pointer(NewWideString(L));
-          if Length(S)>0 then
-            begin
-              if l < succ(length(s)) then
-                movelen := l
-              { also move terminating null }
-              else
-                movelen := succ(length(s));
-              Move(Pointer(S)^,Temp^,movelen * Sizeof(WideChar));
-            end;
-          fpc_widestr_decr_ref(Pointer(S));
-          Pointer(S):=Temp;
-        end;
-      { Force nil termination in case it gets shorter }
-      PWord(Pointer(S)+l*sizeof(WideChar))^:=0;
-{$ifdef MSWINDOWS}
-      if not winwidestringalloc then
-{$endif MSWINDOWS}
-        PWideRec(Pointer(S)-WideFirstOff)^.Len:=l*sizeof(WideChar);
-    end
-  else
-    begin
-      { Length=0 }
-      if Pointer(S)<>nil then
-        fpc_widestr_decr_ref (Pointer(S));
-      Pointer(S):=Nil;
-    end;
-end;
-
-{*****************************************************************************
-                     Public functions, In interface.
-*****************************************************************************}
-
-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 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_widestr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_WIDESTR_UNIQUE']; compilerproc;
-{$ifdef FPC_WINLIKEWIDESTRING}
-  begin
-    pointer(result) := pointer(s);
-  end;
-{$else FPC_WINLIKEWIDESTRING}
-{
-  Make sure reference count of S is 1,
-  using copy-on-write semantics.
-}
-Var
-  SNew : Pointer;
-  L    : SizeInt;
-begin
-  pointer(result) := pointer(s);
-  If Pointer(S)=Nil then
-    exit;
-  if PWideRec(Pointer(S)-WideFirstOff)^.Ref<>1 then
-   begin
-     L:=PWideRec(Pointer(S)-WideFirstOff)^.len div sizeof(WideChar);
-     SNew:=NewWideString (L);
-     Move (PWideChar(S)^,SNew^,(L+1)*sizeof(WideChar));
-     PWideRec(SNew-WideFirstOff)^.len:=L * sizeof(WideChar);
-     fpc_widestr_decr_ref (Pointer(S));  { Thread safe }
-     pointer(S):=SNew;
-     pointer(result):=SNew;
-   end;
-end;
-{$endif FPC_WINLIKEWIDESTRING}
-
-
-Function Fpc_WideStr_Copy (Const S : WideString; Index,Size : SizeInt) : WideString;compilerproc;
-var
-  ResultAddress : Pointer;
-begin
-  ResultAddress:=Nil;
-  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
-   begin
-     If Index<0 Then
-      Index:=0;
-     ResultAddress:=Pointer(NewWideString (Size));
-     if ResultAddress<>Nil then
-      begin
-        Move (PWideChar(S)[Index],ResultAddress^,Size*sizeof(WideChar));
-        PWideRec(ResultAddress-WideFirstOff)^.Len:=Size*sizeof(WideChar);
-        PWideChar(ResultAddress+Size*sizeof(WideChar))^:=#0;
-      end;
-   end;
-  fpc_widestr_decr_ref(Pointer(fpc_widestr_copy));
-  Pointer(fpc_widestr_Copy):=ResultAddress;
-end;
-
-
-Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
-var
-  i,MaxLen : SizeInt;
-  pc : pwidechar;
-begin
-  Pos:=0;
-  if Length(SubStr)>0 then
-   begin
-     MaxLen:=Length(source)-Length(SubStr);
-     i:=0;
-     pc:=@source[1];
-     while (i<=MaxLen) do
-      begin
-        inc(i);
-        if (SubStr[1]=pc^) and
-           (CompareWord(Substr[1],pc^,Length(SubStr))=0) then
-         begin
-           Pos:=i;
-           exit;
-         end;
-        inc(pc);
-      end;
-   end;
-end;
-
-
-{ Faster version for a widechar alone }
-Function Pos (c : WideChar; Const s : WideString) : SizeInt;
-var
-  i: SizeInt;
-  pc : pwidechar;
-begin
-  pc:=@s[1];
-  for i:=1 to length(s) do
-   begin
-     if pc^=c then
-      begin
-        pos:=i;
-        exit;
-      end;
-     inc(pc);
-   end;
-  pos:=0;
-end;
-
-
-Function Pos (c : WideChar; Const s : AnsiString) : SizeInt;
-  begin
-    result:=Pos(c,WideString(s));
-  end;
-
-
-Function Pos (c : AnsiString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
-  begin
-    result:=Pos(WideString(c),s);
-  end;
-
-
-Function Pos (c : ShortString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
-  begin
-    result:=Pos(WideString(c),s);
-  end;
-
-
-Function Pos (c : WideString; Const s : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
-  begin
-    result:=Pos(c,WideString(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 : Char; Const s : WideString) : SizeInt;
-var
-  i: SizeInt;
-  wc : widechar;
-  pc : pwidechar;
-begin
-  wc:=c;
-  pc:=@s[1];
-  for i:=1 to length(s) do
-   begin
-     if pc^=wc then
-      begin
-        pos:=i;
-        exit;
-      end;
-     inc(pc);
-   end;
-  pos:=0;
-end;
-
-
-
-Procedure Delete (Var S : WideString; Index,Size: SizeInt);
-Var
-  LS : SizeInt;
-begin
-  If Length(S)=0 then
-   exit;
-  if index<=0 then
-   exit;
-  LS:=PWideRec(Pointer(S)-WideFirstOff)^.Len div sizeof(WideChar);
-  if (Index<=LS) and (Size>0) then
-   begin
-     UniqueString (S);
-     if Size+Index>LS then
-      Size:=LS-Index+1;
-     if Index+Size<=LS then
-      begin
-        Dec(Index);
-        Move(PWideChar(S)[Index+Size],PWideChar(S)[Index],(LS-Index-Size+1)*sizeof(WideChar));
-      end;
-     Setlength(s,LS-Size);
-   end;
-end;
-
-
-Procedure Insert (Const Source : WideString; Var S : WideString; Index : SizeInt);
-var
-  Temp : WideString;
-  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) := NewWideString(Length(Source)+LS);
-  SetLength(Temp,Length(Source)+LS);
-  If Index>0 then
-    move (PWideChar(S)^,PWideChar(Temp)^,Index*sizeof(WideChar));
-  Move (PWideChar(Source)^,PWideChar(Temp)[Index],Length(Source)*sizeof(WideChar));
-  If (LS-Index)>0 then
-    Move(PWideChar(S)[Index],PWideChar(temp)[Length(Source)+index],(LS-Index)*sizeof(WideChar));
-  S:=Temp;
-end;
-
-
-function UpCase(const s : WideString) : WideString;
-begin
-  result:=widestringmanager.UpperWideStringProc(s);
-end;
-
-
-Procedure SetString (Out S : WideString; Buf : PWideChar; Len : SizeInt);
-var
-  BufLen: SizeInt;
-begin
-  SetLength(S,Len);
-  If (Buf<>Nil) and (Len>0) then
-    begin
-      BufLen := IndexWord(Buf^, Len+1, 0);
-      If (BufLen>0) and (BufLen < Len) then
-        Len := BufLen;
-      Move (Buf[0],S[1],Len*sizeof(WideChar));
-      PWideChar(Pointer(S)+Len*sizeof(WideChar))^:=#0;
-    end;
-end;
-
-
-Procedure SetString (Out S : WideString; Buf : PChar; Len : SizeInt);
-var
-  BufLen: SizeInt;
-begin
-  SetLength(S,Len);
-  If (Buf<>Nil) and (Len>0) then
-    begin
-      BufLen := IndexByte(Buf^, Len+1, 0);
-      If (BufLen>0) and (BufLen < Len) then
-        Len := BufLen;
-      widestringmanager.Ansi2WideMoveProc(Buf,S,Len);
-      //PWideChar(Pointer(S)+Len*sizeof(WideChar))^:=#0;
-    end;
-end;
-
-
-{$ifndef FPUNONE}
-Function fpc_Val_Real_WideStr(Const S : WideString; out Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_WIDESTR']; compilerproc;
-Var
-  SS : String;
-begin
-  fpc_Val_Real_WideStr := 0;
-  if length(S) > 255 then
-    code := 256
-  else
-    begin
-      SS := S;
-      Val(SS,fpc_Val_Real_WideStr,code);
-    end;
-end;
-{$endif}
-
-function fpc_val_enum_widestr(str2ordindex:pointer;const s:widestring;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_widestr,code);
-    end;
-end;
-
-Function fpc_Val_Currency_WideStr(Const S : WideString; out Code : ValSInt): Currency; [public, alias:'FPC_VAL_CURRENCY_WIDESTR']; compilerproc;
-Var
-  SS : String;
-begin
-  if length(S) > 255 then
-    begin
-      fpc_Val_Currency_WideStr:=0;
-      code := 256;
-    end
-  else
-    begin
-      SS := S;
-      Val(SS,fpc_Val_Currency_WideStr,code);
-    end;
-end;
-
-
-Function fpc_Val_UInt_WideStr (Const S : WideString; out Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_WIDESTR']; compilerproc;
-Var
-  SS : ShortString;
-begin
-  fpc_Val_UInt_WideStr := 0;
-  if length(S) > 255 then
-    code := 256
-  else
-    begin
-      SS := S;
-      Val(SS,fpc_Val_UInt_WideStr,code);
-    end;
-end;
-
-
-Function fpc_Val_SInt_WideStr (DestSize: SizeInt; Const S : WideString; out Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_WIDESTR']; compilerproc;
-Var
-  SS : ShortString;
-begin
-  fpc_Val_SInt_WideStr:=0;
-  if length(S)>255 then
-    code:=256
-  else
-    begin
-      SS := S;
-      fpc_Val_SInt_WideStr := int_Val_SInt_ShortStr(DestSize,SS,Code);
-    end;
-end;
-
-
-{$ifndef CPU64}
-
-Function fpc_Val_qword_WideStr (Const S : WideString; out Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_WIDESTR']; compilerproc;
-Var
-  SS : ShortString;
-begin
-  fpc_Val_qword_WideStr:=0;
-  if length(S)>255 then
-    code:=256
-  else
-    begin
-       SS := S;
-       Val(SS,fpc_Val_qword_WideStr,Code);
-    end;
-end;
-
-
-Function fpc_Val_int64_WideStr (Const S : WideString; out Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_WIDESTR']; compilerproc;
-Var
-  SS : ShortString;
-begin
-  fpc_Val_int64_WideStr:=0;
-  if length(S)>255 then
-    code:=256
-  else
-    begin
-       SS := S;
-       Val(SS,fpc_Val_int64_WideStr,Code);
-    end;
-end;
-
-{$endif CPU64}
-
-
-{$ifndef FPUNONE}
-procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : WideString);compilerproc;
-var
-  ss : shortstring;
-begin
-  str_real(len,fr,d,treal_type(rt),ss);
-  s:=ss;
-end;
-{$endif}
-
-procedure fpc_widestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:widestring);compilerproc;
-
-var ss:shortstring;
-
-begin
-  fpc_shortstr_enum(ordinal,len,typinfo,ord2strindex,ss);
-  s:=ss;
-end;
-
-{$ifdef FPC_HAS_STR_CURRENCY}
-procedure fpc_WideStr_Currency(c : Currency;len,fr : SizeInt;out s : WideString);compilerproc;
-var
-  ss : shortstring;
-begin
-  str(c:len:fr,ss);
-  s:=ss;
-end;
-{$endif FPC_HAS_STR_CURRENCY}
-
-Procedure fpc_WideStr_SInt(v : ValSint; Len : SizeInt; out S : WideString);compilerproc;
-Var
-  SS : ShortString;
-begin
-  Str (v:Len,SS);
-  S:=SS;
-end;
-
-
-Procedure fpc_WideStr_UInt(v : ValUInt;Len : SizeInt; out S : WideString);compilerproc;
-Var
-  SS : ShortString;
-begin
-  str(v:Len,SS);
-  S:=SS;
-end;
-
-
-{$ifndef CPU64}
-
-Procedure fpc_WideStr_Int64(v : Int64; Len : SizeInt; out S : WideString);compilerproc;
-Var
-  SS : ShortString;
-begin
-  Str (v:Len,SS);
-  S:=SS;
-end;
-
-
-Procedure fpc_WideStr_Qword(v : Qword;Len : SizeInt; out S : WideString);compilerproc;
-Var
-  SS : ShortString;
-begin
-  str(v:Len,SS);
-  S:=SS;
-end;
-
-{$endif CPU64}
-
-function UnicodeToUtf8(Dest: PChar; Source: PWideChar; 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: PWideChar; SourceChars: SizeUInt): SizeUInt;
-  var
-    i,j : SizeUInt;
-    w : word;
-  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;
-              else
-                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;
-            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);
-              else
-                inc(j,3);
-            end;
-            inc(i);
-          end;
-      end;
-    result:=j+1;
-  end;
-
-
-function Utf8ToUnicode(Dest: PWideChar; 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: PWideChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
-
-var
-  i,j : SizeUInt;
-  w: SizeUInt;
-  b : byte;
-begin
-  if not assigned(Source) then
-  begin
-    result:=0;
-    exit;
-  end;
-  result:=SizeUInt(-1);
-  i:=0;
-  j:=0;
-  if assigned(Dest) then
-    begin
-      while (j<MaxDestChars) and (i<SourceBytes) do
-        begin
-          b:=byte(Source[i]);
-          w:=b;
-          inc(i);
-          // 2 or 3 bytes?
-          if b>=$80 then
-            begin
-              w:=b and $3f;
-              if i>=SourceBytes then
-                exit;
-              // 3 bytes?
-              if (b and $20)<>0 then
-                begin
-                  b:=byte(Source[i]);
-                  inc(i);
-                  if i>=SourceBytes then
-                    exit;
-                  if (b and $c0)<>$80 then
-                    exit;
-                  w:=(w shl 6) or (b and $3f);
-                end;
-              b:=byte(Source[i]);
-              w:=(w shl 6) or (b and $3f);
-              if (b and $c0)<>$80 then
-                exit;
-              inc(i);
-            end;
-          Dest[j]:=WideChar(w);
-          inc(j);
-        end;
-      if j>=MaxDestChars then j:=MaxDestChars-1;
-      Dest[j]:=#0;
-    end
-  else
-    begin
-      while i<SourceBytes do
-        begin
-          b:=byte(Source[i]);
-          inc(i);
-          // 2 or 3 bytes?
-          if b>=$80 then
-            begin
-              if i>=SourceBytes then
-                exit;
-              // 3 bytes?
-              b := b and $3f;
-              if (b and $20)<>0 then
-                begin
-                  b:=byte(Source[i]);
-                  inc(i);
-                  if i>=SourceBytes then
-                    exit;
-                  if (b and $c0)<>$80 then
-                    exit;
-                end;
-              if (byte(Source[i]) and $c0)<>$80 then
-                exit;
-              inc(i);
-            end;
-          inc(j);
-        end;
-    end;
-  result:=j+1;
-end;
-
-
-function UTF8Encode(const s : WideString) : UTF8String;
-  var
-    i : SizeInt;
-    hs : UTF8String;
-  begin
-    result:='';
-    if s='' then
-      exit;
-    SetLength(hs,length(s)*3);
-    i:=UnicodeToUtf8(pchar(hs),length(hs)+1,PWideChar(s),length(s));
-    if i>0 then
-      begin
-        SetLength(hs,i-1);
-        result:=hs;
-      end;
-  end;
-
-
-function UTF8Decode(const s : UTF8String): WideString;
-  var
-    i : SizeInt;
-    hs : WideString;
-  begin
-    result:='';
-    if s='' then
-      exit;
-    SetLength(hs,length(s));
-    i:=Utf8ToUnicode(PWideChar(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;
-
-
-{ converts an utf-16 code point or surrogate pair to utf-32 }
-function utf16toutf32(const S: WideString; const index: SizeInt; out len: longint): UCS4Char; [public, alias: 'FPC_UTF16TOUTF32'];
-var
-  w: widechar;
-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 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
-  SNoWidestrings = 'This binary has no widestrings support compiled in.';
-  SRecompileWithWidestrings = 'Recompile the application with a widestrings-manager in the program uses clause.';
-
-procedure unimplementedwidestring;
-  begin
-{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
-    If IsConsole then
-      begin
-      Writeln(StdErr,SNoWidestrings);
-      Writeln(StdErr,SRecompileWithWidestrings);
-      end;
-{$endif FPC_HAS_FEATURE_CONSOLEIO}
-    HandleErrorFrame(233,get_frame);
-  end;
-
-{$warnings off}
-function GenericWideCase(const s : WideString) : WideString;
-  begin
-    unimplementedwidestring;
-  end;
-
-
-function CompareWideString(const s1, s2 : WideString) : PtrInt;
-  begin
-    unimplementedwidestring;
-  end;
-
-
-function CompareTextWideString(const s1, s2 : WideString): PtrInt;
-  begin
-    unimplementedwidestring;
-  end;
-
-
-function CharLengthPChar(const Str: PChar): PtrInt;
-  begin
-    unimplementedwidestring;
-  end;
-{$warnings on}
-
-procedure initwidestringmanager;
-  begin
-    fillchar(widestringmanager,sizeof(widestringmanager),0);
-{$ifndef HAS_WIDESTRINGMANAGER}
-    widestringmanager.Wide2AnsiMoveProc:=@defaultWide2AnsiMove;
-    widestringmanager.Ansi2WideMoveProc:=@defaultAnsi2WideMove;
-    widestringmanager.UpperWideStringProc:=@GenericWideCase;
-    widestringmanager.LowerWideStringProc:=@GenericWideCase;
-{$endif HAS_WIDESTRINGMANAGER}
-    widestringmanager.CompareWideStringProc:=@CompareWideString;
-    widestringmanager.CompareTextWideStringProc:=@CompareTextWideString;
-    widestringmanager.CharLengthPCharProc:=@CharLengthPChar;
-  end;

rtl/linux/buildrtl.lpi

@@ -0,0 +1,64 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <Runnable Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <Title Value="buildrtl"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="buildrtl.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="buildrtl"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <SearchPaths>
+      <IncludeFiles Value="../inc/;../$(TargetCPU)/;../unix/;../objpas/classes/;../objpas/sysutils/;../objpas/"/>
+      <OtherUnitFiles Value="../objpas/;../objpas/classes/;../objpas/sysutils/;../inc/;../unix/;../$(TargetCPU)/"/>
+      <UnitOutputDirectory Value="../units/$(TargetCPU)-linux"/>
+    </SearchPaths>
+    <Parsing>
+      <Style Value="2"/>
+    </Parsing>
+    <Other>
+      <Verbosity>
+        <ShowNotes Value="False"/>
+        <ShowHints Value="False"/>
+      </Verbosity>
+      <CompilerPath Value="$(CompPath)"/>
+      <ExecuteBefore>
+        <Command Value="cmd.exe /c &quot;if not exist ../units/$(TargetCPU)-linux mkdir ../units/$(TargetCPU)-linux&quot;"/>
+        <ShowAllMessages Value="True"/>
+      </ExecuteBefore>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

rtl/linux/buildrtl.pp

@@ -0,0 +1,20 @@
+{ This unit is only used to edit the rtl with lazarus }
+unit buildrtl;
+
+  interface
+
+    uses
+      system, unixtype, ctypes, baseunix, strings, objpas,b macpas, syscall, unixutil,
+      fpintres, heaptrc, lineinfo, lnfodwrf,
+      termio, unix, linux, initc, cmem, mmx,
+      crt, printer, linuxvcs,
+      sysutils, typinfo, math, matrix, varutils,
+      charset, ucomplex, getopts,
+      errors, sockets, gpm, ipc, serial, terminfo, dl, dynlibs,
+      video, mouse, keyboard, variants, types, dateutils, sysconst, fmtbcd,
+      cthreads, classes, fgl, convutils, stdconvs, strutils, rtlconsts, dos, objects, cwstring, fpcylix, clocale,
+      exeinfo;
+
+  implementation
+
+end.

rtl/linux/system.pp

@@ -329,5 +329,9 @@ begin
   { threading }
   InitSystemThreads;
   initvariantmanager;
+{$ifdef VER2_2}
   initwidestringmanager;
+{$else VER2_2}
+  initunicodestringmanager;
+{$endif VER2_2}
 end.

rtl/objpas/classes/classes.inc

@@ -897,13 +897,16 @@ procedure ObjectBinaryToText(Input, Output: TStream);
   end;
 
   procedure OutString(s: String);
-
   begin
     OutChars(Pointer(S),PChar(S)+Length(S),@CharToOrd);
   end;
 
   procedure OutWString(W: WideString);
+  begin
+    OutChars(Pointer(W),pwidechar(W)+Length(W),@WideCharToOrd);
+  end;
 
+  procedure OutUString(W: UnicodeString);
   begin
     OutChars(Pointer(W),pwidechar(W)+Length(W),@WideCharToOrd);
   end;
@@ -1047,6 +1050,25 @@ procedure ObjectBinaryToText(Input, Output: TStream);
     end;
   end;
 
+  function ReadUStr: UnicodeString;
+  var
+    len: DWord;
+  {$IFDEF ENDIAN_BIG}
+    i : integer;
+  {$ENDIF}
+  begin
+    len := ReadDWord;
+    SetLength(Result, len);
+    if (len > 0) then
+    begin
+      Input.ReadBuffer(Pointer(@Result[1])^, len*2);
+      {$IFDEF ENDIAN_BIG}
+      for i:=1 to len do
+        Result[i]:=widechar(SwapEndian(word(Result[i])));
+      {$ENDIF}
+    end;
+  end;
+
   procedure ReadPropList(indent: String);
 
     procedure ProcessValue(ValueType: TValueType; Indent: String);
@@ -1138,6 +1160,11 @@ procedure ObjectBinaryToText(Input, Output: TStream);
           OutWString(ReadWStr);
           OutLn('');
           end;
+        vaUString:
+          begin
+          OutWString(ReadWStr);
+          OutLn('');
+          end;
         vaNil:
           OutLn('nil');
         vaCollection: begin

rtl/objpas/classes/classesh.inc

@@ -901,7 +901,8 @@ type
 
   TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
     vaString, vaIdent, vaFalse, vaTrue, vaBinary, vaSet, vaLString,
-    vaNil, vaCollection, vaSingle, vaCurrency, vaDate, vaWString, vaInt64, vaUTF8String);
+    vaNil, vaCollection, vaSingle, vaCurrency, vaDate, vaWString, vaInt64,
+    vaUTF8String, vaUString);
 
   TFilerFlag = (ffInherited, ffChildPos, ffInline);
   TFilerFlags = set of TFilerFlag;
@@ -967,6 +968,7 @@ type
     function ReadStr: String; virtual; abstract;
     function ReadString(StringType: TValueType): String; virtual; abstract;
     function ReadWideString: WideString;virtual;abstract;
+    function ReadUnicodeString: UnicodeString;virtual;abstract;
     procedure SkipComponent(SkipComponentInfos: Boolean); virtual; abstract;
     procedure SkipValue; virtual; abstract;
   end;
@@ -1018,6 +1020,7 @@ type
     function ReadStr: String; override;
     function ReadString(StringType: TValueType): String; override;
     function ReadWideString: WideString;override;
+    function ReadUnicodeString: UnicodeString;override;
     procedure SkipComponent(SkipComponentInfos: Boolean); override;
     procedure SkipValue; override;
   end;
@@ -1103,6 +1106,7 @@ type
     function ReadBoolean: Boolean;
     function ReadChar: Char;
     function ReadWideChar: WideChar;
+    function ReadUnicodeChar: UnicodeChar;
     procedure ReadCollection(Collection: TCollection);
     function ReadComponent(Component: TComponent): TComponent;
     procedure ReadComponents(AOwner, AParent: TComponent;
@@ -1121,6 +1125,7 @@ type
     function ReadRootComponent(ARoot: TComponent): TComponent;
     function ReadString: string;
     function ReadWideString: WideString;
+    function ReadUnicodeString: UnicodeString;
     function ReadValue: TValueType;
     procedure CopyValue(Writer: TWriter);
     property Driver: TAbstractObjectReader read FDriver;
@@ -1172,6 +1177,7 @@ type
     procedure WriteSet(Value: LongInt; SetType: Pointer); virtual; abstract;
     procedure WriteString(const Value: String); virtual; abstract;
     procedure WriteWideString(const Value: WideString);virtual;abstract;
+    procedure WriteUnicodeString(const Value: UnicodeString);virtual;abstract;
   end;
 
   { TBinaryObjectWriter }
@@ -1222,6 +1228,7 @@ type
     procedure WriteSet(Value: LongInt; SetType: Pointer); override;
     procedure WriteString(const Value: String); override;
     procedure WriteWideString(const Value: WideString); override;
+    procedure WriteUnicodeString(const Value: UnicodeString); override;
   end;
 
   TTextObjectWriter = class(TAbstractObjectWriter)
@@ -1291,6 +1298,7 @@ type
     procedure WriteRootComponent(ARoot: TComponent);
     procedure WriteString(const Value: string);
     procedure WriteWideString(const Value: WideString);
+    procedure WriteUnicodeString(const Value: UnicodeString);
     property RootAncestor: TComponent read FRootAncestor write FRootAncestor;
     property OnFindAncestor: TFindAncestorEvent read FOnFindAncestor write FOnFindAncestor;
     property OnWriteMethodProperty: TWriteMethodPropertyEvent read FOnWriteMethodProperty write FOnWriteMethodProperty;

rtl/objpas/classes/reader.inc

@@ -339,6 +339,25 @@ begin
   end;
 end;
 
+function TBinaryObjectReader.ReadUnicodeString: UnicodeString;
+var
+  len: DWord;
+{$IFDEF ENDIAN_BIG}
+  i : integer;
+{$ENDIF}
+begin
+  len := ReadDWord;
+  SetLength(Result, len);
+  if (len > 0) then
+  begin
+    Read(Pointer(@Result[1])^, len*2);
+    {$IFDEF ENDIAN_BIG}
+    for i:=1 to len do
+      Result[i]:=UnicodeChar(SwapEndian(word(Result[i])));
+    {$ENDIF}
+  end;
+end;
+
 procedure TBinaryObjectReader.SkipComponent(SkipComponentInfos: Boolean);
 var
   Flags: TFilerFlags;
@@ -409,6 +428,11 @@ begin
         Count:=LongInt(ReadDWord);
         SkipBytes(Count*sizeof(widechar));
       end;
+    vaUString:
+      begin
+        Count:=LongInt(ReadDWord);
+        SkipBytes(Count*sizeof(widechar));
+      end;
     vaSet:
       SkipSetBody;
     vaCollection:
@@ -749,6 +773,19 @@ begin
     raise EReadError.Create(SInvalidPropertyValue);
 end;
             
+function TReader.ReadUnicodeChar: UnicodeChar;
+
+var
+  U: UnicodeString;
+  
+begin
+  U := ReadUnicodeString;
+  if Length(U) = 1 then
+    Result := U[1]
+  else
+    raise EReadError.Create(SInvalidPropertyValue);
+end;
+            
 procedure TReader.ReadCollection(Collection: TCollection);
 var
   Item: TCollectionItem;
@@ -1172,7 +1209,7 @@ begin
       SetOrdProp(Instance, PropInfo, Ord(ReadBoolean));
     tkChar:
       SetOrdProp(Instance, PropInfo, Ord(ReadChar));
-    tkWChar:
+    tkWChar,tkUChar:
       SetOrdProp(Instance, PropInfo, Ord(ReadWideChar));  
     tkEnumeration:
       begin
@@ -1211,13 +1248,15 @@ begin
         end;
       end;
     tkSString, tkLString, tkAString:
-    begin
-      TmpStr:=ReadString;
-      if Assigned(FOnReadStringProperty) then
-        FOnReadStringProperty(Self,Instance,PropInfo,TmpStr);
-      SetStrProp(Instance, PropInfo, TmpStr);
-    end;
-    tkWstring:
+      begin
+        TmpStr:=ReadString;
+        if Assigned(FOnReadStringProperty) then
+          FOnReadStringProperty(Self,Instance,PropInfo,TmpStr);
+        SetStrProp(Instance, PropInfo, TmpStr);
+      end;
+    tkUstring:
+      SetUnicodeStrProp(Instance,PropInfo,ReadUnicodeString);
+    tkWString:
       SetWideStrProp(Instance,PropInfo,ReadWideString);
     {!!!: tkVariant}
     tkClass:
@@ -1365,6 +1404,8 @@ begin
     end
   else if StringType in [vaWString] then
     Result:= FDriver.ReadWidestring
+  else if StringType in [vaUString] then
+    Result:= FDriver.ReadUnicodeString
   else
     raise EReadError.Create(SInvalidPropertyValue);
 end;
@@ -1375,21 +1416,47 @@ var
  s: String;
  i: Integer;
 begin
-  if NextValue in [vaWString,vaUTF8String] then
-  begin
-    ReadValue;
-    Result := FDriver.ReadWideString
-  end
-  else begin
-    //data probable from ObjectTextToBinary
-    s := ReadString;
-    setlength(result,length(s));
-    for i:= 1 to length(s) do begin
-     result[i]:= widechar(ord(s[i])); //no code conversion
+  if NextValue in [vaWString,vaUString,vaUTF8String] then
+    //vaUTF8String needs conversion? 2008-09-06 mse
+    begin
+      ReadValue;
+      Result := FDriver.ReadWideString
+    end
+  else
+    begin
+      //data probable from ObjectTextToBinary
+      s := ReadString;
+      setlength(result,length(s));
+      for i:= 1 to length(s) do begin
+        result[i]:= widechar(ord(s[i])); //no code conversion
+    end;
+  end;
+end;
+
+
+function TReader.ReadUnicodeString: UnicodeString;
+var
+ s: String;
+ i: Integer;
+begin
+  if NextValue in [vaWString,vaUString,vaUTF8String] then 
+    //vaUTF8String needs conversion? 2008-09-06 mse
+    begin
+      ReadValue;
+      Result := FDriver.ReadUnicodeString
+    end
+  else
+    begin
+      //data probable from ObjectTextToBinary
+      s := ReadString;
+      setlength(result,length(s));
+      for i:= 1 to length(s) do begin
+        result[i]:= UnicodeChar(ord(s[i])); //no code conversion
     end;
   end;
 end;
 
+
 function TReader.ReadValue: TValueType;
 begin
   Result := FDriver.ReadValue;

rtl/objpas/classes/writer.inc

@@ -319,6 +319,29 @@ begin
     {$ENDIF}
   end;
 end;
+                      
+procedure TBinaryObjectWriter.WriteUnicodeString(const Value: UnicodeString);
+var len : longword;
+{$IFDEF ENDIAN_BIG}
+    i : integer;
+    us : UnicodeString;
+{$ENDIF}
+begin
+  WriteValue(vaUString);
+  len:=Length(Value);
+  WriteDWord(len);
+  if len > 0 then
+  begin
+    {$IFDEF ENDIAN_BIG}
+    setlength(us,len);
+    for i:=1 to len do
+      us[i]:=widechar(SwapEndian(word(Value[i])));
+    Write(us[1], len*sizeof(UnicodeChar));
+    {$ELSE}
+    Write(Value[1], len*sizeof(UnicodeChar));
+    {$ENDIF}
+  end;
+end;
 
 procedure TBinaryObjectWriter.FlushBuffer;
 begin
@@ -737,6 +760,7 @@ var
   DefMethodValue: TMethod;
   WStrValue, WDefStrValue: WideString;
   StrValue, DefStrValue: String;
+  UStrValue, UDefStrValue: UnicodeString;
   AncestorObj: TObject;
   Component: TComponent;
   ObjValue: TObject;
@@ -876,6 +900,21 @@ begin
           Driver.EndProperty;
         end;
       end;
+    tkUString:
+      begin
+        UStrValue := GetUnicodeStrProp(Instance, PropInfo);
+        if HasAncestor then
+          UDefStrValue := GetUnicodeStrProp(Ancestor, PropInfo)
+        else
+          SetLength(UDefStrValue, 0);
+
+        if UStrValue <> UDefStrValue then
+        begin
+          Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+          WriteUnicodeString(UStrValue);
+          Driver.EndProperty;
+        end;
+      end;
   {!!!: tkVariant:}
     tkClass:
       begin
@@ -1013,3 +1052,8 @@ begin
   Driver.WriteWideString(Value);
 end;
 
+procedure TWriter.WriteUnicodeString(const Value: UnicodeString);
+begin
+  Driver.WriteUnicodeString(Value);
+end;
+

rtl/objpas/sysutils/sysformt.inc

@@ -143,7 +143,11 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
     ReadWidth;
     ReadPrec;
 {$ifdef INWIDEFORMAT}
+{$ifdef VER2_2}
     FormatChar:=UpCase(Fmt[ChPos])[1];
+{$else VER2_2}
+    FormatChar:=UpCase(UnicodeChar(Fmt[ChPos]));
+{$endif VER2_2}
     if word(FormatChar)>255 then
       ReadFormat:=#255
     else

rtl/objpas/typinfo.pp

@@ -38,7 +38,7 @@ unit typinfo;
                    tkSet,tkMethod,tkSString,tkLString,tkAString,
                    tkWString,tkVariant,tkArray,tkRecord,tkInterface,
                    tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord,
-                   tkDynArray,tkInterfaceRaw);
+                   tkDynArray,tkInterfaceRaw,tkProcVar,tkUString,tkUChar);
 
        TOrdType  = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong);
 
@@ -85,7 +85,7 @@ unit typinfo;
 {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
       record
          case TTypeKind of
-            tkUnKnown,tkLString,tkWString,tkAString,tkVariant:
+            tkUnKnown,tkLString,tkWString,tkAString,tkVariant,tkUString:
               ();
             tkInteger,tkChar,tkEnumeration,tkWChar,tkSet:
               (OrdType : TOrdType;
@@ -252,6 +252,11 @@ Function GetWideStrProp(Instance: TObject; const PropName: string): WideString;
 Procedure SetWideStrProp(Instance: TObject; const PropName: string; const Value: WideString);
 Procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: WideString);
 
+Function GetUnicodeStrProp(Instance: TObject; PropInfo: PPropInfo): UnicodeString;
+Function GetUnicodeStrProp(Instance: TObject; const PropName: string): UnicodeString;
+Procedure SetUnicodeStrProp(Instance: TObject; const PropName: string; const Value: UnicodeString);
+Procedure SetUnicodeStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: UnicodeString);
+
 {$ifndef FPUNONE}
 Function  GetFloatProp(Instance: TObject; PropInfo : PPropInfo) : Extended;
 Function  GetFloatProp(Instance: TObject; const PropName: string): Extended;
@@ -1397,6 +1402,91 @@ begin
   end;
 end;
 
+Function GetUnicodeStrProp(Instance: TObject; const PropName: string): UnicodeString;
+begin
+  Result:=GetUnicodeStrProp(Instance, FindPropInfo(Instance, PropName));
+end;
+
+
+procedure SetUnicodeStrProp(Instance: TObject; const PropName: string; const Value: UnicodeString);
+begin
+  SetUnicodeStrProp(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+
+Function GetUnicodeStrProp(Instance: TObject; PropInfo: PPropInfo): UnicodeString;
+type
+  TGetUnicodeStrProcIndex=function(index:longint):UnicodeString of object;
+  TGetUnicodeStrProc=function():UnicodeString of object;
+var
+  AMethod : TMethod;
+begin
+  Result:='';
+  case Propinfo^.PropType^.Kind of
+    tkSString,tkAString:
+      Result:=GetStrProp(Instance,PropInfo);
+    tkWString:
+      Result:=GetWideStrProp(Instance,PropInfo);      
+    tkUString:
+      begin
+        case (PropInfo^.PropProcs) and 3 of
+          ptField:
+            Result := PUnicodeString(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
+          ptstatic,
+          ptvirtual :
+            begin
+              if (PropInfo^.PropProcs and 3)=ptStatic then
+                AMethod.Code:=PropInfo^.GetProc
+              else
+                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.GetProc))^;
+              AMethod.Data:=Instance;
+              if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+                Result:=TGetUnicodeStrProcIndex(AMethod)(PropInfo^.Index)
+              else
+                Result:=TGetUnicodeStrProc(AMethod)();
+            end;
+        end;
+      end;
+  end;
+end;
+
+
+Procedure SetUnicodeStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: UnicodeString);
+type
+  TSetUnicodeStrProcIndex=procedure(index:longint;s:UnicodeString) of object;
+  TSetUnicodeStrProc=procedure(s:UnicodeString) of object;
+var
+  AMethod : TMethod;
+begin
+  case Propinfo^.PropType^.Kind of
+    tkSString,tkAString:
+       SetStrProp(Instance,PropInfo,Value);
+    tkWString:
+       SetWideStrProp(Instance,PropInfo,Value);
+    tkUString:
+      begin
+        case (PropInfo^.PropProcs shr 2) and 3 of
+          ptField:
+            PUnicodeString(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
+          ptstatic,
+          ptvirtual :
+            begin
+              if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
+                AMethod.Code:=PropInfo^.SetProc
+              else
+                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;
+              AMethod.Data:=Instance;
+              if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+                TSetUnicodeStrProcIndex(AMethod)(PropInfo^.Index,Value)
+              else
+                TSetUnicodeStrProc(AMethod)(Value);
+            end;
+        end;
+      end;
+  end;
+end;
+
+
 
 {$ifndef FPUNONE}
 

rtl/unix/cwstring.pp

@@ -705,7 +705,7 @@ end;
 
 Procedure SetCWideStringManager;
 Var
-  CWideStringManager : TWideStringManager;
+  CWideStringManager : TUnicodeStringManager;
 begin
   CWideStringManager:=widestringmanager;
   With CWideStringManager do
@@ -733,8 +733,15 @@ begin
       StrUpperAnsiStringProc:=@AnsiStrUpper;
       ThreadInitProc:=@InitThread;
       ThreadFiniProc:=@FiniThread;
+{$ifndef VER2_2}
+      { Unicode }
+      Unicode2AnsiMoveProc:=@Wide2AnsiMove;
+      Ansi2UnicodeMoveProc:=@Ansi2WideMove;
+      UpperUnicodeStringProc:=@UpperWideString;
+      LowerUnicodeStringProc:=@LowerWideString;
+{$endif VER2_2}
     end;
-  SetWideStringManager(CWideStringManager);
+  SetUnicodeStringManager(CWideStringManager);
 end;
 
 
@@ -752,3 +759,4 @@ finalization
   { fini conversion tables for main program }
   FiniThread;
 end.
+

rtl/win32/buildrtl.lpi

@@ -12,6 +12,7 @@
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
+      <IconPath Value="./"/>
       <TargetFileExt Value=".exe"/>
       <Title Value="buildrtl"/>
     </General>

rtl/win32/system.pp

@@ -899,10 +899,6 @@ end;
 
 {$endif Set_i386_Exception_handler}
 
-{****************************************************************************
-                      OS dependend widestrings
-****************************************************************************}
-
 const
   { MultiByteToWideChar  }
      MB_PRECOMPOSED = 1;
@@ -918,6 +914,9 @@ function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD;
 function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD;
     stdcall; external 'user32' name 'CharLowerBuffW';
 
+{******************************************************************************
+                              Widestring
+ ******************************************************************************}
 
 procedure Win32Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
   var
@@ -947,13 +946,57 @@ procedure Win32Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
 function Win32WideUpper(const s : WideString) : WideString;
   begin
     result:=s;
-    UniqueString(result);
     if length(result)>0 then
       CharUpperBuff(LPWSTR(result),length(result));
   end;
 
 
 function Win32WideLower(const s : WideString) : WideString;
+  begin
+    result:=s;
+    if length(result)>0 then
+      CharLowerBuff(LPWSTR(result),length(result));
+  end;
+
+{******************************************************************************
+                              Unicode
+ ******************************************************************************}
+
+procedure Win32Unicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
+  var
+    destlen: SizeInt;
+  begin
+    // retrieve length including trailing #0
+    // not anymore, because this must also be usable for single characters
+    destlen:=WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
+    // this will null-terminate
+    setlength(dest, destlen);
+    WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
+  end;
+
+procedure Win32Ansi2UnicodeMove(source:pchar;var dest:UnicodeString;len:SizeInt);
+  var
+    destlen: SizeInt;
+  begin
+    // retrieve length including trailing #0
+    // not anymore, because this must also be usable for single characters
+    destlen:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, nil, 0);
+    // this will null-terminate
+    setlength(dest, destlen);
+    MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, @dest[1], destlen);
+  end;
+
+
+function Win32UnicodeUpper(const s : UnicodeString) : UnicodeString;
+  begin
+    result:=s;
+    UniqueString(result);
+    if length(result)>0 then
+      CharUpperBuff(LPWSTR(result),length(result));
+  end;
+
+
+function Win32UnicodeLower(const s : UnicodeString) : UnicodeString;
   begin
     result:=s;
     UniqueString(result);
@@ -966,10 +1009,18 @@ function Win32WideLower(const s : WideString) : WideString;
   are only relevant for the sysutils units }
 procedure InitWin32Widestrings;
   begin
+    { Widestring }
     widestringmanager.Wide2AnsiMoveProc:=@Win32Wide2AnsiMove;
     widestringmanager.Ansi2WideMoveProc:=@Win32Ansi2WideMove;
     widestringmanager.UpperWideStringProc:=@Win32WideUpper;
     widestringmanager.LowerWideStringProc:=@Win32WideLower;
+{$ifndef VER2_2}
+    { Unicode }
+    widestringmanager.Unicode2AnsiMoveProc:=@Win32Unicode2AnsiMove;
+    widestringmanager.Ansi2UnicodeMoveProc:=@Win32Ansi2UnicodeMove;
+    widestringmanager.UpperUnicodeStringProc:=@Win32UnicodeUpper;
+    widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower;
+{$endif VER2_2}
   end;
 
 
@@ -1192,6 +1243,10 @@ begin
   errno:=0;
   initvariantmanager;
   initwidestringmanager;
+{$ifndef VER2_2}
+  initunicodestringmanager;
+{$endif VER2_2}
   InitWin32Widestrings;
   DispCallByIDProc:=@DoDispCallByIDError;
 end.
+

tests/test/trtti1.pp

@@ -11,7 +11,7 @@ Const TypeNames : Array [TTYpeKind] of string[15] =
                      'Float','Set','Method','ShortString','LongString',
                      'AnsiString','WideString','Variant','Array','Record',
                      'Interface','Class','Object','WideChar','Bool','Int64','QWord',
-                     'DynamicArray','RawInterface');
+                     'DynamicArray','RawInterface','ProcVar','UnicodeString','UnicodeChar');
 
 Const OrdinalTypes = [tkInteger,tkChar,tkENumeration,tkbool];
 

tests/test/tstring10.pp

@@ -0,0 +1,27 @@
+program punicodechartest;
+{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
+{$ifdef mswindows}{$apptype console}{$endif}
+uses
+ {$ifdef FPC}{$ifdef linux}cthreads,{$endif}{$endif}
+ sysutils;
+var
+ astr: ansistring;
+ wstr: widestring;
+ ustr: unicodestring;
+begin
+ astr:= '';
+ wstr:= '';
+ ustr:= '';
+ writeln(ptrint(pansichar(astr)));
+ flush(output);
+ writeln(ptrint(pwidechar(wstr)));
+ flush(output);
+ writeln(ptrint(punicodechar(ustr)));
+ flush(output);
+ writeln(ord(pansichar(astr)^));
+ flush(output);
+ writeln(ord(pwidechar(wstr)^));
+ flush(output);
+ writeln(ord(punicodechar(ustr)^));
+ flush(output);
+end.

tests/test/tunistr1.pp

@@ -0,0 +1,19 @@
+{$ifdef unix}
+uses
+  cwstring;
+{$endif unix}
+
+var
+  w : unicodestring;
+  a : ansistring;
+
+begin
+  a:='A';
+  w:=a;
+  if w[1]<>#65 then
+    halt(1);
+  a:=w;
+  if a[1]<>'A' then
+    halt(1);
+  writeln('ok');
+end.

tests/test/tunistr2.pp

@@ -0,0 +1,21 @@
+{$ifdef UNIX}
+uses
+  cwstring;
+{$endif UNIX}
+
+var
+  i : longint;
+  w,w2 : unicodestring;
+  a : ansistring;
+
+begin
+  setlength(w,1000);
+  for i:=1 to 1000 do
+    w[i]:=widechar(i);
+  for i:=1 to 10 do
+    begin
+      a:=w;
+      w2:=a;
+    end;
+  writeln('ok');
+end.

tests/test/tunistr4.pp

@@ -0,0 +1,92 @@
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif fpc}
+
+uses
+{$ifdef unix}
+  cthreads, cwstring,
+{$endif}
+  Classes, SysUtils;
+
+type
+  tc = class(tthread)
+    orgstr: ansistring;
+    cnvstr: unicodestring;
+    constructor create(const s: ansistring; const w: unicodestring);
+    procedure execute; override;
+  end;
+
+const
+  // string with an invalid utf-8 code sequence
+  str1 = #$c1#$34'Życie'#$c1#$34' jest jak papier '#$c1#$34'toaletowy'#$c1#$34' : długie, szare i '#$c1#$34'do'#$c1#$34' dupy';
+  str2 = 'Życie '#$c1#$34'jest'#$c1#$34' jak papier toaletowy : '#$c1#$34'długie'#$c1#$34', szare i do '#$c1#$34'dupy'#$c1#$34'222222222222222222222222222222222222222222222222';
+  str3 = 'Życie jest '#$c1#$34'jak'#$c1#$34' papier 333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333 toaletowy : długie, '#$c1#$34'szare'#$c1#$34' i do dupy';
+  str4 = 'Życie jest 4444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444 jak '#$c1#$34'papier'#$c1#$34' toaletowy : długie, szare '#$c1#$34'i'#$c1#$34' do dupy';
+  count = 20000;
+
+var
+  wstr: unicodestring;
+//  cnvstr: ansistring;
+  error: boolean;
+
+
+constructor tc.create(const s: ansistring; const w: unicodestring);
+begin
+  orgstr:=s;
+  cnvstr:=w;
+  inherited create(true);
+end;
+
+
+procedure tc.execute;
+var
+  i: longint;
+  w: unicodestring;
+begin
+  for i := 1 to count do
+    begin
+      w:=orgstr;
+      if (w<>cnvstr) then
+        error:=true;
+    end;
+end;
+
+var
+  a: array[1..4] of tc;
+  w1,w2,w3,w4: unicodestring;
+  cnvstr: ansistring;
+begin
+  error:=false;
+  cnvstr:=str1;
+  w1:=cnvstr;
+  cnvstr:=str2;
+  w2:=cnvstr;
+  cnvstr:=str3;
+  w3:=cnvstr;
+  cnvstr:=str4;
+  w4:=cnvstr;
+  writeln(w1);
+  writeln(w2);
+  writeln(w3);
+  writeln(w4);
+  a[1]:=tc.create(str1,w1);
+  a[2]:=tc.create(str2,w2);
+  a[3]:=tc.create(str3,w3);
+  a[4]:=tc.create(str4,w4);
+  a[1].resume;
+  a[2].resume;
+  a[3].resume;
+  a[4].resume;
+  a[1].waitfor;
+  a[2].waitfor;
+  a[3].waitfor;
+  a[4].waitfor;
+  a[1].free;
+  a[2].free;
+  a[3].free;
+  a[4].free;
+  
+  if error then
+    halt(1);  
+end.

tests/test/tunistr5.pp

@@ -0,0 +1,45 @@
+{$codepage utf-8}
+
+var
+  ws: unicodestring;
+  us: UCS4String;
+begin
+// the compiler does not yet support characters which require
+// a surrogate pair in utf-16
+//  ws:='鳣ćçŹ你';
+//  so write the last character directly using a utf-16 surrogate pair
+  ws:='鳣ćçŹ'#$d87e#$dc04;
+
+  if (length(ws)<>8) or
+     (ws[1]<>'é') or
+     (ws[2]<>'ł') or
+     (ws[3]<>'Ł') or
+     (ws[4]<>'ć') or
+     (ws[5]<>'ç') or
+     (ws[6]<>'Ź') or
+     (ws[7]<>#$d87e) or
+     (ws[8]<>#$dc04) then
+    halt(1);
+  us:=UnicodeStringToUCS4String(ws);
+  if (length(us)<>8) or
+     (us[0]<>UCS4Char(unicodechar('é'))) or
+     (us[1]<>UCS4Char(unicodechar('ł'))) or
+     (us[2]<>UCS4Char(unicodechar('Ł'))) or
+     (us[3]<>UCS4Char(unicodechar('ć'))) or
+     (us[4]<>UCS4Char(unicodechar('ç'))) or
+     (us[5]<>UCS4Char(unicodechar('Ź'))) or
+     (us[6]<>UCS4Char($2F804)) or
+     (us[7]<>UCS4Char(0)) then
+    halt(2);
+  ws:=UCS4StringToUnicodeString(us);
+  if (length(ws)<>8) or
+     (ws[1]<>'é') or
+     (ws[2]<>'ł') or
+     (ws[3]<>'Ł') or
+     (ws[4]<>'ć') or
+     (ws[5]<>'ç') or
+     (ws[6]<>'Ź') or
+     (ws[7]<>#$d87e) or
+     (ws[8]<>#$dc04) then
+    halt(3);
+end.

tests/test/tunistr6.pp

@@ -0,0 +1,397 @@
+{%skiptarget=wince}
+{$codepage utf-8}
+uses
+  {$ifdef unix}
+  cwstring,
+  {$endif}
+  sysutils;
+
+procedure doerror(i : integer);
+  begin
+    writeln('Error: ',i);
+    halt(i);
+  end;
+
+
+{ normal upper case testing }
+procedure testupper;
+var
+  s: ansistring;
+  w1,w2,w3,w4: unicodestring;
+  i: longint;
+begin
+  w1:='aé'#0'èàł'#$d87e#$dc04;
+  w2:='AÉ'#0'ÈÀŁ'#$d87e#$dc04;
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original upper: ',w2);
+{$endif print}
+  s:=w1;
+{$ifdef print}
+  writeln('ansi: ',s);
+{$endif print}
+  w3:=s;
+  w4:=AnsiUpperCase(s);
+  { filter out unsupported characters }
+  for i:=1 to length(w3) do
+    if w3[i]='?' then
+      begin
+        w2[i]:='?';
+        w1[i]:='?';
+      end;
+  w1:=UnicodeUpperCase(w1);
+{$ifdef print}
+  writeln('unicodeupper: ',w1);
+  writeln('original upper: ',w2);
+  writeln('ansiupper: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(1);
+  if (w4 <> w2) then
+    doerror(2);
+
+  w1:='aéèàł'#$d87e#$dc04;
+  w2:='AÉÈÀŁ'#$d87e#$dc04;
+  s:=w1;
+  w3:=s;
+  w4:=AnsiStrUpper(pchar(s));
+  { filter out unsupported characters }
+  for i:=1 to length(w3) do
+    if w3[i]='?' then
+      begin
+        w2[i]:='?';
+        w1[i]:='?';
+      end;
+  w1:=UnicodeUpperCase(w1);
+{$ifdef print}
+  writeln('unicodeupper: ',w1);
+  writeln('ansistrupper: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(21);
+  if (w4 <> w2) then
+    doerror(22);
+
+end;
+
+
+{ normal lower case testing }
+procedure testlower;
+var
+  s: ansistring;
+  w1,w2,w3,w4: unicodestring;
+  i: longint;
+begin
+  w1:='AÉ'#0'ÈÀŁ'#$d87e#$dc04;
+  w2:='aé'#0'èàł'#$d87e#$dc04;
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original lower: ',w2);
+{$endif print}
+  s:=w1;
+  w3:=s;
+  w4:=AnsiLowerCase(s);
+  { filter out unsupported characters }
+  for i:=1 to length(w3) do
+    if w3[i]='?' then
+      begin
+        w2[i]:='?';
+        w1[i]:='?';
+      end;
+  w1:=UnicodeLowerCase(w1);
+{$ifdef print}
+  writeln('unicodelower: ',w1);
+  writeln('ansilower: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(3);
+  if (w4 <> w2) then
+    doerror(4);
+
+
+  w1:='AÉÈÀŁ'#$d87e#$dc04;
+  w2:='aéèàł'#$d87e#$dc04;
+  s:=w1;
+  w3:=s;
+  w4:=AnsiStrLower(pchar(s));
+  { filter out unsupported characters }
+  for i:=1 to length(w3) do
+    if w3[i]='?' then
+      begin
+        w2[i]:='?';
+        w1[i]:='?';
+      end;
+  w1:=UnicodeLowerCase(w1);
+{$ifdef print}
+  writeln('unicodelower: ',w1);
+  writeln('ansistrlower: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(3);
+  if (w4 <> w2) then
+    doerror(4);
+end;
+
+
+
+{ upper case testing with a missing utf-16 pair at the end }
+procedure testupperinvalid;
+var
+  s: ansistring;
+  w1,w2,w3,w4: unicodestring;
+  i: longint;
+begin
+  { missing utf-16 pair at end }
+  w1:='aé'#0'èàł'#$d87e;
+  w2:='AÉ'#0'ÈÀŁ'#$d87e;
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original upper: ',w2);
+{$endif print}
+  s:=w1;
+  w3:=s;
+  w4:=AnsiUpperCase(s);
+  { filter out unsupported characters }
+  for i:=1 to length(w3) do
+    if w3[i]='?' then
+      begin
+        w2[i]:='?';
+        w1[i]:='?';
+      end;
+  w1:=UnicodeUpperCase(w1);
+{$ifdef print}
+  writeln('unicodeupper: ',w1);
+  writeln('ansiupper: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(5);
+  if (w4 <> w2) then
+    doerror(6);
+end;
+
+
+{ lower case testing with a missing utf-16 pair at the end }
+procedure testlowerinvalid;
+var
+  s: ansistring;
+  w1,w2,w3,w4: unicodestring;
+  i: longint;
+begin
+  { missing utf-16 pair at end}
+  w1:='AÉ'#0'ÈÀŁ'#$d87e;
+  w2:='aé'#0'èàł'#$d87e;
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original lower: ',w2);
+{$endif print}
+  s:=w1;
+  w3:=s;
+  w4:=AnsiLowerCase(s);
+  { filter out unsupported characters }
+  for i:=1 to length(w3) do
+    if w3[i]='?' then
+      begin
+        w2[i]:='?';
+        w1[i]:='?';
+      end;
+  w1:=UnicodeLowerCase(w1);
+{$ifdef print}
+  writeln('unicodelower: ',w1);
+  writeln('ansilower: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(7);
+  if (w4 <> w2) then
+    doerror(8);
+end;
+
+
+
+{ upper case testing with a missing utf-16 pair at the end, followed by a normal char }
+procedure testupperinvalid1;
+var
+  s: ansistring;
+  w1,w2,w3,w4: unicodestring;
+  i: longint;
+begin
+  { missing utf-16 pair at end with char after it}
+  w1:='aé'#0'èàł'#$d87e'j';
+  w2:='AÉ'#0'ÈÀŁ'#$d87e'J';
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original upper: ',w2);
+{$endif print}
+  s:=w1;
+  w3:=s;
+  w4:=AnsiUpperCase(s);
+  { filter out unsupported characters }
+  for i:=1 to length(w3) do
+    if w3[i]='?' then
+      begin
+        w2[i]:='?';
+        w1[i]:='?';
+      end;
+  w1:=UnicodeUpperCase(w1);
+{$ifdef print}
+  writeln('unicodeupper: ',w1);
+  writeln('ansiupper: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(9);
+  if (w4 <> w2) then
+    doerror(10);
+end;
+
+
+{ lower case testing with a missing utf-16 pair at the end, followed by a normal char }
+procedure testlowerinvalid1;
+var
+  s: ansistring;
+  w1,w2,w3,w4: unicodestring;
+  i: longint;
+begin
+  { missing utf-16 pair at end with char after it}
+  w1:='AÉ'#0'ÈÀŁ'#$d87e'J';
+  w2:='aé'#0'èàł'#$d87e'j';
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original lower: ',w2);
+{$endif print}
+  s:=w1;
+  w3:=s;
+  w4:=AnsiLowerCase(s);
+  { filter out unsupported characters }
+  for i:=1 to length(w3) do
+    if w3[i]='?' then
+      begin
+        w2[i]:='?';
+        w1[i]:='?';
+      end;
+  w1:=UnicodeLowerCase(w1);
+{$ifdef print}
+  writeln('unicodelower: ',w1);
+  writeln('ansilower: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(11);
+  if (w4 <> w2) then
+    doerror(12);
+end;
+
+
+{ upper case testing with corrupting the utf-8 string after conversion }
+procedure testupperinvalid2;
+var
+  s: ansistring;
+  w1,w2,w3,w4: unicodestring;
+  i: longint;
+begin
+  w1:='aé'#0'èàł'#$d87e#$dc04'ö';
+  w2:='AÉ'#0'ÈÀŁ'#$d87e#$dc04'Ö';
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original upper: ',w2);
+{$endif print}
+  s:=w1;
+  { truncate the last utf-8 character }
+  setlength(s,length(s)-1);
+  w3:=s;
+  { adjust checking values for new length due to corruption }
+  if length(w3)<>length(w2) then
+    begin
+      setlength(w2,length(w3));
+      setlength(w1,length(w3));
+    end;
+  w4:=AnsiUpperCase(s);
+  { filter out unsupported characters }
+  for i:=1 to length(w3) do
+    if w3[i]='?' then
+      begin
+        w2[i]:='?';
+        w1[i]:='?';
+      end;
+  w1:=UnicodeUpperCase(w1);
+{$ifdef print}
+  writeln('unicodeupper: ',w1);
+  writeln('ansiupper: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(13);
+  if (w4 <> w2) then
+    doerror(14);
+end;
+
+
+{ lower case testing with corrupting the utf-8 string after conversion }
+procedure testlowerinvalid2;
+var
+  s: ansistring;
+  w1,w2,w3,w4: unicodestring;
+  i: longint;
+begin
+  w1:='AÉ'#0'ÈÀŁ'#$d87e#$dc04'Ö';
+  w2:='aé'#0'èàł'#$d87e#$dc04'ö';
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original lower: ',w2);
+{$endif print}
+  s:=w1;
+  { truncate the last utf-8 character }
+  setlength(s,length(s)-1);
+  w3:=s;
+  { adjust checking values for new length due to corruption }
+  if length(w3)<>length(w2) then
+    begin
+      setlength(w2,length(w3));
+      setlength(w1,length(w3));
+    end;
+  w4:=AnsiLowerCase(s);
+  { filter out unsupported characters }
+  for i:=1 to length(w3) do
+    if w3[i]='?' then
+      begin
+        w2[i]:='?';
+        w1[i]:='?';
+      end;
+  w1:=UnicodeLowerCase(w1);
+{$ifdef print}
+  writeln('unicodelower: ',w1);
+  writeln('ansilower: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(15);
+  if (w4 <> w2) then
+    doerror(16);
+end;
+
+
+
+begin
+  testupper;
+  writeln;
+  testlower;
+  writeln;
+  writeln;
+  testupperinvalid;
+  writeln;
+  testlowerinvalid;
+  writeln;
+  writeln;
+  testupperinvalid1;
+  writeln;
+  testlowerinvalid1;
+  writeln;
+  writeln;
+  testupperinvalid2;
+  writeln;
+  testlowerinvalid2;
+  writeln('ok');
+end.

tests/test/tunistr7.pp

@@ -0,0 +1,47 @@
+{$codepage utf-8}
+
+uses
+{$ifdef unix}
+  cwstring,
+{$endif unix}
+  sysutils;
+
+procedure testwcmp;
+var
+  w1,w2: unicodestring;
+  s: ansistring;
+begin
+  w1:='aécde';
+  { filter unsupported characters }
+  s:=w1;
+  w1:=s;
+  w2:=w1;
+
+  if (w1<>w2) then
+    halt(1);
+  w1[2]:='f';
+  if (w1=w2) or
+     WideSameStr(w1,w2) or
+     (WideCompareText(w1,w2)=0) or
+     (WideCompareStr(w1,w2)<0) or
+     (WideCompareStr(w2,w1)>0) then
+    halt(2);
+  w1[2]:=#0;
+  w2[2]:=#0;
+  if (w1<>w2) or
+     not WideSameStr(w1,w2) or
+     (WideCompareStr(w1,w2)<>0) or
+     (WideCompareText(w1,w2)<>0) then
+    halt(3);
+  w1[3]:='m';
+  if WideSameStr(w1,w2) or
+     (WideCompareText(w1,w2)=0) or
+     (WideCompareStr(w1,w2)<0) or
+     (WideCompareStr(w2,w1)>0) then
+    halt(4);
+end;
+
+
+begin
+  testwcmp;
+end.