Merged revisions 9386,9391-9395,9398,9400,9416-9417,9440-9441,9443-9444 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r9386 | florian | 2007-12-02 23:33:56 +0100 (Sun, 02 Dec 2007) | 2 lines

* preparations for unicodestring support in the rtl

........
r9391 | jonas | 2007-12-05 14:05:09 +0100 (Wed, 05 Dec 2007) | 3 lines

  * fixed WideStringToUCS4String and UCS4StringToWideString for code points
    requiring surrogate pairs in utf-16 + test

........
r9392 | jonas | 2007-12-05 15:28:11 +0100 (Wed, 05 Dec 2007) | 3 lines

  * don't override routines hooked by a real widestring manager before
    sysutils initialised

........
r9393 | jonas | 2007-12-05 18:42:35 +0100 (Wed, 05 Dec 2007) | 8 lines

  * fixed wchar_t type (was: widechar, now is cint/cint32/long depending on
    platform)
  + mbstate_t type for all unixes except BeOS (doesn't exist for BeOS)
  + implemented UpperAnsiStringProc/LowerAnsiStringProc for unix
  * fixed Ansi2UCS4Move in cwstring (although it isn't used anywhere
    currently)
  + test for Upper/LowerAnsiString

........
r9394 | jonas | 2007-12-05 18:44:34 +0100 (Wed, 05 Dec 2007) | 4 lines

  - removed commented out implementation of Upper/LowerWideString which
    takes into account surrogate pairs (not needed, since upper/lower
    case characters never need surrogate pairs)

........
r9395 | jonas | 2007-12-05 19:48:54 +0100 (Wed, 05 Dec 2007) | 3 lines

  * characters <= 127, not just < 127, can be concatenated to an
    ansistring without conversion

........
r9398 | jonas | 2007-12-06 09:08:17 +0100 (Thu, 06 Dec 2007) | 2 lines

  * fixed BeOS compilation (patch from Olivier Coursiere)

........
r9400 | jonas | 2007-12-06 16:55:57 +0100 (Thu, 06 Dec 2007) | 2 lines

  * removed some unused variables, which fixes building on non-unix

........
r9416 | jonas | 2007-12-08 17:00:09 +0100 (Sat, 08 Dec 2007) | 6 lines

  * fixed unix CompareWideString to not treat null characters inside
    a widestring as end-of-string + test (which fails on Darwin/FreeBSD
    in utf-8/utf-16 locales, because their libc's wcscoll is documented
    as only working in single-byte locales and falling back to wcscmp
    for others)

........
r9417 | jonas | 2007-12-08 17:00:28 +0100 (Sat, 08 Dec 2007) | 2 lines

  + test for previous commit

........
r9440 | jonas | 2007-12-13 21:41:31 +0100 (Thu, 13 Dec 2007) | 9 lines

  * completed cwstring unit
  * optimized LowerWideString/UpperWideString not to call UniqueString
    for each string character
  * fixed LowerAnsiString/UpperAnsiString in case an ascii character
    has a lower/uppercase version with a different length than 1
  + generic test for ansistring comparisons using on the widestring
    manager (based on glibc test)
  - removed ansi2ucs4-related stuff as it's not used/needed

........
r9441 | jonas | 2007-12-13 21:49:52 +0100 (Thu, 13 Dec 2007) | 2 lines

  * fixed AnsiStrLower/AnsiStrUpper (were exchanged)

........
r9443 | jonas | 2007-12-13 21:55:15 +0100 (Thu, 13 Dec 2007) | 2 lines

  + also test AnsiStrUpper/AnsiStrLower

........
r9444 | jonas | 2007-12-13 22:01:17 +0100 (Thu, 13 Dec 2007) | 2 lines

  * fixed indentation of LowerAnsiString/UpperAnsiString

........

git-svn-id: branches/fixes_2_2@9461 -

.gitattributes

@@ -4910,6 +4910,7 @@ rtl/inc/video.inc svneol=native#text/plain
 rtl/inc/videoh.inc svneol=native#text/plain
 rtl/inc/wstringh.inc svneol=native#text/plain
 rtl/inc/wstrings.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
 rtl/linux/arm/bsyscall.inc svneol=native#text/plain
@@ -7284,6 +7285,9 @@ tests/test/twide1.pp svneol=native#text/plain
 tests/test/twide2.pp svneol=native#text/plain
 tests/test/twide3.pp svneol=native#text/plain
 tests/test/twide4.pp svneol=native#text/plain
+tests/test/twide5.pp svneol=native#text/plain
+tests/test/twide6.pp svneol=native#text/plain
+tests/test/twide7.pp svneol=native#text/plain
 tests/test/uabstrcl.pp svneol=native#text/plain
 tests/test/uenum2a.pp svneol=native#text/plain
 tests/test/uenum2b.pp svneol=native#text/plain
@@ -7380,6 +7384,7 @@ tests/test/units/system/tvalc.pp -text
 tests/test/units/sysutils/execansi.pp svneol=native#text/plain
 tests/test/units/sysutils/execedbya.pp svneol=native#text/plain
 tests/test/units/sysutils/extractquote.pp svneol=native#text/plain
+tests/test/units/sysutils/tastrcmp.pp svneol=native#text/plain
 tests/test/units/sysutils/tfile1.pp svneol=native#text/plain
 tests/test/units/sysutils/tfloattostr.pp -text
 tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain

rtl/beos/ptypes.inc

@@ -90,7 +90,7 @@ type
     pTime    = ^time_t;
     ptime_t =  ^time_t;
     
-    wchar_t   = widechar;
+    wchar_t   = cint32;
     pwchar_t  = ^wchar_t;
 
     socklen_t= cuint32;

rtl/darwin/ptypes.inc

@@ -77,9 +77,9 @@ type
     pTime    = ^time_t;
     ptime_t  = ^time_t;
 
-    wchar_t  = widechar;
+    wchar_t  = cint32;
     pwchar_t = ^wchar_t;
-    wint_t   = cint;
+    wint_t   = cint32;
 
     socklen_t= cuint32;
     TSocklen = socklen_t;
@@ -163,6 +163,13 @@ type
        end;
     pstatfs = ^tstatfs;
 
+    mbstate_t = record
+      case byte of
+        0: (__mbstate8: array[0..127] of char);
+        1: (_mbstateL: clonglong); { for alignment }
+    end;
+    pmbstate_t = ^mbstate_t;
+
    pthread_t            = pointer;
    pthread_attr_t       = record sig: clong; opaque: array[0..{$ifdef cpu64}56{$else}36{$endif}-1] of byte; end;
    pthread_mutex_t      = {$i pmutext.inc}

rtl/freebsd/ptypes.inc

@@ -80,7 +80,7 @@ type
     pUid     = ^Uid_t;
 
     wint_t    = cint32;
-    wchar_t   = widechar;
+    wchar_t   = cint32;
     pwchar_t  = ^wchar_t;
 
 
@@ -186,6 +186,13 @@ type
   end;
   PStatFS=^TStatFS;
 
+    mbstate_t = record
+      case byte of
+        0: (__mbstate8: array[0..127] of char);
+        1: (_mbstateL: cint64); { for alignment }
+    end;
+    pmbstate_t = ^mbstate_t;
+
   ITimerVal= Record
               It_Interval,
               It_Value      : TimeVal;

rtl/inc/wstrings.inc

@@ -3,7 +3,7 @@
     Copyright (c) 1999-2005 by Florian Klaempfl,
     member of the Free Pascal development team.
 
-    This file implements support routines for WideStrings/Unicode with FPC
+    This file implements support routines for WideStrings with FPC
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -14,1845 +14,4 @@
 
  **********************************************************************}
 
-{
-  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
-  lowstart,i  : Longint;
-  p,pc        : pointer;
-  Size,NewLen,
-  OldDestLen  : SizeInt;
-  destcopy    : widestring;
-begin
-  if high(sarr)=0 then
-    begin
-      DestS:='';
-      exit;
-    end;
-  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                                       }
-          destcopy:=dests;
-          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;
-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
-    { result is automatically set to '' }
-    exit;
-  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
-        { result is automatically set to '' }
-        exit;
-      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;
-  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;
-var
-  i: SizeInt;
-  pc : pchar;
-begin
-  pc:=@s[1];
-  for i:=1 to length(s) do
-   begin
-     if widechar(pc^)=c then
-      begin
-        pos:=i;
-        exit;
-      end;
-     inc(pc);
-   end;
-  pos:=0;
-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+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;
-
-
-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;
-
-
-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}
-
-
-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;
-
-{$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>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;
-
-
-function WideStringToUCS4String(const s : WideString) : UCS4String;
-  var
-    i : SizeInt;
-  begin
-    setlength(result,length(s)+1);
-    for i:=1 to length(s) do
-      result[i-1]:=UCS4Char(s[i]);
-    result[length(s)]:=UCS4Char(0);
-  end;
-
-
-function UCS4StringToWideString(const s : UCS4String) : WideString;
-  var
-    i : SizeInt;
-  begin
-    setlength(result,length(s)-1);
-    for i:=1 to length(s)-1 do
-      result[i]:=WideChar(s[i-1]);
-  end;
-
-
-procedure unimplementedwidestring;
-  begin
-    HandleErrorFrame(215,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;
+{$i wustrings.inc}

rtl/inc/wustrings.inc

@@ -0,0 +1,1968 @@
+{
+    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 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
+  lowstart,i  : Longint;
+  p,pc        : pointer;
+  Size,NewLen,
+  OldDestLen  : SizeInt;
+  destcopy    : widestring;
+begin
+  if high(sarr)=0 then
+    begin
+      DestS:='';
+      exit;
+    end;
+  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                                       }
+          destcopy:=dests;
+          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;
+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
+    { result is automatically set to '' }
+    exit;
+  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
+        { result is automatically set to '' }
+        exit;
+      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;
+  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;
+var
+  i: SizeInt;
+  pc : pchar;
+begin
+  pc:=@s[1];
+  for i:=1 to length(s) do
+   begin
+     if widechar(pc^)=c then
+      begin
+        pos:=i;
+        exit;
+      end;
+     inc(pc);
+   end;
+  pos:=0;
+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+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;
+
+
+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;
+
+{$ifdef FPC_HAS_VALSTR_ENUM}
+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;
+{$endif FPC_HAS_VALSTR_ENUM}
+
+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}
+
+
+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;
+
+{$ifdef FPC_HAS_VALSTR_ENUM}
+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;
+{$endif FPC_HAS_VALSTR_ENUM}
+
+{$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>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;
+    result[destindex]:=UCS4Char(0);
+    { destindex <= slen }
+    setlength(result,destindex);
+  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 (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;
+    len      : longint;
+  begin
+    SetLength(result,length(s));
+    resindex:=1;
+    for i:=0 to high(s) do
+      ConcatUTF32ToWideStr(s[i],result,resindex);
+    { adjust result length (may be too big due to growing }
+    { for surrogate pairs)                                }
+    setlength(result,resindex-1);
+  end;
+
+
+procedure unimplementedwidestring;
+  begin
+    HandleErrorFrame(215,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/ptypes.inc

@@ -102,7 +102,7 @@ Type
     pTime     = ^time_t;
     ptime_t   = ^time_t;
 
-    wchar_t   = widechar;
+    wchar_t   = cint32;
     pwchar_t  = ^wchar_t;
 
 {$ifdef cpu64}
@@ -154,6 +154,18 @@ Type
   end;
   PStatFS=^TStatFS;
 
+  mbstate_value_t = record
+    case byte of
+      0: (__wch: wint_t);
+      1: (__wchb: array[0..3] of char);
+  end;
+  
+  mbstate_t = record
+    __count: cint;
+    __value: mbstate_value_t;
+  end;
+  pmbstate_t = ^mbstate_t;
+
   pthread_t = culong;
 
   sched_param = record

rtl/objpas/sysutils/sysint.inc

@@ -20,16 +20,27 @@ procedure InitInternationalGeneric;
     
     { keep these routines out of the executable? }
 {$ifndef FPC_NOGENERICANSIROUTINES}
-    widestringmanager.UpperAnsiStringProc:=@GenericAnsiUpperCase;
-    widestringmanager.LowerAnsiStringProc:=@GenericAnsiLowerCase;    
-    widestringmanager.CompareStrAnsiStringProc:=@GenericAnsiCompareStr;
-    widestringmanager.CompareTextAnsiStringProc:=@GenericAnsiCompareText;
-    widestringmanager.StrCompAnsiStringProc:=@GenericAnsiStrComp;
-    widestringmanager.StrICompAnsiStringProc:=@GenericAnsiStrIComp;
-    widestringmanager.StrLCompAnsiStringProc:=@GenericAnsiStrLComp;
-    widestringmanager.StrLICompAnsiStringProc:=@GenericAnsiStrLIComp;
-    widestringmanager.StrLowerAnsiStringProc:=@GenericAnsiStrLower;
-    widestringmanager.StrUpperAnsiStringProc:=@GenericAnsiStrUpper;
+    { don't override a previously installed widestring manager }
+    if not assigned(widestringmanager.UpperAnsiStringProc) then
+      widestringmanager.UpperAnsiStringProc:=@GenericAnsiUpperCase;
+    if not assigned(widestringmanager.LowerAnsiStringProc) then
+      widestringmanager.LowerAnsiStringProc:=@GenericAnsiLowerCase;    
+    if not assigned(widestringmanager.CompareStrAnsiStringProc) then
+      widestringmanager.CompareStrAnsiStringProc:=@GenericAnsiCompareStr;
+    if not assigned(widestringmanager.CompareTextAnsiStringProc) then
+      widestringmanager.CompareTextAnsiStringProc:=@GenericAnsiCompareText;
+    if not assigned(widestringmanager.StrCompAnsiStringProc) then
+      widestringmanager.StrCompAnsiStringProc:=@GenericAnsiStrComp;
+    if not assigned(widestringmanager.StrICompAnsiStringProc) then
+      widestringmanager.StrICompAnsiStringProc:=@GenericAnsiStrIComp;
+    if not assigned(widestringmanager.StrLCompAnsiStringProc) then
+      widestringmanager.StrLCompAnsiStringProc:=@GenericAnsiStrLComp;
+    if not assigned(widestringmanager.StrLICompAnsiStringProc) then
+      widestringmanager.StrLICompAnsiStringProc:=@GenericAnsiStrLIComp;
+    if not assigned(widestringmanager.StrLowerAnsiStringProc) then
+      widestringmanager.StrLowerAnsiStringProc:=@GenericAnsiStrLower;
+    if not assigned(widestringmanager.StrUpperAnsiStringProc) then
+      widestringmanager.StrUpperAnsiStringProc:=@GenericAnsiStrUpper;
 {$endif FPC_NOGENERICANSIROUTINES}    
   end;
   

rtl/solaris/ptypes.inc

@@ -129,7 +129,11 @@ Type
     uint_t    = cuint;
 
 
-    wchar_t   = widechar;
+{$ifdef cpu64}
+    wchar_t   = cint;
+{$else cpu64}
+    wchar_t   = clong;
+{$endif cpu64}
     pwchar_t  = ^wchar_t;
 
     uid_t    = cuint32;         { used for user ID type        }
@@ -168,6 +172,15 @@ Type
   end;
   PStatFS=^TStatFS;
 
+  mbstate_t = record
+{$ifdef cpu64}
+        __filler: array[0..3] of clong;
+{$else cpu64}
+        __filler: array[0..5] of cint;
+{$endif cpu64}
+  end;
+  pmbstate_t = ^mbstate_t;
+  
 
   clock32_t = int32_t;
   timeval32 = record

rtl/unix/cwstring.pp

@@ -14,6 +14,7 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$inline on}
 
 unit cwstring;
 
@@ -45,11 +46,22 @@ Const
 {$endif}
 
 { helper functions from libc }
-function towlower(__wc:wint_t):wint_t;cdecl;external libiconvname name 'towlower';
-function towupper(__wc:wint_t):wint_t;cdecl;external libiconvname name 'towupper';
-function wcscoll (__s1:pwchar_t; __s2:pwchar_t):cint;cdecl;external libiconvname name 'wcscoll';
-function strcoll (__s1:pchar; __s2:pchar):cint;cdecl;external libiconvname name 'strcoll';
+function towlower(__wc:wint_t):wint_t;cdecl;external clib name 'towlower';
+function towupper(__wc:wint_t):wint_t;cdecl;external clib name 'towupper';
+
+function wcscoll (__s1:pwchar_t; __s2:pwchar_t):cint;cdecl;external clib name 'wcscoll';
+function strcoll (__s1:pchar; __s2:pchar):cint;cdecl;external clib name 'strcoll';
 function setlocale(category: cint; locale: pchar): pchar; cdecl; external clib name 'setlocale';
+{$ifndef beos}
+function mbrtowc(pwc: pwchar_t; const s: pchar; n: size_t; ps: pmbstate_t): size_t; cdecl; external clib name 'mbrtowc';
+function wcrtomb(s: pchar; wc: wchar_t; ps: pmbstate_t): size_t; cdecl; external clib name 'wcrtomb';
+function mbrlen(const s: pchar; n: size_t; ps: pmbstate_t): size_t; cdecl; external clib name 'mbrlen';
+{$else beos}
+function mbtowc(pwc: pwchar_t; const s: pchar; n: size_t): size_t; cdecl; external clib name 'mbtowc';
+function wctomb(s: pchar; wc: wchar_t): size_t; cdecl; external clib name 'wctomb';
+function mblen(const s: pchar; n: size_t): size_t; cdecl; external clib name 'mblen';
+{$endif beos}
+
 
 const
 {$ifdef linux}
@@ -97,6 +109,13 @@ const
   unicode_encoding4 = 'UCS-4BE';
 {$endif  FPC_LITTLE_ENDIAN}
 
+{ en_US.UTF-8 needs maximally 6 chars, UCS-4/UTF-32 needs 4   }
+{ -> 10 should be enough? Should actually use MB_CUR_MAX, but }
+{ that's a libc macro mapped to internal functions/variables  }
+{ and thus not a stable external API on systems where libc    }
+{ breaks backwards compatibility every now and then           }
+  MB_CUR_MAX = 10;
+
 type
   piconv_t = ^iconv_t;
   iconv_t = pointer;
@@ -115,9 +134,10 @@ function iconv(__cd:iconv_t; __inbuf:ppchar; __inbytesleft:psize_t; __outbuf:ppc
 function iconv_close(__cd:iconv_t):cint;cdecl;external libiconvname name 'libiconv_close';
 {$endif}
 
+procedure fpc_rangeerror; [external name 'FPC_RANGEERROR'];
+
+
 threadvar
-  iconv_ansi2ucs4,
-  iconv_ucs42ansi,
   iconv_ansi2wide,
   iconv_wide2ansi : iconv_t;
  
@@ -258,8 +278,8 @@ function LowerWideString(const s : WideString) : WideString;
     i : SizeInt;
   begin
     SetLength(result,length(s));
-    for i:=1 to length(s) do
-      result[i]:=WideChar(towlower(wint_t(s[i])));
+    for i:=0 to length(s)-1 do
+      pwidechar(result)[i]:=WideChar(towlower(wint_t(s[i+1])));
   end;
 
 
@@ -268,49 +288,222 @@ function UpperWideString(const s : WideString) : WideString;
     i : SizeInt;
   begin
     SetLength(result,length(s));
-    for i:=1 to length(s) do
-      result[i]:=WideChar(towupper(wint_t(s[i])));
+    for i:=0 to length(s)-1 do
+      pwidechar(result)[i]:=WideChar(towupper(wint_t(s[i+1])));
   end;
 
 
-procedure Ansi2UCS4Move(source:pchar;var dest:UCS4String;len:SizeInt);
+procedure EnsureAnsiLen(var S: AnsiString; const len: SizeInt); inline;
+begin
+  if (len>length(s)) then
+    if (length(s) < 10*256) then
+      setlength(s,length(s)+10)
+    else
+      setlength(s,length(s)+length(s) shr 8);
+end;
+
+
+procedure ConcatCharToAnsiStr(const c: char; var S: AnsiString; var index: SizeInt);
+begin
+  EnsureAnsiLen(s,index);
+  pchar(@s[index])^:=c;
+  inc(index);
+end;
+
+
+{ concatenates an utf-32 char to a widestring. S *must* be unique when entering. }
+{$ifndef beos}
+procedure ConcatUTF32ToAnsiStr(const nc: wint_t; var S: AnsiString; var index: SizeInt; var mbstate: mbstate_t);
+{$else not beos}
+procedure ConcatUTF32ToAnsiStr(const nc: wint_t; var S: AnsiString; var index: SizeInt);
+{$endif beos}
+var
+  p     : pchar;
+  mblen : size_t;
+begin
+  { we know that s is unique -> avoid uniquestring calls}
+  p:=@s[index];
+  if (nc<=127) then
+    ConcatCharToAnsiStr(char(nc),s,index)
+  else
+    begin
+      EnsureAnsiLen(s,index+MB_CUR_MAX);
+{$ifndef beos}
+      mblen:=wcrtomb(p,wchar_t(nc),@mbstate);
+{$else not beos}
+      mblen:=wctomb(p,wchar_t(nc));
+{$endif not beos}
+      if (mblen<>size_t(-1)) then
+        inc(index,mblen)
+      else
+        begin
+          { invalid wide char }
+          p^:='?';
+          inc(index);
+        end;
+    end;
+end;
+
+
+function LowerAnsiString(const s : AnsiString) : AnsiString;
   var
-    outlength,
-    outoffset,
-    outleft : size_t;
-    srcpos,
-    destpos: pchar;
-    mynil : pchar;
-    my0 : size_t;
+    i, slen,
+    resindex : SizeInt;
+    mblen    : size_t;
+{$ifndef beos}
+    ombstate,
+    nmbstate : mbstate_t;
+{$endif beos}
+    wc       : wchar_t;
   begin
-    mynil:=nil;
-    my0:=0;
-    // extra space
-    outlength:=len+1;
-    setlength(dest,outlength);
-    outlength:=len+1;
-    srcpos:=source;
-    destpos:=pchar(dest);
-    outleft:=outlength*4;
-    while iconv(iconv_ansi2ucs4,@srcpos,psize(@len),@destpos,@outleft)=size_t(-1) do
+{$ifndef beos}
+    fillchar(ombstate,sizeof(ombstate),0);
+    fillchar(nmbstate,sizeof(nmbstate),0);
+{$endif beos}
+    slen:=length(s);
+    SetLength(result,slen+10);
+    i:=1;
+    resindex:=1;
+    while (i<=slen) do
       begin
-        case fpgetCerrno of
-          ESysE2BIG:
+        if (s[i]<=#127) then
+          begin
+            wc:=wchar_t(s[i]);
+            mblen:= 1;
+          end
+        else
+{$ifndef beos}
+          mblen:=mbrtowc(@wc, pchar(@s[i]), slen-i+1, @ombstate);
+{$else not beos}
+          mblen:=mbtowc(@wc, pchar(@s[i]), slen-i+1);
+{$endif not beos}
+        case mblen of
+          size_t(-2):
             begin
-              outoffset:=destpos-pchar(dest);
-              { extend }
-              setlength(dest,outlength+len);
-              inc(outleft,len*4);
-              inc(outlength,len);
-              { string could have been moved }
-              destpos:=pchar(dest)+outoffset;
+              { partial invalid character, copy literally }
+              while (i<=slen) do
+                begin
+                  ConcatCharToAnsiStr(s[i],result,resindex);
+                  inc(i);
+                end;
+            end;
+          size_t(-1), 0:
+            begin
+              { invalid or null character }
+              ConcatCharToAnsiStr(s[i],result,resindex);
+              inc(i);
             end;
           else
-            runerror(231);
-        end;
+            begin
+              { a valid sequence }
+              { even if mblen = 1, the lowercase version may have a }
+              { different length                                     }
+              { We can't do anything special if wchar_t is 16 bit... }
+{$ifndef beos}
+              ConcatUTF32ToAnsiStr(towlower(wint_t(wc)),result,resindex,nmbstate);
+{$else not beos}
+              ConcatUTF32ToAnsiStr(towlower(wint_t(wc)),result,resindex);
+{$endif not beos}
+              inc(i,mblen);
+            end;
+          end;
       end;
-    // truncate string
-    setlength(dest,length(dest)-outleft div 4);
+    SetLength(result,resindex-1);
+  end;
+
+
+function UpperAnsiString(const s : AnsiString) : AnsiString;
+  var
+    i, slen,
+    resindex : SizeInt;
+    mblen    : size_t;
+{$ifndef beos}
+    ombstate,
+    nmbstate : mbstate_t;
+{$endif beos}
+    wc       : wchar_t;
+  begin
+{$ifndef beos}
+    fillchar(ombstate,sizeof(ombstate),0);
+    fillchar(nmbstate,sizeof(nmbstate),0);
+{$endif beos}
+    slen:=length(s);
+    SetLength(result,slen+10);
+    i:=1;
+    resindex:=1;
+    while (i<=slen) do
+      begin
+        if (s[i]<=#127) then
+          begin
+            wc:=wchar_t(s[i]);
+            mblen:= 1;
+          end
+        else
+{$ifndef beos}          
+          mblen:=mbrtowc(@wc, pchar(@s[i]), slen-i+1, @ombstate);
+{$else not beos}
+          mblen:=mbtowc(@wc, pchar(@s[i]), slen-i+1);
+{$endif beos}
+        case mblen of
+          size_t(-2):
+            begin
+              { partial invalid character, copy literally }
+              while (i<=slen) do
+                begin
+                  ConcatCharToAnsiStr(s[i],result,resindex);
+                  inc(i);
+                end;
+            end;
+          size_t(-1), 0:
+            begin
+              { invalid or null character }
+              ConcatCharToAnsiStr(s[i],result,resindex);
+              inc(i);
+            end;
+          else
+            begin
+              { a valid sequence }
+              { even if mblen = 1, the uppercase version may have a }
+              { different length                                     }
+              { We can't do anything special if wchar_t is 16 bit... }
+{$ifndef beos}
+              ConcatUTF32ToAnsiStr(towupper(wint_t(wc)),result,resindex,nmbstate);
+{$else not beos}
+              ConcatUTF32ToAnsiStr(towupper(wint_t(wc)),result,resindex);
+{$endif not beos}
+              inc(i,mblen);
+            end;
+          end;
+      end;
+    SetLength(result,resindex-1);
+  end;
+
+
+function utf16toutf32(const S: WideString; const index: SizeInt; out len: longint): UCS4Char; external name 'FPC_UTF16TOUTF32';
+
+function WideStringToUCS4StringNoNulls(const s : WideString) : UCS4String;
+  var
+    i, slen,
+    destindex : SizeInt;
+    len       : longint;
+    uch       : UCS4Char;
+  begin
+    slen:=length(s);
+    setlength(result,slen+1);
+    i:=1;
+    destindex:=0;
+    while (i<=slen) do
+      begin
+        uch:=utf16toutf32(s,i,len);
+        if (uch=UCS4Char(0)) then
+          uch:=UCS4Char(32);
+        result[destindex]:=uch;
+        inc(destindex);
+        inc(i,len);
+      end;
+    result[destindex]:=UCS4Char(0);
+    { destindex <= slen }
+    setlength(result,destindex);
   end;
 
 
@@ -318,8 +511,9 @@ function CompareWideString(const s1, s2 : WideString) : PtrInt;
   var
     hs1,hs2 : UCS4String;
   begin
-    hs1:=WideStringToUCS4String(s1);
-    hs2:=WideStringToUCS4String(s2);
+    { wcscoll interprets null chars as end-of-string -> filter out }
+    hs1:=WideStringToUCS4StringNoNulls(s1);
+    hs2:=WideStringToUCS4StringNoNulls(s2);
     result:=wcscoll(pwchar_t(hs1),pwchar_t(hs2));
   end;
 
@@ -330,18 +524,169 @@ function CompareTextWideString(const s1, s2 : WideString): PtrInt;
   end;
 
 
+function CharLengthPChar(const Str: PChar): PtrInt;
+  var
+    nextlen: ptrint;
+    s: pchar;
+{$ifndef beos}
+    mbstate: mbstate_t;
+{$endif not beos}
+  begin
+    result:=0;
+    s:=str;
+    repeat
+{$ifdef beos}
+      nextlen:=ptrint(mblen(str,MB_CUR_MAX));
+{$else beos}
+      nextlen:=ptrint(mbrlen(str,MB_CUR_MAX,@mbstate));
+{$endif beos}
+      { skip invalid/incomplete sequences }
+      if (nextlen<0) then
+        nextlen:=1;
+      inc(result,nextlen);
+      inc(s,nextlen);
+    until (nextlen=0);
+  end;
+
+
+function StrCompAnsiIntern(const s1,s2 : PChar; len1, len2: PtrInt): PtrInt;
+  var
+    a,b: pchar;
+    i: PtrInt;
+  begin
+    getmem(a,len1+1);
+    getmem(b,len2+1);
+    for i:=0 to len1-1 do
+      if s1[i]<>#0 then
+        a[i]:=s1[i]
+      else
+        a[i]:=#32;
+    a[len1]:=#0;
+    for i:=0 to len2-1 do
+      if s2[i]<>#0 then
+        b[i]:=s2[i]
+      else
+        b[i]:=#32;
+    b[len2]:=#0;
+    result:=strcoll(a,b);
+    freemem(a);
+    freemem(b);
+  end;
+
+
+function CompareStrAnsiString(const s1, s2: ansistring): PtrInt;
+  begin
+    result:=StrCompAnsiIntern(pchar(s1),pchar(s2),length(s1),length(s2));
+  end;
+
+
 function StrCompAnsi(s1,s2 : PChar): PtrInt;
   begin
     result:=strcoll(s1,s2);
   end;
 
 
+function AnsiCompareText(const S1, S2: ansistring): PtrInt;
+  var
+    a, b: AnsiString;
+  begin
+    a:=UpperAnsistring(s1);
+    b:=UpperAnsistring(s2);
+    result:=StrCompAnsiIntern(pchar(a),pchar(b),length(a),length(b));
+  end;
+
+
+function AnsiStrIComp(S1, S2: PChar): PtrInt;
+  begin
+    result:=AnsiCompareText(ansistring(s1),ansistring(s2));
+  end;
+
+
+function AnsiStrLComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+  var
+    a, b: pchar;
+begin
+  if (IndexChar(s1^,maxlen,#0)<0) then
+    begin
+      getmem(a,maxlen+1);
+      move(s1^,a^,maxlen);
+      a[maxlen]:=#0;
+    end
+  else
+    a:=s1;
+  if (IndexChar(s2^,maxlen,#0)<0) then
+    begin
+      getmem(b,maxlen+1);
+      move(s2^,b^,maxlen);
+      b[maxlen]:=#0;
+    end
+  else
+    b:=s2;
+  result:=strcoll(a,b);
+  if (a<>s1) then
+    freemem(a);
+  if (b<>s2) then
+    freemem(b);
+end;
+
+
+function AnsiStrLIComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+  var
+    a, b: ansistring;
+    len1,len2: SizeInt;
+begin
+  len1:=IndexChar(s1^,maxlen,#0);
+  if (len1<0) then
+    len1:=maxlen;
+  setlength(a,len1);
+  if (len1<>0) then
+    move(s1^,a[1],len1);
+  len2:=IndexChar(s2^,maxlen,#0);
+  if (len2<0) then
+    len2:=maxlen;
+  setlength(b,len2);
+  if (len2<>0) then
+    move(s2^,b[1],len2);
+  result:=AnsiCompareText(a,b);
+end;
+
+
+procedure ansi2pchar(const s: ansistring; const orgp: pchar; out p: pchar);
+var
+  newlen: sizeint;
+begin
+  newlen:=length(s);
+  if newlen>strlen(orgp) then
+    fpc_rangeerror;
+  p:=orgp;
+  if (newlen>0) then
+    move(s[1],p[0],newlen);
+  p[newlen]:=#0;
+end;
+
+
+function AnsiStrLower(Str: PChar): PChar;
+var
+  temp: ansistring;
+begin
+  temp:=loweransistring(str);
+  ansi2pchar(temp,str,result);
+end;
+
+
+function AnsiStrUpper(Str: PChar): PChar;
+var
+  temp: ansistring;
+begin
+  temp:=upperansistring(str);
+  ansi2pchar(temp,str,result);
+end;
+
+
 procedure InitThread;
 begin
   iconv_wide2ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding2);
   iconv_ansi2wide:=iconv_open(unicode_encoding2,nl_langinfo(CODESET));
-  iconv_ucs42ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding4);
-  iconv_ansi2ucs4:=iconv_open(unicode_encoding4,nl_langinfo(CODESET));
 end;
 
 
@@ -351,10 +696,6 @@ begin
     iconv_close(iconv_wide2ansi);
   if (iconv_ansi2wide <> iconv_t(-1)) then
     iconv_close(iconv_ansi2wide);
-  if (iconv_ucs42ansi <> iconv_t(-1)) then
-    iconv_close(iconv_ucs42ansi);
-  if (iconv_ansi2ucs4 <> iconv_t(-1)) then
-    iconv_close(iconv_ansi2ucs4);
 end;
 
 
@@ -373,22 +714,19 @@ begin
 
       CompareWideStringProc:=@CompareWideString;
       CompareTextWideStringProc:=@CompareTextWideString;
-      {
-      CharLengthPCharProc
-
-      UpperAnsiStringProc
-      LowerAnsiStringProc
-      CompareStrAnsiStringProc
-      CompareTextAnsiStringProc
-      }
+
+      CharLengthPCharProc:=@CharLengthPChar;
+
+      UpperAnsiStringProc:=@UpperAnsiString;
+      LowerAnsiStringProc:=@LowerAnsiString;
+      CompareStrAnsiStringProc:=@CompareStrAnsiString;
+      CompareTextAnsiStringProc:=@AnsiCompareText;
       StrCompAnsiStringProc:=@StrCompAnsi;
-      {
-      StrICompAnsiStringProc
-      StrLCompAnsiStringProc
-      StrLICompAnsiStringProc
-      StrLowerAnsiStringProc
-      StrUpperAnsiStringProc
-      }
+      StrICompAnsiStringProc:=@AnsiStrIComp;
+      StrLCompAnsiStringProc:=@AnsiStrLComp;
+      StrLICompAnsiStringProc:=@AnsiStrLIComp;
+      StrLowerAnsiStringProc:=@AnsiStrLower;
+      StrUpperAnsiStringProc:=@AnsiStrUpper;
       ThreadInitProc:=@InitThread;
       ThreadFiniProc:=@FiniThread;
     end;

tests/test/twide5.pp

@@ -0,0 +1,44 @@
+{$codepage utf-8}
+
+var
+  ws: widestring;
+  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:=WideStringToUCS4String(ws);
+  if (length(us)<>7) or
+     (us[0]<>UCS4Char(widechar('é'))) or
+     (us[1]<>UCS4Char(widechar('ł'))) or
+     (us[2]<>UCS4Char(widechar('Ł'))) or
+     (us[3]<>UCS4Char(widechar('ć'))) or
+     (us[4]<>UCS4Char(widechar('ç'))) or
+     (us[5]<>UCS4Char(widechar('Ź'))) or
+     (us[6]<>UCS4Char($2F804)) then
+    halt(2);
+  ws:=UCS4StringToWideString(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/twide6.pp

@@ -0,0 +1,385 @@
+{$codepage utf-8}
+uses
+ {$ifdef unix}
+ cwstring,
+ {$endif}
+  sysutils;
+
+
+{ normal upper case testing }
+procedure testupper;
+var
+  s: ansistring;
+  w1,w2,w3,w4: widestring;
+  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;
+  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:=wideuppercase(w1);
+{$ifdef print}
+  writeln('wideupper: ',w1);
+  writeln('ansiupper: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    halt(1);
+  if (w4 <> w2) then
+    halt(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:=wideuppercase(w1);
+{$ifdef print}
+  writeln('wideupper: ',w1);
+  writeln('ansistrupper: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    halt(1);
+  if (w4 <> w2) then
+    halt(2);
+
+end;
+
+
+{ normal lower case testing }
+procedure testlower;
+var
+  s: ansistring;
+  w1,w2,w3,w4: widestring;
+  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:=widelowercase(w1);
+{$ifdef print}
+  writeln('widelower: ',w1);
+  writeln('ansilower: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    halt(3);
+  if (w4 <> w2) then
+    halt(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:=widelowercase(w1);
+{$ifdef print}
+  writeln('widelower: ',w1);
+  writeln('ansistrlower: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    halt(3);
+  if (w4 <> w2) then
+    halt(4);
+end;
+
+
+
+{ upper case testing with a missing utf-16 pair at the end }
+procedure testupperinvalid;
+var
+  s: ansistring;
+  w1,w2,w3,w4: widestring;
+  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:=wideuppercase(w1);
+{$ifdef print}
+  writeln('wideupper: ',w1);
+  writeln('ansiupper: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    halt(5);
+  if (w4 <> w2) then
+    halt(6);
+end;
+
+
+{ lower case testing with a missing utf-16 pair at the end }
+procedure testlowerinvalid;
+var
+  s: ansistring;
+  w1,w2,w3,w4: widestring;
+  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:=widelowercase(w1);
+{$ifdef print}
+  writeln('widelower: ',w1);
+  writeln('ansilower: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    halt(7);
+  if (w4 <> w2) then
+    halt(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: widestring;
+  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:=wideuppercase(w1);
+{$ifdef print}
+  writeln('wideupper: ',w1);
+  writeln('ansiupper: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    halt(9);
+  if (w4 <> w2) then
+    halt(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: widestring;
+  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:=widelowercase(w1);
+{$ifdef print}
+  writeln('widelower: ',w1);
+  writeln('ansilower: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    halt(11);
+  if (w4 <> w2) then
+    halt(12);
+end;
+
+
+{ upper case testing with corrupting the utf-8 string after conversion }
+procedure testupperinvalid2;
+var
+  s: ansistring;
+  w1,w2,w3,w4: widestring;
+  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:=wideuppercase(w1);
+{$ifdef print}
+  writeln('wideupper: ',w1);
+  writeln('ansiupper: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    halt(13);
+  if (w4 <> w2) then
+    halt(14);
+end;
+
+
+{ lower case testing with corrupting the utf-8 string after conversion }
+procedure testlowerinvalid2;
+var
+  s: ansistring;
+  w1,w2,w3,w4: widestring;
+  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:=widelowercase(w1);
+{$ifdef print}
+  writeln('widelower: ',w1);
+  writeln('ansilower: ',w4);
+{$endif print}
+  if (w1 <> w2) then
+    halt(15);
+  if (w4 <> w2) then
+    halt(16);
+end;
+
+
+
+begin
+  testupper;
+  writeln;
+  testlower;
+  writeln;
+  writeln;
+  testupperinvalid;
+  writeln;
+  testlowerinvalid;
+  writeln;
+  writeln;
+  testupperinvalid1;
+  writeln;
+  testlowerinvalid1;
+  writeln;
+  writeln;
+  testupperinvalid2;
+  writeln;
+  testlowerinvalid2;
+end.

tests/test/twide7.pp

@@ -0,0 +1,47 @@
+{$codepage utf-8}
+
+uses
+{$ifdef unix}
+  cwstring,
+{$endif unix}
+  sysutils;
+
+procedure testwcmp;
+var
+  w1,w2: widestring;
+  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.

tests/test/units/sysutils/tastrcmp.pp

@@ -0,0 +1,167 @@
+{ based on string/tester.c of glibc 2.3.6 
+
+* Tester for string functions.
+   Copyright (C) 1995-2000, 2001, 2003 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C Library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   The GNU C Library 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.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+}
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif fpc}
+
+uses
+{$ifdef unix}
+  cwstring,
+{$endif unix}
+  SysUtils;
+
+var
+  teststr: string;
+  goterror: boolean;
+
+procedure check(b: boolean; testnr: longint);
+begin
+  if not (b) then
+    begin
+      writeln(teststr,' error nr ',testnr);
+      goterror:=true;
+    end;
+end;
+
+procedure testAnsiCompareText;
+begin
+  teststr:='AnsiCompareText';
+  check(ansicomparetext('a', 'a') = 0, 1);
+  check(ansicomparetext('a', 'A') = 0, 2);
+  check(ansicomparetext('A', 'a') = 0, 3);
+  check(ansicomparetext('a', 'b') < 0, 4);
+  check(ansicomparetext('c', 'b') > 0, 5);
+  check(ansicomparetext('abc', 'AbC') = 0, 6);
+  check(ansicomparetext('0123456789', '0123456789') = 0, 7);
+  check(ansicomparetext('', '0123456789') < 0, 8);
+  check(ansicomparetext('AbC', '') > 0, 9);
+  check(ansicomparetext('AbC', 'A') > 0, 10);
+  check(ansicomparetext('AbC', 'Ab') > 0, 11);
+  check(ansicomparetext('AbC', 'ab') > 0, 12);
+  check(ansicomparetext('Ab'#0'C', 'ab'#0) > 0, 13);
+end;
+
+
+procedure testAnsiStrIComp;
+begin
+  teststr:='AnsiStrIComp';
+  check(ansistricomp('a', 'a') = 0, 1);
+  check(ansistricomp('a', 'A') = 0, 2);
+  check(ansistricomp('A', 'a') = 0, 3);
+  check(ansistricomp('a', 'b') < 0, 4);
+  check(ansistricomp('c', 'b') > 0, 5);
+  check(ansistricomp('abc', 'AbC') = 0, 6);
+  check(ansistricomp('0123456789', '0123456789') = 0, 7);
+  check(ansistricomp('', '0123456789') < 0, 8);
+  check(ansistricomp('AbC', '') > 0, 9);
+  check(ansistricomp('AbC', 'A') > 0, 10);
+  check(ansistricomp('AbC', 'Ab') > 0, 11);
+  check(ansistricomp('AbC', 'ab') > 0, 12);
+  check(ansistricomp('Ab'#0'C', 'ab'#0) = 0, 13);
+end;
+
+
+procedure testAnsiStrLComp;
+begin
+  teststr:='AnsiStrIComp';
+  check (ansistrlcomp ('', '', 99) = 0, 1); { Trivial case. }
+  check (ansistrlcomp ('a', 'a', 99) = 0, 2);       { Identity. }
+  check (ansistrlcomp ('abc', 'abc', 99) = 0, 3);   { Multicharacter. }
+  check (ansistrlcomp ('abc', 'abcd', 99) < 0, 4);   { Length unequal. }
+  check (ansistrlcomp ('abcd', 'abc', 99) > 0, 5);
+  check (ansistrlcomp ('abcd', 'abce', 99) < 0, 6);  { Honestly unequal. }
+  check (ansistrlcomp ('abce', 'abcd', 99) > 0, 7);
+  check (ansistrlcomp ('abce', 'abcd', 3) = 0, 10); { Count limited. }
+  check (ansistrlcomp ('abce', 'abc', 3) = 0, 11);  { Count = length. }
+  check (ansistrlcomp ('abcd', 'abce', 4) < 0, 12);  { Nudging limit. }
+  check (ansistrlcomp ('abc', 'def', 0) = 0, 13);   { Zero count. }
+  check (ansistrlcomp ('abc'#0'e', 'abc'#0'd', 99) = 0, 14);
+end;
+
+
+procedure testAnsiCompareStr;
+begin
+  teststr:='AnsiCompareStr';
+  check (ansicomparestr ('', '') = 0, 1);              { Trivial case. }
+  check (ansicomparestr ('a', 'a') = 0, 2);            { Identity. }
+  check (ansicomparestr ('abc', 'abc') = 0, 3);        { Multicharacter. }
+  check (ansicomparestr ('abc', 'abcd') < 0, 4);        { Length mismatches. }
+  check (ansicomparestr ('abcd', 'abc') > 0, 5);
+  check (ansicomparestr ('abcd', 'abce') < 0, 6);       { Honest miscompares. }
+  check (ansicomparestr ('abce', 'abcd') > 0, 7);
+  check (ansicomparestr ('abc'#0'e', 'abc'#0'd') > 0, 8);
+end;
+
+
+procedure testAnsiStrComp;
+begin
+  teststr:='AnsiStrComp';
+  check (ansistrcomp ('', '') = 0, 1);              { Trivial case. }
+  check (ansistrcomp ('a', 'a') = 0, 2);            { Identity. }
+  check (ansistrcomp ('abc', 'abc') = 0, 3);        { Multicharacter. }
+  check (ansistrcomp ('abc', 'abcd') < 0, 4);        { Length mismatches. }
+  check (ansistrcomp ('abcd', 'abc') > 0, 5);
+  check (ansistrcomp ('abcd', 'abce') < 0, 6);       { Honest miscompares. }
+  check (ansistrcomp ('abce', 'abcd') > 0, 7);
+  check (ansistrcomp ('abc'#0'e', 'abc'#0'd') = 0, 8);
+end;
+
+
+procedure testAnsiStrLIComp;
+begin
+  teststr:='AnsiStrLIComp';
+  check(ansistrlicomp('a', 'a', 5) = 0, 1);
+  check(ansistrlicomp('a', 'A', 5) = 0, 2);
+  check(ansistrlicomp('A', 'a', 5) = 0, 3);
+  check(ansistrlicomp('a', 'b', 5) < 0, 4);
+  check(ansistrlicomp('c', 'b', 5) > 0, 5);
+  check(ansistrlicomp('abc', 'AbC', 5) = 0, 6);
+  check(ansistrlicomp('0123456789', '0123456789', 10) = 0, 7);
+  check(ansistrlicomp('', '0123456789', 10) < 0, 8);
+  check(ansistrlicomp('AbC', '', 5) > 0, 9);
+  check(ansistrlicomp('AbC', 'A', 5) > 0, 10);
+  check(ansistrlicomp('AbC', 'Ab', 5) > 0, 11);
+  check(ansistrlicomp('AbC', 'ab', 5) > 0, 12);
+  check(ansistrlicomp('0123456789', 'AbC', 0) = 0, 13);
+  check(ansistrlicomp('AbC', 'abc', 1) = 0, 14);
+  check(ansistrlicomp('AbC', 'abc', 2) = 0, 15);
+  check(ansistrlicomp('AbC', 'abc', 3) = 0, 16);
+  check(ansistrlicomp('AbC', 'abcd', 3) = 0, 17);
+  check(ansistrlicomp('AbC', 'abcd', 4) < 0, 18);
+  check(ansistrlicomp('ADC', 'abcd', 1) = 0, 19);
+  check(ansistrlicomp('ADC', 'abcd', 2) > 0, 20);
+  check(ansistrlicomp('abc'#0'e', 'abc'#0'd', 99) = 0, 21);
+end;
+
+
+begin
+  goterror:=false;
+  testAnsiCompareText;
+  testAnsiStrIComp;
+  testAnsiStrLComp;
+  testAnsiCompareStr;
+  testAnsiStrComp;
+  testAnsiStrLIComp;
+  if goterror then
+    halt(1);
+end.