delphimvcframework/lib/dmustache/SynCommons.pas

/// common functions used by most Synopse projects
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynCommons;

(*
    This file is part of Synopse framework.

    Synopse framework. Copyright (C) 2021 Arnaud Bouchez
      Synopse Informatique - https://synopse.info

  *** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the License.

  The Original Code is Synopse framework.

  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2021
  the Initial Developer. All Rights Reserved.

  Contributor(s):
   - Alan Chate
   - Aleksandr (sha)
   - Alfred Glaenzer (alf)
   - ASiwon
   - Chaa
   - BigStar
   - Eugene Ilyin
   - f-vicente
   - itSDS
   - Johan Bontes
   - kevinday
   - Kevin Chen
   - Maciej Izak (hnb)
   - Marius Maximus (mariuszekpl)
   - mazinsw
   - mingda
   - PBa
   - RalfS
   - Sanyin
   - Pavel Mashlyakovskii (mpv)
   - Wloochacz
   - zed

  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****

*)


{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER

interface

uses
{$ifdef MSWINDOWS}
  Windows,
  Messages,
{$else MSWINDOWS}
  {$ifdef KYLIX3}
    Types,
    LibC,
    SynKylix,
  {$endif KYLIX3}
  {$ifdef FPC}
    BaseUnix,
  {$endif FPC}
{$endif MSWINDOWS}
  Classes,
{$ifndef LVCL}
  SyncObjs, // for TEvent and TCriticalSection
  Contnrs,  // for TObjectList
  {$ifdef HASINLINE}
    Types,
  {$endif HASINLINE}
{$endif LVCL}
{$ifndef NOVARIANTS}
  Variants,
{$endif NOVARIANTS}
  SynLZ, // needed for TSynMapFile .mab format
  SysUtils;


const
  /// the corresponding version of the freeware Synopse framework
  // - includes a commit increasing number (generated by SourceCodeRep tool)
  // - a similar constant shall be defined in SynCrtSock.pas
  SYNOPSE_FRAMEWORK_VERSION = {$I SynopseCommit.inc};

  /// a text including the version and the main active conditional options
  // - usefull for low-level debugging purpose
  SYNOPSE_FRAMEWORK_FULLVERSION  = SYNOPSE_FRAMEWORK_VERSION
    {$ifdef FPC}
      {$ifdef FPC_X64MM}+' x64MM'{$ifdef FPCMM_BOOST}+'b'{$endif}
        {$ifdef FPCMM_SERVER}+'s'{$endif}{$else}
      {$ifdef FPC_FASTMM4}+' FMM4'{$else}
      {$ifdef FPC_SYNTBB}+' TBB'{$else}
      {$ifdef FPC_SYNJEMALLOC}+' JM'{$else}
      {$ifdef FPC_SYNCMEM}+' CM'{$else}
      {$ifdef FPC_CMEM}+' cM'{$endif}{$endif}{$endif}{$endif}{$endif}{$endif}
    {$else}
      {$ifdef LVCL}+' LVCL'{$else}
        {$ifdef ENHANCEDRTL}+' ERTL'{$endif}{$endif}
      {$ifdef FullDebugMode}+' FDM'{$endif}
    {$endif FPC}
    {$ifdef DOPATCHTRTL}+' PRTL'{$endif};


{ ************ common types used for compatibility between compilers and CPU }

const
  /// internal Code Page for UTF-16 Unicode encoding
  // - used e.g. for Delphi 2009+ UnicodeString=String type
  CP_UTF16 = 1200;

  /// fake code page used to recognize TSQLRawBlob
  // - as returned e.g. by TTypeInfo.AnsiStringCodePage from mORMot.pas
  CP_SQLRAWBLOB = 65534;

  /// internal Code Page for RawByteString undefined string
  CP_RAWBYTESTRING = 65535;

  /// US English Windows Code Page, i.e. WinAnsi standard character encoding
  CODEPAGE_US = 1252;

  /// Latin-1 ISO/IEC 8859-1 Code Page
  CODEPAGE_LATIN1 = 819;

{$ifndef MSWINDOWS}
  /// internal Code Page for UTF-8 Unicode encoding
  CP_UTF8 = 65001;
var
  /// contains the curent system code page (default WinAnsi)
  GetACP: integer = CODEPAGE_US;
{$endif}

{$ifdef FPC} { make cross-compiler and cross-CPU types available to Delphi }

type
  PBoolean = ^Boolean;

{$else FPC}

type
  {$ifdef CPU64} // Delphi XE2 seems stable about those types (not Delphi 2009)
  PtrInt = NativeInt;
  PtrUInt = NativeUInt;
  {$else}
  /// a CPU-dependent signed integer type cast of a pointer / register
  // - used for 64-bit compatibility, native under Free Pascal Compiler
  PtrInt = integer;
  /// a CPU-dependent unsigned integer type cast of a pointer / register
  // - used for 64-bit compatibility, native under Free Pascal Compiler
  PtrUInt = cardinal;
  {$endif}
  /// a CPU-dependent unsigned integer type cast of a pointer of pointer
  // - used for 64-bit compatibility, native under Free Pascal Compiler
  PPtrUInt = ^PtrUInt;
  /// a CPU-dependent signed integer type cast of a pointer of pointer
  // - used for 64-bit compatibility, native under Free Pascal Compiler
  PPtrInt = ^PtrInt;

  /// unsigned Int64 doesn't exist under older Delphi, but is defined in FPC
  // - and UInt64 is buggy as hell under Delphi 2007 when inlining functions:
  // older compilers will fallback to signed Int64 values
  // - anyway, consider using SortDynArrayQWord() to compare QWord values
  // in a safe and efficient way, under a CPUX86
  // - you may use UInt64 explicitly in your computation (like in SynEcc.pas),
  // if you are sure that Delphi 6-2007 compiler handles your code as expected,
  // but mORMot code will expect to use QWord for its internal process
  // (e.g. ORM/SOA serialization)
  {$ifdef UNICODE}
  QWord = UInt64;
  {$else}
  QWord = {$ifndef DELPHI5OROLDER}type{$endif} Int64;
  {$endif}
  /// points to an unsigned Int64
  PQWord = ^QWord;

  {$ifndef ISDELPHIXE2}
  /// used to store the handle of a system Thread
  TThreadID = cardinal;
  {$endif}

{$endif FPC}

{$ifdef DELPHI6OROLDER}

// some definitions not available prior to Delphi 7
type
  UInt64 = Int64;

{$endif}

{$ifdef DELPHI5OROLDER}
  // Delphi 5 doesn't have those basic types defined :(
const
  varShortInt = $0010;
  varInt64 = $0014; { vt_i8 }
  soBeginning = soFromBeginning;
  soCurrent = soFromCurrent;
  reInvalidPtr = 2;
  PathDelim  = '\';
  sLineBreak = #13#10;

type
  PPointer = ^Pointer;
  PPAnsiChar = ^PAnsiChar;
  PInteger = ^Integer;
  PCardinal = ^Cardinal;
  PByte = ^Byte;
  PWord = ^Word;
  PBoolean = ^Boolean;
  PDouble = ^Double;
  PComp = ^Comp;
  THandle = LongWord;
  PVarData = ^TVarData;
  TVarData = packed record
    // mostly used for varNull, varInt64, varDouble, varString and varAny
    VType: word;
    case Integer of
      0: (Reserved1: Word;
          case Integer of
            0: (Reserved2, Reserved3: Word;
                case Integer of
                  varSmallInt: (VSmallInt: SmallInt);
                  varInteger:  (VInteger: Integer);
                  varSingle:   (VSingle: Single);
                  varDouble:   (VDouble: Double);     // DOUBLE
                  varCurrency: (VCurrency: Currency);
                  varDate:     (VDate: TDateTime);
                  varOleStr:   (VOleStr: PWideChar);
                  varDispatch: (VDispatch: Pointer);
                  varError:    (VError: HRESULT);
                  varBoolean:  (VBoolean: WordBool);
                  varUnknown:  (VUnknown: Pointer);
                  varByte:     (VByte: Byte);
                  varInt64:    (VInt64: Int64);      // INTEGER
                  varString:   (VString: Pointer);   // TEXT
                  varAny:      (VAny: Pointer);
                  varArray:    (VArray: PVarArray);
                  varByRef:    (VPointer: Pointer);
               );
            1: (VLongs: array[0..2] of LongInt); );
  end;
{$else}
{$ifndef FPC}
type
  // redefined here to not use the wrong definitions from Windows.pas
  PWord = System.PWord;
  PSingle = System.PSingle;
{$endif FPC}
{$endif DELPHI5OROLDER}

type
  /// RawUnicode is an Unicode String stored in an AnsiString
  // - faster than WideString, which are allocated in Global heap (for COM)
  // - an AnsiChar(#0) is added at the end, for having a true WideChar(#0) at ending
  // - length(RawUnicode) returns memory bytes count: use (length(RawUnicode) shr 1)
  // for WideChar count (that's why the definition of this type since Delphi 2009
  // is AnsiString(1200) and not UnicodeString)
  // - pointer(RawUnicode) is compatible with Win32 'Wide' API call
  // - mimic Delphi 2009 UnicodeString, without the WideString or Ansi conversion overhead
  // - all conversion to/from AnsiString or RawUTF8 must be explicit: the
  // compiler is not able to make valid implicit conversion on CP_UTF16
  {$ifdef HASCODEPAGE}
  RawUnicode = type AnsiString(CP_UTF16); // Codepage for an UnicodeString
  {$else}
  RawUnicode = type AnsiString;
  {$endif}

  /// RawUTF8 is an UTF-8 String stored in an AnsiString
  // - use this type instead of System.UTF8String, which behavior changed
  // between Delphi 2009 compiler and previous versions: our implementation
  // is consistent and compatible with all versions of Delphi compiler
  // - mimic Delphi 2009 UTF8String, without the charset conversion overhead
  // - all conversion to/from AnsiString or RawUnicode must be explicit
  {$ifdef HASCODEPAGE}
  RawUTF8 = type AnsiString(CP_UTF8); // Codepage for an UTF8 string
  {$else}
  RawUTF8 = type AnsiString;
  {$endif}

  /// WinAnsiString is a WinAnsi-encoded AnsiString (code page 1252)
  // - use this type instead of System.String, which behavior changed
  // between Delphi 2009 compiler and previous versions: our implementation
  // is consistent and compatible with all versions of Delphi compiler
  // - all conversion to/from RawUTF8 or RawUnicode must be explicit
  {$ifdef HASCODEPAGE}
  WinAnsiString = type AnsiString(CODEPAGE_US); // WinAnsi Codepage
  {$else}
  WinAnsiString = type AnsiString;
  {$endif}

  {$ifdef HASCODEPAGE}
  {$ifdef FPC}
  // missing declaration
  PRawByteString = ^RawByteString;
  {$endif}
  {$else}
  /// define RawByteString, as it does exist in Delphi 2009+
  // - to be used for byte storage into an AnsiString
  // - use this type if you don't want the Delphi compiler not to do any
  // code page conversions when you assign a typed AnsiString to a RawByteString,
  // i.e. a RawUTF8 or a WinAnsiString
  RawByteString = type AnsiString;
  /// pointer to a RawByteString
  PRawByteString = ^RawByteString;
  {$endif}

  /// RawJSON will indicate that this variable content would stay in raw JSON
  // - i.e. won't be serialized into values
  // - could be any JSON content: number, string, object or array
  // - e.g. interface-based service will use it for efficient and AJAX-ready
  // transmission of TSQLTableJSON result
  RawJSON = type RawUTF8;

  /// SynUnicode is the fastest available Unicode native string type, depending
  //  on the compiler used
  // - this type is native to the compiler, so you can use Length() Copy() and
  //   such functions with it (this is not possible with RawUnicodeString type)
  // - before Delphi 2009+, it uses slow OLE compatible WideString
  //   (with our Enhanced RTL, WideString allocation can be made faster by using
  //   an internal caching mechanism of allocation buffers - WideString allocation
  //   has been made much faster since Windows Vista/Seven)
  // - starting with Delphi 2009, it uses fastest UnicodeString type, which
  //   allow Copy On Write, Reference Counting and fast heap memory allocation
  {$ifdef HASVARUSTRING}
  SynUnicode = UnicodeString;
  {$else}
  SynUnicode = WideString;
  {$endif HASVARUSTRING}

  PRawUnicode = ^RawUnicode;
  PRawJSON = ^RawJSON;
  PRawUTF8 = ^RawUTF8;
  PWinAnsiString = ^WinAnsiString;
  PWinAnsiChar = type PAnsiChar;
  PSynUnicode = ^SynUnicode;

  /// a simple wrapper to UTF-8 encoded zero-terminated PAnsiChar
  // - PAnsiChar is used only for Win-Ansi encoded text
  // - the Synopse mORMot framework uses mostly this PUTF8Char type,
  // because all data is internaly stored and expected to be UTF-8 encoded
  PUTF8Char = type PAnsiChar;
  PPUTF8Char = ^PUTF8Char;

  /// a Row/Col array of PUTF8Char, for containing sqlite3_get_table() result
  TPUtf8CharArray = array[0..MaxInt div SizeOf(PUTF8Char)-1] of PUTF8Char;
  PPUtf8CharArray = ^TPUtf8CharArray;

  /// a dynamic array of PUTF8Char pointers
  TPUTF8CharDynArray = array of PUTF8Char;

  /// a dynamic array of UTF-8 encoded strings
  TRawUTF8DynArray = array of RawUTF8;
  PRawUTF8DynArray = ^TRawUTF8DynArray;
  TRawUTF8DynArrayDynArray = array of TRawUTF8DynArray;

  /// a dynamic array of TVarRec, i.e. could match an "array of const" parameter
  TTVarRecDynArray = array of TVarRec;

  {$ifndef NOVARIANTS}
  /// a TVarData values array
  // - is not called TVarDataArray to avoid confusion with the corresponding
  // type already defined in Variants.pas, and used for custom late-binding
  TVarDataStaticArray = array[0..MaxInt div SizeOf(TVarData)-1] of TVarData;
  PVarDataStaticArray = ^TVarDataStaticArray;
  TVariantArray = array[0..MaxInt div SizeOf(Variant)-1] of Variant;
  PVariantArray = ^TVariantArray;
  TVariantDynArray = array of variant;
  PPVariant = ^PVariant;
  {$endif}

  PIntegerDynArray = ^TIntegerDynArray;
  TIntegerDynArray = array of integer;
  TIntegerDynArrayDynArray = array of TIntegerDynArray;
  PCardinalDynArray = ^TCardinalDynArray;
  TCardinalDynArray = array of cardinal;
  PSingleDynArray = ^TSingleDynArray;
  TSingleDynArray = array of Single;
  PInt64DynArray = ^TInt64DynArray;
  TInt64DynArray = array of Int64;
  PQwordDynArray = ^TQwordDynArray;
  TQwordDynArray = array of Qword;
  TPtrUIntDynArray = array of PtrUInt;
  PDoubleDynArray = ^TDoubleDynArray;
  TDoubleDynArray = array of double;
  PCurrencyDynArray = ^TCurrencyDynArray;
  TCurrencyDynArray = array of Currency;
  TWordDynArray = array of word;
  PWordDynArray = ^TWordDynArray;
  TByteDynArray = array of byte;
  PByteDynArray = ^TByteDynArray;
  {$ifndef ISDELPHI2007ANDUP}
  TBytes = array of byte;
  {$endif}
  TObjectDynArray = array of TObject;
  PObjectDynArray = ^TObjectDynArray;
  TPersistentDynArray = array of TPersistent;
  PPersistentDynArray = ^TPersistentDynArray;
  TPointerDynArray = array of pointer;
  PPointerDynArray = ^TPointerDynArray;
  TPPointerDynArray = array of PPointer;
  PPPointerDynArray = ^TPPointerDynArray;
  TMethodDynArray = array of TMethod;
  PMethodDynArray = ^TMethodDynArray;
  TObjectListDynArray = array of TObjectList;
  PObjectListDynArray = ^TObjectListDynArray;
  TFileNameDynArray = array of TFileName;
  PFileNameDynArray = ^TFileNameDynArray;
  TBooleanDynArray = array of boolean;
  PBooleanDynArray = ^TBooleanDynArray;
  TClassDynArray = array of TClass;
  TWinAnsiDynArray = array of WinAnsiString;
  PWinAnsiDynArray = ^TWinAnsiDynArray;
  TRawByteStringDynArray = array of RawByteString;
  TStringDynArray = array of string;
  PStringDynArray = ^TStringDynArray;
  PShortStringDynArray = array of PShortString;
  PPShortStringArray = ^PShortStringArray;
  TShortStringDynArray = array of ShortString;
  TDateTimeDynArray = array of TDateTime;
  PDateTimeDynArray = ^TDateTimeDynArray;
  {$ifndef FPC_OR_UNICODE}
  TDate = type TDateTime;
  TTime = type TDateTime;
  {$endif FPC_OR_UNICODE}
  TDateDynArray = array of TDate;
  PDateDynArray = ^TDateDynArray;
  TTimeDynArray = array of TTime;
  PTimeDynArray = ^TTimeDynArray;
  TWideStringDynArray = array of WideString;
  PWideStringDynArray = ^TWideStringDynArray;
  TSynUnicodeDynArray = array of SynUnicode;
  PSynUnicodeDynArray = ^TSynUnicodeDynArray;
  TGUIDDynArray = array of TGUID;

  PObject = ^TObject;
  PClass = ^TClass;
  PByteArray = ^TByteArray;
  TByteArray = array[0..MaxInt-1] of Byte; // redefine here with {$R-}
  PBooleanArray = ^TBooleanArray;
  TBooleanArray = array[0..MaxInt-1] of Boolean;
  TWordArray  = array[0..MaxInt div SizeOf(word)-1] of word;
  PWordArray = ^TWordArray;
  TIntegerArray = array[0..MaxInt div SizeOf(integer)-1] of integer;
  PIntegerArray = ^TIntegerArray;
  PIntegerArrayDynArray = array of PIntegerArray;
  TPIntegerArray = array[0..MaxInt div SizeOf(PIntegerArray)-1] of PInteger;
  PPIntegerArray = ^TPIntegerArray;
  TCardinalArray = array[0..MaxInt div SizeOf(cardinal)-1] of cardinal;
  PCardinalArray = ^TCardinalArray;
  TInt64Array = array[0..MaxInt div SizeOf(Int64)-1] of Int64;
  PInt64Array = ^TInt64Array;
  TQWordArray = array[0..MaxInt div SizeOf(QWord)-1] of QWord;
  PQWordArray = ^TQWordArray;
  TPtrUIntArray = array[0..MaxInt div SizeOf(PtrUInt)-1] of PtrUInt;
  PPtrUIntArray = ^TPtrUIntArray;
  TSmallIntArray = array[0..MaxInt div SizeOf(SmallInt)-1] of SmallInt;
  PSmallIntArray = ^TSmallIntArray;
  TSingleArray = array[0..MaxInt div SizeOf(Single)-1] of Single;
  PSingleArray = ^TSingleArray;
  TDoubleArray = array[0..MaxInt div SizeOf(Double)-1] of Double;
  PDoubleArray = ^TDoubleArray;
  TDateTimeArray = array[0..MaxInt div SizeOf(TDateTime)-1] of TDateTime;
  PDateTimeArray = ^TDateTimeArray;
  TPAnsiCharArray = array[0..MaxInt div SizeOf(PAnsiChar)-1] of PAnsiChar;
  PPAnsiCharArray = ^TPAnsiCharArray;
  TRawUTF8Array = array[0..MaxInt div SizeOf(RawUTF8)-1] of RawUTF8;
  PRawUTF8Array = ^TRawUTF8Array;
  TRawByteStringArray = array[0..MaxInt div SizeOf(RawByteString)-1] of RawByteString;
  PRawByteStringArray = ^TRawByteStringArray;
  PShortStringArray = array[0..MaxInt div SizeOf(pointer)-1] of PShortString;
  PointerArray = array [0..MaxInt div SizeOf(Pointer)-1] of Pointer;
  PPointerArray = ^PointerArray;
  TObjectArray = array [0..MaxInt div SizeOf(TObject)-1] of TObject;
  PObjectArray = ^TObjectArray;
  TPtrIntArray = array[0..MaxInt div SizeOf(PtrInt)-1] of PtrInt;
  PPtrIntArray = ^TPtrIntArray;
  PInt64Rec = ^Int64Rec;
  PPShortString = ^PShortString;

  {$ifndef DELPHI5OROLDER}
  PIInterface = ^IInterface;
  TInterfaceDynArray = array of IInterface;
  PInterfaceDynArray = ^TInterfaceDynArray;
  {$endif}

  {$ifndef LVCL}
  TCollectionClass = class of TCollection;
  TCollectionItemClass = class of TCollectionItem;
  {$endif}

  /// class-reference type (metaclass) of a TStream
  TStreamClass = class of TStream;

  /// class-reference type (metaclass) of a TInterfacedObject
  TInterfacedObjectClass = class of TInterfacedObject;


{ ************ fast UTF-8 / Unicode / Ansi types and conversion routines **** }

// some constants used for UTF-8 conversion, including surrogates
const
  UTF16_HISURROGATE_MIN = $d800;
  UTF16_HISURROGATE_MAX = $dbff;
  UTF16_LOSURROGATE_MIN = $dc00;
  UTF16_LOSURROGATE_MAX = $dfff;
  UTF8_EXTRABYTES: array[$80..$ff] of byte = (
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,0,0);
  UTF8_EXTRA: array[0..6] of record
    offset, minimum: cardinal;
  end = ( // http://floodyberry.wordpress.com/2007/04/14/utf-8-conversion-tricks
    (offset: $00000000;  minimum: $00010000),
    (offset: $00003080;  minimum: $00000080),
    (offset: $000e2080;  minimum: $00000800),
    (offset: $03c82080;  minimum: $00010000),
    (offset: $fa082080;  minimum: $00200000),
    (offset: $82082080;  minimum: $04000000),
    (offset: $00000000;  minimum: $04000000));
  UTF8_EXTRA_SURROGATE = 3;
  UTF8_FIRSTBYTE: array[2..6] of byte = ($c0,$e0,$f0,$f8,$fc);

type
  /// kind of adding in a TTextWriter
  TTextWriterKind = (twNone, twJSONEscape, twOnSameLine);

  /// an abstract class to handle Ansi to/from Unicode translation
  // - implementations of this class will handle efficiently all Code Pages
  // - this default implementation will use the Operating System APIs
  // - you should not create your own class instance by yourself, but should
  // better retrieve an instance using TSynAnsiConvert.Engine(), which will
  // initialize either a TSynAnsiFixedWidth or a TSynAnsiConvert instance on need
  TSynAnsiConvert = class
  protected
    fCodePage: cardinal;
    fAnsiCharShift: byte;
    {$ifdef KYLIX3}
    fIConvCodeName: RawUTF8;
    {$endif}
    procedure InternalAppendUTF8(Source: PAnsiChar; SourceChars: Cardinal;
      DestTextWriter: TObject; Escape: TTextWriterKind); virtual;
  public
    /// initialize the internal conversion engine
    constructor Create(aCodePage: cardinal); reintroduce; virtual;
    /// returns the engine corresponding to a given code page
    // - a global list of TSynAnsiConvert instances is handled by the unit -
    // therefore, caller should not release the returned instance
    // - will return nil in case of unhandled code page
    // - is aCodePage is 0, will return CurrentAnsiConvert value
    class function Engine(aCodePage: cardinal): TSynAnsiConvert;
    /// direct conversion of a PAnsiChar buffer into an Unicode buffer
    // - Dest^ buffer must be reserved with at least SourceChars*2 bytes
    // - this default implementation will use the Operating System APIs
    // - will append a trailing #0 to the returned PWideChar, unless
    // NoTrailingZero is set
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PWideChar; overload; virtual;
    /// direct conversion of a PAnsiChar buffer into a UTF-8 encoded buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - will append a trailing #0 to the returned PUTF8Char, unless
    // NoTrailingZero is set
    // - this default implementation will use the Operating System APIs
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PUTF8Char; overload; virtual;
    /// convert any Ansi Text into an UTF-16 Unicode String
    // - returns a value using our RawUnicode kind of string
    function AnsiToRawUnicode(const AnsiText: RawByteString): RawUnicode; overload;
    /// convert any Ansi buffer into an Unicode String
    // - returns a value using our RawUnicode kind of string
    function AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode; overload; virtual;
    /// convert any Ansi buffer into an Unicode String
    // - returns a SynUnicode, i.e. Delphi 2009+ UnicodeString or a WideString
    function AnsiToUnicodeString(Source: PAnsiChar; SourceChars: Cardinal): SynUnicode; overload;
    /// convert any Ansi buffer into an Unicode String
    // - returns a SynUnicode, i.e. Delphi 2009+ UnicodeString or a WideString
    function AnsiToUnicodeString(const Source: RawByteString): SynUnicode; overload;
    /// convert any Ansi Text into an UTF-8 encoded String
    // - internaly calls AnsiBufferToUTF8 virtual method
    function AnsiToUTF8(const AnsiText: RawByteString): RawUTF8; virtual;
    /// direct conversion of a PAnsiChar buffer into a UTF-8 encoded string
    // - will call AnsiBufferToUnicode() overloaded virtual method
    function AnsiBufferToRawUTF8(Source: PAnsiChar; SourceChars: Cardinal): RawUTF8; overload; virtual;
    /// direct conversion of an Unicode buffer into a PAnsiChar buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - this default implementation will rely on the Operating System for
    // all non ASCII-7 chars
    function UnicodeBufferToAnsi(Dest: PAnsiChar; Source: PWideChar; SourceChars: Cardinal): PAnsiChar; overload; virtual;
    /// direct conversion of an Unicode buffer into an Ansi Text
    function UnicodeBufferToAnsi(Source: PWideChar; SourceChars: Cardinal): RawByteString; overload; virtual;
    /// convert any Unicode-encoded String into Ansi Text
    // - internaly calls UnicodeBufferToAnsi virtual method
    function RawUnicodeToAnsi(const Source: RawUnicode): RawByteString;
    /// direct conversion of an UTF-8 encoded buffer into a PAnsiChar buffer
    // - Dest^ buffer must be reserved with at least SourceChars bytes
    // - no trailing #0 is appended to the buffer
    function UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
      SourceChars: Cardinal): PAnsiChar; overload; virtual;
    /// convert any UTF-8 encoded buffer into Ansi Text
    // - internaly calls UTF8BufferToAnsi virtual method
    function UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal): RawByteString; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// convert any UTF-8 encoded buffer into Ansi Text
    // - internaly calls UTF8BufferToAnsi virtual method
    procedure UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal;
      var result: RawByteString); overload; virtual;
    /// convert any UTF-8 encoded String into Ansi Text
    // - internaly calls UTF8BufferToAnsi virtual method
    function UTF8ToAnsi(const UTF8: RawUTF8): RawByteString; virtual;
    /// direct conversion of a UTF-8 encoded string into a WinAnsi buffer
    // - will truncate the destination string to DestSize bytes (including the
    // trailing #0), with a maximum handled size of 2048 bytes
    // - returns the number of bytes stored in Dest^ (i.e. the position of #0)
    function Utf8ToAnsiBuffer(const S: RawUTF8; Dest: PAnsiChar; DestSize: integer): integer;
    /// convert any Ansi Text (providing a From converted) into Ansi Text
    function AnsiToAnsi(From: TSynAnsiConvert; const Source: RawByteString): RawByteString; overload;
    /// convert any Ansi buffer (providing a From converted) into Ansi Text
    function AnsiToAnsi(From: TSynAnsiConvert; Source: PAnsiChar; SourceChars: cardinal): RawByteString; overload;
    /// corresponding code page
    property CodePage: Cardinal read fCodePage;
  end;

  /// a class to handle Ansi to/from Unicode translation of fixed width encoding
  // (i.e. non MBCS)
  // - this class will handle efficiently all Code Page availables without MBCS
  // encoding - like WinAnsi (1252) or Russian (1251)
  // - it will use internal fast look-up tables for such encodings
  // - this class could take some time to generate, and will consume more than
  // 64 KB of memory: you should not create your own class instance by yourself,
  // but should better retrieve an instance using TSynAnsiConvert.Engine(), which
  // will initialize either a TSynAnsiFixedWidth or a TSynAnsiConvert instance
  // on need
  // - this class has some additional methods (e.g. IsValid*) which take
  // advantage of the internal lookup tables to provide some fast process
  TSynAnsiFixedWidth = class(TSynAnsiConvert)
  protected
    fAnsiToWide: TWordDynArray;
    fWideToAnsi: TByteDynArray;
    procedure InternalAppendUTF8(Source: PAnsiChar; SourceChars: Cardinal;
      DestTextWriter: TObject; Escape: TTextWriterKind); override;
  public
    /// initialize the internal conversion engine
    constructor Create(aCodePage: cardinal); override;
    /// direct conversion of a PAnsiChar buffer into an Unicode buffer
    // - Dest^ buffer must be reserved with at least SourceChars*2 bytes
    // - will append a trailing #0 to the returned PWideChar, unless
    // NoTrailingZero is set
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PWideChar; override;
    /// direct conversion of a PAnsiChar buffer into a UTF-8 encoded buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - will append a trailing #0 to the returned PUTF8Char, unless
    // NoTrailingZero is set
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PUTF8Char; override;
    /// convert any Ansi buffer into an Unicode String
    // - returns a value using our RawUnicode kind of string
    function AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode; override;
    /// direct conversion of an Unicode buffer into a PAnsiChar buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - this overridden version will use internal lookup tables for fast process
    function UnicodeBufferToAnsi(Dest: PAnsiChar; Source: PWideChar; SourceChars: Cardinal): PAnsiChar; override;
    /// direct conversion of an UTF-8 encoded buffer into a PAnsiChar buffer
    // - Dest^ buffer must be reserved with at least SourceChars bytes
    // - no trailing #0 is appended to the buffer
    function UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
      SourceChars: Cardinal): PAnsiChar; override;
    /// conversion of a wide char into the corresponding Ansi character
    // - return -1 for an unknown WideChar in the current code page
    function WideCharToAnsiChar(wc: cardinal): integer;
    /// return TRUE if the supplied unicode buffer only contains characters of
    // the corresponding Ansi code page
    // - i.e. if the text can be displayed using this code page
    function IsValidAnsi(WideText: PWideChar; Length: PtrInt): boolean; overload;
    /// return TRUE if the supplied unicode buffer only contains characters of
    // the corresponding Ansi code page
    // - i.e. if the text can be displayed using this code page
    function IsValidAnsi(WideText: PWideChar): boolean; overload;
    /// return TRUE if the supplied UTF-8 buffer only contains characters of
    // the corresponding Ansi code page
    // - i.e. if the text can be displayed using this code page
    function IsValidAnsiU(UTF8Text: PUTF8Char): boolean;
    /// return TRUE if the supplied UTF-8 buffer only contains 8 bits characters
    // of the corresponding Ansi code page
    // - i.e. if the text can be displayed with only 8 bit unicode characters
    // (e.g. no "tm" or such) within this code page
    function IsValidAnsiU8Bit(UTF8Text: PUTF8Char): boolean;
    /// direct access to the Ansi-To-Unicode lookup table
    // - use this array like AnsiToWide: array[byte] of word
    property AnsiToWide: TWordDynArray read fAnsiToWide;
    /// direct access to the Unicode-To-Ansi lookup table
    // - use this array like WideToAnsi: array[word] of byte
    // - any unhandled WideChar will return ord('?')
    property WideToAnsi: TByteDynArray read fWideToAnsi;
  end;

  /// a class to handle UTF-8 to/from Unicode translation
  // - match the TSynAnsiConvert signature, for code page CP_UTF8
  // - this class is mostly a non-operation for conversion to/from UTF-8
  TSynAnsiUTF8 = class(TSynAnsiConvert)
  private
    function UnicodeBufferToUTF8(Dest: PAnsiChar; DestChars: Cardinal;
      Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
  protected
    procedure InternalAppendUTF8(Source: PAnsiChar; SourceChars: Cardinal;
      DestTextWriter: TObject; Escape: TTextWriterKind); override;
  public
    /// initialize the internal conversion engine
    constructor Create(aCodePage: cardinal); override;
    /// direct conversion of a PAnsiChar UTF-8 buffer into an Unicode buffer
    // - Dest^ buffer must be reserved with at least SourceChars*2 bytes
    // - will append a trailing #0 to the returned PWideChar, unless
    // NoTrailingZero is set
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PWideChar; override;
    /// direct conversion of a PAnsiChar UTF-8 buffer into a UTF-8 encoded buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - will append a trailing #0 to the returned PUTF8Char, unless
    // NoTrailingZero is set
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PUTF8Char; override;
    /// convert any UTF-8 Ansi buffer into an Unicode String
    // - returns a value using our RawUnicode kind of string
    function AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode; override;
    /// direct conversion of an Unicode buffer into a PAnsiChar UTF-8 buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    function UnicodeBufferToAnsi(Dest: PAnsiChar; Source: PWideChar; SourceChars: Cardinal): PAnsiChar; override;
    /// direct conversion of an Unicode buffer into an Ansi Text
    function UnicodeBufferToAnsi(Source: PWideChar; SourceChars: Cardinal): RawByteString; override;
    /// direct conversion of an UTF-8 encoded buffer into a PAnsiChar UTF-8 buffer
    // - Dest^ buffer must be reserved with at least SourceChars bytes
    // - no trailing #0 is appended to the buffer
    function UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
      SourceChars: Cardinal): PAnsiChar; override;
    /// convert any UTF-8 encoded buffer into Ansi Text
    procedure UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal;
      var result: RawByteString); override;
    /// convert any UTF-8 encoded String into Ansi Text
    // - directly assign the input as result, since no conversion is needed
    function UTF8ToAnsi(const UTF8: RawUTF8): RawByteString; override;
    /// convert any Ansi Text into an UTF-8 encoded String
    // - directly assign the input as result, since no conversion is needed
    function AnsiToUTF8(const AnsiText: RawByteString): RawUTF8; override;
    /// direct conversion of a PAnsiChar buffer into a UTF-8 encoded string
    function AnsiBufferToRawUTF8(Source: PAnsiChar; SourceChars: Cardinal): RawUTF8; override;
  end;

  /// a class to handle UTF-16 to/from Unicode translation
  // - match the TSynAnsiConvert signature, for code page CP_UTF16
  // - even if UTF-16 is not an Ansi format, code page CP_UTF16 may have been
  // used to store UTF-16 encoded binary content
  // - this class is mostly a non-operation for conversion to/from Unicode
  TSynAnsiUTF16 = class(TSynAnsiConvert)
  public
    /// initialize the internal conversion engine
    constructor Create(aCodePage: cardinal); override;
    /// direct conversion of a PAnsiChar UTF-16 buffer into an Unicode buffer
    // - Dest^ buffer must be reserved with at least SourceChars*2 bytes
    // - will append a trailing #0 to the returned PWideChar, unless
    // NoTrailingZero is set
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PWideChar; override;
    /// direct conversion of a PAnsiChar UTF-16 buffer into a UTF-8 encoded buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - will append a trailing #0 to the returned PUTF8Char, unless
    // NoTrailingZero is set
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PUTF8Char; override;
    /// convert any UTF-16 Ansi buffer into an Unicode String
    // - returns a value using our RawUnicode kind of string
    function AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode; override;
    /// direct conversion of an Unicode buffer into a PAnsiChar UTF-16 buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    function UnicodeBufferToAnsi(Dest: PAnsiChar; Source: PWideChar; SourceChars: Cardinal): PAnsiChar; override;
    /// direct conversion of an UTF-8 encoded buffer into a PAnsiChar UTF-16 buffer
    // - Dest^ buffer must be reserved with at least SourceChars bytes
    // - no trailing #0 is appended to the buffer
    function UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
      SourceChars: Cardinal): PAnsiChar; override;
  end;


  /// implements a stack-based storage of some (UTF-8 or binary) text
  // - avoid temporary memory allocation via the heap for up to 4KB of data
  // - could be used e.g. to make a temporary copy when JSON is parsed in-place
  // - call one of the Init() overloaded methods, then Done to release its memory
  // - all Init() methods will allocate 16 more bytes, for a trailing #0 and
  // to ensure our fast JSON parsing won't trigger any GPF (since it may read
  // up to 4 bytes ahead via its PInteger() trick) or any SSE4.2 function
  {$ifdef USERECORDWITHMETHODS}TSynTempBuffer = record
    {$else}TSynTempBuffer = object{$endif}
  public
    /// the text/binary length, in bytes, excluding the trailing #0
    len: PtrInt;
    /// where the text/binary is available (and any Source has been copied)
    // - equals nil if len=0
    buf: pointer;
    /// initialize a temporary copy of the content supplied as RawByteString
    // - will also allocate and copy the ending #0 (even for binary)
    procedure Init(const Source: RawByteString); overload;
    /// initialize a temporary copy of the supplied text buffer, ending with #0
    function Init(Source: PUTF8Char): PUTF8Char; overload;
    /// initialize a temporary copy of the supplied text buffer
    procedure Init(Source: pointer; SourceLen: PtrInt); overload;
    /// initialize a new temporary buffer of a given number of bytes
    function Init(SourceLen: PtrInt): pointer; overload;
    /// initialize a temporary buffer with the length of the internal stack
    function InitOnStack: pointer;
    /// initialize the buffer returning the internal buffer size (4095 bytes)
    // - could be used e.g. for an API call, first trying with plain temp.Init
    // and using temp.buf and temp.len safely in the call, only calling
    // temp.Init(expectedsize) if the API returned an error about an insufficient
    // buffer space
    function Init: integer; overload; {$ifdef HASINLINE}inline;{$endif}
    /// initialize a new temporary buffer of a given number of random bytes
    // - will fill the buffer via FillRandom() calls
    // - forcegsl is true by default, since Lecuyer's generator has no HW bug
    function InitRandom(RandomLen: integer; forcegsl: boolean=true): pointer;
    /// initialize a new temporary buffer filled with 32-bit integer increasing values
    function InitIncreasing(Count: PtrInt; Start: PtrInt=0): PIntegerArray;
    /// initialize a new temporary buffer of a given number of zero bytes
    function InitZero(ZeroLen: PtrInt): pointer;
    /// finalize the temporary storage
    procedure Done; overload; {$ifdef HASINLINE}inline;{$endif}
    /// finalize the temporary storage, and create a RawUTF8 string from it
    procedure Done(EndBuf: pointer; var Dest: RawUTF8); overload;
  private
    // default 4KB buffer allocated on stack - after the len/buf main fields
    tmp: array[0..4095] of AnsiChar;
  end;

  /// function prototype to be used for hashing of an element
  // - it must return a cardinal hash, with as less collision as possible
  // - TDynArrayHashed.Init will use crc32c() if no custom function is supplied,
  // which will run either as software or SSE4.2 hardware, with good colision
  // for most used kind of data
  THasher = function(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;

var
  /// global TSynAnsiConvert instance to handle WinAnsi encoding (code page 1252)
  // - this instance is global and instantied during the whole program life time
  // - it will be created from hard-coded values, and not using the system API,
  // since it appeared that some systems (e.g. in Russia) did tweak the registry
  // so that 1252 code page maps 1251 code page
  WinAnsiConvert: TSynAnsiFixedWidth;

  /// global TSynAnsiConvert instance to handle current system encoding
  // - this is the encoding as used by the AnsiString Delphi, so will be used
  // before Delphi 2009 to speed-up VCL string handling (especially for UTF-8)
  // - this instance is global and instantied during the whole program life time
  CurrentAnsiConvert: TSynAnsiConvert;

  /// global TSynAnsiConvert instance to handle UTF-8 encoding (code page CP_UTF8)
  // - this instance is global and instantied during the whole program life time
  UTF8AnsiConvert: TSynAnsiUTF8;

/// check if a codepage should be handled by a TSynAnsiFixedWidth page
function IsFixedWidthCodePage(aCodePage: cardinal): boolean;
  {$ifdef HASINLINE}inline;{$endif}

const
  /// HTTP header name for the content type, as defined in the corresponding RFC
  HEADER_CONTENT_TYPE = 'Content-Type: ';

  /// HTTP header name for the content type, in upper case
  // - as defined in the corresponding RFC
  // - could be used e.g. with IdemPChar() to retrieve the Content-Type value
  HEADER_CONTENT_TYPE_UPPER = 'CONTENT-TYPE: ';

  /// HTTP header name for the client IP, in upper case
  // - as defined in our HTTP server classes
  // - could be used e.g. with IdemPChar() to retrieve the remote IP address
  HEADER_REMOTEIP_UPPER = 'REMOTEIP: ';

  /// HTTP header name for the authorization token, in upper case
  // - could be used e.g. with IdemPChar() to retrieve a JWT value
  // - will detect header computed e.g. by SynCrtSock.AuthorizationBearer()
  HEADER_BEARER_UPPER = 'AUTHORIZATION: BEARER ';

  /// MIME content type used for JSON communication (as used by the Microsoft
  // WCF framework and the YUI framework)
  JSON_CONTENT_TYPE = 'application/json; charset=UTF-8';

  /// HTTP header for MIME content type used for plain JSON
  JSON_CONTENT_TYPE_HEADER = HEADER_CONTENT_TYPE+JSON_CONTENT_TYPE;

  /// MIME content type used for plain JSON, in upper case
  // - could be used e.g. with IdemPChar() to retrieve the Content-Type value
  JSON_CONTENT_TYPE_UPPER = 'APPLICATION/JSON';

  /// HTTP header for MIME content type used for plain JSON, in upper case
  // - could be used e.g. with IdemPChar() to retrieve the Content-Type value
  JSON_CONTENT_TYPE_HEADER_UPPER = HEADER_CONTENT_TYPE_UPPER+JSON_CONTENT_TYPE_UPPER;

  /// MIME content type used for plain UTF-8 text
  TEXT_CONTENT_TYPE = 'text/plain; charset=UTF-8';

  /// HTTP header for MIME content type used for plain UTF-8 text
  TEXT_CONTENT_TYPE_HEADER = HEADER_CONTENT_TYPE+TEXT_CONTENT_TYPE;

  /// MIME content type used for UTF-8 encoded HTML
  HTML_CONTENT_TYPE = 'text/html; charset=UTF-8';

  /// HTTP header for MIME content type used for UTF-8 encoded HTML
  HTML_CONTENT_TYPE_HEADER = HEADER_CONTENT_TYPE+HTML_CONTENT_TYPE;

  /// MIME content type used for UTF-8 encoded XML
  XML_CONTENT_TYPE = 'text/xml; charset=UTF-8';

  /// HTTP header for MIME content type used for UTF-8 encoded XML
  XML_CONTENT_TYPE_HEADER = HEADER_CONTENT_TYPE+XML_CONTENT_TYPE;

  /// MIME content type used for raw binary data
  BINARY_CONTENT_TYPE = 'application/octet-stream';

  /// MIME content type used for raw binary data, in upper case
  BINARY_CONTENT_TYPE_UPPER = 'APPLICATION/OCTET-STREAM';

  /// HTTP header for MIME content type used for raw binary data
  BINARY_CONTENT_TYPE_HEADER = HEADER_CONTENT_TYPE+BINARY_CONTENT_TYPE;

  /// MIME content type used for a JPEG picture
  JPEG_CONTENT_TYPE = 'image/jpeg';

var
  /// MIME content type used for JSON communication
  // - i.e. 'application/json; charset=UTF-8'
  // - this global will be initialized with JSON_CONTENT_TYPE constant, to
  // avoid a memory allocation each time it is assigned to a variable
  JSON_CONTENT_TYPE_VAR: RawUTF8;

  /// HTTP header for MIME content type used for plain JSON
  // - this global will be initialized with JSON_CONTENT_TYPE_HEADER constant,
  // to avoid a memory allocation each time it is assigned to a variable
  JSON_CONTENT_TYPE_HEADER_VAR: RawUTF8;

  /// can be used to avoid a memory allocation for res := 'null'
  NULL_STR_VAR: RawUTF8;

/// compute the new capacity when expanding an array of items
// - handle tiny, small, medium, large and huge sizes properly to reduce
// memory usage and maximize performance
function NextGrow(capacity: integer): integer;

/// equivalence to SetString(s,nil,len) function
// - faster especially under FPC
procedure FastSetString(var s: RawUTF8; p: pointer; len: PtrInt);
  {$ifndef HASCODEPAGE}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// equivalence to SetString(s,nil,len) function with a specific code page
// - faster especially under FPC
procedure FastSetStringCP(var s; p: pointer; len, codepage: PtrInt);
  {$ifndef HASCODEPAGE}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// initialize a RawByteString, ensuring returned "aligned" pointer is 16-bytes aligned
// - to be used e.g. for proper SSE process
procedure GetMemAligned(var s: RawByteString; p: pointer; len: PtrInt;
  out aligned: pointer);

/// equivalence to @UTF8[1] expression to ensure a RawUTF8 variable is unique
// - will ensure that the string refcount is 1, and return a pointer to the text
// - under FPC, @UTF8[1] does not call UniqueString() as it does with Delphi
// - if UTF8 is a constant (refcount=-1), will create a temporary copy in heap
function UniqueRawUTF8(var UTF8: RawUTF8): pointer;
  {$ifdef HASINLINE}inline;{$endif}

/// will fast replace all #0 chars as ~
// - could be used after UniqueRawUTF8() on a in-placed modified JSON buffer,
// in which all values have been ended with #0
// - you can optionally specify a maximum size, in bytes (this won't reallocate
// the string, but just add a #0 at some point in the UTF8 buffer)
// - could allow logging of parsed input e.g. after an exception
procedure UniqueRawUTF8ZeroToTilde(var UTF8: RawUTF8; MaxSize: integer=maxInt);

/// conversion of a wide char into a WinAnsi (CodePage 1252) char
// - return '?' for an unknown WideChar in code page 1252
function WideCharToWinAnsiChar(wc: cardinal): AnsiChar;
  {$ifdef HASINLINE}inline;{$endif}

/// conversion of a wide char into a WinAnsi (CodePage 1252) char index
// - return -1 for an unknown WideChar in code page 1252
function WideCharToWinAnsi(wc: cardinal): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// return TRUE if the supplied buffer only contains 7-bits Ansi characters
function IsAnsiCompatible(PC: PAnsiChar): boolean; overload;

/// return TRUE if the supplied UTF-16 buffer only contains 7-bits Ansi characters
function IsAnsiCompatibleW(PW: PWideChar): boolean; overload;

/// return TRUE if the supplied buffer only contains 7-bits Ansi characters
function IsAnsiCompatible(PC: PAnsiChar; Len: PtrUInt): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return TRUE if the supplied text only contains 7-bits Ansi characters
function IsAnsiCompatible(const Text: RawByteString): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return TRUE if the supplied UTF-16 buffer only contains 7-bits Ansi characters
function IsAnsiCompatibleW(PW: PWideChar; Len: PtrInt): boolean; overload;

/// return TRUE if the supplied unicode buffer only contains WinAnsi characters
// - i.e. if the text can be displayed using ANSI_CHARSET
function IsWinAnsi(WideText: PWideChar): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return TRUE if the supplied unicode buffer only contains WinAnsi characters
// - i.e. if the text can be displayed using ANSI_CHARSET
function IsWinAnsi(WideText: PWideChar; Length: integer): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return TRUE if the supplied UTF-8 buffer only contains WinAnsi characters
// - i.e. if the text can be displayed using ANSI_CHARSET
function IsWinAnsiU(UTF8Text: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// return TRUE if the supplied UTF-8 buffer only contains WinAnsi 8 bit characters
// - i.e. if the text can be displayed using ANSI_CHARSET with only 8 bit unicode
// characters (e.g. no "tm" or such)
function IsWinAnsiU8Bit(UTF8Text: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// UTF-8 encode one UTF-16 character into Dest
// - return the number of bytes written into Dest (i.e. 1,2 or 3)
// - this method does NOT handle UTF-16 surrogate pairs
function WideCharToUtf8(Dest: PUTF8Char; aWideChar: PtrUInt): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// UTF-8 encode one UTF-16 encoded UCS4 character into Dest
// - return the number of bytes written into Dest (i.e. from 1 up to 6)
// - Source will contain the next UTF-16 character
// - this method DOES handle UTF-16 surrogate pairs
function UTF16CharToUtf8(Dest: PUTF8Char; var Source: PWord): integer;

/// UTF-8 encode one UCS4 character into Dest
// - return the number of bytes written into Dest (i.e. from 1 up to 6)
// - this method DOES handle UTF-16 surrogate pairs
function UCS4ToUTF8(ucs4: cardinal; Dest: PUTF8Char): integer;

/// direct conversion of an AnsiString with an unknown code page into an
// UTF-8 encoded String
// - will assume CurrentAnsiConvert.CodePage prior to Delphi 2009
// - newer UNICODE versions of Delphi will retrieve the code page from string
procedure AnyAnsiToUTF8(const s: RawByteString; var result: RawUTF8); overload;

/// direct conversion of an AnsiString with an unknown code page into an
// UTF-8 encoded String
// - will assume CurrentAnsiConvert.CodePage prior to Delphi 2009
// - newer UNICODE versions of Delphi will retrieve the code page from string
function AnyAnsiToUTF8(const s: RawByteString): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a WinAnsi (CodePage 1252) string into a UTF-8 encoded String
// - faster than SysUtils: don't use Utf8Encode(WideString) -> no Windows.Global(),
// and use a fixed pre-calculated array for individual chars conversion
function WinAnsiToUtf8(const S: WinAnsiString): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a WinAnsi (CodePage 1252) string into a UTF-8 encoded String
// - faster than SysUtils: don't use Utf8Encode(WideString) -> no Windows.Global(),
// and use a fixed pre-calculated array for individual chars conversion
function WinAnsiToUtf8(WinAnsi: PAnsiChar; WinAnsiLen: PtrInt): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a WinAnsi PAnsiChar buffer into a UTF-8 encoded buffer
// - Dest^ buffer must be reserved with at least SourceChars*3
// - call internally WinAnsiConvert fast conversion class
function WinAnsiBufferToUtf8(Dest: PUTF8Char; Source: PAnsiChar; SourceChars: Cardinal): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a WinAnsi shortstring into a UTF-8 text
// - call internally WinAnsiConvert fast conversion class
function ShortStringToUTF8(const source: ShortString): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a WinAnsi (CodePage 1252) string into a Unicode encoded String
// - very fast, by using a fixed pre-calculated array for individual chars conversion
function WinAnsiToRawUnicode(const S: WinAnsiString): RawUnicode;

/// direct conversion of a WinAnsi (CodePage 1252) string into a Unicode buffer
// - very fast, by using a fixed pre-calculated array for individual chars conversion
// - text will be truncated if necessary to avoid buffer overflow in Dest[]
procedure WinAnsiToUnicodeBuffer(const S: WinAnsiString; Dest: PWordArray; DestLen: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a UTF-8 encoded string into a WinAnsi String
function Utf8ToWinAnsi(const S: RawUTF8): WinAnsiString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a UTF-8 encoded zero terminated buffer into a WinAnsi String
function Utf8ToWinAnsi(P: PUTF8Char): WinAnsiString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a UTF-8 encoded zero terminated buffer into a RawUTF8 String
procedure Utf8ToRawUTF8(P: PUTF8Char; var result: RawUTF8);
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a UTF-8 encoded buffer into a WinAnsi PAnsiChar buffer
function UTF8ToWinPChar(dest: PAnsiChar; source: PUTF8Char; count: integer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a UTF-8 encoded buffer into a WinAnsi shortstring buffer
procedure UTF8ToShortString(var dest: shortstring; source: PUTF8Char);

/// direct conversion of an ANSI-7 shortstring into an AnsiString
// - can be used e.g. for names retrieved from RTTI to convert them into RawUTF8
function ShortStringToAnsi7String(const source: shortstring): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of an ANSI-7 shortstring into an AnsiString
// - can be used e.g. for names retrieved from RTTI to convert them into RawUTF8
procedure ShortStringToAnsi7String(const source: shortstring; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an UTF-8 encoded text into a WideChar (UTF-16) buffer
// - faster than System.UTF8ToUnicode
// - sourceBytes can by 0, therefore length is computed from zero terminated source
// - enough place must be available in dest buffer (guess is sourceBytes*3+2)
// - a WideChar(#0) is added at the end (if something is written) unless
// NoTrailingZero is TRUE
// - returns the BYTE count written in dest, excluding the ending WideChar(#0)
function UTF8ToWideChar(dest: PWideChar; source: PUTF8Char; sourceBytes: PtrInt=0;
  NoTrailingZero: boolean=false): PtrInt; overload;

/// convert an UTF-8 encoded text into a WideChar (UTF-16) buffer
// - faster than System.UTF8ToUnicode
// - this overloaded function expect a MaxDestChars parameter
// - sourceBytes can not be 0 for this function
// - enough place must be available in dest buffer (guess is sourceBytes*3+2)
// - a WideChar(#0) is added at the end (if something is written) unless
// NoTrailingZero is TRUE
// - returns the BYTE COUNT (not WideChar count) written in dest, excluding the
// ending WideChar(#0)
function UTF8ToWideChar(dest: PWideChar; source: PUTF8Char;
  MaxDestChars, sourceBytes: PtrInt; NoTrailingZero: boolean=false): PtrInt; overload;

/// calculate the UTF-16 Unicode characters count, UTF-8 encoded in source^
// - count may not match the UCS4 glyphs number, in case of UTF-16 surrogates
// - faster than System.UTF8ToUnicode with dest=nil
function Utf8ToUnicodeLength(source: PUTF8Char): PtrUInt;

/// returns TRUE if the supplied buffer has valid UTF-8 encoding with no #1..#31
// control characters
// - supplied input is a pointer to a #0 ended text buffer
function IsValidUTF8WithoutControlChars(source: PUTF8Char): Boolean; overload;

/// returns TRUE if the supplied buffer has valid UTF-8 encoding with no #0..#31
// control characters
// - supplied input is a RawUTF8 variable
function IsValidUTF8WithoutControlChars(const source: RawUTF8): Boolean; overload;

/// will truncate the supplied UTF-8 value if its length exceeds the specified
// UTF-16 Unicode characters count
// - count may not match the UCS4 glyphs number, in case of UTF-16 surrogates
// - returns FALSE if text was not truncated, TRUE otherwise
function Utf8TruncateToUnicodeLength(var text: RawUTF8; maxUtf16: integer): boolean;

/// will truncate the supplied UTF-8 value if its length exceeds the specified
// bytes count
// - this function will ensure that the returned content will contain only valid
// UTF-8 sequence, i.e. will trim the whole trailing UTF-8 sequence
// - returns FALSE if text was not truncated, TRUE otherwise
function Utf8TruncateToLength(var text: RawUTF8; maxBytes: PtrUInt): boolean;

/// compute the truncated length of the supplied UTF-8 value if it exceeds the
// specified bytes count
// - this function will ensure that the returned content will contain only valid
// UTF-8 sequence, i.e. will trim the whole trailing UTF-8 sequence
// - returns maxUTF8 if text was not truncated, or the number of fitting bytes
function Utf8TruncatedLength(const text: RawUTF8; maxBytes: PtrUInt): PtrInt; overload;

/// compute the truncated length of the supplied UTF-8 value if it exceeds the
// specified bytes count
// - this function will ensure that the returned content will contain only valid
// UTF-8 sequence, i.e. will trim the whole trailing UTF-8 sequence
// - returns maxUTF8 if text was not truncated, or the number of fitting bytes
function Utf8TruncatedLength(text: PAnsiChar; textlen,maxBytes: PtrUInt): PtrInt; overload;

/// calculate the UTF-16 Unicode characters count of the UTF-8 encoded first line
// - count may not match the UCS4 glyphs number, in case of UTF-16 surrogates
// - end the parsing at first #13 or #10 character
function Utf8FirstLineToUnicodeLength(source: PUTF8Char): PtrInt;

/// convert a UTF-8 encoded buffer into a RawUnicode string
// - if L is 0, L is computed from zero terminated P buffer
// - RawUnicode is ended by a WideChar(#0)
// - faster than System.Utf8Decode() which uses slow widestrings
function Utf8DecodeToRawUnicode(P: PUTF8Char; L: integer): RawUnicode; overload;

/// convert a UTF-8 string into a RawUnicode string
function Utf8DecodeToRawUnicode(const S: RawUTF8): RawUnicode; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a UTF-8 string into a RawUnicode string
// - this version doesn't resize the length of the result RawUnicode
// and is therefore useful before a Win32 Unicode API call (with nCount=-1)
// - if DestLen is not nil, the resulting length (in bytes) will be stored within
function Utf8DecodeToRawUnicodeUI(const S: RawUTF8; DestLen: PInteger=nil): RawUnicode; overload;

/// convert a UTF-8 string into a RawUnicode string
// - returns the resulting length (in bytes) will be stored within Dest
function Utf8DecodeToRawUnicodeUI(const S: RawUTF8; var Dest: RawUnicode): integer; overload;

type
  /// option set for RawUnicodeToUtf8() conversion
  TCharConversionFlags = set of (
    ccfNoTrailingZero, ccfReplacementCharacterForUnmatchedSurrogate);

/// convert a RawUnicode PWideChar into a UTF-8 string
procedure RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer;
  var result: RawUTF8; Flags: TCharConversionFlags = [ccfNoTrailingZero]); overload;

/// convert a RawUnicode PWideChar into a UTF-8 string
function RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer;
  Flags: TCharConversionFlags = [ccfNoTrailingZero]): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a RawUnicode UTF-16 PWideChar into a UTF-8 buffer
// - replace system.UnicodeToUtf8 implementation, which is rather slow
// since Delphi 2009+
// - append a trailing #0 to the ending PUTF8Char, unless ccfNoTrailingZero is set
// - if ccfReplacementCharacterForUnmatchedSurrogate is set, this function will identify
// unmatched surrogate pairs and replace them with EF BF BD / FFFD  Unicode
// Replacement character - see https://en.wikipedia.org/wiki/Specials_(Unicode_block)
function RawUnicodeToUtf8(Dest: PUTF8Char; DestLen: PtrInt;
  Source: PWideChar; SourceLen: PtrInt; Flags: TCharConversionFlags): PtrInt; overload;

/// convert a RawUnicode PWideChar into a UTF-8 string
// - this version doesn't resize the resulting RawUTF8 string, but return
// the new resulting RawUTF8 byte count into UTF8Length
function RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer;
  out UTF8Length: integer): RawUTF8; overload;

/// convert a RawUnicode string into a UTF-8 string
function RawUnicodeToUtf8(const Unicode: RawUnicode): RawUTF8; overload;

/// convert a SynUnicode string into a UTF-8 string
function SynUnicodeToUtf8(const Unicode: SynUnicode): RawUTF8;

/// convert a WideString into a UTF-8 string
function WideStringToUTF8(const aText: WideString): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a Unicode encoded buffer into a WinAnsi PAnsiChar buffer
procedure RawUnicodeToWinPChar(dest: PAnsiChar; source: PWideChar; WideCharCount: integer);
  {$ifdef HASINLINE}inline;{$endif}

/// convert a RawUnicode PWideChar into a WinAnsi (code page 1252) string
function RawUnicodeToWinAnsi(WideChar: PWideChar; WideCharCount: integer): WinAnsiString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a RawUnicode string into a WinAnsi (code page 1252) string
function RawUnicodeToWinAnsi(const Unicode: RawUnicode): WinAnsiString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a WideString into a WinAnsi (code page 1252) string
function WideStringToWinAnsi(const Wide: WideString): WinAnsiString;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an AnsiChar buffer (of a given code page) into a UTF-8 string
procedure AnsiCharToUTF8(P: PAnsiChar; L: Integer; var result: RawUTF8; ACP: integer);

/// convert any Raw Unicode encoded String into a generic SynUnicode Text
function RawUnicodeToSynUnicode(const Unicode: RawUnicode): SynUnicode; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any Raw Unicode encoded String into a generic SynUnicode Text
function RawUnicodeToSynUnicode(WideChar: PWideChar; WideCharCount: integer): SynUnicode; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an Unicode buffer into a WinAnsi (code page 1252) string
procedure UnicodeBufferToWinAnsi(source: PWideChar; out Dest: WinAnsiString);

/// convert an Unicode buffer into a generic VCL string
function UnicodeBufferToString(source: PWideChar): string;

{$ifdef HASVARUSTRING}

/// convert a Delphi 2009+ or FPC Unicode string into our UTF-8 string
function UnicodeStringToUtf8(const S: UnicodeString): RawUTF8; inline;

// this function is the same as direct RawUTF8=AnsiString(CP_UTF8) assignment
// but is faster, since it uses no Win32 API call
function UTF8DecodeToUnicodeString(const S: RawUTF8): UnicodeString; overload; inline;

/// convert our UTF-8 encoded buffer into a Delphi 2009+ Unicode string
// - this function is the same as direct assignment, since RawUTF8=AnsiString(CP_UTF8),
// but is faster, since use no Win32 API call
procedure UTF8DecodeToUnicodeString(P: PUTF8Char; L: integer; var result: UnicodeString); overload;

/// convert a Delphi 2009+ Unicode string into a WinAnsi (code page 1252) string
function UnicodeStringToWinAnsi(const S: UnicodeString): WinAnsiString; inline;

/// convert our UTF-8 encoded buffer into a Delphi 2009+ Unicode string
// - this function is the same as direct assignment, since RawUTF8=AnsiString(CP_UTF8),
// but is faster, since use no Win32 API call
function UTF8DecodeToUnicodeString(P: PUTF8Char; L: integer): UnicodeString; overload; inline;

/// convert a Win-Ansi encoded buffer into a Delphi 2009+ Unicode string
// - this function is faster than default RTL, since use no Win32 API call
function WinAnsiToUnicodeString(WinAnsi: PAnsiChar; WinAnsiLen: PtrInt): UnicodeString; overload;

/// convert a Win-Ansi string into a Delphi 2009+ Unicode string
// - this function is faster than default RTL, since use no Win32 API call
function WinAnsiToUnicodeString(const WinAnsi: WinAnsiString): UnicodeString; inline; overload;

{$endif HASVARUSTRING}

/// convert any generic VCL Text into an UTF-8 encoded String
// - in the VCL context, it's prefered to use TLanguageFile.StringToUTF8()
//  method from mORMoti18n, which will handle full i18n of your application
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function StringToUTF8(const Text: string): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any generic VCL Text buffer into an UTF-8 encoded String
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
procedure StringToUTF8(Text: PChar; TextLen: PtrInt; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any generic VCL Text into an UTF-8 encoded String
// - this overloaded function use a faster by-reference parameter for the result
procedure StringToUTF8(const Text: string; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any generic VCL Text into an UTF-8 encoded String
function ToUTF8(const Text: string): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any UTF-8 encoded shortstring Text into an UTF-8 encoded String
// - expects the supplied content to be already ASCII-7 or UTF-8 encoded, e.g.
// a RTTI type or property name: it won't work with Ansi-encoded strings
function ToUTF8(const Ansi7Text: ShortString): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a TGUID into UTF-8 encoded text
// - will return e.g. '3F2504E0-4F89-11D3-9A0C-0305E82C3301' (without the {})
// - if you need the embracing { }, use GUIDToRawUTF8() function instead
function ToUTF8({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): RawUTF8; overload;

{$ifndef NOVARIANTS}

type
  /// function prototype used internally for variant comparison
  // - used in mORMot.pas unit e.g. by TDocVariantData.SortByValue
  TVariantCompare = function(const V1,V2: variant): PtrInt;

/// TVariantCompare-compatible case-sensitive comparison function
// - just a wrapper around SortDynArrayVariantComp(caseInsensitive=false)
function VariantCompare(const V1,V2: variant): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// TVariantCompare-compatible case-insensitive comparison function
// - just a wrapper around SortDynArrayVariantComp(caseInsensitive=true)
function VariantCompareI(const V1,V2: variant): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any Variant into UTF-8 encoded String
// - use VariantSaveJSON() instead if you need a conversion to JSON with
// custom parameters
// - note: null will be returned as 'null'
function VariantToUTF8(const V: Variant): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any Variant into UTF-8 encoded String
// - use VariantSaveJSON() instead if you need a conversion to JSON with
// custom parameters
// - note: null will be returned as 'null'
function ToUTF8(const V: Variant): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any Variant into UTF-8 encoded String
// - use VariantSaveJSON() instead if you need a conversion to JSON with
// custom parameters
// - wasString is set if the V value was a text
// - empty and null variants will be stored as 'null' text - as expected by JSON
// - custom variant types (e.g. TDocVariant) will be stored as JSON
procedure VariantToUTF8(const V: Variant; var result: RawUTF8;
  var wasString: boolean); overload;

/// convert any Variant into UTF-8 encoded String
// - use VariantSaveJSON() instead if you need a conversion to JSON with
// custom parameters
// - returns TRUE if the V value was a text, FALSE if was not (e.g. a number)
// - empty and null variants will be stored as 'null' text - as expected by JSON
// - custom variant types (e.g. TDocVariant) will be stored as JSON
function VariantToUTF8(const V: Variant; var Text: RawUTF8): boolean; overload;

/// convert any date/time Variant into a TDateTime value
// - would handle varDate kind of variant, or use a string conversion and
// ISO-8601 parsing if possible
function VariantToDateTime(const V: Variant; var Value: TDateTime): boolean;

/// fast conversion from hexa chars, supplied as a variant string, into a binary buffer
function VariantHexDisplayToBin(const Hex: variant; Bin: PByte; BinBytes: integer): boolean;

/// fast conversion of a binary buffer into hexa chars, as a variant string
function BinToHexDisplayLowerVariant(Bin: pointer; BinBytes: integer): variant;
  {$ifdef HASINLINE}inline;{$endif}

/// fast comparison of a Variant and UTF-8 encoded String (or number)
// - slightly faster than plain V=Str, which computes a temporary variant
// - here Str='' equals unassigned, null or false
// - if CaseSensitive is false, will use IdemPropNameU() for comparison
function VariantEquals(const V: Variant; const Str: RawUTF8;
  CaseSensitive: boolean=true): boolean; overload;

/// convert any Variant into a VCL string type
// - expects any varString value to be stored as a RawUTF8
// - prior to Delphi 2009, use VariantToString(aVariant) instead of
// string(aVariant) to safely retrieve a string=AnsiString value from a variant
// generated by our framework units - otherwise, you may loose encoded characters
// - for Unicode versions of Delphi, there won't be any potential data loss,
// but this version may be slightly faster than a string(aVariant)
function VariantToString(const V: Variant): string;

/// convert any Variant into a value encoded as with :(..:) inlined parameters
// in FormatUTF8(Format,Args,Params)
procedure VariantToInlineValue(const V: Variant; var result: RawUTF8);

/// convert any Variant into another Variant storing an RawUTF8 of the value
// - e.g. VariantToVariantUTF8('toto')='toto' and VariantToVariantUTF8(12)='12'
function VariantToVariantUTF8(const V: Variant): variant;

/// faster alternative to Finalize(aVariantDynArray)
// - this function will take account and optimize the release of a dynamic
// array of custom variant types values
// - for instance, an array of TDocVariant will be optimized for speed
procedure VariantDynArrayClear(var Value: TVariantDynArray);
  {$ifdef HASINLINE}inline;{$endif}

/// crc32c-based hash of a variant value
// - complex string types will make up to 255 uppercase characters conversion
// if CaseInsensitive is true
// - you can specify your own hashing function if crc32c is not what you expect
function VariantHash(const value: variant; CaseInsensitive: boolean;
  Hasher: THasher=nil): cardinal;

{$endif NOVARIANTS}

{ note: those VariantToInteger*() functions are expected to be there }

/// convert any numerical Variant into a 32-bit integer
// - it will expect true numerical Variant and won't convert any string nor
// floating-pointer Variant, which will return FALSE and won't change the
// Value variable content
function VariantToInteger(const V: Variant; var Value: integer): boolean;

/// convert any numerical Variant into a 64-bit integer
// - it will expect true numerical Variant and won't convert any string nor
// floating-pointer Variant, which will return FALSE and won't change the
// Value variable content
function VariantToInt64(const V: Variant; var Value: Int64): boolean;

/// convert any numerical Variant into a 64-bit integer
// - it will expect true numerical Variant and won't convert any string nor
// floating-pointer Variant, which will return the supplied DefaultValue
function VariantToInt64Def(const V: Variant; DefaultValue: Int64): Int64;

/// convert any numerical Variant into a floating point value
function VariantToDouble(const V: Variant; var Value: double): boolean;

/// convert any numerical Variant into a floating point value
function VariantToDoubleDef(const V: Variant; const default: double=0): double;

/// convert any numerical Variant into a fixed decimals floating point value
function VariantToCurrency(const V: Variant; var Value: currency): boolean;

/// convert any numerical Variant into a boolean value
// - text content will return true after case-insensitive 'true' comparison
function VariantToBoolean(const V: Variant; var Value: Boolean): boolean;

/// convert any numerical Variant into an integer
// - it will expect true numerical Variant and won't convert any string nor
// floating-pointer Variant, which will return the supplied DefaultValue
function VariantToIntegerDef(const V: Variant; DefaultValue: integer): integer; overload;

/// convert any generic VCL Text buffer into an UTF-8 encoded buffer
// - Dest must be able to receive at least SourceChars*3 bytes
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function StringBufferToUtf8(Dest: PUTF8Char; Source: PChar; SourceChars: PtrInt): PUTF8Char; overload;

/// convert any generic VCL 0-terminated Text buffer into an UTF-8 string
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
procedure StringBufferToUtf8(Source: PChar; out result: RawUTF8); overload;

/// convert any generic VCL Text into a Raw Unicode encoded String
// - it's prefered to use TLanguageFile.StringToUTF8() method in mORMoti18n,
// which will handle full i18n of your application
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function StringToRawUnicode(const S: string): RawUnicode; overload;

/// convert any generic VCL Text into a SynUnicode encoded String
// - it's prefered to use TLanguageFile.StringToUTF8() method in mORMoti18n,
// which will handle full i18n of your application
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function StringToSynUnicode(const S: string): SynUnicode; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any generic VCL Text into a SynUnicode encoded String
// - overloaded to avoid a copy to a temporary result string of a function
procedure StringToSynUnicode(const S: string; var result: SynUnicode); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any generic VCL Text into a Raw Unicode encoded String
// - it's prefered to use TLanguageFile.StringToUTF8() method in mORMoti18n,
// which will handle full i18n of your application
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function StringToRawUnicode(P: PChar; L: integer): RawUnicode; overload;

/// convert any Raw Unicode encoded string into a generic VCL Text
// - uses StrLenW() and not length(U) to handle case when was used as buffer
function RawUnicodeToString(const U: RawUnicode): string; overload;

/// convert any Raw Unicode encoded buffer into a generic VCL Text
function RawUnicodeToString(P: PWideChar; L: integer): string; overload;

/// convert any Raw Unicode encoded buffer into a generic VCL Text
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string); overload;

/// convert any SynUnicode encoded string into a generic VCL Text
function SynUnicodeToString(const U: SynUnicode): string;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any UTF-8 encoded String into a generic VCL Text
// - it's prefered to use TLanguageFile.UTF8ToString() in mORMoti18n,
// which will handle full i18n of your application
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function UTF8ToString(const Text: RawUTF8): string;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any UTF-8 encoded buffer into a generic VCL Text
// - it's prefered to use TLanguageFile.UTF8ToString() in mORMoti18n,
// which will handle full i18n of your application
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function UTF8DecodeToString(P: PUTF8Char; L: integer): string; overload;
  {$ifdef UNICODE}inline;{$endif}

/// convert any UTF-8 encoded buffer into a generic VCL Text
procedure UTF8DecodeToString(P: PUTF8Char; L: integer; var result: string); overload;

/// convert any UTF-8 encoded String into a generic WideString Text
function UTF8ToWideString(const Text: RawUTF8): WideString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any UTF-8 encoded String into a generic WideString Text
procedure UTF8ToWideString(const Text: RawUTF8; var result: WideString); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any UTF-8 encoded String into a generic WideString Text
procedure UTF8ToWideString(Text: PUTF8Char; Len: PtrInt; var result: WideString); overload;

/// convert any UTF-8 encoded String into a generic SynUnicode Text
function UTF8ToSynUnicode(const Text: RawUTF8): SynUnicode; overload;

/// convert any UTF-8 encoded String into a generic SynUnicode Text
procedure UTF8ToSynUnicode(const Text: RawUTF8; var result: SynUnicode); overload;

/// convert any UTF-8 encoded buffer into a generic SynUnicode Text
procedure UTF8ToSynUnicode(Text: PUTF8Char; Len: PtrInt; var result: SynUnicode); overload;

/// convert any Ansi 7 bit encoded String into a generic VCL Text
// - the Text content must contain only 7 bit pure ASCII characters
function Ansi7ToString(const Text: RawByteString): string; overload;
  {$ifndef UNICODE}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// convert any Ansi 7 bit encoded String into a generic VCL Text
// - the Text content must contain only 7 bit pure ASCII characters
function Ansi7ToString(Text: PWinAnsiChar; Len: PtrInt): string; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any Ansi 7 bit encoded String into a generic VCL Text
// - the Text content must contain only 7 bit pure ASCII characters
procedure Ansi7ToString(Text: PWinAnsiChar; Len: PtrInt; var result: string); overload;

/// convert any generic VCL Text into Ansi 7 bit encoded String
// - the Text content must contain only 7 bit pure ASCII characters
function StringToAnsi7(const Text: string): RawByteString;

/// convert any generic VCL Text into WinAnsi (Win-1252) 8 bit encoded String
function StringToWinAnsi(const Text: string): WinAnsiString;
  {$ifdef UNICODE}inline;{$endif}

/// fast Format() function replacement, optimized for RawUTF8
// - only supported token is %, which will be written in the resulting string
// according to each Args[] supplied items - so you will never get any exception
// as with the SysUtils.Format() when a specifier is incorrect
// - resulting string has no length limit and uses fast concatenation
// - there is no escape char, so to output a '%' character, you need to use '%'
// as place-holder, and specify '%' as value in the Args array
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
// - any supplied TObject instance will be written as their class name
function FormatUTF8(const Format: RawUTF8; const Args: array of const): RawUTF8; overload;

/// fast Format() function replacement, optimized for RawUTF8
// - overloaded function, which avoid a temporary RawUTF8 instance on stack
procedure FormatUTF8(const Format: RawUTF8; const Args: array of const;
  out result: RawUTF8); overload;

/// fast Format() function replacement, tuned for direct memory buffer write
// - use the same single token % (and implementation) than FormatUTF8()
// - returns the number of UTF-8 bytes appended to Dest^
function FormatBuffer(const Format: RawUTF8; const Args: array of const;
  Dest: pointer; DestLen: PtrInt): PtrInt;

/// fast Format() function replacement, for UTF-8 content stored in shortstring
// - use the same single token % (and implementation) than FormatUTF8()
// - shortstring allows fast stack allocation, so is perfect for small content
// - truncate result if the text size exceeds 255 bytes
procedure FormatShort(const Format: RawUTF8; const Args: array of const;
  var result: shortstring);

/// fast Format() function replacement, for UTF-8 content stored in shortstring
function FormatToShort(const Format: RawUTF8; const Args: array of const): shortstring;

/// fast Format() function replacement, tuned for small content
// - use the same single token % (and implementation) than FormatUTF8()
procedure FormatString(const Format: RawUTF8; const Args: array of const;
  out result: string); overload;

/// fast Format() function replacement, tuned for small content
// - use the same single token % (and implementation) than FormatUTF8()
function FormatString(const Format: RawUTF8; const Args: array of const): string; overload;
  {$ifdef FPC}inline;{$endif}

type
  /// used e.g. by PointerToHexShort/CardinalToHexShort/Int64ToHexShort/FormatShort16
  // - such result type would avoid a string allocation on heap, so are highly
  // recommended e.g. when logging small pieces of information
  TShort16 = string[16];
  PShort16 = ^TShort16;

/// fast Format() function replacement, for UTF-8 content stored in TShort16
// - truncate result if the text size exceeds 16 bytes
procedure FormatShort16(const Format: RawUTF8; const Args: array of const;
  var result: TShort16);

/// fast Format() function replacement, handling % and ? parameters
// - will include Args[] for every % in Format
// - will inline Params[] for every ? in Format, handling special "inlined"
// parameters, as exected by mORMot.pas unit, i.e. :(1234): for numerical
// values, and :('quoted '' string'): for textual values
// - if optional JSONFormat parameter is TRUE, ? parameters will be written
// as JSON quoted strings, without :(...): tokens, e.g. "quoted "" string"
// - resulting string has no length limit and uses fast concatenation
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
// - any supplied TObject instance will be written as their class name
function FormatUTF8(const Format: RawUTF8; const Args, Params: array of const;
  JSONFormat: boolean=false): RawUTF8; overload;

/// read and store text into values[] according to fmt specifiers
// - %d as PInteger, %D as PInt64, %u as PCardinal, %U as PQWord, %f as PDouble,
// %F as PCurrency, %x as 8 hexa chars to PInteger, %X as 16 hexa chars to PInt64,
// %s as PShortString (UTF-8 encoded), %S as PRawUTF8, %L as PRawUTF8 (getting
// all text until the end of the line)
// - optionally, specifiers and any whitespace separated identifiers may be
// extracted and stored into the ident[] array, e.g. '%dFirstInt %s %DOneInt64'
// will store ['dFirstInt','s','DOneInt64'] into ident
function ScanUTF8(const text, fmt: RawUTF8; const values: array of pointer;
  ident: PRawUTF8DynArray=nil): integer; overload;

/// read text from P/PLen and store it into values[] according to fmt specifiers
function ScanUTF8(P: PUTF8Char; PLen: PtrInt; const fmt: RawUTF8;
  const values: array of pointer; ident: PRawUTF8DynArray): integer; overload;

/// convert an open array (const Args: array of const) argument to an UTF-8
// encoded text
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
// - any supplied TObject instance will be written as their class name
procedure VarRecToUTF8(const V: TVarRec; var result: RawUTF8;
  wasString: PBoolean=nil);

type
  /// a memory structure which avoids a temporary RawUTF8 allocation
  // - used by VarRecToTempUTF8() and FormatUTF8()/FormatShort()
  TTempUTF8 = record
    Len: PtrInt;
    Text: PUTF8Char;
    TempRawUTF8: pointer;
    Temp: array[0..23] of AnsiChar;
  end;
  PTempUTF8 = ^TTempUTF8;

/// convert an open array (const Args: array of const) argument to an UTF-8
// encoded text, using a specified temporary buffer
// - this function would allocate a RawUTF8 in TempRawUTF8 only if needed,
// but use the supplied Res.Temp[] buffer for numbers to text conversion -
// caller should ensure to make RawUTF8(TempRawUTF8) := '' on the entry
// - it would return the number of UTF-8 bytes, i.e. Res.Len
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
// - any supplied TObject instance will be written as their class name
function VarRecToTempUTF8(const V: TVarRec; var Res: TTempUTF8): integer;

/// convert an open array (const Args: array of const) argument to an UTF-8
// encoded text, returning FALSE if the argument was not a string value
function VarRecToUTF8IsString(const V: TVarRec; var value: RawUTF8): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an open array (const Args: array of const) argument to an Int64
// - returns TRUE and set Value if the supplied argument is a vtInteger, vtInt64
// or vtBoolean
// - returns FALSE if the argument is not an integer
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
function VarRecToInt64(const V: TVarRec; out value: Int64): boolean;

/// convert an open array (const Args: array of const) argument to a floating
// point value
// - returns TRUE and set Value if the supplied argument is a number (e.g.
// vtInteger, vtInt64, vtCurrency or vtExtended)
// - returns FALSE if the argument is not a number
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
function VarRecToDouble(const V: TVarRec; out value: double): boolean;

/// convert an open array (const Args: array of const) argument to a value
// encoded as with :(...): inlined parameters in FormatUTF8(Format,Args,Params)
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
// - any supplied TObject instance will be written as their class name
procedure VarRecToInlineValue(const V: TVarRec; var result: RawUTF8);

/// get an open array (const Args: array of const) character argument
// - only handle varChar and varWideChar kind of arguments
function VarRecAsChar(const V: TVarRec): integer;
  {$ifdef HASINLINE}inline;{$endif}

type
  /// function prototype used internally for UTF-8 buffer comparison
  // - used in mORMot.pas unit during TSQLTable rows sort and by TSQLQuery
  TUTF8Compare = function(P1,P2: PUTF8Char): PtrInt;

/// convert the endianness of a given unsigned 32-bit integer into BigEndian
function bswap32(a: cardinal): cardinal;
  {$ifndef CPUINTEL}inline;{$endif}

/// convert the endianness of a given unsigned 64-bit integer into BigEndian
function bswap64({$ifdef FPC_X86}constref{$else}const{$endif} a: QWord): QWord;
  {$ifndef CPUINTEL}inline;{$endif}

/// convert the endianness of an array of unsigned 64-bit integer into BigEndian
// - n is required to be > 0
// - warning: on x86, a should be <> b
procedure bswap64array(a,b: PQWordArray; n: PtrInt);

/// fast concatenation of several AnsiStrings
function RawByteStringArrayConcat(const Values: array of RawByteString): RawByteString;

/// creates a TBytes from a RawByteString memory buffer
procedure RawByteStringToBytes(const buf: RawByteString; out bytes: TBytes);

/// creates a RawByteString memory buffer from a TBytes content
procedure BytesToRawByteString(const bytes: TBytes; out buf: RawByteString);
  {$ifdef HASINLINE}inline;{$endif}

/// creates a RawByteString memory buffer from an embedded resource
// - returns '' if the resource is not found
// - warning: resources size may be rounded up to alignment
// - you can specify a library (dll) resource instance handle, if needed
procedure ResourceToRawByteString(const ResName: string; ResType: PChar;
  out buf: RawByteString; Instance: THandle=0);

/// creates a RawByteString memory buffer from an SynLZ-compressed embedded resource
// - returns '' if the resource is not found
// - this method would use SynLZDecompress() after ResourceToRawByteString(),
// with a ResType=PChar(10) (i.e. RC_DATA)
// - you can specify a library (dll) resource instance handle, if needed
procedure ResourceSynLZToRawByteString(const ResName: string;
  out buf: RawByteString; Instance: THandle=0);

{$ifndef ENHANCEDRTL} { is our Enhanced Runtime (or LVCL) library not installed? }

/// fast dedicated RawUTF8 version of Trim()
// - implemented using x86 asm, if possible
// - this Trim() is seldom used, but this RawUTF8 specific version is needed
// e.g. by Delphi 2009+, to avoid two unnecessary conversions into UnicodeString
// - in the middle of VCL code, consider using TrimU() which won't have name
// collision ambiguity as with SysUtils' homonymous function
function Trim(const S: RawUTF8): RawUTF8;

/// fast dedicated RawUTF8 version of Trim()
// - could be used if overloaded Trim() from SysUtils.pas is ambiguous
function TrimU(const S: RawUTF8): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

{$define OWNNORMTOUPPER} { NormToUpper[] exists only in our enhanced RTL }

{$endif ENHANCEDRTL}

/// our fast version of CompareMem() with optimized asm for x86 and tune pascal
function CompareMem(P1, P2: Pointer; Length: PtrInt): Boolean;

{$ifdef HASINLINE}
function CompareMemFixed(P1, P2: Pointer; Length: PtrInt): Boolean; inline;
{$else}
/// a CompareMem()-like function designed for small and fixed-sized content
// - here, Length is expected to be a constant value - typically from sizeof() -
// so that inlining has better performance than calling the CompareMem() function
var CompareMemFixed: function(P1, P2: Pointer; Length: PtrInt): Boolean = CompareMem;
{$endif HASINLINE}

/// a CompareMem()-like function designed for small (a few bytes) content
function CompareMemSmall(P1, P2: Pointer; Length: PtrUInt): Boolean; {$ifdef HASINLINE}inline;{$endif}

/// convert some ASCII-7 text into binary, using Emile Baudot code
// - as used in telegraphs, covering #10 #13 #32 a-z 0-9 - ' , ! : ( + ) $ ? @ . / ;
// charset, following a custom static-huffman-like encoding with 5-bit masks
// - any upper case char will be converted into lowercase during encoding
// - other characters (e.g. UTF-8 accents, or controls chars) will be ignored
// - resulting binary will consume 5 (or 10) bits per character
// - reverse of the BaudotToAscii() function
// - the "baud" symbol rate measurement comes from Emile's name ;)
function AsciiToBaudot(P: PAnsiChar; len: PtrInt): RawByteString; overload;

/// convert some ASCII-7 text into binary, using Emile Baudot code
// - as used in telegraphs, covering #10 #13 #32 a-z 0-9 - ' , ! : ( + ) $ ? @ . / ;
// charset, following a custom static-huffman-like encoding with 5-bit masks
// - any upper case char will be converted into lowercase during encoding
// - other characters (e.g. UTF-8 accents, or controls chars) will be ignored
// - resulting binary will consume 5 (or 10) bits per character
// - reverse of the BaudotToAscii() function
// - the "baud" symbol rate measurement comes from Emile's name ;)
function AsciiToBaudot(const Text: RawUTF8): RawByteString; overload;

/// convert some Baudot code binary, into ASCII-7 text
// - reverse of the AsciiToBaudot() function
// - any uppercase character would be decoded as lowercase - and some characters
// may have disapeared
// - the "baud" symbol rate measurement comes from Emile's name ;)
function BaudotToAscii(Baudot: PByteArray; len: PtrInt): RawUTF8; overload;

/// convert some Baudot code binary, into ASCII-7 text
// - reverse of the AsciiToBaudot() function
// - any uppercase character would be decoded as lowercase - and some characters
// may have disapeared
// - the "baud" symbol rate measurement comes from Emile's name ;)
function BaudotToAscii(const Baudot: RawByteString): RawUTF8; overload;

{$ifdef UNICODE}
/// our fast RawUTF8 version of Pos(), for Unicode only compiler
// - this Pos() is seldom used, but this RawUTF8 specific version is needed
// by Delphi 2009+, to avoid two unnecessary conversions into UnicodeString
// - just a wrapper around PosEx(substr,str,1)
function Pos(const substr, str: RawUTF8): Integer; overload; inline;
{$endif UNICODE}

/// use our fast RawUTF8 version of IntToStr()
// - without any slow UnicodeString=String->AnsiString conversion for Delphi 2009
// - only useful if our Enhanced Runtime (or LVCL) library is not installed
function Int64ToUtf8(Value: Int64): RawUTF8; overload;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// fast RawUTF8 version of IntToStr(), with proper QWord conversion
procedure UInt64ToUtf8(Value: QWord; var result: RawUTF8);

/// use our fast RawUTF8 version of IntToStr()
// - without any slow UnicodeString=String->AnsiString conversion for Delphi 2009
// - only useful if our Enhanced Runtime (or LVCL) library is not installed
function Int32ToUtf8(Value: PtrInt): RawUTF8; overload;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// use our fast RawUTF8 version of IntToStr()
// - without any slow UnicodeString=String->AnsiString conversion for Delphi 2009
// - result as var parameter saves a local assignment and a try..finally
procedure Int32ToUTF8(Value: PtrInt; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// use our fast RawUTF8 version of IntToStr()
// - without any slow UnicodeString=String->AnsiString conversion for Delphi 2009
// - result as var parameter saves a local assignment and a try..finally
procedure Int64ToUtf8(Value: Int64; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// use our fast RawUTF8 version of IntToStr()
function ToUTF8(Value: PtrInt): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

{$ifndef CPU64}
/// use our fast RawUTF8 version of IntToStr()
function ToUTF8(Value: Int64): RawUTF8; overload;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}
{$endif}

/// optimized conversion of a cardinal into RawUTF8
function UInt32ToUtf8(Value: PtrUInt): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// optimized conversion of a cardinal into RawUTF8
procedure UInt32ToUtf8(Value: PtrUInt; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// faster version than default SysUtils.IntToStr implementation
function IntToString(Value: integer): string; overload;

/// faster version than default SysUtils.IntToStr implementation
function IntToString(Value: cardinal): string; overload;

/// faster version than default SysUtils.IntToStr implementation
function IntToString(Value: Int64): string; overload;

/// convert a floating-point value to its numerical text equivalency
function DoubleToString(Value: Double): string;

/// convert a currency value from its Int64 binary representation into
// its numerical text equivalency
// - decimals are joined by 2 (no decimal, 2 decimals, 4 decimals)
function Curr64ToString(Value: Int64): string;

type
  /// used to store a set of 8-bit encoded characters
  TSynAnsicharSet = set of AnsiChar;
  /// used to store a set of 8-bit unsigned integers
  TSynByteSet = set of Byte;

/// check all character within text are spaces or control chars
// - i.e. a faster alternative to trim(text)=''
function IsVoid(const text: RawUTF8): boolean;

/// returns the supplied text content, without any control char
// - a control char has an ASCII code #0 .. #32, i.e. text[]<=' '
// - you can specify a custom char set to be excluded, if needed
function TrimControlChars(const text: RawUTF8; const controls: TSynAnsicharSet=[#0..' ']): RawUTF8;

var
  /// best possible precision when rendering a "single" kind of float
  // - can be used as parameter for ExtendedToShort/ExtendedToStr
  // - is defined as a var, so that you may be able to override the default
  // settings, for the whole process
  SINGLE_PRECISION: integer = 8;
  /// best possible precision when rendering a "double" kind of float
  // - can be used as parameter for ExtendedToShort/ExtendedToStr
  // - is defined as a var, so that you may be able to override the default
  // settings, for the whole process
  DOUBLE_PRECISION: integer = 15;
  /// best possible precision when rendering a "extended" kind of float
  // - can be used as parameter for ExtendedToShort/ExtendedToStr
  // - is defined as a var, so that you may be able to override the default
  // settings, for the whole process
  EXTENDED_PRECISION: integer = 18;

const
  /// a typical error allowed when working with double floating-point values
  // - 1E-12 is too small, and triggers sometimes some unexpected errors;
  // FPC RTL uses 1E-4 so we are paranoid enough
  DOUBLE_SAME = 1E-11;

type
  {$ifdef TSYNEXTENDED80}
  /// the floating-point type to be used for best precision and speed
  // - will allow to fallback to double e.g. on x64 and ARM CPUs
  TSynExtended = extended;
  {$else}
  /// ARM/Delphi 64-bit does not support 80bit extended -> double is enough
  TSynExtended = double;
  {$endif TSYNEXTENDED80}

  /// the non-number values potentially stored in an IEEE floating point
  TFloatNan = (fnNumber, fnNan, fnInf, fnNegInf);
  {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  /// will actually change anything only on FPC ARM/Aarch64 plaforms
  unaligned = Double;
  {$endif}


const
  /// the JavaScript-like values of non-number IEEE constants
  // - as recognized by FloatToShortNan, and used by TTextWriter.Add()
  // when serializing such single/double/extended floating-point values
  JSON_NAN: array[TFloatNan] of string[11] = (
    '0', '"NaN"', '"Infinity"', '"-Infinity"');

type
  /// small structure used as convenient result to Div100() procedure
  TDiv100Rec = packed record
    /// contains V div 100 after Div100(V)
    D: cardinal;
    /// contains V mod 100 after Div100(V)
    M: cardinal;
  end;

/// simple wrapper to efficiently compute both division and modulo per 100
// - compute result.D = Y div 100 and result.M = Y mod 100
// - under FPC, will use fast multiplication by reciprocal so can be inlined
// - under Delphi, we use our own optimized asm version (which can't be inlined)
procedure Div100(Y: cardinal; var res: TDiv100Rec);
  {$ifdef FPC} inline; {$endif}

/// compare to floating point values, with IEEE 754 double precision
// - use this function instead of raw = operator
// - the precision is calculated from the A and B value range
// - faster equivalent than SameValue() in Math unit
// - if you know the precision range of A and B, it's faster to check abs(A-B)<range
function SameValue(const A, B: Double; DoublePrec: double = DOUBLE_SAME): Boolean;

/// compare to floating point values, with IEEE 754 double precision
// - use this function instead of raw = operator
// - the precision is calculated from the A and B value range
// - faster equivalent than SameValue() in Math unit
// - if you know the precision range of A and B, it's faster to check abs(A-B)<range
function SameValueFloat(const A, B: TSynExtended; DoublePrec: TSynExtended = DOUBLE_SAME): Boolean;

/// a comparison function for sorting IEEE 754 double precision values
function CompareFloat(const A, B: double): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// a comparison function for sorting 32-bit signed integer values
function CompareInteger(const A, B: integer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// a comparison function for sorting 64-bit signed integer values
function CompareInt64(const A, B: Int64): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// a comparison function for sorting 32-bit unsigned integer values
function CompareCardinal(const A, B: cardinal): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// a comparison function for sorting 64-bit unsigned integer values
// - note that QWord(A)>QWord(B) is wrong on older versions of Delphi, so you
// should better use this function or SortDynArrayQWord() to properly compare
// two QWord values over CPUX86
function CompareQWord(A, B: QWord): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// compute the sum of values, using a running compensation for lost low-order bits
// - a naive "Sum := Sum + Data" will be restricted to 53 bits of resolution,
// so will eventually result in an incorrect number
// - Kahan algorithm keeps track of the accumulated error in integer operations,
// to achieve a precision of more than 100 bits
// - see https://en.wikipedia.org/wiki/Kahan_summation_algorithm
procedure KahanSum(const Data: double; var Sum, Carry: double);
  {$ifdef HASINLINE}inline;{$endif}

/// convert a floating-point value to its numerical text equivalency
// - on Delphi Win32, calls FloatToText() in ffGeneral mode; on FPC uses str()
// - DOUBLE_PRECISION will redirect to DoubleToShort() and its faster Fabian
// Loitsch's Grisu algorithm if available
// - returns the count of chars stored into S, i.e. length(S)
function ExtendedToShort(var S: ShortString; Value: TSynExtended; Precision: integer): integer;

/// convert a floating-point value to its numerical text equivalency without
// scientification notation
// - DOUBLE_PRECISION will redirect to DoubleToShortNoExp() and its faster Fabian
// Loitsch's Grisu algorithm if available - or calls str(Value:0:precision,S)
// - returns the count of chars stored into S, i.e. length(S)
function ExtendedToShortNoExp(var S: ShortString; Value: TSynExtended;
  Precision: integer): integer;

/// check if the supplied text is NAN/INF/+INF/-INF, i.e. not a number
// - as returned by ExtendedToShort/DoubleToShort textual conversion
// - such values do appear as IEEE floating points, but are not defined in JSON
function FloatToShortNan(const s: shortstring): TFloatNan;
  {$ifdef HASINLINE}inline;{$endif}

/// check if the supplied text is NAN/INF/+INF/-INF, i.e. not a number
// - as returned e.g. by ExtendedToStr/DoubleToStr textual conversion
// - such values do appear as IEEE floating points, but are not defined in JSON
function FloatToStrNan(const s: RawUTF8): TFloatNan;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a floating-point value to its numerical text equivalency
function ExtendedToStr(Value: TSynExtended; Precision: integer): RawUTF8; overload;

/// convert a floating-point value to its numerical text equivalency
procedure ExtendedToStr(Value: TSynExtended; Precision: integer; var result: RawUTF8); overload;

/// recognize if the supplied text is NAN/INF/+INF/-INF, i.e. not a number
// - returns the number as text (stored into tmp variable), or "Infinity",
// "-Infinity", and "NaN" for corresponding IEEE special values
// - result is a PShortString either over tmp, or JSON_NAN[]
function FloatToJSONNan(const s: ShortString): PShortString;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a floating-point value to its JSON text equivalency
// - depending on the platform, it may either call str() or FloatToText()
// in ffGeneral mode (the shortest possible decimal string using fixed or
// scientific format)
// - returns the number as text (stored into tmp variable), or "Infinity",
// "-Infinity", and "NaN" for corresponding IEEE special values
// - result is a PShortString either over tmp, or JSON_NAN[]
function ExtendedToJSON(var tmp: ShortString; Value: TSynExtended;
  Precision: integer; NoExp: boolean): PShortString;

/// convert a 64-bit floating-point value to its numerical text equivalency
// - on Delphi Win32, calls FloatToText() in ffGeneral mode
// - on other platforms, i.e. Delphi Win64 and all FPC targets, will use our own
// faster Fabian Loitsch's Grisu algorithm implementation
// - returns the count of chars stored into S, i.e. length(S)
function DoubleToShort(var S: ShortString; const Value: double): integer;
  {$ifdef FPC}inline;{$endif}

/// convert a 64-bit floating-point value to its numerical text equivalency
// without scientific notation
// - on Delphi Win32, calls FloatToText() in ffGeneral mode
// - on other platforms, i.e. Delphi Win64 and all FPC targets, will use our own
// faster Fabian Loitsch's Grisu algorithm implementation
// - returns the count of chars stored into S, i.e. length(S)
function DoubleToShortNoExp(var S: ShortString; const Value: double): integer;
  {$ifdef FPC}inline;{$endif}

{$ifdef DOUBLETOSHORT_USEGRISU}
const
  // special text returned if the double is not a number
  C_STR_INF: string[3] = 'Inf';
  C_STR_QNAN: string[3] = 'Nan';

  // min_width parameter special value, as used internally by FPC for str(d,s)
  // - DoubleToAscii() only accept C_NO_MIN_WIDTH or 0 for min_width: space
  // trailing has been removed in this cut-down version
  C_NO_MIN_WIDTH = -32767;

/// raw function to convert a 64-bit double into a shortstring, stored in str
// - implements Fabian Loitsch's Grisu algorithm dedicated to double values
// - currently, SynCommnons only set min_width=0 (for DoubleToShortNoExp to avoid
// any scientific notation ) or min_width=C_NO_MIN_WIDTH (for DoubleToShort to
// force the scientific notation when the double cannot be represented as
// a simple fractinal number)
procedure DoubleToAscii(min_width, frac_digits: integer; const v: double; str: PAnsiChar);
{$endif DOUBLETOSHORT_USEGRISU}

/// convert a 64-bit floating-point value to its JSON text equivalency
// - on Delphi Win32, calls FloatToText() in ffGeneral mode
// - on other platforms, i.e. Delphi Win64 and all FPC targets, will use our own
// faster Fabian Loitsch's Grisu algorithm
// - returns the number as text (stored into tmp variable), or "Infinity",
// "-Infinity", and "NaN" for corresponding IEEE special values
// - result is a PShortString either over tmp, or JSON_NAN[]
function DoubleToJSON(var tmp: ShortString; Value: double; NoExp: boolean): PShortString;

/// convert a 64-bit floating-point value to its numerical text equivalency
function DoubleToStr(Value: Double): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a 64-bit floating-point value to its numerical text equivalency
procedure DoubleToStr(Value: Double; var result: RawUTF8); overload;

/// fast retrieve the position of a given character
function PosChar(Str: PUTF8Char; Chr: AnsiChar): PUTF8Char;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// fast retrieve the position of any value of a given set of characters
// - see also strspn() function which is likely to be faster
function PosCharAny(Str: PUTF8Char; Characters: PAnsiChar): PUTF8Char;

/// a non case-sensitive RawUTF8 version of Pos()
// - uppersubstr is expected to be already in upper case
// - this version handle only 7 bit ASCII (no accentuated characters)
function PosI(uppersubstr: PUTF8Char; const str: RawUTF8): PtrInt;

/// a non case-sensitive version of Pos()
// - uppersubstr is expected to be already in upper case
// - this version handle only 7 bit ASCII (no accentuated characters)
function StrPosI(uppersubstr,str: PUTF8Char): PUTF8Char;

/// a non case-sensitive RawUTF8 version of Pos()
// - substr is expected to be already in upper case
// - this version will decode the UTF-8 content before using NormToUpper[]
function PosIU(substr: PUTF8Char; const str: RawUTF8): Integer;

/// internal fast integer val to text conversion
// - expect the last available temporary char position in P
// - return the last written char position (write in reverse order in P^)
// - typical use:
//  !function Int32ToUTF8(Value: PtrInt): RawUTF8;
//  !var tmp: array[0..23] of AnsiChar;
//  !    P: PAnsiChar;
//  !begin
//  !  P := StrInt32(@tmp[23],Value);
//  !  SetString(result,P,@tmp[23]-P);
//  !end;
// - convert the input value as PtrInt, so as Int64 on 64-bit CPUs
// - not to be called directly: use IntToStr() or Int32ToUTF8() instead
function StrInt32(P: PAnsiChar; val: PtrInt): PAnsiChar;

/// internal fast unsigned integer val to text conversion
// - expect the last available temporary char position in P
// - return the last written char position (write in reverse order in P^)
// - convert the input value as PtrUInt, so as QWord on 64-bit CPUs
function StrUInt32(P: PAnsiChar; val: PtrUInt): PAnsiChar;

/// internal fast Int64 val to text conversion
// - same calling convention as with StrInt32() above
function StrInt64(P: PAnsiChar; const val: Int64): PAnsiChar;
  {$ifdef HASINLINE}inline;{$endif}

/// internal fast unsigned Int64 val to text conversion
// - same calling convention as with StrInt32() above
function StrUInt64(P: PAnsiChar; const val: QWord): PAnsiChar;
  {$ifdef CPU64}inline;{$endif}

/// fast add some characters to a RawUTF8 string
// - faster than SetString(tmp,Buffer,BufferLen); Text := Text+tmp;
procedure AppendBufferToRawUTF8(var Text: RawUTF8; Buffer: pointer; BufferLen: PtrInt);

/// fast add one character to a RawUTF8 string
// - faster than Text := Text + ch;
procedure AppendCharToRawUTF8(var Text: RawUTF8; Ch: AnsiChar);

/// fast add some characters to a RawUTF8 string
// - faster than Text := Text+RawUTF8(Buffers[0])+RawUTF8(Buffers[0])+...
procedure AppendBuffersToRawUTF8(var Text: RawUTF8; const Buffers: array of PUTF8Char);

/// fast add some characters from a RawUTF8 string into a given buffer
// - warning: the Buffer should contain enough space to store the Text, otherwise
// you may encounter buffer overflows and random memory errors
function AppendRawUTF8ToBuffer(Buffer: PUTF8Char; const Text: RawUTF8): PUTF8Char;

/// fast add text conversion of a 32-bit unsigned integer value into a given buffer
// - warning: the Buffer should contain enough space to store the text, otherwise
// you may encounter buffer overflows and random memory errors
function AppendUInt32ToBuffer(Buffer: PUTF8Char; Value: PtrUInt): PUTF8Char;

/// fast add text conversion of 0-999 integer value into a given buffer
// - warning: it won't check that Value is in 0-999 range
// - up to 4 bytes may be written to the buffer (including trailing #0)
function Append999ToBuffer(Buffer: PUTF8Char; Value: PtrUInt): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// buffer-safe version of StrComp(), to be used with PUTF8Char/PAnsiChar
// - pure pascal StrComp() won't access the memory beyond the string, but this
// function is defined for compatibility with SSE 4.2 expectations
function StrCompFast(Str1, Str2: pointer): PtrInt;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// fastest available version of StrComp(), to be used with PUTF8Char/PAnsiChar
// - won't use SSE4.2 instructions on supported CPUs by default, which may read
// some bytes beyond the s string, so should be avoided e.g. over memory mapped
// files - call explicitely StrCompSSE42() if you are confident on your input
var StrComp: function (Str1, Str2: pointer): PtrInt = StrCompFast;

/// pure pascal version of strspn(), to be used with PUTF8Char/PAnsiChar
// - please note that this optimized version may read up to 3 bytes beyond
// accept but never after s end, so is safe e.g. over memory mapped files
function strspnpas(s,accept: pointer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// pure pascal version of strcspn(), to be used with PUTF8Char/PAnsiChar
// - please note that this optimized version may read up to 3 bytes beyond
// reject but never after s end, so is safe e.g. over memory mapped files
function strcspnpas(s,reject: pointer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// fastest available version of strspn(), to be used with PUTF8Char/PAnsiChar
// - returns size of initial segment of s which appears in accept chars, e.g.
// ! strspn('abcdef','debca')=5
// - won't use SSE4.2 instructions on supported CPUs by default, which may read
// some bytes beyond the s string, so should be avoided e.g. over memory mapped
// files - call explicitely strspnsse42() if you are confident on your input
var strspn: function (s,accept: pointer): integer = strspnpas;

/// fastest available version of strcspn(), to be used with PUTF8Char/PAnsiChar
// - returns size of initial segment of s which doesn't appears in reject chars, e.g.
// ! strcspn('1234,6789',',')=4
// - won't use SSE4.2 instructions on supported CPUs by default, which may read
// some bytes beyond the s string, so should be avoided e.g. over memory mapped
// files - call explicitely strcspnsse42() if you are confident on your input
var strcspn: function (s,reject: pointer): integer = strcspnpas;

{$ifdef CPUINTEL}
{$ifndef ABSOLUTEPASCAL}
{$ifdef HASAESNI}
/// SSE 4.2 version of StrComp(), to be used with PUTF8Char/PAnsiChar
// - please note that this optimized version may read up to 15 bytes
// beyond the string; this is rarely a problem but it may generate protection
// violations, which could trigger fatal SIGABRT or SIGSEGV on Posix system
// - could be used instead of StrComp() when you are confident about your
// Str1/Str2 input buffers, checking if cfSSE42 in CpuFeatures
function StrCompSSE42(Str1, Str2: pointer): PtrInt;

// - please note that this optimized version may read up to 15 bytes
// beyond the string; this is rarely a problem but it may generate protection
// violations, which could trigger fatal SIGABRT or SIGSEGV on Posix system
// - could be used instead of StrLen() when you are confident about your
// S input buffers, checking if cfSSE42 in CpuFeatures
function StrLenSSE42(S: pointer): PtrInt;
{$endif HASAESNI}

/// SSE 4.2 version of strspn(), to be used with PUTF8Char/PAnsiChar
// - please note that this optimized version may read up to 15 bytes
// beyond the string; this is rarely a problem but it may generate protection
// violations, which could trigger fatal SIGABRT or SIGSEGV on Posix system
// - could be used instead of strspn() when you are confident about your
// s/accept input buffers, checking if cfSSE42 in CpuFeatures
function strspnsse42(s,accept: pointer): integer;

/// SSE 4.2 version of strcspn(), to be used with PUTF8Char/PAnsiChar
// - please note that this optimized version may read up to 15 bytes
// beyond the string; this is rarely a problem but it may generate protection
// violations, which could trigger fatal SIGABRT or SIGSEGV on Posix system
// - could be used instead of strcspn() when you are confident about your
// s/reject input buffers, checking if cfSSE42 in CpuFeatures
function strcspnsse42(s,reject: pointer): integer;

/// SSE 4.2 version of GetBitsCountPtrInt()
// - defined just for regression tests - call GetBitsCountPtrInt() instead
function GetBitsCountSSE42(value: PtrInt): PtrInt;
{$endif ABSOLUTEPASCAL}
{$endif CPUINTEL}

/// use our fast version of StrIComp(), to be used with PUTF8Char/PAnsiChar
function StrIComp(Str1, Str2: pointer): PtrInt;
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// slower version of StrLen(), but which will never read beyond the string
// - this version won't access the memory beyond the string, so may be
// preferred to StrLen(), when using e.g. memory mapped files or any memory
// protected buffer
function StrLenPas(S: pointer): PtrInt;

/// our fast version of StrLen(), to be used with PUTF8Char/PAnsiChar
// - if available, a fast SSE2 asm will be used on Intel/AMD CPUs
// - won't use SSE4.2 instructions on supported CPUs by default, which may read
// some bytes beyond the string, so should be avoided e.g. over memory mapped
// files - call explicitely StrLenSSE42() if you are confident on your input
var StrLen: function(S: pointer): PtrInt = StrLenPas;

{$ifdef ABSOLUTEPASCAL}
var FillcharFast: procedure(var Dest; count: PtrInt; Value: byte) = system.FillChar;
var MoveFast: procedure(const Source; var Dest; Count: PtrInt) = system.Move;
{$else}
{$ifdef CPUX64} // will define its own self-dispatched SSE2/AVX functions
type
  /// cpuERMS is slightly slower than cpuAVX so is not available by default
  TX64CpuFeatures = set of(cpuAVX, cpuAVX2 {$ifdef WITH_ERMS}, cpuERMS{$endif});
var
  /// internal flags used by FillCharFast - easier from asm that CpuFeatures
  CPUIDX64: TX64CpuFeatures;
procedure FillcharFast(var dst; cnt: PtrInt; value: byte);
procedure MoveFast(const src; var dst; cnt: PtrInt);
{$else}

/// our fast version of FillChar()
// - on Intel i386/x86_64, will use fast SSE2/ERMS instructions (if available),
// or optimized X87 assembly implementation for older CPUs
// - on non-Intel CPUs, it will fallback to the default RTL FillChar()
// - note: Delphi x86_64 is far from efficient: even ERMS was wrongly
// introduced in latest updates
var FillcharFast: procedure(var Dest; count: PtrInt; Value: byte);

/// our fast version of move()
// - on Delphi Intel i386/x86_64, will use fast SSE2 instructions (if available),
// or optimized X87 assembly implementation for older CPUs
// - on non-Intel CPUs, it will fallback to the default RTL Move()
var MoveFast: procedure(const Source; var Dest; Count: PtrInt);

{$endif CPUX64}
{$endif ABSOLUTEPASCAL}

/// an alternative Move() function tuned for small unaligned counts
// - warning: expects Count>0 and Source/Dest not nil
// - warning: doesn't support buffers overlapping
procedure MoveSmall(Source, Dest: Pointer; Count: PtrUInt);
  {$ifdef HASINLINE}inline;{$endif}

/// our fast version of StrLen(), to be used with PWideChar
function StrLenW(S: PWideChar): PtrInt;

/// use our fast version of StrComp(), to be used with PWideChar
function StrCompW(Str1, Str2: PWideChar): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// use our fast version of StrCompL(), to be used with PUTF8Char
function StrCompL(P1,P2: PUTF8Char; L, Default: Integer): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// use our fast version of StrCompIL(), to be used with PUTF8Char
function StrCompIL(P1,P2: PUTF8Char; L: Integer; Default: Integer=0): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

{$ifdef USENORMTOUPPER}
{$ifdef OWNNORMTOUPPER}
type
  TNormTable = packed array[AnsiChar] of AnsiChar;
  PNormTable = ^TNormTable;
  TNormTableByte = packed array[byte] of byte;
  PNormTableByte = ^TNormTableByte;

var
  /// the NormToUpper[] array is defined in our Enhanced RTL: define it now
  //  if it was not installed
  // - handle 8 bit upper chars as in WinAnsi / code page 1252 (e.g. accents)
  NormToUpper: TNormTable;
  NormToUpperByte: TNormTableByte absolute NormToUpper;

  /// the NormToLower[] array is defined in our Enhanced RTL: define it now
  //  if it was not installed
  // - handle 8 bit upper chars as in WinAnsi / code page 1252 (e.g. accents)
  NormToLower: TNormTable;
  NormToLowerByte: TNormTableByte absolute NormToLower;
{$endif}
{$else}
{$undef OWNNORMTOUPPER}
{$endif}

var
  /// this table will convert 'a'..'z' into 'A'..'Z'
  // - so it will work with UTF-8 without decoding, whereas NormToUpper[] expects
  // WinAnsi encoding
  NormToUpperAnsi7: TNormTable;
  NormToUpperAnsi7Byte: TNormTableByte absolute NormToUpperAnsi7;
  /// case sensitive NormToUpper[]/NormToLower[]-like table
  // - i.e. NormToNorm[c] = c
  NormToNorm: TNormTable;
  NormToNormByte: TNormTableByte absolute NormToNorm;


/// get the signed 32-bit integer value stored in P^
// - we use the PtrInt result type, even if expected to be 32-bit, to use
// native CPU register size (don't want any 32-bit overflow here)
// - will end parsing when P^ does not contain any number (e.g. it reaches any
// ending #0 char)
function GetInteger(P: PUTF8Char): PtrInt; overload;

/// get the signed 32-bit integer value stored in P^..PEnd^
// - will end parsing when P^ does not contain any number (e.g. it reaches any
// ending #0 char), or when P reached PEnd (avoiding any buffer overflow)
function GetInteger(P,PEnd: PUTF8Char): PtrInt; overload;

/// get the signed 32-bit integer value stored in P^
// - if P if nil or not start with a valid numerical value, returns Default
function GetIntegerDef(P: PUTF8Char; Default: PtrInt): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// get the signed 32-bit integer value stored in P^
// - this version return 0 in err if no error occured, and 1 if an invalid
// character was found, not its exact index as for the val() function
function GetInteger(P: PUTF8Char; var err: integer): PtrInt; overload;

/// get the unsigned 32-bit integer value stored in P^
// - we use the PtrUInt result type, even if expected to be 32-bit, to use
// native CPU register size (don't want any 32-bit overflow here)
function GetCardinal(P: PUTF8Char): PtrUInt;

/// get the unsigned 32-bit integer value stored in P^
// - if P if nil or not start with a valid numerical value, returns Default
function GetCardinalDef(P: PUTF8Char; Default: PtrUInt): PtrUInt;

/// get the unsigned 32-bit integer value stored as Unicode string in P^
function GetCardinalW(P: PWideChar): PtrUInt;

/// get a boolean value stored as true/false text in P^
// - would also recognize any non 0 integer as true
function GetBoolean(P: PUTF8Char): boolean;

/// get the 64-bit integer value stored in P^
function GetInt64(P: PUTF8Char): Int64; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// get the 64-bit integer value stored in P^
// - if P if nil or not start with a valid numerical value, returns Default
function GetInt64Def(P: PUTF8Char; const Default: Int64): Int64;

/// get the 64-bit signed integer value stored in P^
procedure SetInt64(P: PUTF8Char; var result: Int64);
  {$ifdef CPU64}inline;{$endif}

/// get the 64-bit unsigned integer value stored in P^
procedure SetQWord(P: PUTF8Char; var result: QWord);
  {$ifdef CPU64}inline;{$endif}

/// get the 64-bit signed integer value stored in P^
// - set the err content to the index of any faulty character, 0 if conversion
// was successful (same as the standard val function)
function GetInt64(P: PUTF8Char; var err: integer): Int64; overload;
  {$ifdef CPU64}inline;{$endif}

/// get the 64-bit unsigned integer value stored in P^
// - set the err content to the index of any faulty character, 0 if conversion
// was successful (same as the standard val function)
function GetQWord(P: PUTF8Char; var err: integer): QWord;

/// get the extended floating point value stored in P^
// - set the err content to the index of any faulty character, 0 if conversion
// was successful (same as the standard val function)
function GetExtended(P: PUTF8Char; out err: integer): TSynExtended; overload;

/// get the extended floating point value stored in P^
// - this overloaded version returns 0 as a result if the content of P is invalid
function GetExtended(P: PUTF8Char): TSynExtended; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// copy a floating-point text buffer with proper correction and validation
// - will correct on the fly '.5' -> '0.5' and '-.5' -> '-0.5'
// - will end not only on #0 but on any char not matching 1[.2[e[-]3]] pattern
// - is used when the input comes from a third-party source with no regular
// output, e.g. a database driver, via TTextWriter.AddFloatStr
function FloatStrCopy(s, d: PUTF8Char): PUTF8Char;

/// get the WideChar stored in P^ (decode UTF-8 if necessary)
// - any surrogate (UCS4>$ffff) will be returned as '?'
function GetUTF8Char(P: PUTF8Char): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// get the UCS4 char stored in P^ (decode UTF-8 if necessary)
function NextUTF8UCS4(var P: PUTF8Char): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// get the signed 32-bit integer value stored in a RawUTF8 string
// - we use the PtrInt result type, even if expected to be 32-bit, to use
// native CPU register size (don't want any 32-bit overflow here)
function UTF8ToInteger(const value: RawUTF8; Default: PtrInt=0): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// get and check range of a signed 32-bit integer stored in a RawUTF8 string
// - we use the PtrInt result type, even if expected to be 32-bit, to use
// native CPU register size (don't want any 32-bit overflow here)
function UTF8ToInteger(const value: RawUTF8; Min,max: PtrInt; Default: PtrInt=0): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// get the signed 32-bit integer value stored in a RawUTF8 string
// - returns TRUE if the supplied text was successfully converted into an integer
function ToInteger(const text: RawUTF8; out value: integer): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// get the unsigned 32-bit cardinal value stored in a RawUTF8 string
// - returns TRUE if the supplied text was successfully converted into a cardinal
function ToCardinal(const text: RawUTF8; out value: cardinal; minimal: cardinal=0): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// get the signed 64-bit integer value stored in a RawUTF8 string
// - returns TRUE if the supplied text was successfully converted into an Int64
function ToInt64(const text: RawUTF8; out value: Int64): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// get a 64-bit floating-point value stored in a RawUTF8 string
// - returns TRUE if the supplied text was successfully converted into a double
function ToDouble(const text: RawUTF8; out value: double): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// get the signed 64-bit integer value stored in a RawUTF8 string
// - returns the default value if the supplied text was not successfully
// converted into an Int64
function UTF8ToInt64(const text: RawUTF8; const default: Int64=0): Int64;

/// encode a string to be compatible with URI encoding
function UrlEncode(const svar: RawUTF8): RawUTF8; overload;

/// encode a string to be compatible with URI encoding
function UrlEncode(Text: PUTF8Char): RawUTF8; overload;

/// encode supplied parameters to be compatible with URI encoding
// - parameters must be supplied two by two, as Name,Value pairs, e.g.
// ! url := UrlEncode(['select','*','where','ID=12','offset',23,'object',aObject]);
// - parameters names should be plain ASCII-7 RFC compatible identifiers
// (0..9a..zA..Z_.~), otherwise their values are skipped
// - parameters values can be either textual, integer or extended, or any TObject
// - TObject serialization into UTF-8 will be processed by the ObjectToJSON()
// function
function UrlEncode(const NameValuePairs: array of const): RawUTF8; overload;

/// encode a JSON object UTF-8 buffer into URI parameters
// - you can specify property names to ignore during the object decoding
// - you can omit the leading query delimiter ('?') by setting IncludeQueryDelimiter=false
// - warning: the ParametersJSON input buffer will be modified in-place
function UrlEncodeJsonObject(const URIName: RawUTF8; ParametersJSON: PUTF8Char;
  const PropNamesToIgnore: array of RawUTF8; IncludeQueryDelimiter: Boolean=true): RawUTF8; overload;

/// encode a JSON object UTF-8 buffer into URI parameters
// - you can specify property names to ignore during the object decoding
// - you can omit the leading query delimiter ('?') by setting IncludeQueryDelimiter=false
// - overloaded function which will make a copy of the input JSON before parsing
function UrlEncodeJsonObject(const URIName, ParametersJSON: RawUTF8;
  const PropNamesToIgnore: array of RawUTF8; IncludeQueryDelimiter: Boolean=true): RawUTF8; overload;

/// decode a string compatible with URI encoding into its original value
// - you can specify the decoding range (as in copy(s,i,len) function)
function UrlDecode(const s: RawUTF8; i: PtrInt=1; len: PtrInt=-1): RawUTF8; overload;

/// decode a string compatible with URI encoding into its original value
function UrlDecode(U: PUTF8Char): RawUTF8; overload;

/// decode a specified parameter compatible with URI encoding into its original
// textual value
// - UrlDecodeValue('select=%2A&where=LastName%3D%27M%C3%B4net%27','SELECT=',V,@Next)
// will return Next^='where=...' and V='*'
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeValue(U: PUTF8Char; const Upper: RawUTF8; var Value: RawUTF8;
  Next: PPUTF8Char=nil): boolean;

/// decode a specified parameter compatible with URI encoding into its original
// integer numerical value
// - UrlDecodeInteger('offset=20&where=LastName%3D%27M%C3%B4net%27','OFFSET=',O,@Next)
// will return Next^='where=...' and O=20
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeInteger(U: PUTF8Char; const Upper: RawUTF8; var Value: integer;
  Next: PPUTF8Char=nil): boolean;

/// decode a specified parameter compatible with URI encoding into its original
// cardinal numerical value
// - UrlDecodeCardinal('offset=20&where=LastName%3D%27M%C3%B4net%27','OFFSET=',O,@Next)
// will return Next^='where=...' and O=20
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeCardinal(U: PUTF8Char; const Upper: RawUTF8; var Value: Cardinal;
  Next: PPUTF8Char=nil): boolean;

/// decode a specified parameter compatible with URI encoding into its original
// Int64 numerical value
// - UrlDecodeInt64('offset=20&where=LastName%3D%27M%C3%B4net%27','OFFSET=',O,@Next)
// will return Next^='where=...' and O=20
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeInt64(U: PUTF8Char; const Upper: RawUTF8; var Value: Int64;
  Next: PPUTF8Char=nil): boolean;

/// decode a specified parameter compatible with URI encoding into its original
// floating-point value
// - UrlDecodeExtended('price=20.45&where=LastName%3D%27M%C3%B4net%27','PRICE=',P,@Next)
// will return Next^='where=...' and P=20.45
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeExtended(U: PUTF8Char; const Upper: RawUTF8; var Value: TSynExtended;
  Next: PPUTF8Char=nil): boolean;

/// decode a specified parameter compatible with URI encoding into its original
// floating-point value
// - UrlDecodeDouble('price=20.45&where=LastName%3D%27M%C3%B4net%27','PRICE=',P,@Next)
// will return Next^='where=...' and P=20.45
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeDouble(U: PUTF8Char; const Upper: RawUTF8; var Value: double;
  Next: PPUTF8Char=nil): boolean;

/// returns TRUE if all supplied parameters do exist in the URI encoded text
// - CSVNames parameter shall provide as a CSV list of names
// - e.g. UrlDecodeNeedParameters('price=20.45&where=LastName%3D','price,where')
// will return TRUE
function UrlDecodeNeedParameters(U, CSVNames: PUTF8Char): boolean;

/// decode the next Name=Value&.... pair from input URI
// - Name is returned directly (should be plain ASCII 7 bit text)
// - Value is returned after URI decoding (from %.. patterns)
// - if a pair is decoded, return a PUTF8Char pointer to the next pair in
// the input buffer, or points to #0 if all content has been processed
// - if a pair is not decoded, return nil
function UrlDecodeNextNameValue(U: PUTF8Char; var Name,Value: RawUTF8): PUTF8Char;

/// decode a URI-encoded Value from an input buffer
// - decoded value is set in Value out variable
// - returns a pointer just after the decoded value (may points e.g. to
// #0 or '&') - it is up to the caller to continue the process or not
function UrlDecodeNextValue(U: PUTF8Char; out Value: RawUTF8): PUTF8Char;

/// decode a URI-encoded Name from an input buffer
// - decoded value is set in Name out variable
// - returns a pointer just after the decoded name, after the '='
// - returns nil if there was no name=... pattern in U
function UrlDecodeNextName(U: PUTF8Char; out Name: RawUTF8): PUTF8Char;

/// checks if the supplied UTF-8 text don't need URI encoding
// - returns TRUE if all its chars are non-void plain ASCII-7 RFC compatible
// identifiers (0..9a..zA..Z-_.~)
function IsUrlValid(P: PUTF8Char): boolean;

/// checks if the supplied UTF-8 text values don't need URI encoding
// - returns TRUE if all its chars of all strings are non-void plain ASCII-7 RFC
// compatible identifiers (0..9a..zA..Z-_.~)
function AreUrlValid(const Url: array of RawUTF8): boolean;

/// ensure the supplied URI contains a trailing '/' charater
function IncludeTrailingURIDelimiter(const URI: RawByteString): RawByteString;

/// encode name/value pairs into CSV/INI raw format
function CSVEncode(const NameValuePairs: array of const;
  const KeySeparator: RawUTF8='='; const ValueSeparator: RawUTF8=#13#10): RawUTF8;

/// find a given name in name/value pairs, and returns the value as RawUTF8
function ArrayOfConstValueAsText(const NameValuePairs: array of const;
  const aName: RawUTF8): RawUTF8;

/// returns TRUE if the given text buffer contains a..z,A..Z,0..9,_ characters
// - should match most usual property names values or other identifier names
// in the business logic source code
// - i.e. can be tested via IdemPropName*() functions, and the MongoDB-like
// extended JSON syntax as generated by dvoSerializeAsExtendedJson
// - first char must be alphabetical or '_', following chars can be
// alphanumerical or '_'
function PropNameValid(P: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if the given text buffers contains A..Z,0..9,_ characters
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
// - this function won't check the first char the same way than PropNameValid()
function PropNamesValid(const Values: array of RawUTF8): boolean;

type
  /// kind of character used from JSON_CHARS[] for efficient JSON parsing
  TJsonChar = set of (jcJsonIdentifierFirstChar, jcJsonIdentifier,
    jcEndOfJSONField, jcEndOfJSONFieldOr0, jcEndOfJSONValueField,
    jcDigitChar, jcDigitFirstChar, jcDigitFloatChar);
  /// defines a branch-less table used for JSON parsing
  TJsonCharSet = array[AnsiChar] of TJsonChar;
  PJsonCharSet = ^TJsonCharSet;
var
  /// branch-less table used for JSON parsing
  JSON_CHARS: TJsonCharSet;

/// returns TRUE if the given text buffer contains simple characters as
// recognized by JSON extended syntax
// - follow GetJSONPropName and GotoNextJSONObjectOrArray expectations
function JsonPropNameValid(P: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if the given text buffers would be escaped when written as JSON
// - e.g. if contains " or \ characters, as defined by
// http://www.ietf.org/rfc/rfc4627.txt
function NeedsJsonEscape(const Text: RawUTF8): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if the given text buffers would be escaped when written as JSON
// - e.g. if contains " or \ characters, as defined by
// http://www.ietf.org/rfc/rfc4627.txt
function NeedsJsonEscape(P: PUTF8Char): boolean; overload;

/// returns TRUE if the given text buffers would be escaped when written as JSON
// - e.g. if contains " or \ characters, as defined by
// http://www.ietf.org/rfc/rfc4627.txt
function NeedsJsonEscape(P: PUTF8Char; PLen: integer): boolean; overload;

/// case insensitive comparison of ASCII identifiers
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
function IdemPropName(const P1,P2: shortstring): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// case insensitive comparison of ASCII identifiers
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
// - this version expects P2 to be a PAnsiChar with a specified length
function IdemPropName(const P1: shortstring; P2: PUTF8Char; P2Len: PtrInt): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// case insensitive comparison of ASCII identifiers
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
// - this version expects P1 and P2 to be a PAnsiChar with specified lengths
function IdemPropName(P1,P2: PUTF8Char; P1Len,P2Len: PtrInt): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// case insensitive comparison of ASCII identifiers
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
// - this version expects P2 to be a PAnsiChar with specified length
function IdemPropNameU(const P1: RawUTF8; P2: PUTF8Char; P2Len: PtrInt): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// case insensitive comparison of ASCII identifiers of same length
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
// - this version expects P1 and P2 to be a PAnsiChar with an already checked
// identical length, so may be used for a faster process, e.g. in a loop
// - if P1 and P2 are RawUTF8, you should better call overloaded function
// IdemPropNameU(const P1,P2: RawUTF8), which would be slightly faster by
// using the length stored before the actual text buffer of each RawUTF8
function IdemPropNameUSameLen(P1,P2: PUTF8Char; P1P2Len: PtrInt): boolean;
  {$ifndef ANDROID}{$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}{$endif}

/// case insensitive comparison of ASCII identifiers
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
function IdemPropNameU(const P1,P2: RawUTF8): boolean; overload;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// returns true if the beginning of p^ is the same as up^
// - ignore case - up^ must be already Upper
// - chars are compared as 7 bit Ansi only (no accentuated characters): but when
// you only need to search for field names e.g. IdemPChar() is prefered, because
// it'll be faster than IdemPCharU(), if UTF-8 decoding is not mandatory
// - if p is nil, will return FALSE
// - if up is nil, will return TRUE
function IdemPChar(p: PUTF8Char; up: PAnsiChar): boolean;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// returns true if the beginning of p^ is the same as up^, ignoring white spaces
// - ignore case - up^ must be already Upper
// - any white space in the input p^ buffer is just ignored
// - chars are compared as 7 bit Ansi only (no accentuated characters): but when
// you only need to search for field names e.g. IdemPChar() is prefered, because
// it'll be faster than IdemPCharU(), if UTF-8 decoding is not mandatory
// - if p is nil, will return FALSE
// - if up is nil, will return TRUE
function IdemPCharWithoutWhiteSpace(p: PUTF8Char; up: PAnsiChar): boolean;

/// returns the index of a matching beginning of p^ in upArray[]
// - returns -1 if no item matched
// - ignore case - upArray^ must be already Upper
// - chars are compared as 7 bit Ansi only (no accentuated characters)
// - warning: this function expects upArray[] items to have AT LEAST TWO
// CHARS (it will use a fast comparison of initial 2 bytes)
function IdemPCharArray(p: PUTF8Char; const upArray: array of PAnsiChar): integer; overload;

/// returns the index of a matching beginning of p^ in upArray two characters
// - returns -1 if no item matched
// - ignore case - upArray^ must be already Upper
// - chars are compared as 7 bit Ansi only (no accentuated characters)
function IdemPCharArray(p: PUTF8Char; const upArrayBy2Chars: RawUTF8): integer; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns true if the beginning of p^ is the same as up^
// - ignore case - up^ must be already Upper
// - this version will decode the UTF-8 content before using NormToUpper[], so
// it will be slower than the IdemPChar() function above, but will handle
// WinAnsi accentuated characters (e.g. 'e' acute will be matched as 'E')
function IdemPCharU(p, up: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// returns true if the beginning of p^ is same as up^
// - ignore case - up^ must be already Upper
// - this version expects p^ to point to an Unicode char array
function IdemPCharW(p: PWideChar; up: PUTF8Char): boolean;

/// check matching ending of p^ in upText
// - returns true if the item matched
// - ignore case - upText^ must be already Upper
// - chars are compared as 7 bit Ansi only (no accentuated characters)
function EndWith(const text, upText: RawUTF8): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// returns the index of a matching ending of p^ in upArray[]
// - returns -1 if no item matched
// - ignore case - upArray^ must be already Upper
// - chars are compared as 7 bit Ansi only (no accentuated characters)
function EndWithArray(const text: RawUTF8; const upArray: array of RawUTF8): integer;

/// returns true if the file name extension contained in p^ is the same same as extup^
// - ignore case - extup^ must be already Upper
// - chars are compared as WinAnsi (codepage 1252), not as UTF-8
// - could be used e.g. like IdemFileExt(aFileName,'.JP');
function IdemFileExt(p: PUTF8Char; extup: PAnsiChar; sepChar: AnsiChar='.'): Boolean;

/// returns matching file name extension index as extup^
// - ignore case - extup[] must be already Upper
// - chars are compared as WinAnsi (codepage 1252), not as UTF-8
// - could be used e.g. like IdemFileExts(aFileName,['.PAS','.INC']);
function IdemFileExts(p: PUTF8Char; const extup: array of PAnsiChar;
  sepChar: AnsiChar='.'): integer;

/// internal function, used to retrieve a UCS4 char (>127) from UTF-8
// - not to be called directly, but from inlined higher-level functions
// - here U^ shall be always >= #80
// - typical use is as such:
// !  ch := ord(P^);
// !  if ch and $80=0 then
// !    inc(P) else
// !    ch := GetHighUTF8UCS4(P);
function GetHighUTF8UCS4(var U: PUTF8Char): PtrUInt;

/// retrieve the next UCS4 value stored in U, then update the U pointer
// - this function will decode the UTF-8 content before using NormToUpper[]
// - will return '?' if the UCS4 value is higher than #255: so use this function
// only if you need to deal with ASCII characters (e.g. it's used for Soundex
// and for ContainsUTF8 function)
function GetNextUTF8Upper(var U: PUTF8Char): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// points to the beginning of the next word stored in U
// - returns nil if reached the end of U (i.e. #0 char)
// - here a "word" is a Win-Ansi word, i.e. '0'..'9', 'A'..'Z'
function FindNextUTF8WordBegin(U: PUTF8Char): PUTF8Char;

/// return true if up^ is contained inside the UTF-8 buffer p^
// - search up^ at the beginning of every UTF-8 word (aka in Soundex)
// - here a "word" is a Win-Ansi word, i.e. '0'..'9', 'A'..'Z'
// - up^ must be already Upper
function ContainsUTF8(p, up: PUTF8Char): boolean;

/// returns TRUE if the supplied uppercased text is contained in the text buffer
function GetLineContains(p,pEnd, up: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// copy source into a 256 chars dest^ buffer with 7 bits upper case conversion
// - used internally for short keys match or case-insensitive hash
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be defined e.g. as
// array[byte] of AnsiChar on the caller stack)
function UpperCopy255(dest: PAnsiChar; const source: RawUTF8): PAnsiChar; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// copy source^ into a 256 chars dest^ buffer with 7 bits upper case conversion
// - used internally for short keys match or case-insensitive hash
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be defined e.g. as
// array[byte] of AnsiChar on the caller stack)
// - won't use SSE4.2 instructions on supported CPUs by default, which may read
// some bytes beyond the s string, so should be avoided e.g. over memory mapped
// files - call explicitely UpperCopy255BufSSE42() if you are confident on your input
var UpperCopy255Buf: function(dest: PAnsiChar; source: PUTF8Char; sourceLen: PtrInt): PAnsiChar;

/// copy source^ into a 256 chars dest^ buffer with 7 bits upper case conversion
// - used internally for short keys match or case-insensitive hash
// - this version is written in optimized pascal
// - you should not have to call this function, but rely on UpperCopy255Buf()
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be defined e.g. as
// array[byte] of AnsiChar on the caller stack)
function UpperCopy255BufPas(dest: PAnsiChar; source: PUTF8Char; sourceLen: PtrInt): PAnsiChar;

{$ifndef PUREPASCAL}
{$ifndef DELPHI5OROLDER}
/// SSE 4.2 version of UpperCopy255Buf()
// - copy source^ into a 256 chars dest^ buffer with 7 bits upper case conversion
// - please note that this optimized version may read up to 15 bytes
// beyond the string; this is rarely a problem but it may generate protection
// violations, which could trigger fatal SIGABRT or SIGSEGV on Posix system
// - could be used instead of UpperCopy255Buf() when you are confident about your
// dest/source input buffers, checking if cfSSE42 in CpuFeatures
function UpperCopy255BufSSE42(dest: PAnsiChar; source: PUTF8Char; sourceLen: PtrInt): PAnsiChar;
{$endif DELPHI5OROLDER}
{$endif PUREPASCAL}

/// copy source into dest^ with WinAnsi 8 bits upper case conversion
// - used internally for short keys match or case-insensitive hash
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be array[byte] of
// AnsiChar)
function UpperCopyWin255(dest: PWinAnsiChar; const source: RawUTF8): PWinAnsiChar;

/// copy WideChar source into dest^ with upper case conversion
// - used internally for short keys match or case-insensitive hash
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be array[byte] of
// AnsiChar)
function UpperCopy255W(dest: PAnsiChar; const source: SynUnicode): PAnsiChar; overload;

/// copy WideChar source into dest^ with upper case conversion
// - used internally for short keys match or case-insensitive hash
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be array[byte] of
// AnsiChar)
function UpperCopy255W(dest: PAnsiChar; source: PWideChar; L: integer): PAnsiChar; overload;

/// copy source into dest^ with 7 bits upper case conversion
// - returns final dest pointer
// - will copy up to the source buffer end: so Dest^ should be big enough -
// which will the case e.g. if Dest := pointer(source)
function UpperCopy(dest: PAnsiChar; const source: RawUTF8): PAnsiChar;

/// copy source into dest^ with 7 bits upper case conversion
// - returns final dest pointer
// - this special version expect source to be a shortstring
function UpperCopyShort(dest: PAnsiChar; const source: shortstring): PAnsiChar;

{$ifdef USENORMTOUPPER}

/// fast UTF-8 comparison using the NormToUpper[] array for all 8 bits values
// - this version expects u1 and u2 to be zero-terminated
// - this version will decode each UTF-8 glyph before using NormToUpper[]
// - current implementation handles UTF-16 surrogates
function UTF8IComp(u1, u2: PUTF8Char): PtrInt;

/// copy WideChar source into dest^ with upper case conversion, using the
// NormToUpper[] array for all 8 bits values, encoding the result as UTF-8
// - returns final dest pointer
// - current implementation handles UTF-16 surrogates
function UTF8UpperCopy(Dest, Source: PUTF8Char; SourceChars: Cardinal): PUTF8Char;

/// copy WideChar source into dest^ with upper case conversion, using the
// NormToUpper[] array for all 8 bits values, encoding the result as UTF-8
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be array[byte] of
// AnsiChar), with UTF-8 encoding
function UTF8UpperCopy255(dest: PAnsiChar; const source: RawUTF8): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// fast UTF-8 comparison using the NormToUpper[] array for all 8 bits values
// - this version expects u1 and u2 not to be necessary zero-terminated, but
// uses L1 and L2 as length for u1 and u2 respectively
// - use this function for SQLite3 collation (TSQLCollateFunc)
// - this version will decode the UTF-8 content before using NormToUpper[]
// - current implementation handles UTF-16 surrogates
function UTF8ILComp(u1, u2: PUTF8Char; L1,L2: cardinal): PtrInt;

/// fast case-insensitive Unicode comparison
// - use the NormToUpperAnsi7Byte[] array, i.e. compare 'a'..'z' as 'A'..'Z'
// - this version expects u1 and u2 to be zero-terminated
function AnsiICompW(u1, u2: PWideChar): PtrInt;

/// SameText() overloaded function with proper UTF-8 decoding
// - fast version using NormToUpper[] array for all Win-Ansi characters
// - this version will decode each UTF-8 glyph before using NormToUpper[]
// - current implementation handles UTF-16 surrogates as UTF8IComp()
function SameTextU(const S1, S2: RawUTF8): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion of the supplied text into 8 bit uppercase
// - this will not only convert 'a'..'z' into 'A'..'Z', but also accentuated
// latin characters ('e' acute into 'E' e.g.), using NormToUpper[] array
// - it will therefore decode the supplied UTF-8 content to handle more than
// 7 bit of ascii characters (so this function is dedicated to WinAnsi code page
// 1252 characters set)
function UpperCaseU(const S: RawUTF8): RawUTF8;

/// fast conversion of the supplied text into 8 bit lowercase
// - this will not only convert 'A'..'Z' into 'a'..'z', but also accentuated
// latin characters ('E' acute into 'e' e.g.), using NormToLower[] array
// - it will therefore decode the supplied UTF-8 content to handle more than
// 7 bit of ascii characters
function LowerCaseU(const S: RawUTF8): RawUTF8;

/// fast conversion of the supplied text into 8 bit case sensitivity
// - convert the text in-place, returns the resulting length
// - it will decode the supplied UTF-8 content to handle more than 7 bit
// of ascii characters during the conversion (leaving not WinAnsi characters
// untouched)
// - will not set the last char to #0 (caller must do that if necessary)
function ConvertCaseUTF8(P: PUTF8Char; const Table: TNormTableByte): PtrInt;

{$endif USENORMTOUPPER}

/// check if the supplied text has some case-insentitive 'a'..'z','A'..'Z' chars
// - will therefore be correct with true UTF-8 content, but only for 7 bit
function IsCaseSensitive(const S: RawUTF8): boolean; overload;

/// check if the supplied text has some case-insentitive 'a'..'z','A'..'Z' chars
// - will therefore be correct with true UTF-8 content, but only for 7 bit
function IsCaseSensitive(P: PUTF8Char; PLen: PtrInt): boolean; overload;

/// fast conversion of the supplied text into uppercase
// - this will only convert 'a'..'z' into 'A'..'Z' (no NormToUpper use), and
// will therefore be correct with true UTF-8 content, but only for 7 bit
function UpperCase(const S: RawUTF8): RawUTF8;

/// fast conversion of the supplied text into uppercase
// - this will only convert 'a'..'z' into 'A'..'Z' (no NormToUpper use), and
// will therefore be correct with true UTF-8 content, but only for 7 bit
procedure UpperCaseCopy(Text: PUTF8Char; Len: PtrInt; var result: RawUTF8); overload;

/// fast conversion of the supplied text into uppercase
// - this will only convert 'a'..'z' into 'A'..'Z' (no NormToUpper use), and
// will therefore be correct with true UTF-8 content, but only for 7 bit
procedure UpperCaseCopy(const Source: RawUTF8; var Dest: RawUTF8); overload;

/// fast in-place conversion of the supplied variable text into uppercase
// - this will only convert 'a'..'z' into 'A'..'Z' (no NormToUpper use), and
// will therefore be correct with true UTF-8 content, but only for 7 bit
procedure UpperCaseSelf(var S: RawUTF8);

/// fast conversion of the supplied text into lowercase
// - this will only convert 'A'..'Z' into 'a'..'z' (no NormToLower use), and
// will therefore be correct with true UTF-8 content
function LowerCase(const S: RawUTF8): RawUTF8;

/// fast conversion of the supplied text into lowercase
// - this will only convert 'A'..'Z' into 'a'..'z' (no NormToLower use), and
// will therefore be correct with true UTF-8 content
procedure LowerCaseCopy(Text: PUTF8Char; Len: PtrInt; var result: RawUTF8);

/// fast in-place conversion of the supplied variable text into lowercase
// - this will only convert 'A'..'Z' into 'a'..'z' (no NormToLower use), and
// will therefore be correct with true UTF-8 content, but only for 7 bit
procedure LowerCaseSelf(var S: RawUTF8);

/// accurate conversion of the supplied UTF-8 content into the corresponding
// upper-case Unicode characters
// - this version will use the Operating System API, and will therefore be
// much slower than UpperCase/UpperCaseU versions, but will handle all
// kind of unicode characters
function UpperCaseUnicode(const S: RawUTF8): RawUTF8;

/// accurate conversion of the supplied UTF-8 content into the corresponding
// lower-case Unicode characters
// - this version will use the Operating System API, and will therefore be
// much slower than LowerCase/LowerCaseU versions, but will handle all
// kind of unicode characters
function LowerCaseUnicode(const S: RawUTF8): RawUTF8;

///  trims leading whitespace characters from the string by removing
// new line, space, and tab characters
function TrimLeft(const S: RawUTF8): RawUTF8;

/// trims trailing whitespace characters from the string by removing trailing
// newline, space, and tab characters
function TrimRight(const S: RawUTF8): RawUTF8;

/// single-allocation (therefore faster) alternative to Trim(copy())
procedure TrimCopy(const S: RawUTF8; start,count: PtrInt;
  var result: RawUTF8);

/// fast WinAnsi comparison using the NormToUpper[] array for all 8 bits values
function AnsiIComp(Str1, Str2: pointer): PtrInt;
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// extract a line from source array of chars
// - next will contain the beginning of next line, or nil if source if ended
function GetNextLine(source: PUTF8Char; out next: PUTF8Char; andtrim: boolean=false): RawUTF8;

{$ifdef UNICODE}
/// extract a line from source array of chars
// - next will contain the beginning of next line, or nil if source if ended
// - this special version expect UnicodeString pointers, and return an UnicodeString
function GetNextLineW(source: PWideChar; out next: PWideChar): string;

/// find the Value of UpperName in P, till end of current section
// - expect UpperName as 'NAME='
// - this special version expect UnicodeString pointer, and return a VCL string
function FindIniNameValueW(P: PWideChar; UpperName: PUTF8Char): string;

/// find a Name= Value in a [Section] of a INI Unicode Content
// - this function scans the Content memory buffer, and is
// therefore very fast (no temporary TMemIniFile is created)
// - if Section equals '', find the Name= value before any [Section]
function FindIniEntryW(const Content: string; const Section, Name: RawUTF8): string;
{$endif UNICODE}

{$ifdef PUREPASCAL}
{$ifdef HASINLINE}
function PosExPas(pSub, p: PUTF8Char; Offset: PtrUInt): PtrInt;
function PosEx(const SubStr, S: RawUTF8; Offset: PtrUInt=1): PtrInt; inline;
{$else}
var PosEx: function(const SubStr, S: RawUTF8; Offset: PtrUInt=1): PtrInt;
{$endif}
{$else}

/// faster RawUTF8 Equivalent of standard StrUtils.PosEx
function PosEx(const SubStr, S: RawUTF8; Offset: PtrUInt=1): integer;

{$endif PUREPASCAL}

/// our own PosEx() function dedicated to VCL string process
// - Delphi XE or older don't support Pos() with an Offset
var PosExString: function(const SubStr, S: string; Offset: PtrUInt=1): PtrInt;

/// optimized version of PosEx() with search text as one AnsiChar
function PosExChar(Chr: AnsiChar; const Str: RawUTF8): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// split a RawUTF8 string into two strings, according to SepStr separator
// - if SepStr is not found, LeftStr=Str and RightStr=''
// - if ToUpperCase is TRUE, then LeftStr and RightStr will be made uppercase
procedure Split(const Str, SepStr: RawUTF8; var LeftStr, RightStr: RawUTF8; ToUpperCase: boolean=false); overload;

/// split a RawUTF8 string into two strings, according to SepStr separator
// - this overloaded function returns the right string as function result
// - if SepStr is not found, LeftStr=Str and result=''
// - if ToUpperCase is TRUE, then LeftStr and result will be made uppercase
function Split(const Str, SepStr: RawUTF8; var LeftStr: RawUTF8; ToUpperCase: boolean=false): RawUTF8; overload;

/// returns the left part of a RawUTF8 string, according to SepStr separator
// - if SepStr is found, returns Str first chars until (and excluding) SepStr
// - if SepStr is not found, returns Str
function Split(const Str, SepStr: RawUTF8; StartPos: integer=1): RawUTF8; overload;

/// split a RawUTF8 string into several strings, according to SepStr separator
// - this overloaded function will fill a DestPtr[] array of PRawUTF8
// - if any DestPtr[]=nil, the item will be skipped
// - if input Str end before al SepStr[] are found, DestPtr[] is set to ''
// - returns the number of values extracted into DestPtr[]
function Split(const Str: RawUTF8; const SepStr: array of RawUTF8;
  const DestPtr: array of PRawUTF8): PtrInt; overload;

/// returns the last occurence of the given SepChar separated context
// - e.g. SplitRight('01/2/34','/')='34'
// - if SepChar doesn't appear, will return Str, e.g. SplitRight('123','/')='123'
// - if LeftStr is supplied, the RawUTF8 it points to will be filled with
// the left part just before SepChar ('' if SepChar doesn't appear)
function SplitRight(const Str: RawUTF8; SepChar: AnsiChar; LeftStr: PRawUTF8=nil): RawUTF8;

/// returns the last occurence of the given SepChar separated context
// - e.g. SplitRight('path/one\two/file.ext','/\')='file.ext', i.e.
// SepChars='/\' will be like ExtractFileName() over RawUTF8 string
// - if SepChar doesn't appear, will return Str, e.g. SplitRight('123','/')='123'
function SplitRights(const Str, SepChar: RawUTF8): RawUTF8;

/// actual replacement function called by StringReplaceAll() on first match
// - not to be called as such, but defined globally for proper inlining
function StringReplaceAllProcess(const S, OldPattern, NewPattern: RawUTF8;
  found: integer): RawUTF8;

/// fast version of StringReplace(S, OldPattern, NewPattern,[rfReplaceAll]);
function StringReplaceAll(const S, OldPattern, NewPattern: RawUTF8): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast version of several cascaded StringReplaceAll()
function StringReplaceAll(const S: RawUTF8; const OldNewPatternPairs: array of RawUTF8): RawUTF8; overload;

/// fast replace of a specified char by a given string
function StringReplaceChars(const Source: RawUTF8; OldChar, NewChar: AnsiChar): RawUTF8;

/// fast replace of all #9 chars by a given string
function StringReplaceTabs(const Source,TabText: RawUTF8): RawUTF8;

/// format a text content with SQL-like quotes
// - UTF-8 version of the function available in SysUtils
// - this function implements what is specified in the official SQLite3
// documentation: "A string constant is formed by enclosing the string in single
// quotes ('). A single quote within the string can be encoded by putting two
// single quotes in a row - as in Pascal."
function QuotedStr(const S: RawUTF8; Quote: AnsiChar=''''): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// format a text content with SQL-like quotes
// - UTF-8 version of the function available in SysUtils
// - this function implements what is specified in the official SQLite3
// documentation: "A string constant is formed by enclosing the string in single
// quotes ('). A single quote within the string can be encoded by putting two
// single quotes in a row - as in Pascal."
procedure QuotedStr(const S: RawUTF8; Quote: AnsiChar; var result: RawUTF8); overload;

/// convert UTF-8 content into a JSON string
// - with proper escaping of the content, and surounding " characters
procedure QuotedStrJSON(const aText: RawUTF8; var result: RawUTF8;
  const aPrefix: RawUTF8=''; const aSuffix: RawUTF8=''); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert UTF-8 buffer into a JSON string
// - with proper escaping of the content, and surounding " characters
procedure QuotedStrJSON(P: PUTF8Char; PLen: PtrInt; var result: RawUTF8;
  const aPrefix: RawUTF8=''; const aSuffix: RawUTF8=''); overload;

/// convert UTF-8 content into a JSON string
// - with proper escaping of the content, and surounding " characters
function QuotedStrJSON(const aText: RawUTF8): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// unquote a SQL-compatible string
// - the first character in P^ must be either ' or " then internal double quotes
// are transformed into single quotes
// - 'text '' end'   -> text ' end
// - "text "" end"   -> text " end
// - returns nil if P doesn't contain a valid SQL string
// - returns a pointer just after the quoted text otherwise
function UnQuoteSQLStringVar(P: PUTF8Char; out Value: RawUTF8): PUTF8Char;

/// unquote a SQL-compatible string
function UnQuoteSQLString(const Value: RawUTF8): RawUTF8;

/// unquote a SQL-compatible symbol name
// - e.g. '[symbol]' -> 'symbol' or '"symbol"' -> 'symbol'
function UnQuotedSQLSymbolName(const ExternalDBSymbol: RawUTF8): RawUTF8;

/// get the next character after a quoted buffer
// - the first character in P^ must be either ', either "
// - it will return the latest quote position, ignoring double quotes within
function GotoEndOfQuotedString(P: PUTF8Char): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// get the next character after a quoted buffer
// - the first character in P^ must be "
// - it will return the latest " position, ignoring \" within
function GotoEndOfJSONString(P: PUTF8Char): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// get the next character not in [#1..' ']
function GotoNextNotSpace(P: PUTF8Char): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// get the next character not in [#9,' ']
function GotoNextNotSpaceSameLine(P: PUTF8Char): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// get the next character in [#1..' ']
function GotoNextSpace(P: PUTF8Char): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// check if the next character not in [#1..' '] matchs a given value
// - first ignore any non space character
// - then returns TRUE if P^=ch, setting P to the character after ch
// - or returns FALSE if P^<>ch, leaving P at the level of the unexpected char
function NextNotSpaceCharIs(var P: PUTF8Char; ch: AnsiChar): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// go to the beginning of the SQL statement, ignoring all blanks and comments
// - used to check the SQL statement command (e.g. is it a SELECT?)
function SQLBegin(P: PUTF8Char): PUTF8Char;

/// add a condition to a SQL WHERE clause, with an ' and ' if where is not void
procedure SQLAddWhereAnd(var where: RawUTF8; const condition: RawUTF8);

/// return true if the parameter is void or begin with a 'SELECT' SQL statement
// - used to avoid code injection and to check if the cache must be flushed
// - VACUUM, PRAGMA, or EXPLAIN statements also return true, since they won't
// change the data content
// - WITH recursive statement expect no INSERT/UPDATE/DELETE pattern in the SQL
// - if P^ is a SELECT and SelectClause is set to a variable, it would
// contain the field names, from SELECT ...field names... FROM
function isSelect(P: PUTF8Char; SelectClause: PRawUTF8=nil): boolean;

/// return true if IdemPChar(source,searchUp), and go to the next line of source
function IdemPCharAndGetNextLine(var source: PUTF8Char; searchUp: PAnsiChar): boolean;

/// return true if IdemPChar(source,searchUp), and retrieve the value item
// - typical use may be:
// ! if IdemPCharAndGetNextItem(P,
// !   'CONTENT-DISPOSITION: FORM-DATA; NAME="',Name,'"') then ...
function IdemPCharAndGetNextItem(var source: PUTF8Char; const searchUp: RawUTF8;
  var Item: RawUTF8; Sep: AnsiChar=#13): boolean;

/// fast go to next text line, ended by #13 or #13#10
// - returns the beginning of next line, or nil if source^=#0 was reached
function GotoNextLine(source: PUTF8Char): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// compute the line length from a size-delimited source array of chars
// - will use fast assembly on x86-64 CPU, and expects TextEnd to be not nil
// - is likely to read some bytes after the TextEnd buffer, so GetLineSize()
// may be preferred, e.g. on memory mapped files
function BufferLineLength(Text, TextEnd: PUTF8Char): PtrInt;
  {$ifndef CPUX64}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// compute the line length from source array of chars
// - if PEnd = nil, end counting at either #0, #13 or #10
// - otherwise, end counting at either #13 or #10
// - just a wrapper around BufferLineLength() checking PEnd=nil case
function GetLineSize(P,PEnd: PUTF8Char): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// returns true if the line length from source array of chars is not less than
// the specified count
function GetLineSizeSmallerThan(P,PEnd: PUTF8Char; aMinimalCount: integer): boolean;

/// return next CSV string from P
// - P=nil after call when end of text is reached
function GetNextItem(var P: PUTF8Char; Sep: AnsiChar= ','): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return next CSV string from P
// - P=nil after call when end of text is reached
procedure GetNextItem(var P: PUTF8Char; Sep: AnsiChar; var result: RawUTF8); overload;

/// return next CSV string (unquoted if needed) from P
// - P=nil after call when end of text is reached
procedure GetNextItem(var P: PUTF8Char; Sep, Quote: AnsiChar; var result: RawUTF8); overload;

/// return trimmed next CSV string from P
// - P=nil after call when end of text is reached
procedure GetNextItemTrimed(var P: PUTF8Char; Sep: AnsiChar; var result: RawUTF8);

/// return next CRLF separated value string from P, ending #10 or #13#10 trimmed
// - any kind of line feed (CRLF or LF) will be handled, on all operating systems
// - as used e.g. by TSynNameValue.InitFromCSV and TDocVariantData.InitCSV
// - P=nil after call when end of text is reached
procedure GetNextItemTrimedCRLF(var P: PUTF8Char; var result: RawUTF8);

/// return next CSV string from P, nil if no more
// - this function returns the generic string type of the compiler, and
// therefore can be used with ready to be displayed text (e.g. for the VCL)
function GetNextItemString(var P: PChar; Sep: Char= ','): string;

/// return next string delimited with #13#10 from P, nil if no more
// - this function returns a RawUnicode string type
function GetNextStringLineToRawUnicode(var P: PChar): RawUnicode;

/// append some text lines with the supplied Values[]
// - if any Values[] item is '', no line is added
// - otherwise, appends 'Caption: Value', with Caption taken from CSV
procedure AppendCSVValues(const CSV: string; const Values: array of string;
  var Result: string; const AppendBefore: string=#13#10);

/// return a CSV list of the iterated same value
// - e.g. CSVOfValue('?',3)='?,?,?'
function CSVOfValue(const Value: RawUTF8; Count: cardinal; const Sep: RawUTF8=','): RawUTF8;

 /// retrieve the next CSV separated bit index
// - each bit was stored as BitIndex+1, i.e. 0 to mark end of CSV chunk
// - several bits set to one can be regrouped via 'first-last,' syntax
procedure SetBitCSV(var Bits; BitsCount: integer; var P: PUTF8Char);

/// convert a set of bit into a CSV content
// - each bit is stored as BitIndex+1, and separated by a ','
// - several bits set to one can be regrouped via 'first-last,' syntax
// - ',0' is always appended at the end of the CSV chunk to mark its end
function GetBitCSV(const Bits; BitsCount: integer): RawUTF8;

/// return next CSV string from P, nil if no more
// - output text would be trimmed from any left or right space
procedure GetNextItemShortString(var P: PUTF8Char; out Dest: ShortString; Sep: AnsiChar= ',');

/// decode next CSV hexadecimal string from P, nil if no more or not matching BinBytes
// - Bin is filled with 0 if the supplied CSV content is invalid
// - if Sep is #0, it will read the hexadecimal chars until a whitespace is reached
function GetNextItemHexDisplayToBin(var P: PUTF8Char; Bin: PByte; BinBytes: integer;
  Sep: AnsiChar= ','): boolean;


type
  /// some stack-allocated zero-terminated character buffer
  // - as used by GetNextTChar64
  TChar64 = array[0..63] of AnsiChar;

/// return next CSV string from P as a #0-ended buffer, false if no more
// - if Sep is #0, will copy all characters until next whitespace char
// - returns the number of bytes stored into Buf[]
function GetNextTChar64(var P: PUTF8Char; Sep: AnsiChar; out Buf: TChar64): PtrInt;

/// return next CSV string as unsigned integer from P, 0 if no more
// - if Sep is #0, it won't be searched for
function GetNextItemCardinal(var P: PUTF8Char; Sep: AnsiChar=','): PtrUInt;

/// return next CSV string as signed integer from P, 0 if no more
// - if Sep is #0, it won't be searched for
function GetNextItemInteger(var P: PUTF8Char; Sep: AnsiChar=','): PtrInt;

/// return next CSV string as 64-bit signed integer from P, 0 if no more
// - if Sep is #0, it won't be searched for
function GetNextItemInt64(var P: PUTF8Char; Sep: AnsiChar=','): Int64;

/// return next CSV string as 64-bit unsigned integer from P, 0 if no more
// - if Sep is #0, it won't be searched for
function GetNextItemQWord(var P: PUTF8Char; Sep: AnsiChar=','): QWord;

/// return next CSV hexadecimal string as 64-bit unsigned integer from P
// - returns 0 if no valid hexadecimal text is available in P
// - if Sep is #0, it won't be searched for
// - will first fill the 64-bit value with 0, then decode each two hexadecimal
// characters available in P
// - could be used to decode TTextWriter.AddBinToHexDisplayMinChars() output
function GetNextItemHexa(var P: PUTF8Char; Sep: AnsiChar=','): QWord;

/// return next CSV string as unsigned integer from P, 0 if no more
// - P^ will point to the first non digit character (the item separator, e.g.
// ',' for CSV)
function GetNextItemCardinalStrict(var P: PUTF8Char): PtrUInt;

/// return next CSV string as unsigned integer from P, 0 if no more
// - this version expects P^ to point to an Unicode char array
function GetNextItemCardinalW(var P: PWideChar; Sep: WideChar=','): PtrUInt;

/// return next CSV string as double from P, 0.0 if no more
// - if Sep is #0, will return all characters until next whitespace char
function GetNextItemDouble(var P: PUTF8Char; Sep: AnsiChar=','): double;

/// return next CSV string as currency from P, 0.0 if no more
// - if Sep is #0, will return all characters until next whitespace char
function GetNextItemCurrency(var P: PUTF8Char; Sep: AnsiChar=','): currency; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return next CSV string as currency from P, 0.0 if no more
// - if Sep is #0, will return all characters until next whitespace char
procedure GetNextItemCurrency(var P: PUTF8Char; out result: currency; Sep: AnsiChar=','); overload;

/// return n-th indexed CSV string in P, starting at Index=0 for first one
function GetCSVItem(P: PUTF8Char; Index: PtrUInt; Sep: AnsiChar=','): RawUTF8; overload;

/// return n-th indexed CSV string (unquoted if needed) in P, starting at Index=0 for first one
function GetUnQuoteCSVItem(P: PUTF8Char; Index: PtrUInt; Sep: AnsiChar=','; Quote: AnsiChar=''''): RawUTF8; overload;

/// return n-th indexed CSV string in P, starting at Index=0 for first one
// - this function return the generic string type of the compiler, and
// therefore can be used with ready to be displayed text (i.e. the VCL)
function GetCSVItemString(P: PChar; Index: PtrUInt; Sep: Char=','): string;

/// return last CSV string in the supplied UTF-8 content
function GetLastCSVItem(const CSV: RawUTF8; Sep: AnsiChar=','): RawUTF8;

/// return the index of a Value in a CSV string
// - start at Index=0 for first one
// - return -1 if specified Value was not found in CSV items
function FindCSVIndex(CSV: PUTF8Char; const Value: RawUTF8; Sep: AnsiChar = ',';
  CaseSensitive: boolean=true; TrimValue: boolean=false): integer;

/// add the strings in the specified CSV text into a dynamic array of UTF-8 strings
procedure CSVToRawUTF8DynArray(CSV: PUTF8Char; var Result: TRawUTF8DynArray;
  Sep: AnsiChar=','; TrimItems: boolean=false; AddVoidItems: boolean=false); overload;

/// add the strings in the specified CSV text into a dynamic array of UTF-8 strings
procedure CSVToRawUTF8DynArray(const CSV,Sep,SepEnd: RawUTF8; var Result: TRawUTF8DynArray); overload;

/// return the corresponding CSV text from a dynamic array of UTF-8 strings
function RawUTF8ArrayToCSV(const Values: array of RawUTF8; const Sep: RawUTF8= ','): RawUTF8;

/// return the corresponding CSV quoted text from a dynamic array of UTF-8 strings
// - apply QuoteStr() function to each Values[] item
function RawUTF8ArrayToQuotedCSV(const Values: array of RawUTF8; const Sep: RawUTF8=',';
  Quote: AnsiChar=''''): RawUTF8;

/// append some prefix to all CSV values
// ! AddPrefixToCSV('One,Two,Three','Pre')='PreOne,PreTwo,PreThree'
function AddPrefixToCSV(CSV: PUTF8Char; const Prefix: RawUTF8;
  Sep: AnsiChar = ','): RawUTF8;

/// append a Value to a CSV string
procedure AddToCSV(const Value: RawUTF8; var CSV: RawUTF8; const Sep: RawUTF8 = ',');
  {$ifdef HASINLINE}inline;{$endif}

/// change a Value within a CSV string
function RenameInCSV(const OldValue, NewValue: RawUTF8; var CSV: RawUTF8;
  const Sep: RawUTF8 = ','): boolean;

/// quick helper to initialize a dynamic array of RawUTF8 from some constants
// - can be used e.g. as:
// ! MyArray := TRawUTF8DynArrayFrom(['a','b','c']);
function TRawUTF8DynArrayFrom(const Values: array of RawUTF8): TRawUTF8DynArray;

/// check if the TypeInfo() points to an "array of RawUTF8"
// - e.g. returns true for TypeInfo(TRawUTF8DynArray) or other sub-types
// defined as "type aNewType = type TRawUTF8DynArray"
function IsRawUTF8DynArray(typeinfo: pointer): boolean;

/// append one or several values to a local "array of const" variable
procedure AddArrayOfConst(var Dest: TTVarRecDynArray; const Values: array of const);

/// low-level efficient search of Value in Values[]
// - CaseSensitive=false will use StrICmp() for A..Z / a..z equivalence
function FindRawUTF8(Values: PRawUTF8; const Value: RawUTF8; ValuesCount: integer;
  CaseSensitive: boolean): integer; overload;

/// return the index of Value in Values[], -1 if not found
// - CaseSensitive=false will use StrICmp() for A..Z / a..z equivalence
function FindRawUTF8(const Values: TRawUTF8DynArray; const Value: RawUTF8;
  CaseSensitive: boolean=true): integer; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return the index of Value in Values[], -1 if not found
// - CaseSensitive=false will use StrICmp() for A..Z / a..z equivalence
function FindRawUTF8(const Values: array of RawUTF8; const Value: RawUTF8;
  CaseSensitive: boolean=true): integer; overload;

/// return the index of Value in Values[], -1 if not found
// - here name search would use fast IdemPropNameU() function
function FindPropName(const Names: array of RawUTF8; const Name: RawUTF8): integer; overload;

/// return the index of Value in Values[] using IdemPropNameU(), -1 if not found
// - typical use with a dynamic array is like:
// ! index := FindPropName(pointer(aDynArray),length(aDynArray),aValue);
function FindPropName(Values: PRawUTF8; const Value: RawUTF8;
  ValuesCount: integer): integer; overload;

/// true if Value was added successfully in Values[]
function AddRawUTF8(var Values: TRawUTF8DynArray; const Value: RawUTF8;
  NoDuplicates: boolean=false; CaseSensitive: boolean=true): boolean; overload;

/// add the Value to Values[], with an external count variable, for performance
procedure AddRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  const Value: RawUTF8); overload;

/// true if both TRawUTF8DynArray are the same
// - comparison is case-sensitive
function RawUTF8DynArrayEquals(const A,B: TRawUTF8DynArray): boolean; overload;

/// true if both TRawUTF8DynArray are the same for a given number of items
// - A and B are expected to have at least Count items
// - comparison is case-sensitive
function RawUTF8DynArrayEquals(const A,B: TRawUTF8DynArray; Count: integer): boolean; overload;

/// convert the string dynamic array into a dynamic array of UTF-8 strings
procedure StringDynArrayToRawUTF8DynArray(const Source: TStringDynArray;
  var Result: TRawUTF8DynArray);

/// convert the string list into a dynamic array of UTF-8 strings
procedure StringListToRawUTF8DynArray(Source: TStringList; var Result: TRawUTF8DynArray);

/// search for a value from its uppercased named entry
// - i.e. iterate IdemPChar(source,UpperName) over every line of the source
// - returns the text just after UpperName if it has been found at line beginning
// - returns nil if UpperName was not found was not found at any line beginning
// - could be used as alternative to FindIniNameValue() and FindIniNameValueInteger()
// if there is no section, i.e. if search should not stop at '[' but at source end
function FindNameValue(P: PUTF8Char; UpperName: PAnsiChar): PUTF8Char; overload;

/// search and returns a value from its uppercased named entry
// - i.e. iterate IdemPChar(source,UpperName) over every line of the source
// - returns true and the trimmed text just after UpperName if it has been found
// at line beginning
// - returns false if UpperName was not found was not found at any line beginning
// - could be used e.g. to efficently extract a value from HTTP headers, whereas
// FindIniNameValue() is tuned for [section]-oriented INI files
function FindNameValue(const NameValuePairs: RawUTF8; UpperName: PAnsiChar;
  var Value: RawUTF8): boolean; overload;

/// find a Name= Value in a [Section] of a INI RawUTF8 Content
// - this function scans the Content memory buffer, and is
// therefore very fast (no temporary TMemIniFile is created)
// - if Section equals '', find the Name= value before any [Section]
function FindIniEntry(const Content, Section,Name: RawUTF8): RawUTF8;

/// find a Name= Value in a [Section] of a INI WinAnsi Content
// - same as FindIniEntry(), but the value is converted from WinAnsi into UTF-8
function FindWinAnsiIniEntry(const Content, Section,Name: RawUTF8): RawUTF8;

/// find a Name= numeric Value in a [Section] of a INI RawUTF8 Content and
// return it as an integer, or 0 if not found
// - this function scans the Content memory buffer, and is
// therefore very fast (no temporary TMemIniFile is created)
// - if Section equals '', find the Name= value before any [Section]
function FindIniEntryInteger(const Content, Section,Name: RawUTF8): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// find a Name= Value in a [Section] of a .INI file
// - if Section equals '', find the Name= value before any [Section]
// - use internaly fast FindIniEntry() function above
function FindIniEntryFile(const FileName: TFileName; const Section,Name: RawUTF8): RawUTF8;

/// update a Name= Value in a [Section] of a INI RawUTF8 Content
// - this function scans and update the Content memory buffer, and is
// therefore very fast (no temporary TMemIniFile is created)
// - if Section equals '', update the Name= value before any [Section]
procedure UpdateIniEntry(var Content: RawUTF8; const Section,Name,Value: RawUTF8);

/// update a Name= Value in a [Section] of a .INI file
// - if Section equals '', update the Name= value before any [Section]
// - use internaly fast UpdateIniEntry() function above
procedure UpdateIniEntryFile(const FileName: TFileName; const Section,Name,Value: RawUTF8);

/// find the position of the [SEARCH] section in source
// - return true if [SEARCH] was found, and store pointer to the line after it in source
function FindSectionFirstLine(var source: PUTF8Char; search: PAnsiChar): boolean;

/// find the position of the [SEARCH] section in source
// - return true if [SEARCH] was found, and store pointer to the line after it in source
// - this version expects source^ to point to an Unicode char array
function FindSectionFirstLineW(var source: PWideChar; search: PUTF8Char): boolean;

/// retrieve the whole content of a section as a string
// - SectionFirstLine may have been obtained by FindSectionFirstLine() function above
function GetSectionContent(SectionFirstLine: PUTF8Char): RawUTF8; overload;

/// retrieve the whole content of a section as a string
// - use SectionFirstLine() then previous GetSectionContent()
function GetSectionContent(const Content, SectionName: RawUTF8): RawUTF8; overload;

/// delete a whole [Section]
// - if EraseSectionHeader is TRUE (default), then the [Section] line is also
// deleted together with its content lines
// - return TRUE if something was changed in Content
// - return FALSE if [Section] doesn't exist or is already void
function DeleteSection(var Content: RawUTF8; const SectionName: RawUTF8;
  EraseSectionHeader: boolean=true): boolean; overload;

/// delete a whole [Section]
// - if EraseSectionHeader is TRUE (default), then the [Section] line is also
// deleted together with its content lines
// - return TRUE if something was changed in Content
// - return FALSE if [Section] doesn't exist or is already void
// - SectionFirstLine may have been obtained by FindSectionFirstLine() function above
function DeleteSection(SectionFirstLine: PUTF8Char; var Content: RawUTF8;
  EraseSectionHeader: boolean=true): boolean; overload;

/// replace a whole [Section] content by a new content
// - create a new [Section] if none was existing
procedure ReplaceSection(var Content: RawUTF8; const SectionName,
  NewSectionContent: RawUTF8); overload;

/// replace a whole [Section] content by a new content
// - create a new [Section] if none was existing
// - SectionFirstLine may have been obtained by FindSectionFirstLine() function above
procedure ReplaceSection(SectionFirstLine: PUTF8Char;
  var Content: RawUTF8; const NewSectionContent: RawUTF8); overload;

/// return TRUE if Value of UpperName does exist in P, till end of current section
// - expect UpperName as 'NAME='
function ExistsIniName(P: PUTF8Char; UpperName: PAnsiChar): boolean;

/// find the Value of UpperName in P, till end of current section
// - expect UpperName as 'NAME='
function FindIniNameValue(P: PUTF8Char; UpperName: PAnsiChar): RawUTF8;

/// return TRUE if one of the Value of UpperName exists in P, till end of
// current section
// - expect UpperName e.g. as 'CONTENT-TYPE: '
// - expect UpperValues to be any upper value with left side matching, e.g. as
// used by IsHTMLContentTypeTextual() function:
// ! result := ExistsIniNameValue(htmlHeaders,HEADER_CONTENT_TYPE_UPPER,
// !  ['TEXT/','APPLICATION/JSON','APPLICATION/XML']);
// - warning: this function calls IdemPCharArray(), so expects UpperValues[]
/// items to have AT LEAST TWO CHARS (it will use fast initial 2 bytes compare)
function ExistsIniNameValue(P: PUTF8Char; const UpperName: RawUTF8;
  const UpperValues: array of PAnsiChar): boolean;

/// find the integer Value of UpperName in P, till end of current section
// - expect UpperName as 'NAME='
// - return 0 if no NAME= entry was found
function FindIniNameValueInteger(P: PUTF8Char; UpperName: PAnsiChar): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// replace a value from a given set of name=value lines
// - expect UpperName as 'UPPERNAME=', otherwise returns false
// - if no UPPERNAME= entry was found, then Name+NewValue is added to Content
// - a typical use may be:
// ! UpdateIniNameValue(headers,HEADER_CONTENT_TYPE,HEADER_CONTENT_TYPE_UPPER,contenttype);
function UpdateIniNameValue(var Content: RawUTF8; const Name, UpperName, NewValue: RawUTF8): boolean;

/// read a File content into a String
// - content can be binary or text
// - returns '' if file was not found or any read error occured
// - wil use GetFileSize() API by default, unless HasNoSize is defined,
// and read will be done using a buffer (required e.g. for char files under Linux)
// - uses RawByteString for byte storage, whatever the codepage is
function StringFromFile(const FileName: TFileName; HasNoSize: boolean=false): RawByteString;

/// create a File from a string content
// - uses RawByteString for byte storage, whatever the codepage is
function FileFromString(const Content: RawByteString; const FileName: TFileName;
  FlushOnDisk: boolean=false; FileDate: TDateTime=0): boolean;

/// get text File contents (even Unicode or UTF8) and convert it into a
// Charset-compatible AnsiString (for Delphi 7) or an UnicodeString (for Delphi
// 2009 and up) according to any BOM marker at the beginning of the file
// - before Delphi 2009, the current string code page is used (i.e. CurrentAnsiConvert)
function AnyTextFileToString(const FileName: TFileName; ForceUTF8: boolean=false): string;

/// get text file contents (even Unicode or UTF8) and convert it into an
// Unicode string according to any BOM marker at the beginning of the file
// - any file without any BOM marker will be interpreted as plain ASCII: in this
// case, the current string code page is used (i.e. CurrentAnsiConvert class)
function AnyTextFileToSynUnicode(const FileName: TFileName; ForceUTF8: boolean=false): SynUnicode;

/// get text file contents (even Unicode or UTF8) and convert it into an
// UTF-8 string according to any BOM marker at the beginning of the file
// - if AssumeUTF8IfNoBOM is FALSE, the current string code page is used (i.e.
// CurrentAnsiConvert class) for conversion from ANSI into UTF-8
// - if AssumeUTF8IfNoBOM is TRUE, any file without any BOM marker will be
// interpreted as UTF-8
function AnyTextFileToRawUTF8(const FileName: TFileName; AssumeUTF8IfNoBOM: boolean=false): RawUTF8;

/// read a TStream content into a String
// - it will read binary or text content from the current position until the
// end (using TStream.Size)
// - uses RawByteString for byte storage, whatever the codepage is
function StreamToRawByteString(aStream: TStream): RawByteString;

/// create a TStream from a string content
// - uses RawByteString for byte storage, whatever the codepage is
// - in fact, the returned TStream is a TRawByteString instance, since this
// function is just a wrapper around:
// ! result := TRawByteStringStream.Create(aString);
function RawByteStringToStream(const aString: RawByteString): TStream;
  {$ifdef HASINLINE}inline;{$endif}

/// read an UTF-8 text from a TStream
// - format is Length(Integer):Text, i.e. the one used by WriteStringToStream
// - will return '' if there is no such text in the stream
// - you can set a MaxAllowedSize value, if you know how long the size should be
// - it will read from the current position in S: so if you just write into S,
// it could be a good idea to rewind it before call, e.g.:
// !  WriteStringToStream(Stream,aUTF8Text);
// !  Stream.Seek(0,soBeginning);
// !  str := ReadStringFromStream(Stream);
function ReadStringFromStream(S: TStream; MaxAllowedSize: integer=255): RawUTF8;

/// write an UTF-8 text into a TStream
// - format is Length(Integer):Text, i.e. the one used by ReadStringFromStream
function WriteStringToStream(S: TStream; const Text: RawUTF8): boolean;

/// get a file date and time, from its name
// - returns 0 if file doesn't exist
// - under Windows, will use GetFileAttributesEx fast API
function FileAgeToDateTime(const FileName: TFileName): TDateTime;

/// get a file size, from its name
// - returns 0 if file doesn't exist
// - under Windows, will use GetFileAttributesEx fast API
function FileSize(const FileName: TFileName): Int64; overload;

/// get a file size, from its handle
// - returns 0 if file doesn't exist
function FileSize(F: THandle): Int64; overload;

/// get low-level file information, in a cross-platform way
// - returns true on success
// - here file write/creation time are given as TUnixMSTime values, for better
// cross-platform process - note that FileCreateDateTime may not be supported
// by most Linux file systems, so the oldest timestamp available is returned
// as failover on such systems (probably the latest file metadata writing)
function FileInfoByHandle(aFileHandle: THandle; out FileId, FileSize,
  LastWriteAccess, FileCreateDateTime: Int64): Boolean;

/// get a file date and time, from a FindFirst/FindNext search
// - the returned timestamp is in local time, not UTC
// - this method would use the F.Timestamp field available since Delphi XE2
function SearchRecToDateTime(const F: TSearchRec): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// check if a FindFirst/FindNext found instance is actually a file
function SearchRecValidFile(const F: TSearchRec): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// check if a FindFirst/FindNext found instance is actually a folder
function SearchRecValidFolder(const F: TSearchRec): boolean;
  {$ifdef HASINLINE}inline;{$endif}

const
  /// operating-system dependent wildchar to match all files in a folder
  FILES_ALL = {$ifdef MSWINDOWS}'*.*'{$else}'*'{$endif};

/// delete the content of a specified directory
// - only one level of file is deleted within the folder: no recursive deletion
// is processed by this function (for safety)
// - if DeleteOnlyFilesNotDirectory is TRUE, it won't remove the folder itself,
// but just the files found in it
function DirectoryDelete(const Directory: TFileName; const Mask: TFileName=FILES_ALL;
  DeleteOnlyFilesNotDirectory: Boolean=false; DeletedCount: PInteger=nil): Boolean;

/// delete the files older than a given age in a specified directory
// - for instance, to delete all files older than one day:
// ! DirectoryDeleteOlderFiles(FolderName, 1);
// - only one level of file is deleted within the folder: no recursive deletion
// is processed by this function, unless Recursive is TRUE
// - if Recursive=true, caller should set TotalSize^=0 to have an accurate value
function DirectoryDeleteOlderFiles(const Directory: TFileName; TimePeriod: TDateTime;
   const Mask: TFileName=FILES_ALL; Recursive: Boolean=false; TotalSize: PInt64=nil): Boolean;

/// creates a directory if not already existing
// - returns the full expanded directory name, including trailing backslash
// - returns '' on error, unless RaiseExceptionOnCreationFailure=true
function EnsureDirectoryExists(const Directory: TFileName;
  RaiseExceptionOnCreationFailure: boolean=false): TFileName;

/// check if the directory is writable for the current user
// - try to write a small file with a random name
function IsDirectoryWritable(const Directory: TFileName): boolean;

/// compute an unique temporary file name
// - following 'exename_01234567.tmp' pattern, in the system temporary folder
function TemporaryFileName: TFileName;

type
  {$A-}
  /// file found result item, as returned by FindFiles()
  // - Delphi "object" is buggy on stack -> also defined as record with methods
  {$ifdef USERECORDWITHMETHODS}TFindFiles = record
    {$else}TFindFiles = object{$endif}
  public
    /// the matching file name, including its folder name
    Name: TFileName;
    /// the matching file attributes
    Attr: Integer;
    /// the matching file size
    Size: Int64;
    /// the matching file date/time
    Timestamp: TDateTime;
    /// fill the item properties from a FindFirst/FindNext's TSearchRec
    procedure FromSearchRec(const Directory: TFileName; const F: TSearchRec);
    /// returns some ready-to-be-loggued text
    function ToText: shortstring;
  end;
  {$A+}
  /// result list, as returned by FindFiles()
  TFindFilesDynArray = array of TFindFiles;

  /// a pointer to a TFileName variable
  PFileName = ^TFileName;

/// search for matching file names
// - just a wrapper around FindFirst/FindNext
// - you may specify several masks in Mask, e.g. as '*.jpg;*.jpeg'
function FindFiles(const Directory,Mask: TFileName;
  const IgnoreFileName: TFileName=''; SortByName: boolean=false;
  IncludesDir: boolean=true; SubFolder: Boolean=false): TFindFilesDynArray;

/// convert a result list, as returned by FindFiles(), into an array of Files[].Name
function FindFilesDynArrayToFileNames(const Files: TFindFilesDynArray): TFileNameDynArray;

/// ensure all files in Dest folder(s) do match the one in Reference
// - won't copy all files from Reference folders, but only update files already
// existing in Dest, which did change since last synchronization
// - will also process recursively nested folders if SubFolder is true
// - will use file content instead of file date check if ByContent is true
// - can optionally write the synched file name to the console
// - returns the number of files copied during the process
function SynchFolders(const Reference, Dest: TFileName; SubFolder: boolean=false;
  ByContent: boolean=false; WriteFileNameToConsole: boolean=false): integer;

{$ifdef DELPHI5OROLDER}

/// DirectoryExists returns a boolean value that indicates whether the
//  specified directory exists (and is actually a directory)
function DirectoryExists(const Directory: string): Boolean;

/// case-insensitive comparison of filenames
function SameFileName(const S1, S2: TFileName): Boolean;

/// retrieve the corresponding environment variable value
function GetEnvironmentVariable(const Name: string): string;

/// retrieve the full path name of the given execution module (e.g. library)
function GetModuleName(Module: HMODULE): TFileName;

/// try to encode a time
function TryEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;

/// alias to ExcludeTrailingBackslash() function
function ExcludeTrailingPathDelimiter(const FileName: TFileName): TFileName;

/// alias to IncludeTrailingBackslash() function
function IncludeTrailingPathDelimiter(const FileName: TFileName): TFileName;

type
  EOSError = class(Exception)
  public
    ErrorCode: DWORD;
  end;

/// raise an EOSError exception corresponding to the last error reported by Windows
procedure RaiseLastOSError;

{$endif DELPHI5OROLDER}

{$ifdef DELPHI6OROLDER}
procedure VarCastError;
{$endif}

/// compute the file name, including its path if supplied, but without its extension
// - e.g. GetFileNameWithoutExt('/var/toto.ext') = '/var/toto'
// - may optionally return the extracted extension, as '.ext'
function GetFileNameWithoutExt(const FileName: TFileName;
  Extension: PFileName=nil): TFileName;

/// extract a file extension from a file name, then compare with a comma
// separated list of extensions
// - e.g. GetFileNameExtIndex('test.log','exe,log,map')=1
// - will return -1 if no file extension match
// - will return any matching extension, starting count at 0
// - extension match is case-insensitive
function GetFileNameExtIndex(const FileName, CSVExt: TFileName): integer;

/// copy one file to another, similar to the Windows API
function CopyFile(const Source, Target: TFileName; FailIfExists: boolean): boolean;

/// copy the date of one file to another
function FileSetDateFrom(const Dest: TFileName; SourceHandle: integer): boolean;

/// retrieve a property value in a text-encoded class
// - follows the Delphi serialized text object format, not standard .ini
// - if the property is a string, the simple quotes ' are trimed
function FindObjectEntry(const Content, Name: RawUTF8): RawUTF8;

/// retrieve a filename property value in a text-encoded class
// - follows the Delphi serialized text object format, not standard .ini
// - if the property is a string, the simple quotes ' are trimed
// - any file path and any extension are trimmed
function FindObjectEntryWithoutExt(const Content, Name: RawUTF8): RawUTF8;


/// return true if UpperValue (Ansi) is contained in A^ (Ansi)
// - find UpperValue starting at word beginning, not inside words
function FindAnsi(A, UpperValue: PAnsiChar): boolean;

/// return true if UpperValue (Ansi) is contained in U^ (UTF-8 encoded)
// - find UpperValue starting at word beginning, not inside words
// - UTF-8 decoding is done on the fly (no temporary decoding buffer is used)
function FindUTF8(U: PUTF8Char; UpperValue: PAnsiChar): boolean;

/// return true if Upper (Unicode encoded) is contained in U^ (UTF-8 encoded)
// - will use the slow but accurate Operating System API to perform the
// comparison at Unicode-level
function FindUnicode(PW: PWideChar; Upper: PWideChar; UpperLen: PtrInt): boolean;

/// trim first lowercase chars ('otDone' will return 'Done' e.g.)
// - return a PUTF8Char to avoid any memory allocation
function TrimLeftLowerCase(const V: RawUTF8): PUTF8Char;

/// trim first lowercase chars ('otDone' will return 'Done' e.g.)
// - return an RawUTF8 string: enumeration names are pure 7bit ANSI with Delphi 7
// to 2007, and UTF-8 encoded with Delphi 2009+
function TrimLeftLowerCaseShort(V: PShortString): RawUTF8;

/// trim first lowercase chars ('otDone' will return 'Done' e.g.)
// - return a shortstring: enumeration names are pure 7bit ANSI with Delphi 7
// to 2007, and UTF-8 encoded with Delphi 2009+
function TrimLeftLowerCaseToShort(V: PShortString): ShortString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// trim first lowercase chars ('otDone' will return 'Done' e.g.)
// - return a shortstring: enumeration names are pure 7bit ANSI with Delphi 7
// to 2007, and UTF-8 encoded with Delphi 2009+
procedure TrimLeftLowerCaseToShort(V: PShortString; out result: ShortString); overload;

/// convert a CamelCase string into a space separated one
// - 'OnLine' will return 'On line' e.g., and 'OnMyLINE' will return 'On my LINE'
// - will handle capital words at the beginning, middle or end of the text, e.g.
// 'KLMFlightNumber' will return 'KLM flight number' and 'GoodBBCProgram' will
// return 'Good BBC program'
// - will handle a number at the beginning, middle or end of the text, e.g.
// 'Email12' will return 'Email 12'
// - '_' char is transformed into ' - '
// - '__' chars are transformed into ': '
// - return an RawUTF8 string: enumeration names are pure 7bit ANSI with Delphi 7
// to 2007, and UTF-8 encoded with Delphi 2009+
function UnCamelCase(const S: RawUTF8): RawUTF8; overload;

/// convert a CamelCase string into a space separated one
// - 'OnLine' will return 'On line' e.g., and 'OnMyLINE' will return 'On my LINE'
// - will handle capital words at the beginning, middle or end of the text, e.g.
// 'KLMFlightNumber' will return 'KLM flight number' and 'GoodBBCProgram' will
// return 'Good BBC program'
// - will handle a number at the beginning, middle or end of the text, e.g.
// 'Email12' will return 'Email 12'
// - return the char count written into D^
// - D^ and P^ are expected to be UTF-8 encoded: enumeration and property names
// are pure 7bit ANSI with Delphi 7 to 2007, and UTF-8 encoded with Delphi 2009+
// - '_' char is transformed into ' - '
// - '__' chars are transformed into ': '
function UnCamelCase(D, P: PUTF8Char): integer; overload;

/// convert a string into an human-friendly CamelCase identifier
// - replacing spaces or punctuations by an uppercase character
// - as such, it is not the reverse function to UnCamelCase()
procedure CamelCase(P: PAnsiChar; len: PtrInt; var s: RawUTF8;
  const isWord: TSynByteSet=[ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z')]); overload;

/// convert a string into an human-friendly CamelCase identifier
// - replacing spaces or punctuations by an uppercase character
// - as such, it is not the reverse function to UnCamelCase()
procedure CamelCase(const text: RawUTF8; var s: RawUTF8;
  const isWord: TSynByteSet=[ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z')]); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// UnCamelCase and translate a char buffer
// - P is expected to be #0 ended
// - return "string" type, i.e. UnicodeString for Delphi 2009+
procedure GetCaptionFromPCharLen(P: PUTF8Char; out result: string);

/// will get a class name as UTF-8
// - will trim 'T', 'TSyn', 'TSQL' or 'TSQLRecord' left side of the class name
// - will encode the class name as UTF-8 (for Unicode Delphi versions)
// - is used e.g. to extract the SQL table name for a TSQLRecord class
function GetDisplayNameFromClass(C: TClass): RawUTF8;

///  UnCamelCase and translate the class name, triming any left 'T', 'TSyn',
// 'TSQL' or 'TSQLRecord'
// - return generic VCL string type, i.e. UnicodeString for Delphi 2009+
function GetCaptionFromClass(C: TClass): string;

/// just a wrapper around vmtClassName to avoid a string conversion
function ClassNameShort(C: TClass): PShortString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// just a wrapper around vmtClassName to avoid a string conversion
function ClassNameShort(Instance: TObject): PShortString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// just a wrapper around vmtParent to avoid a function call
// - slightly faster than TClass.ClassParent thanks to proper inlining
function GetClassParent(C: TClass): TClass;
  {$ifdef HASINLINE}inline;{$endif}

/// just a wrapper around vmtClassName to avoid a string/RawUTF8 conversion
function ToText(C: TClass): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// just a wrapper around vmtClassName to avoid a string/RawUTF8 conversion
procedure ToText(C: TClass; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

type
  /// information about one method, as returned by GetPublishedMethods
  TPublishedMethodInfo = record
    /// the method name
    Name: RawUTF8;
    /// a callback to the method, for the given class instance
    Method: TMethod;
  end;
  /// information about all methods, as returned by GetPublishedMethods
  TPublishedMethodInfoDynArray = array of TPublishedMethodInfo;

/// retrieve published methods information about any class instance
// - will optionaly accept a Class, in this case Instance is ignored
// - will work with FPC and Delphi RTTI
function GetPublishedMethods(Instance: TObject; out Methods: TPublishedMethodInfoDynArray;
  aClass: TClass = nil): integer;

{$ifdef LINUX}
const
  ANSI_CHARSET = 0;
  DEFAULT_CHARSET = 1;
  SYMBOL_CHARSET = 2;
  SHIFTJIS_CHARSET = $80;
  HANGEUL_CHARSET = 129;
  GB2312_CHARSET = 134;
  CHINESEBIG5_CHARSET = 136;
  OEM_CHARSET = 255;
  JOHAB_CHARSET = 130;
  HEBREW_CHARSET = 177;
  ARABIC_CHARSET = 178;
  GREEK_CHARSET = 161;
  TURKISH_CHARSET = 162;
  VIETNAMESE_CHARSET = 163;
  THAI_CHARSET = 222;
  EASTEUROPE_CHARSET = 238;
  RUSSIAN_CHARSET = 204;
  BALTIC_CHARSET = 186;
{$else}
{$ifdef FPC}
const
  VIETNAMESE_CHARSET = 163;
{$endif}
{$endif}

/// convert a char set to a code page
function CharSetToCodePage(CharSet: integer): cardinal;

/// convert a code page to a char set
function CodePageToCharSet(CodePage: Cardinal): Integer;

/// retrieve the MIME content type from a supplied binary buffer
// - inspect the first bytes, to guess from standard known headers
// - return the MIME type, ready to be appended to a 'Content-Type: ' HTTP header
// - returns DefaultContentType if the binary buffer has an unknown layout
function GetMimeContentTypeFromBuffer(Content: Pointer; Len: PtrInt;
  const DefaultContentType: RawUTF8): RawUTF8;

/// retrieve the MIME content type from its file name or a supplied binary buffer
// - will first check for known file extensions, then inspect the binary content
// - return the MIME type, ready to be appended to a 'Content-Type: ' HTTP header
// - default is 'application/octet-stream' (BINARY_CONTENT_TYPE) or
// 'application/fileextension' if FileName was specified
// - see @http://en.wikipedia.org/wiki/Internet_media_type for most common values
function GetMimeContentType(Content: Pointer; Len: PtrInt;
   const FileName: TFileName=''): RawUTF8;

/// retrieve the HTTP header for MIME content type from a supplied binary buffer
// - just append HEADER_CONTENT_TYPE and GetMimeContentType() result
// - can be used as such:
// !  Call.OutHead := GetMimeContentTypeHeader(Call.OutBody,aFileName);
function GetMimeContentTypeHeader(const Content: RawByteString;
  const FileName: TFileName=''): RawUTF8;

/// retrieve if some content is compressed, from a supplied binary buffer
// - returns TRUE, if the header in binary buffer "may" be compressed (this method
// can trigger false positives), e.g. begin with most common already compressed
// zip/gz/gif/png/jpeg/avi/mp3/mp4 markers (aka "magic numbers")
function IsContentCompressed(Content: Pointer; Len: PtrInt): boolean;

/// returns TRUE if the supplied HTML Headers contains 'Content-Type: text/...',
// 'Content-Type: application/json' or 'Content-Type: application/xml'
function IsHTMLContentTypeTextual(Headers: PUTF8Char): Boolean;

/// fast guess of the size, in pixels, of a JPEG memory buffer
// - will only scan for basic JPEG structure, up to the StartOfFrame (SOF) chunk
// - returns TRUE if the buffer is likely to be a JPEG picture, and set the
// Height + Width variable with its dimensions - but there may be false positive
// recognition, and no waranty that the memory buffer holds a valid JPEG picture
// - returns FALSE if the buffer does not have any expected SOI/SOF markers
function GetJpegSize(jpeg: PAnsiChar; len: PtrInt; out Height, Width: integer): boolean; overload;

/// fast guess of the size, in pixels, of a JPEG file
// - will only scan for basic JPEG structure, up to the StartOfFrame (SOF) chunk
// - returns TRUE if the buffer is likely to be a JPEG picture, and set the
// Height + Width variable with its dimensions - but there may be false positive
// recognition, and no waranty that the file is a valid JPEG picture
// - returns FALSE if the file content does not have any expected SOI/SOF markers
function GetJpegSize(const jpeg: TFileName; out Height, Width: integer): boolean; overload;

type
  /// used by MultiPartFormDataDecode() to return one item of its data
  TMultiPart = record
    Name: RawUTF8;
    FileName: RawUTF8;
    ContentType: RawUTF8;
    Encoding: RawUTF8;
    Content: RawByteString;
  end;
  /// used by MultiPartFormDataDecode() to return all its data items
  TMultiPartDynArray = array of TMultiPart;

/// decode multipart/form-data POST request content
// - following RFC1867
function MultiPartFormDataDecode(const MimeType,Body: RawUTF8;
  var MultiPart: TMultiPartDynArray): boolean;

/// encode multipart fields and files
// - only one of them can be used because MultiPartFormDataDecode must implement
// both decodings
// - MultiPart: parts to build the multipart content from, which may be created
// using MultiPartFormDataAddFile/MultiPartFormDataAddField
// - MultiPartContentType: variable returning
// $ Content-Type: multipart/form-data; boundary=xxx
// where xxx is the first generated boundary
// - MultiPartContent: generated multipart content
function MultiPartFormDataEncode(const MultiPart: TMultiPartDynArray;
  var MultiPartContentType, MultiPartContent: RawUTF8): boolean;

/// encode a file in a multipart array
// - FileName: file to encode
// - Multipart: where the part is added
// - Name: name of the part, is empty the name 'File###' is generated
function MultiPartFormDataAddFile(const FileName: TFileName;
  var MultiPart: TMultiPartDynArray; const Name: RawUTF8 = ''): boolean;

/// encode a field in a multipart array
// - FieldName: field name of the part
// - FieldValue: value of the field
// - Multipart: where the part is added
function MultiPartFormDataAddField(const FieldName, FieldValue: RawUTF8;
  var MultiPart: TMultiPartDynArray): boolean;

/// retrieve the index where to insert a PUTF8Char in a sorted PUTF8Char array
// - R is the last index of available entries in P^ (i.e. Count-1)
// - string comparison is case-sensitive StrComp (so will work with any PAnsiChar)
// - returns -1 if the specified Value was found (i.e. adding will duplicate a value)
// - will use fast O(log(n)) binary search algorithm
function FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the index where to insert a PUTF8Char in a sorted PUTF8Char array
// - this overloaded function accept a custom comparison function for sorting
// - R is the last index of available entries in P^ (i.e. Count-1)
// - string comparison is case-sensitive (so will work with any PAnsiChar)
// - returns -1 if the specified Value was found (i.e. adding will duplicate a value)
// - will use fast O(log(n)) binary search algorithm
function FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char;
  Compare: TUTF8Compare): PtrInt; overload;

/// retrieve the index where is located a PUTF8Char in a sorted PUTF8Char array
// - R is the last index of available entries in P^ (i.e. Count-1)
// - string comparison is case-sensitive StrComp (so will work with any PAnsiChar)
// - returns -1 if the specified Value was not found
// - will use inlined binary search algorithm with optimized x86_64 branchless asm
// - slightly faster than plain FastFindPUTF8CharSorted(P,R,Value,@StrComp)
function FastFindPUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt; overload;

/// retrieve the index where is located a PUTF8Char in a sorted uppercase PUTF8Char array
// - P[] array is expected to be already uppercased
// - searched Value is converted to uppercase before search via UpperCopy255Buf(),
// so is expected to be short, i.e. length < 250
// - R is the last index of available entries in P^ (i.e. Count-1)
// - returns -1 if the specified Value was not found
// - will use fast O(log(n)) binary search algorithm
// - slightly faster than plain FastFindPUTF8CharSorted(P,R,Value,@StrIComp)
function FastFindUpperPUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt;
  Value: PUTF8Char; ValueLen: PtrInt): PtrInt;

/// retrieve the index where is located a PUTF8Char in a sorted PUTF8Char array
// - R is the last index of available entries in P^ (i.e. Count-1)
// - string comparison will use the specified Compare function
// - returns -1 if the specified Value was not found
// - will use fast O(log(n)) binary search algorithm
function FastFindPUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char;
  Compare: TUTF8Compare): PtrInt; overload;

/// retrieve the index of a PUTF8Char in a PUTF8Char array via a sort indexed
// - will use fast O(log(n)) binary search algorithm
function FastFindIndexedPUTF8Char(P: PPUTF8CharArray; R: PtrInt;
  var SortedIndexes: TCardinalDynArray; Value: PUTF8Char;
  ItemComp: TUTF8Compare): PtrInt;

/// add a RawUTF8 value in an alphaticaly sorted dynamic array of RawUTF8
// - returns the index where the Value was added successfully in Values[]
// - returns -1 if the specified Value was alredy present in Values[]
//  (we must avoid any duplicate for O(log(n)) binary search)
// - if CoValues is set, its content will be moved to allow inserting a new
// value at CoValues[result] position - a typical usage of CoValues is to store
// the corresponding ID to each RawUTF8 item
// - if FastLocatePUTF8CharSorted() has been already called, this index can
// be set to optional ForceIndex parameter
// - by default, exact (case-sensitive) match is used; you can specify a custom
// compare function if needed in Compare optional parameter
function AddSortedRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  const Value: RawUTF8; CoValues: PIntegerDynArray=nil; ForcedIndex: PtrInt=-1;
  Compare: TUTF8Compare=nil): PtrInt;

/// delete a RawUTF8 item in a dynamic array of RawUTF8
// - if CoValues is set, the integer item at the same index is also deleted
function DeleteRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  Index: integer; CoValues: PIntegerDynArray=nil): boolean; overload;

/// delete a RawUTF8 item in a dynamic array of RawUTF8;
function DeleteRawUTF8(var Values: TRawUTF8DynArray; Index: integer): boolean; overload;

/// sort a dynamic array of RawUTF8 items
// - if CoValues is set, the integer items are also synchronized
// - by default, exact (case-sensitive) match is used; you can specify a custom
// compare function if needed in Compare optional parameter
procedure QuickSortRawUTF8(var Values: TRawUTF8DynArray; ValuesCount: integer;
  CoValues: PIntegerDynArray=nil; Compare: TUTF8Compare=nil);

/// sort a dynamic array of PUTF8Char items, via an external array of indexes
// - you can use FastFindIndexedPUTF8Char() for fast O(log(n)) binary search
procedure QuickSortIndexedPUTF8Char(Values: PPUtf8CharArray; Count: Integer;
  var SortedIndexes: TCardinalDynArray; CaseSensitive: boolean=false);

/// fast search of an unsigned integer position in an integer array
// - Count is the number of cardinal entries in P^
// - returns P where P^=Value
// - returns nil if Value was not found
function IntegerScan(P: PCardinalArray; Count: PtrInt; Value: cardinal): PCardinal;

/// fast search of an unsigned integer position in an integer array
// - Count is the number of integer entries in P^
// - return index of P^[index]=Value
// - return -1 if Value was not found
function IntegerScanIndex(P: PCardinalArray; Count: PtrInt; Value: cardinal): PtrInt;

/// fast search of an integer position in a 64-bit integer array
// - Count is the number of Int64 entries in P^
// - returns P where P^=Value
// - returns nil if Value was not found
function Int64Scan(P: PInt64Array; Count: PtrInt; const Value: Int64): PInt64;

/// fast search of an integer position in a signed 64-bit integer array
// - Count is the number of Int64 entries in P^
// - returns index of P^[index]=Value
// - returns -1 if Value was not found
function Int64ScanIndex(P: PInt64Array; Count: PtrInt; const Value: Int64): PtrInt;

/// fast search of an integer position in an unsigned 64-bit integer array
// - Count is the number of QWord entries in P^
// - returns index of P^[index]=Value
// - returns -1 if Value was not found
function QWordScanIndex(P: PQWordArray; Count: PtrInt; const Value: QWord): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// fast search of an unsigned integer in an integer array
// - returns true if P^=Value within Count entries
// - returns false if Value was not found
function IntegerScanExists(P: PCardinalArray; Count: PtrInt; Value: cardinal): boolean;

/// fast search of an integer value in a 64-bit integer array
// - returns true if P^=Value within Count entries
// - returns false if Value was not found
function Int64ScanExists(P: PInt64Array; Count: PtrInt; const Value: Int64): boolean;

/// fast search of a pointer-sized unsigned integer position
// in an pointer-sized integer array
// - Count is the number of pointer-sized integer entries in P^
// - return index of P^[index]=Value
// - return -1 if Value was not found
function PtrUIntScanIndex(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// fast search of a pointer-sized unsigned integer in an pointer-sized integer array
// - Count is the number of pointer-sized integer entries in P^
// - returns true if P^=Value within Count entries
// - returns false if Value was not found
function PtrUIntScan(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): pointer;
  {$ifdef HASINLINE}inline;{$endif}

/// fast search of a pointer-sized unsigned integer position
// in an pointer-sized integer array
// - Count is the number of pointer-sized integer entries in P^
// - returns true if P^=Value within Count entries
// - returns false if Value was not found
function PtrUIntScanExists(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// fast search of an unsigned Byte value position in a Byte array
// - Count is the number of Byte entries in P^
// - return index of P^[index]=Value
// - return -1 if Value was not found
function ByteScanIndex(P: PByteArray; Count: PtrInt; Value: Byte): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// fast search of an unsigned Word value position in a Word array
// - Count is the number of Word entries in P^
// - return index of P^[index]=Value
// - return -1 if Value was not found
function WordScanIndex(P: PWordArray; Count: PtrInt; Value: word): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// fast search of a binary value position in a fixed-size array
// - Count is the number of entries in P^[]
// - return index of P^[index]=Elem^, comparing ElemSize bytes
// - return -1 if Value was not found
function AnyScanIndex(P,Elem: pointer; Count,ElemSize: PtrInt): PtrInt;

/// fast search of a binary value position in a fixed-size array
// - Count is the number of entries in P^[]
function AnyScanExists(P,Elem: pointer; Count,ElemSize: PtrInt): boolean;

/// sort an Integer array, low values first
procedure QuickSortInteger(ID: PIntegerArray; L, R: PtrInt); overload;

/// sort an Integer array, low values first
procedure QuickSortInteger(ID,CoValues: PIntegerArray; L, R: PtrInt); overload;

/// sort an Integer array, low values first
procedure QuickSortInteger(var ID: TIntegerDynArray); overload;

/// sort a 16 bit unsigned Integer array, low values first
procedure QuickSortWord(ID: PWordArray; L, R: PtrInt);

/// sort a 64-bit signed Integer array, low values first
procedure QuickSortInt64(ID: PInt64Array; L, R: PtrInt); overload;

/// sort a 64-bit unsigned Integer array, low values first
// - QWord comparison are implemented correctly under FPC or Delphi 2009+ -
// older compilers will use fast and exact SortDynArrayQWord()
procedure QuickSortQWord(ID: PQWordArray; L, R: PtrInt); overload;

/// sort a 64-bit Integer array, low values first
procedure QuickSortInt64(ID,CoValues: PInt64Array; L, R: PtrInt); overload;

type
  /// event handler called by NotifySortedIntegerChanges()
  // - Sender is an opaque const value, maybe a TObject or any pointer
  TOnNotifySortedIntegerChange = procedure(const Sender; Value: integer) of object;

/// compares two 32-bit signed sorted integer arrays, and call event handlers
// to notify the corresponding modifications in an O(n) time
// - items in both old[] and new[] arrays are required to be sorted
procedure NotifySortedIntegerChanges(old, new: PIntegerArray; oldn, newn: PtrInt;
  const added, deleted: TOnNotifySortedIntegerChange; const sender);

/// copy an integer array, then sort it, low values first
procedure CopyAndSortInteger(Values: PIntegerArray; ValuesCount: integer;
  var Dest: TIntegerDynArray);

/// copy an integer array, then sort it, low values first
procedure CopyAndSortInt64(Values: PInt64Array; ValuesCount: integer;
  var Dest: TInt64DynArray);

/// fast O(log(n)) binary search of an integer value in a sorted integer array
// - R is the last index of available integer entries in P^ (i.e. Count-1)
// - return index of P^[result]=Value
// - return -1 if Value was not found
function FastFindIntegerSorted(P: PIntegerArray; R: PtrInt; Value: integer): PtrInt; overload;

/// fast O(log(n)) binary search of an integer value in a sorted integer array
// - return index of Values[result]=Value
// - return -1 if Value was not found
function FastFindIntegerSorted(const Values: TIntegerDynArray; Value: integer): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast O(log(n)) binary search of a 16 bit unsigned integer value in a sorted array
function FastFindWordSorted(P: PWordArray; R: PtrInt; Value: Word): PtrInt;

/// fast O(log(n)) binary search of a 64-bit signed integer value in a sorted array
// - R is the last index of available integer entries in P^ (i.e. Count-1)
// - return index of P^[result]=Value
// - return -1 if Value was not found
function FastFindInt64Sorted(P: PInt64Array; R: PtrInt; const Value: Int64): PtrInt; overload;

/// fast O(log(n)) binary search of a 64-bit unsigned integer value in a sorted array
// - R is the last index of available integer entries in P^ (i.e. Count-1)
// - return index of P^[result]=Value
// - return -1 if Value was not found
// - QWord comparison are implemented correctly under FPC or Delphi 2009+ -
// older compilers will fast and exact SortDynArrayQWord()
function FastFindQWordSorted(P: PQWordArray; R: PtrInt; const Value: QWord): PtrInt; overload;

/// sort a PtrInt array, low values first
procedure QuickSortPtrInt(P: PPtrIntArray; L, R: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// fast O(log(n)) binary search of a PtrInt value in a sorted array
function FastFindPtrIntSorted(P: PPtrIntArray; R: PtrInt; Value: PtrInt): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// sort a pointer array, low values first
procedure QuickSortPointer(P: PPointerArray; L, R: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// fast O(log(n)) binary search of a Pointer value in a sorted array
function FastFindPointerSorted(P: PPointerArray; R: PtrInt; Value: Pointer): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the index where to insert an integer value in a sorted integer array
// - R is the last index of available integer entries in P^ (i.e. Count-1)
// - returns -1 if the specified Value was found (i.e. adding will duplicate a value)
function FastLocateIntegerSorted(P: PIntegerArray; R: PtrInt; Value: integer): PtrInt;

/// retrieve the index where to insert a word value in a sorted word array
// - R is the last index of available integer entries in P^ (i.e. Count-1)
// - returns -1 if the specified Value was found (i.e. adding will duplicate a value)
function FastLocateWordSorted(P: PWordArray; R: integer; Value: word): PtrInt;

/// add an integer value in a sorted dynamic array of integers
// - returns the index where the Value was added successfully in Values[]
// - returns -1 if the specified Value was already present in Values[]
//  (we must avoid any duplicate for O(log(n)) binary search)
// - if CoValues is set, its content will be moved to allow inserting a new
// value at CoValues[result] position
function AddSortedInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer; CoValues: PIntegerDynArray=nil): PtrInt; overload;

/// add an integer value in a sorted dynamic array of integers
// - overloaded function which do not expect an external Count variable
function AddSortedInteger(var Values: TIntegerDynArray;
  Value: integer; CoValues: PIntegerDynArray=nil): PtrInt; overload;

/// insert an integer value at the specified index position of a dynamic array
// of integers
// - if Index is invalid, the Value is inserted at the end of the array
function InsertInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: Integer; Index: PtrInt; CoValues: PIntegerDynArray=nil): PtrInt;

/// add an integer value at the end of a dynamic array of integers
// - returns TRUE if Value was added successfully in Values[], in this case
// length(Values) will be increased
function AddInteger(var Values: TIntegerDynArray; Value: integer;
  NoDuplicates: boolean=false): boolean; overload;

/// add an integer value at the end of a dynamic array of integers
// - this overloaded function will use a separate Count variable (faster)
// - it won't search for any existing duplicate
procedure AddInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// add an integer array at the end of a dynamic array of integer
function AddInteger(var Values: TIntegerDynArray; const Another: TIntegerDynArray): PtrInt; overload;

/// add an integer value at the end of a dynamic array of integers
// - this overloaded function will use a separate Count variable (faster),
// and would allow to search for duplicates
// - returns TRUE if Value was added successfully in Values[], in this case
// ValuesCount will be increased, but length(Values) would stay fixed most
// of the time (since it stores the Values[] array capacity)
function AddInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer; NoDuplicates: boolean): boolean; overload;

/// add a 16-bit integer value at the end of a dynamic array of integers
function AddWord(var Values: TWordDynArray; var ValuesCount: integer; Value: Word): PtrInt;

/// add a 64-bit integer value at the end of a dynamic array of integers
function AddInt64(var Values: TInt64DynArray; var ValuesCount: integer; Value: Int64): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// add a 64-bit integer value at the end of a dynamic array
function AddInt64(var Values: TInt64DynArray; Value: Int64): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// add a 64-bit integer array at the end of a dynamic array
function AddInt64(var Values: TInt64DynArray; const Another: TInt64DynArray): PtrInt; overload;

/// if not already existing, add a 64-bit integer value to a dynamic array
function AddInt64Once(var Values: TInt64DynArray; Value: Int64): PtrInt;

/// if not already existing, add a 64-bit integer value to a sorted dynamic array
procedure AddInt64Sorted(var Values: TInt64DynArray; Value: Int64);

/// delete any 32-bit integer in Values[]
procedure DeleteInteger(var Values: TIntegerDynArray; Index: PtrInt); overload;

/// delete any 32-bit integer in Values[]
procedure DeleteInteger(var Values: TIntegerDynArray; var ValuesCount: Integer; Index: PtrInt); overload;

/// remove some 32-bit integer from Values[]
// - Excluded is declared as var, since it will be sorted in-place during process
// if it contains more than ExcludedSortSize items (i.e. if the sort is worth it)
procedure ExcludeInteger(var Values, Excluded: TIntegerDynArray;
  ExcludedSortSize: Integer=32);

/// ensure some 32-bit integer from Values[] will only contain Included[]
// - Included is declared as var, since it will be sorted in-place during process
// if it contains more than IncludedSortSize items (i.e. if the sort is worth it)
procedure IncludeInteger(var Values, Included: TIntegerDynArray;
  IncludedSortSize: Integer=32);

/// sort and remove any 32-bit duplicated integer from Values[]
procedure DeduplicateInteger(var Values: TIntegerDynArray); overload;

/// sort and remove any 32-bit duplicated integer from Values[]
// - returns the new Values[] length
function DeduplicateInteger(var Values: TIntegerDynArray; Count: integer): integer; overload;

/// low-level function called by DeduplicateInteger()
function DeduplicateIntegerSorted(val: PIntegerArray; last: PtrInt): PtrInt;

/// create a new 32-bit integer dynamic array with the values from another one
procedure CopyInteger(const Source: TIntegerDynArray; out Dest: TIntegerDynArray);

/// delete any 16-bit integer in Values[]
procedure DeleteWord(var Values: TWordDynArray; Index: PtrInt);

/// delete any 64-bit integer in Values[]
procedure DeleteInt64(var Values: TInt64DynArray; Index: PtrInt); overload;

/// delete any 64-bit integer in Values[]
procedure DeleteInt64(var Values: TInt64DynArray; var ValuesCount: Integer; Index: PtrInt); overload;

/// remove some 64-bit integer from Values[]
// - Excluded is declared as var, since it will be sorted in-place during process
// if it contains more than ExcludedSortSize items (i.e. if the sort is worth it)
procedure ExcludeInt64(var Values, Excluded: TInt64DynArray;
  ExcludedSortSize: Integer=32);

/// ensure some 64-bit integer from Values[] will only contain Included[]
// - Included is declared as var, since it will be sorted in-place during process
// if it contains more than IncludedSortSize items (i.e. if the sort is worth it)
procedure IncludeInt64(var Values, Included: TInt64DynArray;
  IncludedSortSize: Integer=32);

/// sort and remove any 64-bit duplicated integer from Values[]
procedure DeduplicateInt64(var Values: TInt64DynArray); overload;

/// sort and remove any 64-bit duplicated integer from Values[]
// - returns the new Values[] length
function DeduplicateInt64(var Values: TInt64DynArray; Count: integer): integer; overload;

/// low-level function called by DeduplicateInt64()
// - warning: caller should ensure that last>0
function DeduplicateInt64Sorted(val: PInt64Array; last: PtrInt): PtrInt;

/// create a new 64-bit integer dynamic array with the values from another one
procedure CopyInt64(const Source: TInt64DynArray; out Dest: TInt64DynArray);

/// find the maximum 32-bit integer in Values[]
function MaxInteger(const Values: TIntegerDynArray; ValuesCount: PtrInt;
  MaxStart: integer=-1): Integer;

/// sum all 32-bit integers in Values[]
function SumInteger(const Values: TIntegerDynArray; ValuesCount: PtrInt): Integer;

/// fill already allocated Reversed[] so that Reversed[Values[i]]=i
procedure Reverse(const Values: TIntegerDynArray; ValuesCount: PtrInt;
  Reversed: PIntegerArray);

/// fill some values with i,i+1,i+2...i+Count-1
procedure FillIncreasing(Values: PIntegerArray; StartValue: integer; Count: PtrUInt);

/// copy some Int64 values into an unsigned integer array
procedure Int64ToUInt32(Values64: PInt64Array; Values32: PCardinalArray; Count: PtrInt);

/// append the strings in the specified CSV text into a dynamic array of integer
procedure CSVToIntegerDynArray(CSV: PUTF8Char; var Result: TIntegerDynArray;
  Sep: AnsiChar= ',');

/// append the strings in the specified CSV text into a dynamic array of integer
procedure CSVToInt64DynArray(CSV: PUTF8Char; var Result: TInt64DynArray;
  Sep: AnsiChar= ','); overload;

/// convert the strings in the specified CSV text into a dynamic array of integer
function CSVToInt64DynArray(CSV: PUTF8Char; Sep: AnsiChar= ','): TInt64DynArray; overload;

/// return the corresponding CSV text from a dynamic array of 32-bit integer
// - you can set some custom Prefix and Suffix text
function IntegerDynArrayToCSV(Values: PIntegerArray; ValuesCount: integer;
  const Prefix: RawUTF8=''; const Suffix: RawUTF8=''; InlinedValue: boolean=false): RawUTF8; overload;

/// return the corresponding CSV text from a dynamic array of 32-bit integer
// - you can set some custom Prefix and Suffix text
function IntegerDynArrayToCSV(const Values: TIntegerDynArray;
  const Prefix: RawUTF8=''; const Suffix: RawUTF8=''; InlinedValue: boolean=false): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return the corresponding CSV text from a dynamic array of 64-bit integers
// - you can set some custom Prefix and Suffix text
function Int64DynArrayToCSV(Values: PInt64Array; ValuesCount: integer;
  const Prefix: RawUTF8=''; const Suffix: RawUTF8=''; InlinedValue: boolean=false): RawUTF8; overload;

/// return the corresponding CSV text from a dynamic array of 64-bit integers
// - you can set some custom Prefix and Suffix text
function Int64DynArrayToCSV(const Values: TInt64DynArray;
  const Prefix: RawUTF8=''; const Suffix: RawUTF8=''; InlinedValue: boolean=false): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// quick helper to initialize a dynamic array of integer from some constants
// - can be used e.g. as:
// ! MyArray := TIntegerDynArrayFrom([1,2,3]);
// - see also FromI32()
function TIntegerDynArrayFrom(const Values: array of integer): TIntegerDynArray;

/// quick helper to initialize a dynamic array of integer from 64-bit integers
// - will raise a ESynException if any Value[] can not fit into 32-bit, unless
// raiseExceptionOnOverflow is FALSE and the returned array slot is filled
// with maxInt/minInt
function TIntegerDynArrayFrom64(const Values: TInt64DynArray;
  raiseExceptionOnOverflow: boolean=true): TIntegerDynArray;

/// quick helper to initialize a dynamic array of 64-bit integers from 32-bit values
// - see also FromI64() for 64-bit signed integer values input
function TInt64DynArrayFrom(const Values: TIntegerDynArray): TInt64DynArray;

/// quick helper to initialize a dynamic array of 64-bit integers from 32-bit values
// - see also FromU64() for 64-bit unsigned integer values input
function TQWordDynArrayFrom(const Values: TCardinalDynArray): TQWordDynArray;

/// initializes a dynamic array from a set of 32-bit integer signed values
function FromI32(const Values: array of integer): TIntegerDynArray;
  {$ifdef FPC}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// initializes a dynamic array from a set of 32-bit integer unsigned values
function FromU32(const Values: array of cardinal): TCardinalDynArray;
  {$ifdef FPC}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// initializes a dynamic array from a set of 64-bit integer signed values
function FromI64(const Values: array of Int64): TInt64DynArray;
  {$ifdef FPC}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// initializes a dynamic array from a set of 64-bit integer unsigned values
function FromU64(const Values: array of QWord): TQWordDynArray;
  {$ifdef FPC}{$ifdef HASINLINE}inline;{$endif}{$endif}

type
  /// used to store and retrieve Words in a sorted array
  // - Delphi "object" is buggy on stack -> also defined as record with methods
  {$ifdef USERECORDWITHMETHODS}TSortedWordArray = record
    {$else}TSortedWordArray = object{$endif}
  public
    /// the actual 16-bit word storage
    Values: TWordDynArray;
    /// how many items are currently in Values[]
    Count: PtrInt;
    /// add a value into the sorted array
    // - return the index of the new inserted value into the Values[] array
    // - return -(foundindex+1) if this value is already in the Values[] array
    function Add(aValue: Word): PtrInt;
    /// return the index if the supplied value in the Values[] array
    // - return -1 if not found
    function IndexOf(aValue: Word): PtrInt; {$ifdef HASINLINE}inline;{$endif}
  end;
  PSortedWordArray = ^TSortedWordArray;

  /// used to store and retrieve Integers in a sorted array
  // - Delphi "object" is buggy on stack -> also defined as record with methods
  {$ifdef USERECORDWITHMETHODS}TSortedIntegerArray = record
    {$else}TSortedIntegerArray = object{$endif}
  public
    /// the actual 32-bit integers storage
    Values: TIntegerDynArray;
    /// how many items are currently in Values[]
    Count: PtrInt;
    /// add a value into the sorted array
    // - return the index of the new inserted value into the Values[] array
    // - return -(foundindex+1) if this value is already in the Values[] array
    function Add(aValue: integer): PtrInt;
    /// return the index if the supplied value in the Values[] array
    // - return -1 if not found
    function IndexOf(aValue: integer): PtrInt; {$ifdef HASINLINE}inline;{$endif}
  end;
  PSortedIntegerArray = ^TSortedIntegerArray;

  /// comparison function as expected by MedianQuickSelect()
  // - should return TRUE if Values[IndexA]>Values[IndexB]
  TOnValueGreater = function(IndexA,IndexB: PtrInt): boolean of object;

/// compute the median of an integer serie of values, using "Quickselect"
// - based on the algorithm described in "Numerical recipes in C", Second Edition,
// translated from Nicolas Devillard's C code: http://ndevilla.free.fr/median/median
// - warning: the supplied Integer array is modified in-place during the process,
// and won't be fully sorted on output (this is no QuickSort alternative)
function MedianQuickSelectInteger(Values: PIntegerArray; n: integer): integer;

/// compute the median of a serie of values, using "Quickselect"
// - based on the algorithm described in "Numerical recipes in C", Second Edition
// - expect the values information to be available from a comparison callback
// - this version will use a temporary index list to exchange items order
// (supplied as a TSynTempBuffer), so won't change the supplied values themself
// - returns the index of the median Value
function MedianQuickSelect(const OnCompare: TOnValueGreater; n: integer;
  var TempBuffer: TSynTempBuffer): integer;

/// compute GCD of two integers using substraction-based Euclidean algorithm
function gcd(a, b: cardinal): cardinal;

/// performs a QuickSort using a comparison callback
procedure QuickSortCompare(const OnCompare: TOnValueGreater;
  Index: PIntegerArray; L,R: PtrInt);

/// convert a cardinal into a 32-bit variable-length integer buffer
function ToVarUInt32(Value: cardinal; Dest: PByte): PByte;

/// return the number of bytes necessary to store a 32-bit variable-length integer
// - i.e. the ToVarUInt32() buffer size
function ToVarUInt32Length(Value: PtrUInt): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// return the number of bytes necessary to store some data with a its
// 32-bit variable-length integer legnth
function ToVarUInt32LengthWithData(Value: PtrUInt): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an integer into a 32-bit variable-length integer buffer
// - store negative values as cardinal two-complement, i.e.
// 0=0,1=1,2=-1,3=2,4=-2...
function ToVarInt32(Value: PtrInt; Dest: PByte): PByte;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// convert a 32-bit variable-length integer buffer into a cardinal
// - fast inlined process for any number < 128
// - use overloaded FromVarUInt32() or FromVarUInt32Safe() with a SourceMax
// pointer to avoid any potential buffer overflow
function FromVarUInt32(var Source: PByte): cardinal; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// safely convert a 32-bit variable-length integer buffer into a cardinal
// - slower but safer process checking out of boundaries memory access in Source
// - SourceMax is expected to be not nil, and to point to the first byte
// just after the Source memory buffer
// - returns nil on error, or point to next input data on successful decoding
function FromVarUInt32Safe(Source, SourceMax: PByte; out Value: cardinal): PByte;

/// convert a 32-bit variable-length integer buffer into a cardinal
// - will call FromVarUInt32() if SourceMax=nil, or FromVarUInt32Safe() if set
// - returns false on error, true if Value has been set properly
function FromVarUInt32(var Source: PByte; SourceMax: PByte; out Value: cardinal): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a 32-bit variable-length integer buffer into a cardinal
// - this version could be called if number is likely to be > $7f, so it
// inlining the first byte won't make any benefit
function FromVarUInt32Big(var Source: PByte): cardinal;

/// convert a 32-bit variable-length integer buffer into a cardinal
// - used e.g. when inlining FromVarUInt32()
// - this version must be called if Source^ has already been checked to be > $7f
// ! result := Source^;
// ! inc(Source);
// ! if result>$7f then
// !   result := (result and $7F) or FromVarUInt32Up128(Source);
function FromVarUInt32Up128(var Source: PByte): cardinal;

/// convert a 32-bit variable-length integer buffer into a cardinal
// - this version must be called if Source^ has already been checked to be > $7f
function FromVarUInt32High(var Source: PByte): cardinal;

/// convert a 32-bit variable-length integer buffer into an integer
// - decode negative values from cardinal two-complement, i.e.
// 0=0,1=1,2=-1,3=2,4=-2...
function FromVarInt32(var Source: PByte): integer;

/// convert a UInt64 into a 64-bit variable-length integer buffer
function ToVarUInt64(Value: QWord; Dest: PByte): PByte;

/// convert a 64-bit variable-length integer buffer into a UInt64
function FromVarUInt64(var Source: PByte): QWord; overload;

/// safely convert a 64-bit variable-length integer buffer into a UInt64
// - slower but safer process checking out of boundaries memory access in Source
// - SourceMax is expected to be not nil, and to point to the first byte
// just after the Source memory buffer
// - returns nil on error, or point to next input data on successful decoding
function FromVarUInt64Safe(Source, SourceMax: PByte; out Value: QWord): PByte;

/// convert a 64-bit variable-length integer buffer into a UInt64
// - will call FromVarUInt64() if SourceMax=nil, or FromVarUInt64Safe() if set
// - returns false on error, true if Value has been set properly
function FromVarUInt64(var Source: PByte; SourceMax: PByte; out Value: Qword): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a Int64 into a 64-bit variable-length integer buffer
function ToVarInt64(Value: Int64; Dest: PByte): PByte; {$ifdef HASINLINE}inline;{$endif}

/// convert a 64-bit variable-length integer buffer into a Int64
function FromVarInt64(var Source: PByte): Int64;

/// convert a 64-bit variable-length integer buffer into a Int64
// - this version won't update the Source pointer
function FromVarInt64Value(Source: PByte): Int64;

/// jump a value in the 32-bit or 64-bit variable-length integer buffer
function GotoNextVarInt(Source: PByte): pointer; {$ifdef HASINLINE}inline;{$endif}

/// convert a RawUTF8 into an UTF-8 encoded variable-length buffer
function ToVarString(const Value: RawUTF8; Dest: PByte): PByte;

/// jump a value in variable-length text buffer
function GotoNextVarString(Source: PByte): pointer; {$ifdef HASINLINE}inline;{$endif}

/// retrieve a variable-length UTF-8 encoded text buffer in a newly allocation RawUTF8
function FromVarString(var Source: PByte): RawUTF8; overload;

/// safe retrieve a variable-length UTF-8 encoded text buffer in a newly allocation RawUTF8
// - supplied SourceMax value will avoid any potential buffer overflow
function FromVarString(var Source: PByte; SourceMax: PByte): RawUTF8; overload;

/// retrieve a variable-length text buffer
// - this overloaded function will set the supplied code page to the AnsiString
procedure FromVarString(var Source: PByte; var Value: RawByteString;
  CodePage: integer); overload;

/// retrieve a variable-length text buffer
// - this overloaded function will set the supplied code page to the AnsiString
// and will also check for the SourceMax end of buffer
// - returns TRUE on success, or FALSE on any buffer overload detection
function FromVarString(var Source: PByte; SourceMax: PByte;
  var Value: RawByteString; CodePage: integer): boolean; overload;

/// retrieve a variable-length UTF-8 encoded text buffer in a temporary buffer
// - caller should call Value.Done after use of the Value.buf memory
// - this overloaded function would include a trailing #0, so Value.buf could
// be parsed as a valid PUTF8Char buffer (e.g. containing JSON)
procedure FromVarString(var Source: PByte; var Value: TSynTempBuffer); overload;

/// retrieve a variable-length UTF-8 encoded text buffer in a temporary buffer
// - caller should call Value.Done after use of the Value.buf memory
// - this overloaded function will also check for the SourceMax end of buffer,
// returning TRUE on success, or FALSE on any buffer overload detection
function FromVarString(var Source: PByte; SourceMax: PByte;
  var Value: TSynTempBuffer): boolean; overload;

type
  /// kind of result returned by FromVarBlob() function
  TValueResult = record
    /// start of data value
    Ptr: PAnsiChar;
    /// value length (in bytes)
    Len: PtrInt;
  end;

/// retrieve pointer and length to a variable-length text/blob buffer
function FromVarBlob(Data: PByte): TValueResult; {$ifdef HASINLINE}inline;{$endif}



{ ************ low-level RTTI types and conversion routines ***************** }

type
  /// specify ordinal (tkInteger and tkEnumeration) storage size and sign
  // - note: Int64 is stored as its own TTypeKind, not as tkInteger
  TOrdType = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong
    {$ifdef FPC_NEWRTTI},otSQWord,otUQWord{$endif});

  /// specify floating point (ftFloat) storage size and precision
  // - here ftDouble is renamed ftDoub to avoid confusion with TSQLDBFieldType
  TFloatType = (ftSingle,ftDoub,ftExtended,ftComp,ftCurr);

{$ifdef FPC}
  /// available type families for FPC RTTI values
  // - values differs from Delphi, and are taken from FPC typinfo.pp unit
  // - here below, we defined tkLString instead of tkAString to match Delphi -
  // see https://lists.freepascal.org/pipermail/fpc-devel/2013-June/032360.html
  // "Compiler uses internally some LongStrings which is not possible to use
  // for variable declarations" so tkLStringOld seems never used in practice
  TTypeKind = (tkUnknown,tkInteger,tkChar,tkEnumeration,tkFloat,
    tkSet,tkMethod,tkSString,tkLStringOld{=tkLString},tkLString{=tkAString},
    tkWString,tkVariant,tkArray,tkRecord,tkInterface,
    tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord,
    tkDynArray,tkInterfaceRaw,tkProcVar,tkUString,tkUChar,
    tkHelper,tkFile,tkClassRef,tkPointer);

const
  /// potentially managed types in TTypeKind RTTI enumerate
  // - should match ManagedType*() functions
  tkManagedTypes = [tkLStringOld,tkLString,tkWstring,tkUstring,tkArray,
                    tkObject,tkRecord,tkDynArray,tkInterface,tkVariant];
  /// maps record or object in TTypeKind RTTI enumerate
  tkRecordTypes = [tkObject,tkRecord];
  /// maps record or object in TTypeKind RTTI enumerate
  tkRecordKinds = [tkObject,tkRecord];

type
  ///  TTypeKind RTTI enumerate as defined in Delphi 6 and up
  TDelphiTypeKind = (dkUnknown, dkInteger, dkChar, dkEnumeration, dkFloat,
    dkString, dkSet, dkClass, dkMethod, dkWChar, dkLString, dkWString,
    dkVariant, dkArray, dkRecord, dkInterface, dkInt64, dkDynArray,
    dkUString, dkClassRef, dkPointer, dkProcedure);

const
  /// convert FPC's TTypeKind to Delphi's RTTI enumerate
  // - used internally for cross-compiler TDynArray binary serialization
  FPCTODELPHI: array[TTypeKind] of TDelphiTypeKind = (
    dkUnknown,dkInteger,dkChar,dkEnumeration,dkFloat,
    dkSet,dkMethod,dkString,dkLString,dkLString,
    dkWString,dkVariant,dkArray,dkRecord,dkInterface,
    dkClass,dkRecord,dkWChar,dkEnumeration,dkInt64,dkInt64,
    dkDynArray,dkInterface,dkProcedure,dkUString,dkWChar,
    dkPointer,dkPointer,dkClassRef,dkPointer);

  /// convert Delphi's TTypeKind to FPC's RTTI enumerate
  DELPHITOFPC: array[TDelphiTypeKind] of TTypeKind = (
    tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
    tkSString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
    tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray,
    tkUString, tkClassRef, tkPointer, tkProcVar);

{$else}
  /// available type families for Delphi 6 and up, similar to typinfo.pas
  // - redefined here to be shared between SynCommons.pas and mORMot.pas,
  // also leveraging FPC compatibility as much as possible (FPC's typinfo.pp
  // is not convenient to share code with Delphi - see e.g. its tkLString)
  TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
    tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
    tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray
    {$ifdef UNICODE}, tkUString, tkClassRef, tkPointer, tkProcedure{$endif});

const
  /// maps record or object in TTypeKind RTTI enumerate
  tkRecordTypes = [tkRecord];
  /// maps record or object in TTypeKind RTTI enumerate
  tkRecordKinds = tkRecord;

{$endif FPC}

  /// maps long string in TTypeKind RTTI enumerate
  tkStringTypes =
    [tkLString, {$ifdef FPC}tkLStringOld,{$endif} tkWString
     {$ifdef HASVARUSTRING}, tkUString{$endif}];
  /// maps 1, 8, 16, 32 and 64-bit ordinal in TTypeKind RTTI enumerate
  tkOrdinalTypes =
    [tkInteger, tkChar, tkWChar, tkEnumeration, tkSet, tkInt64
     {$ifdef FPC},tkBool,tkQWord{$endif}];
  /// quick retrieve how many bytes an ordinal consist in
  ORDTYPE_SIZE: array[TOrdType] of byte =
    (1,1,2,2,4,4{$ifdef FPC_NEWRTTI},8,8{$endif});

type
  PTypeKind = ^TTypeKind;
  TTypeKinds = set of TTypeKind;
  POrdType = ^TOrdType;
  PFloatType = ^TFloatType;

function ToText(k: TTypeKind): PShortString; overload;

type
  /// function prototype to be used for TDynArray Sort and Find method
  // - common functions exist for base types: see e.g. SortDynArrayBoolean,
  // SortDynArrayByte, SortDynArrayWord, SortDynArrayInteger, SortDynArrayCardinal,
  // SortDynArrayInt64, SortDynArrayQWord, SordDynArraySingle, SortDynArrayDouble,
  // SortDynArrayAnsiString, SortDynArrayAnsiStringI, SortDynArrayUnicodeString,
  // SortDynArrayUnicodeStringI, SortDynArrayString, SortDynArrayStringI
  // - any custom type (even records) can be compared then sort by defining
  // such a custom function
  // - must return 0 if A=B, -1 if A<B, 1 if A>B
  TDynArraySortCompare = function(const A,B): integer;

  /// event oriented version of TDynArraySortCompare
  TEventDynArraySortCompare = function(const A,B): integer of object;

  /// optional event called by TDynArray.LoadFrom method after each item load
  // - could be used e.g. for string interning or some custom initialization process
  // - won't be called if the dynamic array has ElemType=nil
  TDynArrayAfterLoadFrom = procedure(var A) of object;

  /// internal enumeration used to specify some standard Delphi arrays
  // - will be used e.g. to match JSON serialization or TDynArray search
  // (see TDynArray and TDynArrayHash InitSpecific method)
  // - djBoolean would generate an array of JSON boolean values
  // - djByte .. djTimeLog match numerical JSON values
  // - djDateTime .. djHash512 match textual JSON values
  // - djVariant will match standard variant JSON serialization (including
  // TDocVariant or other custom types, if any)
  // - djCustom will be used for registered JSON serializer (invalid for
  // InitSpecific methods call)
  // - see also djPointer and djObject constant aliases for a pointer or
  // TObject field hashing / comparison
  // - is used also by TDynArray.InitSpecific() to define the main field type
  TDynArrayKind = (
    djNone,
    djBoolean, djByte, djWord, djInteger, djCardinal, djSingle,
    djInt64, djQWord, djDouble, djCurrency,  djTimeLog,
    djDateTime, djDateTimeMS, djRawUTF8, djWinAnsi, djString,
    djRawByteString, djWideString, djSynUnicode,
    djHash128, djHash256, djHash512,
    djInterface, {$ifndef NOVARIANTS}djVariant,{$endif}
    djCustom);

  /// internal set to specify some standard Delphi arrays
  TDynArrayKinds = set of TDynArrayKind;

  /// internal integer type used for string/dynarray header reference counters
  TRefCnt = {$ifdef FPC}SizeInt{$else}longint{$endif};
  /// internal pointer integer type used for string/dynarray header reference counters
  PRefCnt = ^TRefCnt;

  /// internal integer type used for string header length field
  TStrLen = {$ifdef FPC}SizeInt{$else}longint{$endif};
  /// internal pointer integer type used for string header length field
  PStrLen = ^TStrLen;

  /// internal pointer integer type used for dynamic array header length field
  PDALen = PPtrInt;

{$ifdef FPC}
  /// map the Delphi/FPC dynamic array header (stored before each instance)
  // - define globally for proper inlining with FPC
  // - match tdynarray type definition in dynarr.inc
  TDynArrayRec = {packed} record
    /// dynamic array reference count (basic memory management mechanism)
    refCnt: TRefCnt;
    /// equals length-1
    high: tdynarrayindex;
    function GetLength: sizeint; inline;
    procedure SetLength(len: sizeint); inline;
    property length: sizeint read GetLength write SetLength;
  end;
  PDynArrayRec = ^TDynArrayRec;
{$endif FPC}

const
  /// cross-compiler negative offset to TStrRec.length field
  // - to be used inlined e.g. as PStrLen(p-_STRLEN)^
  _STRLEN = SizeOf(TStrLen);
  /// cross-compiler negative offset to TStrRec.refCnt field
  // - to be used inlined e.g. as PRefCnt(p-_STRREFCNT)^
  _STRREFCNT = Sizeof(TRefCnt)+_STRLEN;

  /// cross-compiler negative offset to TDynArrayRec.high/length field
  // - to be used inlined e.g. as PDALen(PtrUInt(Values)-_DALEN)^{$ifdef FPC}+1{$endif}
  _DALEN = SizeOf(PtrInt);
  /// cross-compiler negative offset to TDynArrayRec.refCnt field
  // - to be used inlined e.g. as PRefCnt(PtrUInt(Values)-_DAREFCNT)^
  _DAREFCNT = Sizeof(TRefCnt)+_DALEN;

function ToText(k: TDynArrayKind): PShortString; overload;

{$ifndef NOVARIANTS}

type
  /// possible options for a TDocVariant JSON/BSON document storage
  // - dvoIsArray and dvoIsObject will store the "Kind: TDocVariantKind" state -
  // you should never have to define these two options directly
  // - dvoNameCaseSensitive will be used for every name lookup - here
  // case-insensitivity is restricted to a-z A-Z 0-9 and _ characters
  // - dvoCheckForDuplicatedNames will be used for method
  // TDocVariantData.AddValue(), but not when setting properties at
  // variant level: for consistency, "aVariant.AB := aValue" will replace
  // any previous value for the name "AB"
  // - dvoReturnNullForUnknownProperty will be used when retrieving any value
  // from its name (for dvObject kind of instance), or index (for dvArray or
  // dvObject kind of instance)
  // - by default, internal values will be copied by-value from one variant
  // instance to another, to ensure proper safety - but it may be too slow:
  // if you set dvoValueCopiedByReference, the internal
  // TDocVariantData.VValue/VName instances will be copied by-reference,
  // to avoid memory allocations, BUT it may break internal process if you change
  // some values in place (since VValue/VName and VCount won't match) - as such,
  // if you set this option, ensure that you use the content as read-only
  // - any registered custom types may have an extended JSON syntax (e.g.
  // TBSONVariant does for MongoDB types), and will be searched during JSON
  // parsing, unless dvoJSONParseDoNotTryCustomVariants is set (slightly faster)
  // - by default, it will only handle direct JSON [array] of {object}: but if
  // you define dvoJSONObjectParseWithinString, it will also try to un-escape
  // a JSON string first, i.e. handle "[array]" or "{object}" content (may be
  // used e.g. when JSON has been retrieved from a database TEXT column) - is
  // used for instance by VariantLoadJSON()
  // - JSON serialization will follow the standard layout, unless
  // dvoSerializeAsExtendedJson is set so that the property names would not
  // be escaped with double quotes, writing '{name:"John",age:123}' instead of
  // '{"name":"John","age":123}': this extended json layout is compatible with
  // http://docs.mongodb.org/manual/reference/mongodb-extended-json and with
  // TDocVariant JSON unserialization, also our SynCrossPlatformJSON unit, but
  // NOT recognized by most JSON clients, like AJAX/JavaScript or C#/Java
  // - by default, only integer/Int64/currency number values are allowed, unless
  // dvoAllowDoubleValue is set and 32-bit floating-point conversion is tried,
  // with potential loss of precision during the conversion
  // - dvoInternNames and dvoInternValues will use shared TRawUTF8Interning
  // instances to maintain a list of RawUTF8 names/values for all TDocVariant,
  // so that redundant text content will be allocated only once on heap
  TDocVariantOption =
    (dvoIsArray, dvoIsObject,
     dvoNameCaseSensitive, dvoCheckForDuplicatedNames,
     dvoReturnNullForUnknownProperty,
     dvoValueCopiedByReference, dvoJSONParseDoNotTryCustomVariants,
     dvoJSONObjectParseWithinString, dvoSerializeAsExtendedJson,
     dvoAllowDoubleValue, dvoInternNames, dvoInternValues);

  /// set of options for a TDocVariant storage
  // - you can use JSON_OPTIONS[true] if you want to create a fast by-reference
  // local document as with _ObjFast/_ArrFast/_JsonFast - i.e.
  // [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference]
  // - when specifying the options, you should not include dvoIsArray nor
  // dvoIsObject directly in the set, but explicitly define TDocVariantDataKind
  TDocVariantOptions = set of TDocVariantOption;

  /// pointer to a set of options for a TDocVariant storage
  // - you may use e.g. @JSON_OPTIONS[true], @JSON_OPTIONS[false],
  // @JSON_OPTIONS_FAST_STRICTJSON or @JSON_OPTIONS_FAST_EXTENDED
  PDocVariantOptions = ^TDocVariantOptions;

const
  /// some convenient TDocVariant options, as JSON_OPTIONS[CopiedByReference]
  // - JSON_OPTIONS[false] is e.g. _Json() and _JsonFmt() functions default
  // - JSON_OPTIONS[true] are used e.g. by _JsonFast() and _JsonFastFmt() functions
  JSON_OPTIONS: array[Boolean] of TDocVariantOptions = (
    [dvoReturnNullForUnknownProperty],
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference]);

  /// same as JSON_OPTIONS[true], but can not be used as PDocVariantOptions
  JSON_OPTIONS_FAST =
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference];

  /// TDocVariant options which may be used for plain JSON parsing
  // - this won't recognize any extended syntax
  JSON_OPTIONS_FAST_STRICTJSON: TDocVariantOptions =
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoJSONParseDoNotTryCustomVariants];

  /// TDocVariant options to be used for case-sensitive TSynNameValue-like
  // storage, with optional extended JSON syntax serialization
  // - consider using JSON_OPTIONS_FAST_EXTENDED for case-insensitive objects
  JSON_OPTIONS_NAMEVALUE: array[boolean] of TDocVariantOptions = (
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoNameCaseSensitive],
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoNameCaseSensitive,dvoSerializeAsExtendedJson]);

  /// TDocVariant options to be used for case-sensitive TSynNameValue-like
  // storage, RawUTF8 interning and optional extended JSON syntax serialization
  // - consider using JSON_OPTIONS_FAST_EXTENDED for case-insensitive objects,
  // or JSON_OPTIONS_NAMEVALUE[] if you don't expect names and values interning
  JSON_OPTIONS_NAMEVALUEINTERN: array[boolean] of TDocVariantOptions = (
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoNameCaseSensitive,dvoInternNames,dvoInternValues],
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoNameCaseSensitive,dvoInternNames,dvoInternValues,
     dvoSerializeAsExtendedJson]);

  /// TDocVariant options to be used so that JSON serialization would
  // use the unquoted JSON syntax for field names
  // - you could use it e.g. on a TSQLRecord variant published field to
  // reduce the JSON escape process during storage in the database, by
  // customizing your TSQLModel instance:
  // !  (aModel.Props[TSQLMyRecord]['VariantProp'] as TSQLPropInfoRTTIVariant).
  // !    DocVariantOptions := JSON_OPTIONS_FAST_EXTENDED;
  // or - in a cleaner way - by overriding TSQLRecord.InternalDefineModel():
  // ! class procedure TSQLMyRecord.InternalDefineModel(Props: TSQLRecordProperties);
  // ! begin
  // !   (Props.Fields.ByName('VariantProp') as TSQLPropInfoRTTIVariant).
  // !     DocVariantOptions := JSON_OPTIONS_FAST_EXTENDED;
  // ! end;
  // or to set all variant fields at once:
  // ! class procedure TSQLMyRecord.InternalDefineModel(Props: TSQLRecordProperties);
  // ! begin
  // !   Props.SetVariantFieldsDocVariantOptions(JSON_OPTIONS_FAST_EXTENDED);
  // ! end;
  // - consider using JSON_OPTIONS_NAMEVALUE[true] for case-sensitive
  // TSynNameValue-like storage, or JSON_OPTIONS_FAST_EXTENDEDINTERN if you
  // expect RawUTF8 names and values interning
  JSON_OPTIONS_FAST_EXTENDED: TDocVariantOptions =
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoSerializeAsExtendedJson];

  /// TDocVariant options for JSON serialization with efficient storage
  // - i.e. unquoted JSON syntax for field names and RawUTF8 interning
  // - may be used e.g. for efficient persistence of similar data
  // - consider using JSON_OPTIONS_FAST_EXTENDED if you don't expect
  // RawUTF8 names and values interning, or need BSON variants parsing
  JSON_OPTIONS_FAST_EXTENDEDINTERN: TDocVariantOptions =
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoSerializeAsExtendedJson,dvoJSONParseDoNotTryCustomVariants,
     dvoInternNames,dvoInternValues];

{$endif NOVARIANTS}

const
  /// TDynArrayKind alias for a pointer field hashing / comparison
  djPointer = {$ifdef CPU64}djInt64{$else}djCardinal{$endif};

  /// TDynArrayKind alias for a TObject field hashing / comparison
  djObject = djPointer;

type
  /// the available JSON format, for TTextWriter.AddJSONReformat() and its
  // JSONBufferReformat() and JSONReformat() wrappers
  // - jsonCompact is the default machine-friendly single-line layout
  // - jsonHumanReadable will add line feeds and indentation, for a more
  // human-friendly result
  // - jsonUnquotedPropName will emit the jsonHumanReadable layout, but
  // with all property names being quoted only if necessary: this format
  // could be used e.g. for configuration files - this format, similar to the
  // one used in the MongoDB extended syntax, is not JSON compatible: do not
  // use it e.g. with AJAX clients, but is would be handled as expected by all
  // our units as valid JSON input, without previous correction
  // - jsonUnquotedPropNameCompact will emit single-line layout with unquoted
  // property names
  TTextWriterJSONFormat = (
    jsonCompact, jsonHumanReadable,
    jsonUnquotedPropName, jsonUnquotedPropNameCompact);

  TDynArrayObjArray = (oaUnknown, oaFalse, oaTrue);

  /// a wrapper around a dynamic array with one dimension
  // - provide TList-like methods using fast RTTI information
  // - can be used to fast save/retrieve all memory content to a TStream
  // - note that the "const Elem" is not checked at compile time nor runtime:
  // you must ensure that Elem matchs the element type of the dynamic array
  // - can use external Count storage to make Add() and Delete() much faster
  // (avoid most reallocation of the memory buffer)
  // - Note that TDynArray is just a wrapper around an existing dynamic array:
  // methods can modify the content of the associated variable but the TDynArray
  // doesn't contain any data by itself. It is therefore aimed to initialize
  // a TDynArray wrapper on need, to access any existing dynamic array.
  // - is defined as an object or as a record, due to a bug
  // in Delphi 2009/2010 compiler (at least): this structure is not initialized
  // if defined as an object on the stack, but will be as a record :(
  {$ifdef UNDIRECTDYNARRAY}TDynArray = record
  {$else}TDynArray = object {$endif}
  private
    fValue: PPointer;
    fTypeInfo: pointer;
    fElemType{$ifdef DYNARRAYELEMTYPE2}, fElemType2{$endif}: pointer;
    fCountP: PInteger;
    fCompare: TDynArraySortCompare;
    fElemSize: cardinal;
    fKnownSize: integer;
    fParser: integer; // index to GlobalJSONCustomParsers.fParsers[]
    fSorted: boolean;
    fKnownType: TDynArrayKind;
    fIsObjArray: TDynArrayObjArray;
    function GetCount: PtrInt; {$ifdef HASINLINE}inline;{$endif}
    procedure SetCount(aCount: PtrInt);
    function GetCapacity: PtrInt; {$ifdef HASINLINE}inline;{$endif}
    procedure SetCapacity(aCapacity: PtrInt);
    procedure SetCompare(const aCompare: TDynArraySortCompare); {$ifdef HASINLINE}inline;{$endif}
    function FindIndex(const Elem; aIndex: PIntegerDynArray;
      aCompare: TDynArraySortCompare): PtrInt;
    function GetArrayTypeName: RawUTF8;
    function GetArrayTypeShort: PShortString;
    function GetIsObjArray: boolean; {$ifdef HASINLINE}inline;{$endif}
    function ComputeIsObjArray: boolean;
    procedure SetIsObjArray(aValue: boolean); {$ifdef HASINLINE}inline;{$endif}
    function LoadFromHeader(var Source: PByte; SourceMax: PByte): integer;
    function LoadKnownType(Data,Source,SourceMax: PAnsiChar): boolean;
    /// faster than RTL + handle T*ObjArray + ensure unique
    procedure InternalSetLength(OldLength,NewLength: PtrUInt);
  public
    /// initialize the wrapper with a one-dimension dynamic array
    // - the dynamic array must have been defined with its own type
    // (e.g. TIntegerDynArray = array of Integer)
    // - if aCountPointer is set, it will be used instead of length() to store
    // the dynamic array items count - it will be much faster when adding
    // elements to the array, because the dynamic array won't need to be
    // resized each time - but in this case, you should use the Count property
    // instead of length(array) or high(array) when accessing the data: in fact
    // length(array) will store the memory size reserved, not the items count
    // - if aCountPointer is set, its content will be set to 0, whatever the
    // array length is, or the current aCountPointer^ value is
    // - a sample usage may be:
    // !var DA: TDynArray;
    // !    A: TIntegerDynArray;
    // !begin
    // !  DA.Init(TypeInfo(TIntegerDynArray),A);
    // ! (...)
    // - a sample usage may be (using a count variable):
    // !var DA: TDynArray;
    // !    A: TIntegerDynArray;
    // !    ACount: integer;
    // !    i: integer;
    // !begin
    // !  DA.Init(TypeInfo(TIntegerDynArray),A,@ACount);
    // !  for i := 1 to 100000 do
    // !    DA.Add(i); // MUCH faster using the ACount variable
    // ! (...)   // now you should use DA.Count or Count instead of length(A)
    procedure Init(aTypeInfo: pointer; var aValue; aCountPointer: PInteger=nil);
    /// initialize the wrapper with a one-dimension dynamic array
    // - this version accepts to specify how comparison should occur, using
    // TDynArrayKind  kind of first field
    // - djNone and djCustom are too vague, and will raise an exception
    // - no RTTI check is made over the corresponding array layout: you shall
    // ensure that the aKind parameter matches the dynamic array element definition
    // - aCaseInsensitive will be used for djRawUTF8..djHash512 text comparison
    procedure InitSpecific(aTypeInfo: pointer; var aValue; aKind: TDynArrayKind;
      aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
    /// define the reference to an external count integer variable
    // - Init and InitSpecific methods will reset the aCountPointer to 0: you
    // can use this method to set the external count variable without overriding
    // the current value
    procedure UseExternalCount(var aCountPointer: Integer);
      {$ifdef HASINLINE}inline;{$endif}
    /// low-level computation of KnownType and KnownSize fields from RTTI
    // - do nothing if has already been set at initialization, or already computed
    function GuessKnownType(exactType: boolean=false): TDynArrayKind;
    /// check this dynamic array from the GlobalJSONCustomParsers list
    // - returns TRUE if this array has a custom JSON parser
    function HasCustomJSONParser: boolean;
    /// initialize the wrapper to point to no dynamic array
    procedure Void;
    /// check if the wrapper points to a dynamic array
    function IsVoid: boolean;
    /// add an element to the dynamic array
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Add(i+10) e.g.)
    // - returns the index of the added element in the dynamic array
    // - note that because of dynamic array internal memory managment, adding
    // may reallocate the list every time a record is added, unless an external
    // count variable has been specified in Init(...,@Count) method
    function Add(const Elem): PtrInt;
    /// add an element to the dynamic array
    // - this version add a void element to the array, and returns its index
    // - note: if you use this method to add a new item with a reference to the
    // dynamic array, using a local variable is needed under FPC:
    // !    i := DynArray.New;
    // !    with Values[i] do begin // otherwise Values is nil -> GPF
    // !      Field1 := 1;
    // !      ...
    function New: integer;
    /// add an element to the dynamic array at the position specified by Index
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Insert(10,i+10) e.g.)
    procedure Insert(Index: PtrInt; const Elem);
    /// get and remove the last element stored in the dynamic array
    // - Add + Pop/Peek will implement a LIFO (Last-In-First-Out) stack
    // - warning: Elem must be of the same exact type than the dynamic array
    // - returns true if the item was successfully copied and removed
    // - use Peek() if you don't want to remove the item
    function Pop(var Dest): boolean;
    /// get the last element stored in the dynamic array
    // - Add + Pop/Peek will implement a LIFO (Last-In-First-Out) stack
    // - warning: Elem must be of the same exact type than the dynamic array
    // - returns true if the item was successfully copied into Dest
    // - use Pop() if you also want to remove the item
    function Peek(var Dest): boolean;
    /// delete the whole dynamic array content
    // - this method will recognize T*ObjArray types and free all instances
    procedure Clear; {$ifdef HASINLINE}inline;{$endif}
    /// delete the whole dynamic array content, ignoring exceptions
    // - returns true if no exception occured when calling Clear, false otherwise
    // - you should better not call this method, which will catch and ignore
    // all exceptions - but it may somewhat make sense in a destructor
    // - this method will recognize T*ObjArray types and free all instances
    function ClearSafe: boolean;
    /// delete one item inside the dynamic array
    // - the deleted element is finalized if necessary
    // - this method will recognize T*ObjArray types and free all instances
    function Delete(aIndex: PtrInt): boolean;
    /// search for an element value inside the dynamic array
    // - return the index found (0..Count-1), or -1 if Elem was not found
    // - will search for all properties content of the eLement: TList.IndexOf()
    // searches by address, this method searches by content using the RTTI
    // element description (and not the Compare property function)
    // - use the Find() method if you want the search via the Compare property
    // function, or e.g. to search only with some part of the element content
    // - will work with simple types: binaries (byte, word, integer, Int64,
    // Currency, array[0..255] of byte, packed records with no reference-counted
    // type within...), string types (e.g. array of string), and packed records
    // with binary and string types within (like TFileVersion)
    // - won't work with not packed types (like a shorstring, or a record
    // with byte or word fields with {$A+}): in this case, the padding data
    // (i.e. the bytes between the aligned feeds can be filled as random, and
    // there is no way with standard RTTI do know which they are)
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write IndexOf(i+10) e.g.)
    function IndexOf(const Elem): PtrInt;
    /// search for an element value inside the dynamic array
    // - this method will use the Compare property function for the search
    // - return the index found (0..Count-1), or -1 if Elem was not found
    // - if the array is sorted, it will use fast O(log(n)) binary search
    // - if the array is not sorted, it will use slower O(n) iterating search
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Find(i+10) e.g.)
    function Find(const Elem): PtrInt; overload;
    /// search for an element value inside the dynamic array, from an external
    // indexed lookup table
    // - return the index found (0..Count-1), or -1 if Elem was not found
    // - this method will use a custom comparison function, with an external
    // integer table, as created by the CreateOrderedIndex() method: it allows
    // multiple search orders in the same dynamic array content
    // - if an indexed lookup is supplied, it must already be sorted:
    // this function will then use fast O(log(n)) binary search
    // - if an indexed lookup is not supplied (i.e aIndex=nil),
    // this function will use slower but accurate O(n) iterating search
    // - warning; the lookup index should be synchronized if array content
    // is modified (in case of adding or deletion)
    function Find(const Elem; const aIndex: TIntegerDynArray;
      aCompare: TDynArraySortCompare): PtrInt; overload;
    /// search for an element value, then fill all properties if match
    // - this method will use the Compare property function for the search,
    // or the supplied indexed lookup table and its associated compare function
    // - if Elem content matches, all Elem fields will be filled with the record
    // - can be used e.g. as a simple dictionary: if Compare will match e.g. the
    // first string field (i.e. set to SortDynArrayString), you can fill the
    // first string field with the searched value (if returned index is >= 0)
    // - return the index found (0..Count-1), or -1 if Elem was not found
    // - if the array is sorted, it will use fast O(log(n)) binary search
    // - if the array is not sorted, it will use slower O(n) iterating search
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Find(i+10) e.g.)
    function FindAndFill(var Elem; aIndex: PIntegerDynArray=nil;
      aCompare: TDynArraySortCompare=nil): integer;
    /// search for an element value, then delete it if match
    // - this method will use the Compare property function for the search,
    // or the supplied indexed lookup table and its associated compare function
    // - if Elem content matches, this item will be deleted from the array
    // - can be used e.g. as a simple dictionary: if Compare will match e.g. the
    // first string field (i.e. set to SortDynArrayString), you can fill the
    // first string field with the searched value (if returned index is >= 0)
    // - return the index deleted (0..Count-1), or -1 if Elem was not found
    // - if the array is sorted, it will use fast O(log(n)) binary search
    // - if the array is not sorted, it will use slower O(n) iterating search
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Find(i+10) e.g.)
    function FindAndDelete(const Elem; aIndex: PIntegerDynArray=nil;
      aCompare: TDynArraySortCompare=nil): integer;
    /// search for an element value, then update the item if match
    // - this method will use the Compare property function for the search,
    // or the supplied indexed lookup table and its associated compare function
    // - if Elem content matches, this item will be updated with the supplied value
    // - can be used e.g. as a simple dictionary: if Compare will match e.g. the
    // first string field (i.e. set to SortDynArrayString), you can fill the
    // first string field with the searched value (if returned index is >= 0)
    // - return the index found (0..Count-1), or -1 if Elem was not found
    // - if the array is sorted, it will use fast O(log(n)) binary search
    // - if the array is not sorted, it will use slower O(n) iterating search
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Find(i+10) e.g.)
    function FindAndUpdate(const Elem; aIndex: PIntegerDynArray=nil;
      aCompare: TDynArraySortCompare=nil): integer;
    /// search for an element value, then add it if none matched
    // - this method will use the Compare property function for the search,
    // or the supplied indexed lookup table and its associated compare function
    // - if no Elem content matches, the item will added to the array
    // - can be used e.g. as a simple dictionary: if Compare will match e.g. the
    // first string field (i.e. set to SortDynArrayString), you can fill the
    // first string field with the searched value (if returned index is >= 0)
    // - return the index found (0..Count-1), or -1 if Elem was not found and
    // the supplied element has been succesfully added
    // - if the array is sorted, it will use fast O(log(n)) binary search
    // - if the array is not sorted, it will use slower O(n) iterating search
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Find(i+10) e.g.)
    function FindAndAddIfNotExisting(const Elem; aIndex: PIntegerDynArray=nil;
      aCompare: TDynArraySortCompare=nil): integer;
    /// sort the dynamic array elements, using the Compare property function
    // - it will change the dynamic array content, and exchange all elements
    // in order to be sorted in increasing order according to Compare function
    procedure Sort(aCompare: TDynArraySortCompare=nil); overload;
    /// sort some dynamic array elements, using the Compare property function
    // - this method allows to sort only some part of the items
    // - it will change the dynamic array content, and exchange all elements
    // in order to be sorted in increasing order according to Compare function
    procedure SortRange(aStart, aStop: integer; aCompare: TDynArraySortCompare=nil);
    /// sort the dynamic array elements, using a Compare method (not function)
    // - it will change the dynamic array content, and exchange all elements
    // in order to be sorted in increasing order according to Compare function,
    // unless aReverse is true
    // - it won't mark the array as Sorted, since the comparer is local
    procedure Sort(const aCompare: TEventDynArraySortCompare; aReverse: boolean=false); overload;
    /// search the elements range which match a given value in a sorted dynamic array
    // - this method will use the Compare property function for the search
    // - returns TRUE and the matching indexes, or FALSE if none found
    // - if the array is not sorted, returns FALSE
    function FindAllSorted(const Elem; out FirstIndex,LastIndex: Integer): boolean;
    /// search for an element value inside a sorted dynamic array
    // - this method will use the Compare property function for the search
    // - will be faster than a manual FindAndAddIfNotExisting+Sort process
    // - returns TRUE and the index of existing Elem, or FALSE and the index
    // where the Elem is to be inserted so that the array remains sorted
    // - you should then call FastAddSorted() later with the returned Index
    // - if the array is not sorted, returns FALSE and Index=-1
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (no FastLocateSorted(i+10) e.g.)
    function FastLocateSorted(const Elem; out Index: Integer): boolean;
    /// insert a sorted element value at the proper place
    // - the index should have been computed by FastLocateSorted(): false
    // - you may consider using FastLocateOrAddSorted() instead
    procedure FastAddSorted(Index: Integer; const Elem);
    /// search and add an element value inside a sorted dynamic array
    // - this method will use the Compare property function for the search
    // - will be faster than a manual FindAndAddIfNotExisting+Sort process
    // - returns the index of the existing Elem and wasAdded^=false
    // - returns the sorted index of the inserted Elem and wasAdded^=true
    // - if the array is not sorted, returns -1 and wasAdded^=false
    // - is just a wrapper around FastLocateSorted+FastAddSorted
    function FastLocateOrAddSorted(const Elem; wasAdded: PBoolean=nil): integer;
    /// delete a sorted element value at the proper place
    // - plain Delete(Index) would reset the fSorted flag to FALSE, so use
    // this method with a FastLocateSorted/FastAddSorted array
    procedure FastDeleteSorted(Index: Integer);
    /// will reverse all array elements, in place
    procedure Reverse;
    /// sort the dynamic array elements using a lookup array of indexes
    // - in comparison to the Sort method, this CreateOrderedIndex won't change
    // the dynamic array content, but only create (or update) the supplied
    // integer lookup array, using the specified comparison function
    // - if aCompare is not supplied, the method will use fCompare (if defined)
    // - you should provide either a void either a valid lookup table, that is
    // a table with one to one lookup (e.g. created with FillIncreasing)
    // - if the lookup table has less elements than the main dynamic array,
    // its content will be recreated
    procedure CreateOrderedIndex(var aIndex: TIntegerDynArray;
      aCompare: TDynArraySortCompare); overload;
    /// sort the dynamic array elements using a lookup array of indexes
    // - this overloaded method will use the supplied TSynTempBuffer for
    // index storage, so use PIntegerArray(aIndex.buf) to access the values
    // - caller should always make aIndex.Done once done
    procedure CreateOrderedIndex(out aIndex: TSynTempBuffer;
      aCompare: TDynArraySortCompare); overload;
    /// sort using a lookup array of indexes, after a Add()
    // - will resize aIndex if necessary, and set aIndex[Count-1] := Count-1
    procedure CreateOrderedIndexAfterAdd(var aIndex: TIntegerDynArray;
      aCompare: TDynArraySortCompare);
    /// save the dynamic array content into a (memory) stream
    // - will handle array of binaries values (byte, word, integer...), array of
    // strings or array of packed records, with binaries and string properties
    // - will use a proprietary binary format, with some variable-length encoding
    // of the string length - note that if you change the type definition, any
    // previously-serialized content will fail, maybe triggering unexpected GPF:
    // use SaveToTypeInfoHash if you share this binary data accross executables
    // - Stream position will be set just after the added data
    // - is optimized for memory streams, but will work with any kind of TStream
    procedure SaveToStream(Stream: TStream);
    /// load the dynamic array content from a (memory) stream
    // - stream content must have been created using SaveToStream method
    // - will handle array of binaries values (byte, word, integer...), array of
    // strings or array of packed records, with binaries and string properties
    // - will use a proprietary binary format, with some variable-length encoding
    // of the string length - note that if you change the type definition, any
    // previously-serialized content will fail, maybe triggering unexpected GPF:
    // use SaveToTypeInfoHash if you share this binary data accross executables
    procedure LoadFromStream(Stream: TCustomMemoryStream);
    /// save the dynamic array content into an allocated memory buffer
    // - Dest buffer must have been allocated to contain at least the number
    // of bytes returned by the SaveToLength method
    // - return a pointer at the end of the data written in Dest, nil in case
    // of an invalid input buffer
    // - will use a proprietary binary format, with some variable-length encoding
    // of the string length - note that if you change the type definition, any
    // previously-serialized content will fail, maybe triggering unexpected GPF:
    // use SaveToTypeInfoHash if you share this binary data accross executables
    // - this method will raise an ESynException for T*ObjArray types
    // - use TDynArray.LoadFrom or TDynArrayLoadFrom to decode the saved buffer
    function SaveTo(Dest: PAnsiChar): PAnsiChar; overload;
    /// compute the number of bytes needed by SaveTo() to persist a dynamic array
    // - will use a proprietary binary format, with some variable-length encoding
    // of the string length - note that if you change the type definition, any
    // previously-serialized content will fail, maybe triggering unexpected GPF:
    // use SaveToTypeInfoHash if you share this binary data accross executables
    // - this method will raise an ESynException for T*ObjArray types
    function SaveToLength: integer;
    /// save the dynamic array content into a RawByteString
    // - will use a proprietary binary format, with some variable-length encoding
    // of the string length - note that if you change the type definition, any
    // previously-serialized content will fail, maybe triggering unexpected GPF:
    // use SaveToTypeInfoHash if you share this binary data accross executables
    // - this method will raise an ESynException for T*ObjArray types
    // - use TDynArray.LoadFrom or TDynArrayLoadFrom to decode the saved buffer
    function SaveTo: RawByteString; overload;
    /// compute a crc32c-based hash of the RTTI for this dynamic array
    // - can be used to ensure that the TDynArray.SaveTo binary layout
    // is compatible accross executables
    // - won't include the RTTI type kind, as TypeInfoToHash(), but only
    // ElemSize or ElemType information, or any previously registered
    // TTextWriter.RegisterCustomJSONSerializerFromText definition
    function SaveToTypeInfoHash(crc: cardinal=0): cardinal;
    /// unserialize dynamic array content from binary written by TDynArray.SaveTo
    // - return nil if the Source buffer is incorrect: invalid type, wrong
    // checksum, or optional SourceMax overflow
    // - return a non nil pointer just after the Source content on success
    // - this method will raise an ESynException for T*ObjArray types
    // - you can optionally call AfterEach callback for each row loaded
    // - if you don't want to allocate all items on memory, but just want to
    // iterate over all items stored in a TDynArray.SaveTo memory buffer,
    // consider using TDynArrayLoadFrom object
    function LoadFrom(Source: PAnsiChar; AfterEach: TDynArrayAfterLoadFrom=nil;
      NoCheckHash: boolean=false; SourceMax: PAnsiChar=nil): PAnsiChar;
    /// unserialize the dynamic array content from a TDynArray.SaveTo binary string
    // - same as LoadFrom, and will check for any buffer overflow since we
    // know the actual end of input buffer
    function LoadFromBinary(const Buffer: RawByteString;
      NoCheckHash: boolean=false): boolean;
    /// serialize the dynamic array content as JSON
    // - is just a wrapper around TTextWriter.AddDynArrayJSON()
    // - this method will therefore recognize T*ObjArray types
    function SaveToJSON(EnumSetsAsText: boolean=false;
      reformat: TTextWriterJSONFormat=jsonCompact): RawUTF8; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// serialize the dynamic array content as JSON
    // - is just a wrapper around TTextWriter.AddDynArrayJSON()
    // - this method will therefore recognize T*ObjArray types
    procedure SaveToJSON(out Result: RawUTF8; EnumSetsAsText: boolean=false;
      reformat: TTextWriterJSONFormat=jsonCompact); overload;
    /// load the dynamic array content from an UTF-8 encoded JSON buffer
    // - expect the format as saved by TTextWriter.AddDynArrayJSON method, i.e.
    // handling TBooleanDynArray, TIntegerDynArray, TInt64DynArray, TCardinalDynArray,
    // TDoubleDynArray, TCurrencyDynArray, TWordDynArray, TByteDynArray,
    // TRawUTF8DynArray, TWinAnsiDynArray, TRawByteStringDynArray,
    // TStringDynArray, TWideStringDynArray, TSynUnicodeDynArray,
    // TTimeLogDynArray and TDateTimeDynArray as JSON array - or any customized
    // valid JSON serialization as set by TTextWriter.RegisterCustomJSONSerializer
    // - or any other kind of array as Base64 encoded binary stream precessed
    // via JSON_BASE64_MAGIC (UTF-8 encoded \uFFF0 special code)
    // - typical handled content could be
    // ! '[1,2,3,4]' or '["\uFFF0base64encodedbinary"]'
    // - return a pointer at the end of the data read from P, nil in case
    // of an invalid input buffer
    // - this method will recognize T*ObjArray types, and will first free
    // any existing instance before unserializing, to avoid memory leak
    // - warning: the content of P^ will be modified during parsing: please
    // make a local copy if it will be needed later (using e.g. TSynTempBufer)
    function LoadFromJSON(P: PUTF8Char; aEndOfObject: PUTF8Char=nil{$ifndef NOVARIANTS};
      CustomVariantOptions: PDocVariantOptions=nil{$endif}): PUTF8Char;
    {$ifndef NOVARIANTS}
    /// load the dynamic array content from a TDocVariant instance
    // - will convert the TDocVariant into JSON, the call LoadFromJSON
    function LoadFromVariant(const DocVariant: variant): boolean;
    {$endif NOVARIANTS}
    ///  select a sub-section (slice) of a dynamic array content
    procedure Slice(var Dest; aCount: Cardinal; aFirstIndex: cardinal=0);
    /// add elements from a given dynamic array variable
    // - the supplied source DynArray MUST be of the same exact type as the
    // current used for this TDynArray - warning: pass here a reference to
    // a "array of ..." variable, not another TDynArray instance; if you
    // want to add another TDynArray, use AddDynArray() method
    // - you can specify the start index and the number of items to take from
    // the source dynamic array (leave as -1 to add till the end)
    // - returns the number of items added to the array
    function AddArray(const DynArrayVar; aStartIndex: integer=0; aCount: integer=-1): integer;
    {$ifndef DELPHI5OROLDER}
    /// fast initialize a wrapper for an existing dynamic array of the same type
    // - is slightly faster than
    // ! Init(aAnother.ArrayType,aValue,nil);
    procedure InitFrom(const aAnother: TDynArray; var aValue);
      {$ifdef HASINLINE}inline;{$endif}
    /// add elements from a given TDynArray
    // - the supplied source TDynArray MUST be of the same exact type as the
    // current used for this TDynArray, otherwise it won't do anything
    // - you can specify the start index and the number of items to take from
    // the source dynamic array (leave as -1 to add till the end)
    procedure AddDynArray(const aSource: TDynArray; aStartIndex: integer=0; aCount: integer=-1);
    /// compare the content of the two arrays, returning TRUE if both match
    // - this method compares using any supplied Compare property (unless
    // ignorecompare=true), or by content using the RTTI element description
    // of the whole array items
    // - will call SaveToJSON to compare T*ObjArray kind of arrays
    function Equals(const B: TDynArray; ignorecompare: boolean=false): boolean;
    /// set all content of one dynamic array to the current array
    // - both must be of the same exact type
    // - T*ObjArray will be reallocated and copied by content (using a temporary
    // JSON serialization), unless ObjArrayByRef is true and pointers are copied
    procedure Copy(const Source: TDynArray; ObjArrayByRef: boolean=false);
    /// set all content of one dynamic array to the current array
    // - both must be of the same exact type
    // - T*ObjArray will be reallocated and copied by content (using a temporary
    // JSON serialization), unless ObjArrayByRef is true and pointers are copied
    procedure CopyFrom(const Source; MaxElem: integer; ObjArrayByRef: boolean=false);
    /// set all content of the current dynamic array to another array variable
    // - both must be of the same exact type
    // - resulting length(Dest) will match the exact items count, even if an
    // external Count integer variable is used by this instance
    // - T*ObjArray will be reallocated and copied by content (using a temporary
    // JSON serialization), unless ObjArrayByRef is true and pointers are copied
    procedure CopyTo(out Dest; ObjArrayByRef: boolean=false);
    {$endif DELPHI5OROLDER}
    /// returns a pointer to an element of the array
    // - returns nil if aIndex is out of range
    // - since TDynArray is just a wrapper around an existing array, you should
    // better use direct access to its wrapped variable, and not using this
    // slower and more error prone method (such pointer access lacks of strong
    // typing abilities), which was designed for TDynArray internal use
    function ElemPtr(index: PtrInt): pointer; {$ifdef HASINLINE}inline;{$endif}
    /// will copy one element content from its index into another variable
    // - do nothing if index is out of range
    procedure ElemCopyAt(index: PtrInt; var Dest); {$ifdef FPC}inline;{$endif}
    /// will move one element content from its index into another variable
    // - will erase the internal item after copy
    // - do nothing if index is out of range
    procedure ElemMoveTo(index: PtrInt; var Dest);
    /// will copy one variable content into an indexed element
    // - do nothing if index is out of range
    // - ClearBeforeCopy will call ElemClear() before the copy, which may be safer
    // if the source item is a copy of Values[index] with some dynamic arrays
    procedure ElemCopyFrom(const Source; index: PtrInt;
      ClearBeforeCopy: boolean=false); {$ifdef FPC}inline;{$endif}
    /// compare the content of two elements, returning TRUE if both values equal
    // - this method compares first using any supplied Compare property,
    // then by content using the RTTI element description of the whole record
    function ElemEquals(const A,B): boolean;
    /// will reset the element content
    procedure ElemClear(var Elem);
    /// will copy one element content
    procedure ElemCopy(const A; var B); {$ifdef FPC}inline;{$endif}
    /// will copy the first field value of an array element
    // - will use the array KnownType to guess the copy routine to use
    // - returns false if the type information is not enough for a safe copy
    function ElemCopyFirstField(Source,Dest: Pointer): boolean;
    /// save an array element into a serialized binary content
    // - use the same layout as TDynArray.SaveTo, but for a single item
    // - you can use ElemLoad method later to retrieve its content
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write ElemSave(i+10) e.g.)
    function ElemSave(const Elem): RawByteString;
    /// load an array element as saved by the ElemSave method into Elem variable
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write ElemLoad(P,i+10) e.g.)
    procedure ElemLoad(Source: PAnsiChar; var Elem; SourceMax: PAnsiChar=nil); overload;
    /// load an array element as saved by the ElemSave method
    // - this overloaded method will retrieve the element as a memory buffer,
    // which should be cleared by ElemLoadClear() before release
    function ElemLoad(Source: PAnsiChar; SourceMax: PAnsiChar=nil): RawByteString; overload;
    /// search for an array element as saved by the ElemSave method
    // - same as ElemLoad() + Find()/IndexOf() + ElemLoadClear()
    // - will call Find() method if Compare property is set
    // - will call generic IndexOf() method if no Compare property is set
    function ElemLoadFind(Source: PAnsiChar; SourceMax: PAnsiChar=nil): integer;
    /// finalize a temporary buffer used to store an element via ElemLoad()
    // - will release any managed type referenced inside the RawByteString,
    // then void the variable
    // - is just a wrapper around ElemClear(pointer(ElemTemp)) + ElemTemp := ''
    procedure ElemLoadClear(var ElemTemp: RawByteString);

    /// retrieve or set the number of elements of the dynamic array
    // - same as length(DynArray) or SetLength(DynArray)
    // - this property will recognize T*ObjArray types, so will free any stored
    // instance if the array is sized down
    property Count: PtrInt read GetCount write SetCount;
    /// the internal buffer capacity
    // - if no external Count pointer was set with Init, is the same as Count
    // - if an external Count pointer is set, you can set a value to this
    // property before a massive use of the Add() method e.g.
    // - if no external Count pointer is set, set a value to this property
    // will affect the Count value, i.e. Add() will append after this count
    // - this property will recognize T*ObjArray types, so will free any stored
    // instance if the array is sized down
    property Capacity: PtrInt read GetCapacity write SetCapacity;
    /// the compare function to be used for Sort and Find methods
    // - by default, no comparison function is set
    // - common functions exist for base types: e.g. SortDynArrayByte, SortDynArrayBoolean,
    // SortDynArrayWord, SortDynArrayInteger, SortDynArrayCardinal, SortDynArraySingle,
    // SortDynArrayInt64, SortDynArrayDouble, SortDynArrayAnsiString,
    // SortDynArrayAnsiStringI, SortDynArrayString, SortDynArrayStringI,
    // SortDynArrayUnicodeString, SortDynArrayUnicodeStringI
    property Compare: TDynArraySortCompare read fCompare write SetCompare;
    /// must be TRUE if the array is currently in sorted order according to
    // the compare function
    // - Add/Delete/Insert/Load* methods will reset this property to false
    // - Sort method will set this property to true
    // - you MUST set this property to false if you modify the dynamic array
    // content in your code, so that Find() won't try to wrongly use binary
    // search in an unsorted array, and miss its purpose
    property Sorted: boolean read fSorted write fSorted;
    /// low-level direct access to the storage variable
    property Value: PPointer read fValue;
    /// the first field recognized type
    // - could have been set at initialization, or after a GuessKnownType call
    property KnownType: TDynArrayKind read fKnownType;
    /// the raw storage size of the first field KnownType
    property KnownSize: integer read fKnownSize;
    /// the known RTTI information of the whole array
    property ArrayType: pointer read fTypeInfo;
    /// the known type name of the whole array, as RawUTF8
    property ArrayTypeName: RawUTF8 read GetArrayTypeName;
    /// the known type name of the whole array, as PShortString
    property ArrayTypeShort: PShortString read GetArrayTypeShort;
    /// the internal in-memory size of one element, as retrieved from RTTI
    property ElemSize: cardinal read fElemSize;
    /// the internal type information of one element, as retrieved from RTTI
    property ElemType: pointer read fElemType;
    /// if this dynamic aray is a T*ObjArray
    property IsObjArray: boolean read GetIsObjArray write SetIsObjArray;
  end;
  /// a pointer to a TDynArray wrapper instance
  PDynArray = ^TDynArray;

  /// allows to iterate over a TDynArray.SaveTo binary buffer
  // - may be used as alternative to TDynArray.LoadFrom, if you don't want
  // to allocate all items at once, but retrieve items one by one
  TDynArrayLoadFrom = object
  protected
    DynArray: TDynArray; // used to access RTTI
    Hash: PCardinalArray;
    PositionEnd: PAnsiChar;
  public
    /// how many items were saved in the TDynArray.SaveTo binary buffer
    // - equals -1 if Init() failed to unserialize its header
    Count: integer;
    /// the zero-based index of the current item pointed by next Step() call
    // - is in range 0..Count-1 until Step() returns false
    Current: integer;
    /// current position in the TDynArray.SaveTo binary buffer
    // - after Step() returned false, points just after the binary buffer,
    // like a regular TDynArray.LoadFrom
    Position: PAnsiChar;
    /// initialize iteration over a TDynArray.SaveTo binary buffer
    // - returns true on success, with Count and Position being set
    // - returns false if the supplied binary buffer is not correct
    // - you can specify an optional SourceMaxLen to avoid any buffer overflow
    function Init(ArrayTypeInfo: pointer; Source: PAnsiChar;
      SourceMaxLen: PtrInt=0): boolean; overload;
    /// initialize iteration over a TDynArray.SaveTo binary buffer
    // - returns true on success, with Count and Position being set
    // - returns false if the supplied binary buffer is not correct
    function Init(ArrayTypeInfo: pointer; const Source: RawByteString): boolean; overload;
    /// iterate over the current stored item
    // - Elem should point to a variable of the exact item type stored in this
    // dynamic array
    // - returns true if Elem was filled with one value, or false if all
    // items were read, and Position contains the end of the binary buffer
    function Step(out Elem): boolean;
    /// extract the first field value of the current stored item
    // - returns true if Field was filled with one value, or false if all
    // items were read, and Position contains the end of the binary buffer
    // - could be called before Step(), to pre-allocate a new item instance,
    // or update an existing instance
    function FirstField(out Field): boolean;
    /// after all items are read by Step(), validate the stored hash
    // - returns true if items hash is correct, false otherwise
    function CheckHash: boolean;
  end;

  /// function prototype to be used for hashing of a dynamic array element
  // - this function must use the supplied hasher on the Elem data
  TDynArrayHashOne = function(const Elem; Hasher: THasher): cardinal;

  /// event handler to be used for hashing of a dynamic array element
  // - can be set as an alternative to TDynArrayHashOne
  TEventDynArrayHashOne = function(const Elem): cardinal of object;

  {.$define DYNARRAYHASHCOLLISIONCOUNT}

  /// allow O(1) lookup to any dynamic array content
  // - this won't handle the storage process (like add/update), just efficiently
  // maintain a hash table over an existing dynamic array: several TDynArrayHasher
  // could be applied to a single TDynArray wrapper
  // - TDynArrayHashed will use a TDynArrayHasher for its own store
  {$ifdef USERECORDWITHMETHODS}TDynArrayHasher = record
  {$else}TDynArrayHasher = object {$endif}
  private
    DynArray: PDynArray;
    HashElement: TDynArrayHashOne;
    EventHash: TEventDynArrayHashOne;
    Hasher: THasher;
    HashTable: TIntegerDynArray; // store 0 for void entry, or Index+1
    HashTableSize: integer;
    ScanCounter: integer; // Scan()>=0 up to CountTrigger*2
    State: set of (hasHasher, canHash);
    function HashTableIndex(aHashCode: cardinal): cardinal; {$ifdef HASINLINE}inline;{$endif}
    procedure HashAdd(aHashCode: cardinal; var result: integer);
    procedure HashDelete(aArrayIndex, aHashTableIndex: integer; aHashCode: cardinal);
    procedure RaiseFatalCollision(const caller: RawUTF8; aHashCode: cardinal);
  public
    /// associated item comparison - may differ from DynArray^.Compare
    Compare: TDynArraySortCompare;
    /// custom method-based comparison function
    EventCompare: TEventDynArraySortCompare;
    /// after how many FindBeforeAdd() or Scan() the hashing starts - default 32
    CountTrigger: integer;
    {$ifdef DYNARRAYHASHCOLLISIONCOUNT}
    /// low-level access to an hash collisions counter
    FindCollisions: cardinal;
    {$endif}
    /// initialize the hash table for a given dynamic array storage
    // - you can call this method several times, e.g. if aCaseInsensitive changed
    procedure Init(aDynArray: PDynArray; aHashElement: TDynArrayHashOne;
     aEventHash: TEventDynArrayHashOne; aHasher: THasher; aCompare: TDynArraySortCompare;
     aEventCompare: TEventDynArraySortCompare; aCaseInsensitive: boolean);
    /// initialize a known hash table for a given dynamic array storage
    // - you can call this method several times, e.g. if aCaseInsensitive changed
    procedure InitSpecific(aDynArray: PDynArray; aKind: TDynArrayKind; aCaseInsensitive: boolean);
    /// allow custom hashing via a method event
    procedure SetEventHash(const event: TEventDynArrayHashOne);
    /// search for an element value inside the dynamic array without hashing
    // - trigger hashing if ScanCounter reaches CountTrigger*2
    function Scan(Elem: pointer): integer;
    /// search for an element value inside the dynamic array with hashing
    function Find(Elem: pointer): integer; overload;
    /// search for a hashed element value inside the dynamic array with hashing
    function Find(Elem: pointer; aHashCode: cardinal): integer; overload;
    /// search for a hash position inside the dynamic array with hashing
    function Find(aHashCode: cardinal; aForAdd: boolean): integer; overload;
    /// returns position in array, or next void index in HashTable[] as -(index+1)
    function FindOrNew(aHashCode: cardinal; Elem: pointer; aHashTableIndex: PInteger=nil): integer;
    /// search an hashed element value for adding, updating the internal hash table
    // - trigger hashing if Count reaches CountTrigger
    function FindBeforeAdd(Elem: pointer; out wasAdded: boolean; aHashCode: cardinal): integer;
    /// search and delete an element value, updating the internal hash table
    function FindBeforeDelete(Elem: pointer): integer;
    /// reset the hash table - no rehash yet
    procedure Clear;
    /// full computation of the internal hash table
    // - returns the number of duplicated values found
    function ReHash(forced: boolean): integer;
    /// compute the hash of a given item
    function HashOne(Elem: pointer): cardinal; {$ifdef FPC_OR_DELPHIXE4}inline;{$endif}
      { not inlined to circumvent Delphi 2007=C1632, 2010=C1872, XE3=C2130 }
    /// retrieve the low-level hash of a given item
    function GetHashFromIndex(aIndex: PtrInt): cardinal;
  end;

  /// pointer to a TDynArrayHasher instance
  PDynArrayHasher = ^TDynArrayHasher;

  /// used to access any dynamic arrray elements using fast hash
  // - by default, binary sort could be used for searching items for TDynArray:
  // using a hash is faster on huge arrays for implementing a dictionary
  // - in this current implementation, modification (update or delete) of an
  // element is not handled yet: you should rehash all content - only
  // TDynArrayHashed.FindHashedForAdding / FindHashedAndUpdate /
  // FindHashedAndDelete will refresh the internal hash
  // - this object extends the TDynArray type, since presence of Hashs[] dynamic
  // array will increase code size if using TDynArrayHashed instead of TDynArray
  // - in order to have the better performance, you should use an external Count
  // variable, AND set the Capacity property to the expected maximum count (this
  // will avoid most ReHash calls for FindHashedForAdding+FindHashedAndUpdate)
  {$ifdef UNDIRECTDYNARRAY}
  TDynArrayHashed = record
  // pseudo inheritance for most used methods
  private
    function GetCount: PtrInt;                 inline;
    procedure SetCount(aCount: PtrInt) ;       inline;
    procedure SetCapacity(aCapacity: PtrInt);  inline;
    function GetCapacity: PtrInt;              inline;
  public
    InternalDynArray: TDynArray;
    function Value: PPointer;           inline;
    function ElemSize: PtrUInt;         inline;
    function ElemType: Pointer;         inline;
    function KnownType: TDynArrayKind;  inline;
    procedure Clear;                    inline;
    procedure ElemCopy(const A; var B); inline;
    function ElemPtr(index: PtrInt): pointer; inline;
    procedure ElemCopyAt(index: PtrInt; var Dest); inline;
    // warning: you shall call ReHash() after manual Add/Delete
    function Add(const Elem): integer;  inline;
    procedure Delete(aIndex: PtrInt);  inline;
    function SaveTo: RawByteString; overload; inline;
    function SaveTo(Dest: PAnsiChar): PAnsiChar; overload; inline;
    function SaveToJSON(EnumSetsAsText: boolean=false;
      reformat: TTextWriterJSONFormat=jsonCompact): RawUTF8; inline;
    procedure Sort(aCompare: TDynArraySortCompare=nil); inline;
    function LoadFromJSON(P: PUTF8Char; aEndOfObject: PUTF8Char=nil{$ifndef NOVARIANTS};
      CustomVariantOptions: PDocVariantOptions=nil{$endif}): PUTF8Char; inline;
    function SaveToLength: integer; inline;
    function LoadFrom(Source: PAnsiChar; AfterEach: TDynArrayAfterLoadFrom=nil;
      NoCheckHash: boolean=false; SourceMax: PAnsiChar=nil): PAnsiChar;  inline;
    function LoadFromBinary(const Buffer: RawByteString;
      NoCheckHash: boolean=false): boolean; inline;
    procedure CreateOrderedIndex(var aIndex: TIntegerDynArray;
      aCompare: TDynArraySortCompare);
    property Count: PtrInt read GetCount write SetCount;
    property Capacity: PtrInt read GetCapacity write SetCapacity;
  private
  {$else UNDIRECTDYNARRAY}
  TDynArrayHashed = object(TDynArray)
  protected
  {$endif UNDIRECTDYNARRAY}
    fHash: TDynArrayHasher;
    procedure SetEventHash(const event: TEventDynArrayHashOne); {$ifdef HASINLINE}inline;{$endif}
    function GetHashFromIndex(aIndex: PtrInt): Cardinal; {$ifdef HASINLINE}inline;{$endif}
  public
    /// initialize the wrapper with a one-dimension dynamic array
    // - this version accepts some hash-dedicated parameters: aHashElement to
    // set how to hash each element, aCompare to handle hash collision
    // - if no aHashElement is supplied, it will hash according to the RTTI, i.e.
    // strings or binary types, and the first field for records (strings included)
    // - if no aCompare is supplied, it will use default Equals() method
    // - if no THasher function is supplied, it will use the one supplied in
    // DefaultHasher global variable, set to crc32c() by default - using
    // SSE4.2 instruction if available
    // - if CaseInsensitive is set to TRUE, it will ignore difference in 7 bit
    // alphabetic characters (e.g. compare 'a' and 'A' as equal)
    procedure Init(aTypeInfo: pointer; var aValue;
      aHashElement: TDynArrayHashOne=nil; aCompare: TDynArraySortCompare=nil;
      aHasher: THasher=nil; aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
    /// initialize the wrapper with a one-dimension dynamic array
    // - this version accepts to specify how both hashing and comparison should
    // occur, setting the TDynArrayKind kind of first/hashed field
    // - djNone and djCustom are too vague, and will raise an exception
    // - no RTTI check is made over the corresponding array layout: you shall
    // ensure that aKind matches the dynamic array element definition
    // - aCaseInsensitive will be used for djRawUTF8..djHash512 text comparison
    procedure InitSpecific(aTypeInfo: pointer; var aValue; aKind: TDynArrayKind;
      aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
    /// will compute all hash from the current elements of the dynamic array
    // - is called within the TDynArrayHashed.Init method to initialize the
    // internal hash array
    // - can be called on purpose, when modifications have been performed on
    // the dynamic array content (e.g. in case of element deletion or update,
    // or after calling LoadFrom/Clear method) - this is not necessary after
    // FindHashedForAdding / FindHashedAndUpdate / FindHashedAndDelete methods
    // - returns the number of duplicated items found - which won't be available
    // by hashed FindHashed() by definition
    function ReHash(forAdd: boolean=false): integer;
    /// search for an element value inside the dynamic array using hashing
    // - Elem should be of the type expected by both the hash function and
    // Equals/Compare methods: e.g. if the searched/hashed field in a record is
    // a string as first field, you can safely use a string variable as Elem
    // - Elem must refer to a variable: e.g. you can't write FindHashed(i+10)
    // - will call fHashElement(Elem,fHasher) to compute the needed hash
    // - returns -1 if not found, or the index in the dynamic array if found
    function FindHashed(const Elem): integer;
    /// search for an element value inside the dynamic array using its hash
    // - returns -1 if not found, or the index in the dynamic array if found
    // - aHashCode parameter constains an already hashed value of the item,
    // to be used e.g. after a call to HashFind()
    function FindFromHash(const Elem; aHashCode: cardinal): integer;
    /// search for an element value inside the dynamic array using hashing, and
    // fill Elem with the found content
    // - return the index found (0..Count-1), or -1 if Elem was not found
    // - ElemToFill should be of the type expected by the dynamic array, since
    // all its fields will be set on match
    function FindHashedAndFill(var ElemToFill): integer;
    /// search for an element value inside the dynamic array using hashing, and
    // add a void entry to the array if was not found (unless noAddEntry is set)
    // - this method will use hashing for fast retrieval
    // - Elem should be of the type expected by both the hash function and
    // Equals/Compare methods: e.g. if the searched/hashed field in a record is
    // a string as first field, you can safely use a string variable as Elem
    // - returns either the index in the dynamic array if found (and set wasAdded
    // to false), either the newly created index in the dynamic array (and set
    // wasAdded to true)
    // - for faster process (avoid ReHash), please set the Capacity property
    // - warning: in contrast to the Add() method, if an entry is added to the
    // array (wasAdded=true), the entry is left VOID: you must set the field
    // content to expecting value - in short, Elem is used only for searching,
    // not copied to the newly created entry in the array  - check
    // FindHashedAndUpdate() for a method actually copying Elem fields
    function FindHashedForAdding(const Elem; out wasAdded: boolean;
      noAddEntry: boolean=false): integer; overload;
    /// search for an element value inside the dynamic array using hashing, and
    // add a void entry to the array if was not found (unless noAddEntry is set)
    // - overloaded method acepting an already hashed value of the item, to be used
    // e.g. after a call to HashFind()
    function FindHashedForAdding(const Elem; out wasAdded: boolean;
      aHashCode: cardinal; noAddEntry: boolean=false): integer; overload;
    /// ensure a given element name is unique, then add it to the array
    // - expected element layout is to have a RawUTF8 field at first position
    // - the aName is searched (using hashing) to be unique, and if not the case,
    // an ESynException.CreateUTF8() is raised with the supplied arguments
    // - use internaly FindHashedForAdding method
    // - this version will set the field content with the unique value
    // - returns a pointer to the newly added element (to set other fields)
    function AddUniqueName(const aName: RawUTF8; const ExceptionMsg: RawUTF8;
      const ExceptionArgs: array of const; aNewIndex: PInteger=nil): pointer; overload;
    /// ensure a given element name is unique, then add it to the array
    // - just a wrapper to AddUniqueName(aName,'',[],aNewIndex)
    function AddUniqueName(const aName: RawUTF8; aNewIndex: PInteger=nil): pointer; overload;
    /// search for a given element name, make it unique, and add it to the array
    // - expected element layout is to have a RawUTF8 field at first position
    // - the aName is searched (using hashing) to be unique, and if not the case,
    // some suffix is added to make it unique
    // - use internaly FindHashedForAdding method
    // - this version will set the field content with the unique value
    // - returns a pointer to the newly added element (to set other fields)
    function AddAndMakeUniqueName(aName: RawUTF8): pointer;
    /// search for an element value inside the dynamic array using hashing, then
    // update any matching item, or add the item if none matched
    // - by design, hashed field shouldn't have been modified by this update,
    // otherwise the method won't be able to find and update the old hash: in
    // this case, you should first call FindHashedAndDelete(OldElem) then
    // FindHashedForAdding(NewElem) to properly handle the internal hash table
    // - if AddIfNotExisting is FALSE, returns the index found (0..Count-1),
    // or -1 if Elem was not found - update will force slow rehash all content
    // - if AddIfNotExisting is TRUE, returns the index found (0..Count-1),
    // or the index newly created/added is the Elem value was not matching -
    // add won't rehash all content - for even faster process (avoid ReHash),
    // please set the Capacity property
    // - Elem should be of the type expected by the dynamic array, since its
    // content will be copied into the dynamic array, and it must refer to a
    // variable: e.g. you can't write FindHashedAndUpdate(i+10)
    function FindHashedAndUpdate(const Elem; AddIfNotExisting: boolean): integer;
    /// search for an element value inside the dynamic array using hashing, and
    // delete it if matchs
    // - return the index deleted (0..Count-1), or -1 if Elem was not found
    // - can optionally copy the deleted item to FillDeleted^ before erased
    // - Elem should be of the type expected by both the hash function and
    // Equals/Compare methods, and must refer to a variable: e.g. you can't
    // write FindHashedAndDelete(i+10)
    // - it won't call slow ReHash but refresh the hash table as needed
    function FindHashedAndDelete(const Elem; FillDeleted: pointer=nil;
      noDeleteEntry: boolean=false): integer;
    /// will search for an element value inside the dynamic array without hashing
    // - is used internally when Count < HashCountTrigger
    // - is preferred to Find(), since EventCompare would be used if defined
    // - Elem should be of the type expected by both the hash function and
    // Equals/Compare methods, and must refer to a variable: e.g. you can't
    // write Scan(i+10)
    // - returns -1 if not found, or the index in the dynamic array if found
    // - an internal algorithm can switch to hashing if Scan() is called often,
    // even if the number of items is lower than HashCountTrigger
    function Scan(const Elem): integer;
    /// retrieve the hash value of a given item, from its index
    property Hash[aIndex: PtrInt]: Cardinal read GetHashFromIndex;
    /// alternative event-oriented Compare function to be used for Sort and Find
    // - will be used instead of Compare, to allow object-oriented callbacks
    property EventCompare: TEventDynArraySortCompare read fHash.EventCompare write fHash.EventCompare;
    /// custom hash function to be used for hashing of a dynamic array element
    property HashElement: TDynArrayHashOne read fHash.HashElement;
    /// alternative event-oriented Hash function for ReHash
    // - this object-oriented callback will be used instead of HashElement
    // on each dynamic array entries - HashElement will still be used on
    // const Elem values, since they may be just a sub part of the stored entry
    property EventHash: TEventDynArrayHashOne read fHash.EventHash write SetEventHash;
    /// after how many items the hashing take place
    // - for smallest arrays, O(n) search if faster than O(1) hashing, since
    // maintaining internal hash table has some CPU and memory costs
    // - internal search is able to switch to hashing if it founds out that it
    // may have some benefit, e.g. if Scan() is called 2*HashCountTrigger times
    // - equals 32 by default, i.e. start hashing when Count reaches 32 or
    // manual Scan() is called 64 times
    property HashCountTrigger: integer read fHash.CountTrigger write fHash.CountTrigger;
    /// access to the internal hash table
    // - you can call e.g. Hasher.Clear to invalidate the whole hash table
    property Hasher: TDynArrayHasher read fHash;
  end;


  /// defines a wrapper interface around a dynamic array of TObject
  // - implemented by TObjectDynArrayWrapper for instance
  // - i.e. most common methods are available to work with a dynamic array
  // - warning: the IObjectDynArray MUST be defined in the stack, class or
  // record BEFORE the dynamic array it is wrapping, otherwise you may leak
  // memory - see for instance TSQLRestServer class:
  // ! fSessionAuthentications: IObjectDynArray; // defined before the array
  // ! fSessionAuthentication: TSQLRestServerAuthenticationDynArray;
  // note that allocation time as variable on the local stack may depend on the
  // compiler, and its optimization
  IObjectDynArray = interface
    ['{A0D50BD0-0D20-4552-B365-1D63393511FC}']
    /// search one element within the TObject instances
    function Find(Instance: TObject): integer;
    /// add one element to the dynamic array of TObject instances
    // - once added, the Instance will be owned by this TObjectDynArray instance
    function Add(Instance: TObject): integer;
    /// delete one element from the TObject dynamic array
    // - deleted TObject instance will be freed as expected
    procedure Delete(Index: integer);
    /// sort the dynamic array content according to a specified comparer
    procedure Sort(Compare: TDynArraySortCompare);
    /// delete all TObject instances, and release the memory
    // - is not to be called for most use, thanks to reference-counting memory
    // handling, but can be handy for quick release
    procedure Clear;
    /// ensure the internal list capacity is set to the current Count
    // - may be used to publish the associated dynamic array with the expected
    // final size, once IObjectDynArray is out of scope
    procedure Slice;
    /// returns the number of TObject instances available
    // - note that the length of the associated dynamic array is used to store
    // the capacity of the list, so won't probably never match with this value
    function Count: integer;
    /// returns the internal array capacity of TObject instances available
    // - which is in fact the length() of the associated dynamic array
    function Capacity: integer;
  end;

  /// a wrapper to own a dynamic array of TObject
  // - this version behave list a TObjectList (i.e. owning the class instances)
  // - but the dynamic array is NOT owned by the instance
  // - will define an internal Count property, using the dynamic array length
  // as capacity: adding and deleting will be much faster
  // - implements IObjectDynArray, so that most common methods are available
  // to work with the dynamic array
  // - does not need any sub-classing of generic overhead to work, and will be
  // reference counted
  // - warning: the IObjectDynArray MUST be defined in the stack, class or
  // record BEFORE the dynamic array it is wrapping, otherwise you may leak
  // memory, and TObjectDynArrayWrapper.Destroy will raise an ESynException
  // - warning: issues with Delphi 10.4 Sydney were reported, which seemed to
  // change the order of fields finalization, so the whole purpose of this
  // wrapper may have become incompatible with Delphi 10.4 and up
  // - a sample usage may be:
  // !var DA: IObjectDynArray; // defined BEFORE the dynamic array itself
  // !    A: array of TMyObject;
  // !    i: integer;
  // !begin
  // !  DA := TObjectDynArrayWrapper.Create(A);
  // !  DA.Add(TMyObject.Create('one'));
  // !  DA.Add(TMyObject.Create('two'));
  // !  DA.Delete(0);
  // !  assert(DA.Count=1);
  // !  assert(A[0].Name='two');
  // !  DA.Clear;
  // !  assert(DA.Count=0);
  // !  DA.Add(TMyObject.Create('new'));
  // !  assert(DA.Count=1);
  // !end; // will auto-release DA (no need of try..finally DA.Free)
  TObjectDynArrayWrapper = class(TInterfacedObject, IObjectDynArray)
  protected
    fValue: PPointer;
    fCount: integer;
    fOwnObjects: boolean;
  public
    /// initialize the wrapper with a one-dimension dynamic array of TObject
    // - by default, objects will be owned by this class, but you may set
    // aOwnObjects=false if you expect the dynamic array to remain available
    constructor Create(var aValue; aOwnObjects: boolean=true);
    /// will release all associated TObject instances
    destructor Destroy; override;
    /// search one element within the TObject instances
    function Find(Instance: TObject): integer;
    /// add one element to the dynamic array of TObject instances
    // - once added, the Instance will be owned by this TObjectDynArray instance
    // (unless aOwnObjects was false in Create)
    function Add(Instance: TObject): integer;
    /// delete one element from the TObject dynamic array
    // - deleted TObject instance will be freed as expected (unless aOwnObjects
    // was defined as false in Create)
    procedure Delete(Index: integer);
    /// sort the dynamic array content according to a specified comparer
    procedure Sort(Compare: TDynArraySortCompare);
    /// delete all TObject instances, and release the memory
    // - is not to be called for most use, thanks to reference-counting memory
    // handling, but can be handy for quick release
    // - warning: won't release the instances if aOwnObjects was false in Create
    procedure Clear;
    /// ensure the internal list capacity is set to the current Count
    // - may be used to publish the associated dynamic array with the expected
    // final size, once IObjectDynArray is out of scope
    procedure Slice;
    /// returns the number of TObject instances available
    // - note that the length() of the associated dynamic array is used to store
    // the capacity of the list, so won't probably never match with this value
    function Count: integer;
    /// returns the internal array capacity of TObject instances available
    // - which is in fact the length() of the associated dynamic array
    function Capacity: integer;
  end;

  /// abstract parent class with a virtual constructor, ready to be overridden
  // to initialize the instance
  // - you can specify such a class if you need an object including published
  // properties (like TPersistent) with a virtual constructor (e.g. to
  // initialize some nested class properties)
  TPersistentWithCustomCreate = class(TPersistent)
  public
    /// this virtual constructor will be called at instance creation
    // - this constructor does nothing, but is declared as virtual so that
    // inherited classes may safely override this default void implementation
    constructor Create; virtual;
  end;

  {$M+}
  /// abstract parent class with threadsafe implementation of IInterface and
  // a virtual constructor
  // - you can specify e.g. such a class to TSQLRestServer.ServiceRegister() if
  // you need an interfaced object with a virtual constructor, ready to be
  // overridden to initialize the instance
  TInterfacedObjectWithCustomCreate = class(TInterfacedObject)
  public
    /// this virtual constructor will be called at instance creation
    // - this constructor does nothing, but is declared as virtual so that
    // inherited classes may safely override this default void implementation
    constructor Create; virtual;
    /// used to mimic TInterfacedObject reference counting
    // - Release=true will call TInterfacedObject._Release
    // - Release=false will call TInterfacedObject._AddRef
    // - could be used to emulate proper reference counting of the instance
    // via interfaces variables, but still storing plain class instances
    // (e.g. in a global list of instances)
    procedure RefCountUpdate(Release: boolean); virtual;
  end;

  /// our own empowered TPersistent-like parent class
  // - TPersistent has an unexpected speed overhead due a giant lock introduced
  // to manage property name fixup resolution (which we won't use outside the VCL)
  // - this class has a virtual constructor, so is a preferred alternative
  // to both TPersistent and TPersistentWithCustomCreate classes
  // - for best performance, any type inheriting from this class will bypass
  // some regular steps: do not implement interfaces or use TMonitor with them!
  TSynPersistent = class(TObject)
  protected
    // this default implementation will call AssignError()
    procedure AssignTo(Dest: TSynPersistent); virtual;
    procedure AssignError(Source: TSynPersistent);
  public
    /// this virtual constructor will be called at instance creation
    // - this constructor does nothing, but is declared as virtual so that
    // inherited classes may safely override this default void implementation
    constructor Create; virtual;
    /// allows to implement a TPersistent-like assignement mechanism
    // - inherited class should override AssignTo() protected method
    // to implement the proper assignment
    procedure Assign(Source: TSynPersistent); virtual;
    /// optimized initialization code
    // - somewhat faster than the regular RTL implementation - especially
    // since rewritten in pure asm on Delphi/x86
    // - warning: this optimized version won't initialize the vmtIntfTable
    // for this class hierarchy: as a result, you would NOT be able to
    // implement an interface with a TSynPersistent descendent (but you should
    // not need to, but inherit from TInterfacedObject)
    // - warning: under FPC, it won't initialize fields management operators
    class function NewInstance: TObject; override;
    {$ifndef FPC_OR_PUREPASCAL}
    /// optimized x86 asm finalization code
    // - warning: this version won't release either any allocated TMonitor
    // (as available since Delphi 2009) - do not use TMonitor with
    // TSynPersistent, but rather the faster TSynPersistentLock class
    procedure FreeInstance; override;
    {$endif}
  end;
  {$M-}

  /// simple and efficient TList, without any notification
  // - regular TList has an internal notification mechanism which slows down
  // basic process, and most used methods were not defined as virtual, so can't
  // be easily inherited
  // - stateless methods (like Add/Clear/Exists/Remove) are defined as virtual
  // since can be overriden e.g. by TSynObjectListLocked to add a TSynLocker
  TSynList = class(TSynPersistent)
  protected
    fCount: integer;
    fList: TPointerDynArray;
    function Get(index: Integer): pointer; {$ifdef HASINLINE} inline; {$endif}
  public
    /// add one item to the list
    function Add(item: pointer): integer; virtual;
    /// delete all items of the list
    procedure Clear; virtual;
    /// delete one item from the list
    procedure Delete(index: integer); virtual;
    /// fast retrieve one item in the list
    function IndexOf(item: pointer): integer; virtual;
    /// fast check if one item exists in the list
    function Exists(item: pointer): boolean; virtual;
    /// fast delete one item in the list
    function Remove(item: pointer): integer; virtual;
    /// how many items are stored in this TList instance
    property Count: integer read fCount;
    /// low-level access to the items stored in this TList instance
    property List: TPointerDynArray read fList;
    /// low-level array-like access to the items stored in this TList instance
    // - warning: if index is out of range, will return nil and won't raise
    // any exception
    property Items[index: Integer]: pointer read Get; default;
  end;

  /// simple and efficient TObjectList, without any notification
  TSynObjectList = class(TSynList)
  protected
    fOwnObjects: boolean;
  public
    /// initialize the object list
    constructor Create(aOwnObjects: boolean=true); reintroduce;
    /// delete one object from the list
    procedure Delete(index: integer); override;
    /// delete all objects of the list
    procedure Clear; override;
    /// delete all objects of the list in reverse order
    // - for some kind of processes, owned objects should be removed from the
    // last added to the first
    procedure ClearFromLast; virtual;
    /// finalize the store items
    destructor Destroy; override;
  end;

  /// allow to add cross-platform locking methods to any class instance
  // - typical use is to define a Safe: TSynLocker property, call Safe.Init
  // and Safe.Done in constructor/destructor methods, and use Safe.Lock/UnLock
  // methods in a try ... finally section
  // - in respect to the TCriticalSection class, fix a potential CPU cache line
  // conflict which may degrade the multi-threading performance, as reported by
  // @http://www.delphitools.info/2011/11/30/fixing-tcriticalsection
  // - internal padding is used to safely store up to 7 values protected
  // from concurrent access with a mutex, so that SizeOf(TSynLocker)>128
  // - for object-level locking, see TSynPersistentLock which owns one such
  // instance, or call low-level fSafe := NewSynLocker in your constructor,
  // then fSafe^.DoneAndFreemem in your destructor
  TSynLocker = object
  protected
    fSection: TRTLCriticalSection;
    fSectionPadding: PtrInt; // paranoid to avoid FUTEX_WAKE_PRIVATE=EAGAIN
    fLocked, fInitialized: boolean;
    {$ifndef NOVARIANTS}
    function GetVariant(Index: integer): Variant;
    procedure SetVariant(Index: integer; const Value: Variant);
    function GetInt64(Index: integer): Int64;
    procedure SetInt64(Index: integer; const Value: Int64);
    function GetBool(Index: integer): boolean;
    procedure SetBool(Index: integer; const Value: boolean);
    function GetUnlockedInt64(Index: integer): Int64;
    procedure SetUnlockedInt64(Index: integer; const Value: Int64);
    function GetPointer(Index: integer): Pointer;
    procedure SetPointer(Index: integer; const Value: Pointer);
    function GetUTF8(Index: integer): RawUTF8;
    procedure SetUTF8(Index: integer; const Value: RawUTF8);
    {$endif NOVARIANTS}
  public
    /// internal padding data, also used to store up to 7 variant values
    // - this memory buffer will ensure no CPU cache line mixup occurs
    // - you should not use this field directly, but rather the Locked[],
    // LockedInt64[], LockedUTF8[] or LockedPointer[] methods
    // - if you want to access those array values, ensure you protect them
    // using a Safe.Lock; try ... Padding[n] ... finally Safe.Unlock structure,
    // and maintain the PaddingUsedCount field accurately
    Padding: array[0..6] of TVarData;
    /// number of values stored in the internal Padding[] array
    // - equals 0 if no value is actually stored, or a 1..7 number otherwise
    // - you should not have to use this field, but for optimized low-level
    // direct access to Padding[] values, within a Lock/UnLock safe block
    PaddingUsedCount: integer;
    /// initialize the mutex
    // - calling this method is mandatory (e.g. in the class constructor owning
    // the TSynLocker instance), otherwise you may encounter unexpected
    // behavior, like access violations or memory leaks
    procedure Init;
    /// finalize the mutex
    // - calling this method is mandatory (e.g. in the class destructor owning
    // the TSynLocker instance), otherwise you may encounter unexpected
    // behavior, like access violations or memory leaks
    procedure Done;
    /// finalize the mutex, and call FreeMem() on the pointer of this instance
    // - should have been initiazed with a NewSynLocker call
    procedure DoneAndFreeMem;
    /// lock the instance for exclusive access
    // - this method is re-entrant from the same thread (you can nest Lock/UnLock
    // calls in the same thread), but would block any other Lock attempt in
    // another thread
    // - use as such to avoid race condition (from a Safe: TSynLocker property):
    // ! Safe.Lock;
    // ! try
    // !   ...
    // ! finally
    // !   Safe.Unlock;
    // ! end;
    procedure Lock; {$ifdef HASINLINE}inline;{$endif}
    /// will try to acquire the mutex
    // - use as such to avoid race condition (from a Safe: TSynLocker property):
    // ! if Safe.TryLock then
    // !   try
    // !     ...
    // !   finally
    // !     Safe.Unlock;
    // !   end;
    function TryLock: boolean; {$ifdef HASINLINE}inline;{$endif}
    /// will try to acquire the mutex for a given time
    // - use as such to avoid race condition (from a Safe: TSynLocker property):
    // ! if Safe.TryLockMS(100) then
    // !   try
    // !     ...
    // !   finally
    // !     Safe.Unlock;
    // !   end;
    function TryLockMS(retryms: integer): boolean;
    /// release the instance for exclusive access
    // - each Lock/TryLock should have its exact UnLock opposite, so a
    // try..finally block is mandatory for safe code
    procedure UnLock; {$ifdef HASINLINE}inline;{$endif}
    /// will enter the mutex until the IUnknown reference is released
    // - could be used as such under Delphi:
    // !begin
    // !  ... // unsafe code
    // !  Safe.ProtectMethod;
    // !  ... // thread-safe code
    // !end; // local hidden IUnknown will release the lock for the method
    // - warning: under FPC, you should assign its result to a local variable -
    // see bug http://bugs.freepascal.org/view.php?id=26602
    // !var LockFPC: IUnknown;
    // !begin
    // !  ... // unsafe code
    // !  LockFPC := Safe.ProtectMethod;
    // !  ... // thread-safe code
    // !end; // LockFPC will release the lock for the method
    // or
    // !begin
    // !  ... // unsafe code
    // !  with Safe.ProtectMethod do begin
    // !    ... // thread-safe code
    // !  end; // local hidden IUnknown will release the lock for the method
    // !end;
    function ProtectMethod: IUnknown;
    /// returns true if the mutex is currently locked by another thread
    property IsLocked: boolean read fLocked;
    /// returns true if the Init method has been called for this mutex
    // - is only relevant if the whole object has been previously filled with 0,
    // i.e. as part of a class or as global variable, but won't be accurate
    // when allocated on stack
    property IsInitialized: boolean read fInitialized;
    {$ifndef NOVARIANTS}
    /// safe locked access to a Variant value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // LockedBool, LockedInt64, LockedPointer and LockedUTF8 array properties
    // - returns null if the Index is out of range
    property Locked[Index: integer]: Variant read GetVariant write SetVariant;
    /// safe locked access to a Int64 value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked and LockedUTF8 array properties
    // - Int64s will be stored internally as a varInt64 variant
    // - returns nil if the Index is out of range, or does not store a Int64
    property LockedInt64[Index: integer]: Int64 read GetInt64 write SetInt64;
    /// safe locked access to a boolean value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked, LockedInt64, LockedPointer and LockedUTF8 array properties
    // - value will be stored internally as a varBoolean variant
    // - returns nil if the Index is out of range, or does not store a boolean
    property LockedBool[Index: integer]: boolean read GetBool write SetBool;
    /// safe locked access to a pointer/TObject value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked, LockedBool, LockedInt64 and LockedUTF8 array properties
    // - pointers will be stored internally as a varUnknown variant
    // - returns nil if the Index is out of range, or does not store a pointer
    property LockedPointer[Index: integer]: Pointer read GetPointer write SetPointer;
    /// safe locked access to an UTF-8 string value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked and LockedPointer array properties
    // - UTF-8 string will be stored internally as a varString variant
    // - returns '' if the Index is out of range, or does not store a string
    property LockedUTF8[Index: integer]: RawUTF8 read GetUTF8 write SetUTF8;
    /// safe locked in-place increment to an Int64 value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked and LockedUTF8 array properties
    // - Int64s will be stored internally as a varInt64 variant
    // - returns the newly stored value
    // - if the internal value is not defined yet, would use 0 as default value
    function LockedInt64Increment(Index: integer; const Increment: Int64): Int64;
    /// safe locked in-place exchange of a Variant value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked and LockedUTF8 array properties
    // - returns the previous stored value, or null if the Index is out of range
    function LockedExchange(Index: integer; const Value: variant): variant;
    /// safe locked in-place exchange of a pointer/TObject value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked and LockedUTF8 array properties
    // - pointers will be stored internally as a varUnknown variant
    // - returns the previous stored value, nil if the Index is out of range,
    // or does not store a pointer
    function LockedPointerExchange(Index: integer; Value: pointer): pointer;
    /// unsafe access to a Int64 value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked and LockedUTF8 array properties
    // - Int64s will be stored internally as a varInt64 variant
    // - returns nil if the Index is out of range, or does not store a Int64
    // - you should rather call LockedInt64[] property, or use this property
    // with a Lock; try ... finally UnLock block
    property UnlockedInt64[Index: integer]: Int64 read GetUnlockedInt64 write SetUnlockedInt64;
    {$endif NOVARIANTS}
  end;
  PSynLocker = ^TSynLocker;

  /// adding locking methods to a TSynPersistent with virtual constructor
  // - you may use this class instead of the RTL TCriticalSection, since it
  // would use a TSynLocker which does not suffer from CPU cache line conflit
  TSynPersistentLock = class(TSynPersistent)
  protected
    fSafe: PSynLocker; // TSynLocker would increase inherited fields offset
  public
    /// initialize the instance, and its associated lock
    constructor Create; override;
    /// finalize the instance, and its associated lock
    destructor Destroy; override;
    /// access to the associated instance critical section
    // - call Safe.Lock/UnLock to protect multi-thread access on this storage
    property Safe: PSynLocker read fSafe;
  end;

  /// used for backward compatibility only with existing code
  TSynPersistentLocked = class(TSynPersistentLock);

  /// adding locking methods to a TInterfacedObject with virtual constructor
  TInterfacedObjectLocked = class(TInterfacedObjectWithCustomCreate)
  protected
    fSafe: PSynLocker; // TSynLocker would increase inherited fields offset
  public
    /// initialize the object instance, and its associated lock
    constructor Create; override;
    /// release the instance (including the locking resource)
    destructor Destroy; override;
    /// access to the locking methods of this instance
    // - use Safe.Lock/TryLock with a try ... finally Safe.Unlock block
    property Safe: PSynLocker read fSafe;
  end;

  /// used to determine the exact class type of a TInterfacedObjectWithCustomCreate
  // - could be used to create instances using its virtual constructor
  TInterfacedObjectWithCustomCreateClass = class of TInterfacedObjectWithCustomCreate;

  /// used to determine the exact class type of a TPersistentWithCustomCreateClass
  // - could be used to create instances using its virtual constructor
  TPersistentWithCustomCreateClass = class of TPersistentWithCustomCreate;

  /// used to determine the exact class type of a TSynPersistent
  // - could be used to create instances using its virtual constructor
  TSynPersistentClass = class of TSynPersistent;


  /// used to store one list of hashed RawUTF8 in TRawUTF8Interning pool
  // - Delphi "object" is buggy on stack -> also defined as record with methods
  {$ifdef USERECORDWITHMETHODS}TRawUTF8InterningSlot = record
    {$else}TRawUTF8InterningSlot = object{$endif}
  public
    /// actual RawUTF8 storage
    Value: TRawUTF8DynArray;
    /// hashed access to the Value[] list
    Values: TDynArrayHashed;
    /// associated mutex for thread-safe process
    Safe: TSynLocker;
    /// initialize the RawUTF8 slot (and its Safe mutex)
    procedure Init;
    /// finalize the RawUTF8 slot - mainly its associated Safe mutex
    procedure Done;
    /// returns the interned RawUTF8 value
    procedure Unique(var aResult: RawUTF8; const aText: RawUTF8; aTextHash: cardinal);
    /// ensure the supplied RawUTF8 value is interned
    procedure UniqueText(var aText: RawUTF8; aTextHash: cardinal);
    /// delete all stored RawUTF8 values
    procedure Clear;
    /// reclaim any unique RawUTF8 values
    function Clean(aMaxRefCount: integer): integer;
    /// how many items are currently stored in Value[]
    function Count: integer;
  end;

  /// allow to store only one copy of distinct RawUTF8 values
  // - thanks to the Copy-On-Write feature of string variables, this may
  // reduce a lot the memory overhead of duplicated text content
  // - this class is thread-safe and optimized for performance
  TRawUTF8Interning = class(TSynPersistent)
  protected
    fPool: array of TRawUTF8InterningSlot;
    fPoolLast: integer;
  public
    /// initialize the storage and its internal hash pools
    // - aHashTables is the pool size, and should be a power of two <= 512
    constructor Create(aHashTables: integer=4); reintroduce;
    /// finalize the storage
    destructor Destroy; override;
    /// return a RawUTF8 variable stored within this class
    // - if aText occurs for the first time, add it to the internal string pool
    // - if aText does exist in the internal string pool, return the shared
    // instance (with its reference counter increased), to reduce memory usage
    function Unique(const aText: RawUTF8): RawUTF8; overload;
    /// return a RawUTF8 variable stored within this class from a text buffer
    // - if aText occurs for the first time, add it to the internal string pool
    // - if aText does exist in the internal string pool, return the shared
    // instance (with its reference counter increased), to reduce memory usage
    function Unique(aText: PUTF8Char; aTextLen: PtrInt): RawUTF8; overload;
    /// return a RawUTF8 variable stored within this class
    // - if aText occurs for the first time, add it to the internal string pool
    // - if aText does exist in the internal string pool, return the shared
    // instance (with its reference counter increased), to reduce memory usage
    procedure Unique(var aResult: RawUTF8; const aText: RawUTF8); overload;
    /// return a RawUTF8 variable stored within this class from a text buffer
    // - if aText occurs for the first time, add it to the internal string pool
    // - if aText does exist in the internal string pool, return the shared
    // instance (with its reference counter increased), to reduce memory usage
    procedure Unique(var aResult: RawUTF8; aText: PUTF8Char; aTextLen: PtrInt); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// ensure a RawUTF8 variable is stored within this class
    // - if aText occurs for the first time, add it to the internal string pool
    // - if aText does exist in the internal string pool, set the shared
    // instance (with its reference counter increased), to reduce memory usage
    procedure UniqueText(var aText: RawUTF8);
    {$ifndef NOVARIANTS}
    /// return a variant containing a RawUTF8 stored within this class
    // - similar to RawUTF8ToVariant(), but with string interning
    procedure UniqueVariant(var aResult: variant; const aText: RawUTF8); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// return a variant containing a RawUTF8 stored within this class
    // - similar to RawUTF8ToVariant(StringToUTF8()), but with string interning
    // - this method expects the text to be supplied as a VCL string, which will
    // be converted into a variant containing a RawUTF8 varString instance
    procedure UniqueVariantString(var aResult: variant; const aText: string);
    /// return a variant, may be containing a RawUTF8 stored within this class
    // - similar to TextToVariant(), but with string interning
    // - first try with GetNumericVariantFromJSON(), then fallback to
    // RawUTF8ToVariant() with string variable interning
    procedure UniqueVariant(var aResult: variant; aText: PUTF8Char; aTextLen: PtrInt;
      aAllowVarDouble: boolean=false); overload;
    /// ensure a variant contains only RawUTF8 stored within this class
    // - supplied variant should be a varString containing a RawUTF8 value
    procedure UniqueVariant(var aResult: variant); overload; {$ifdef HASINLINE}inline;{$endif}
    {$endif NOVARIANTS}
    /// delete any previous storage pool
    procedure Clear;
    /// reclaim any unique RawUTF8 values
    // - i.e. run a garbage collection process of all values with RefCount=1
    // by default, i.e. all string which are not used any more; you may set
    // aMaxRefCount to a higher value, depending on your expecations, i.e. 2 to
    // delete all string which are referenced only once outside of the pool
    // - returns the number of unique RawUTF8 cleaned from the internal pool
    // - to be executed on a regular basis - but not too often, since the
    // process can be time consumming, and void the benefit of interning
    function Clean(aMaxRefCount: integer=1): integer;
    /// how many items are currently stored in this instance
    function Count: integer;
  end;

  /// store one Name/Value pair, as used by TSynNameValue class
  TSynNameValueItem = record
    /// the name of the Name/Value pair
    // - this property is hashed by TSynNameValue for fast retrieval
    Name: RawUTF8;
    /// the value of the Name/Value pair
    Value: RawUTF8;
    /// any associated Pointer or numerical value
    Tag: PtrInt;
  end;

  /// Name/Value pairs storage, as used by TSynNameValue class
  TSynNameValueItemDynArray = array of TSynNameValueItem;

  /// event handler used to convert on the fly some UTF-8 text content
  TOnSynNameValueConvertRawUTF8 = function(const text: RawUTF8): RawUTF8 of object;

  /// callback event used by TSynNameValue
  TOnSynNameValueNotify = procedure(const Item: TSynNameValueItem; Index: PtrInt) of object;

  /// pseudo-class used to store Name/Value RawUTF8 pairs
  // - use internaly a TDynArrayHashed instance for fast retrieval
  // - is therefore faster than TRawUTF8List
  // - is defined as an object, not as a class: you can use this in any
  // class, without the need to destroy the content
  // - Delphi "object" is buggy on stack -> also defined as record with methods
  {$ifdef USERECORDWITHMETHODS}TSynNameValue = record
  {$else}TSynNameValue = object {$endif}
  private
    fOnAdd: TOnSynNameValueNotify;
    function GetBlobData: RawByteString;
    procedure SetBlobData(const aValue: RawByteString);
    function GetStr(const aName: RawUTF8): RawUTF8; {$ifdef HASINLINE}inline;{$endif}
    function GetInt(const aName: RawUTF8): Int64; {$ifdef HASINLINE}inline;{$endif}
    function GetBool(const aName: RawUTF8): Boolean; {$ifdef HASINLINE}inline;{$endif}
  public
    /// the internal Name/Value storage
    List: TSynNameValueItemDynArray;
    /// the number of Name/Value pairs
    Count: integer;
    /// low-level access to the internal storage hasher
    DynArray: TDynArrayHashed;
    /// initialize the storage
    // - will also reset the internal List[] and the internal hash array
    procedure Init(aCaseSensitive: boolean);
    /// add an element to the array
    // - if aName already exists, its associated Value will be updated
    procedure Add(const aName, aValue: RawUTF8; aTag: PtrInt=0);
    /// reset content, then add all name=value pairs from a supplied .ini file
    // section content
    // - will first call Init(false) to initialize the internal array
    // - Section can be retrieved e.g. via FindSectionFirstLine()
    procedure InitFromIniSection(Section: PUTF8Char; OnTheFlyConvert: TOnSynNameValueConvertRawUTF8=nil;
      OnAdd: TOnSynNameValueNotify=nil);
    /// reset content, then add all name=value; CSV pairs
    // - will first call Init(false) to initialize the internal array
    // - if ItemSep=#10, then any kind of line feed (CRLF or LF) will be handled
    procedure InitFromCSV(CSV: PUTF8Char; NameValueSep: AnsiChar='=';
      ItemSep: AnsiChar=#10);
    /// reset content, then add all fields from an JSON object
    // - will first call Init() to initialize the internal array
    // - then parse the incoming JSON object, storing all its field values
    // as RawUTF8, and returning TRUE if the supplied content is correct
    // - warning: the supplied JSON buffer will be decoded and modified in-place
    function InitFromJSON(JSON: PUTF8Char; aCaseSensitive: boolean=false): boolean;
    /// reset content, then add all name, value pairs
    // - will first call Init(false) to initialize the internal array
    procedure InitFromNamesValues(const Names, Values: array of RawUTF8);
    /// search for a Name, return the index in List
    // - using fast O(1) hash algoritm
    function Find(const aName: RawUTF8): integer;
    /// search for the first chars of a Name, return the index in List
    // - using O(n) calls of IdemPChar() function
    // - here aUpperName should be already uppercase, as expected by IdemPChar()
    function FindStart(const aUpperName: RawUTF8): integer;
    /// search for a Value, return the index in List
    // - using O(n) brute force algoritm with case-sensitive aValue search
    function FindByValue(const aValue: RawUTF8): integer;
    /// search for a Name, and delete its entry in the List if it exists
    function Delete(const aName: RawUTF8): boolean;
    /// search for a Value, and delete its entry in the List if it exists
    // - returns the number of deleted entries
    // - you may search for more than one match, by setting a >1 Limit value
    function DeleteByValue(const aValue: RawUTF8; Limit: integer=1): integer;
    /// search for a Name, return the associated Value as a UTF-8 string
    function Value(const aName: RawUTF8; const aDefaultValue: RawUTF8=''): RawUTF8;
    /// search for a Name, return the associated Value as integer
    function ValueInt(const aName: RawUTF8; const aDefaultValue: Int64=0): Int64;
    /// search for a Name, return the associated Value as boolean
    // - returns true only if the value is exactly '1'
    function ValueBool(const aName: RawUTF8): Boolean;
    /// search for a Name, return the associated Value as an enumerate
    // - returns true and set aEnum if aName was found, and associated value
    // matched an aEnumTypeInfo item
    // - returns false if no match was found
    function ValueEnum(const aName: RawUTF8; aEnumTypeInfo: pointer; out aEnum;
      aEnumDefault: byte=0): boolean; overload;
    /// returns all values, as CSV or INI content
    function AsCSV(const KeySeparator: RawUTF8='=';
      const ValueSeparator: RawUTF8=#13#10; const IgnoreKey: RawUTF8=''): RawUTF8;
    /// returns all values as a JSON object of string fields
    function AsJSON: RawUTF8;
    /// fill the supplied two arrays of RawUTF8 with the stored values
    procedure AsNameValues(out Names,Values: TRawUTF8DynArray);
    {$ifndef NOVARIANTS}
    /// search for a Name, return the associated Value as variant
    // - returns null if the name was not found
    function ValueVariantOrNull(const aName: RawUTF8): variant;
    /// compute a TDocVariant document from the stored values
    // - output variant will be reset and filled as a TDocVariant instance,
    // ready to be serialized as a JSON object
    // - if there is no value stored (i.e. Count=0), set null
    procedure AsDocVariant(out DocVariant: variant;
      ExtendedJson: boolean=false; ValueAsString: boolean=true;
      AllowVarDouble: boolean=false); overload;
    /// compute a TDocVariant document from the stored values
    function AsDocVariant(ExtendedJson: boolean=false; ValueAsString: boolean=true): variant; overload; {$ifdef HASINLINE}inline;{$endif}
    /// merge the stored values into a TDocVariant document
    // - existing properties would be updated, then new values will be added to
    // the supplied TDocVariant instance, ready to be serialized as a JSON object
    // - if ValueAsString is TRUE, values would be stored as string
    // - if ValueAsString is FALSE, numerical values would be identified by
    // IsString() and stored as such in the resulting TDocVariant
    // - if you let ChangedProps point to a TDocVariantData, it would contain
    // an object with the stored values, just like AsDocVariant
    // - returns the number of updated values in the TDocVariant, 0 if
    // no value was changed
    function MergeDocVariant(var DocVariant: variant;
      ValueAsString: boolean; ChangedProps: PVariant=nil;
      ExtendedJson: boolean=false; AllowVarDouble: boolean=false): integer;
    {$endif}
    /// returns true if the Init() method has been called
    function Initialized: boolean;
    /// can be used to set all data from one BLOB memory buffer
    procedure SetBlobDataPtr(aValue: pointer);
    /// can be used to set or retrieve all stored data as one BLOB content
    property BlobData: RawByteString read GetBlobData write SetBlobData;
    /// event triggerred after an item has just been added to the list
    property OnAfterAdd: TOnSynNameValueNotify read fOnAdd write fOnAdd;
    /// search for a Name, return the associated Value as a UTF-8 string
    // - returns '' if aName is not found in the stored keys
    property Str[const aName: RawUTF8]: RawUTF8 read GetStr; default;
    /// search for a Name, return the associated Value as integer
    // - returns 0 if aName is not found, or not a valid Int64 in the stored keys
    property Int[const aName: RawUTF8]: Int64 read GetInt;
    /// search for a Name, return the associated Value as boolean
    // - returns true if aName stores '1' as associated value
    property Bool[const aName: RawUTF8]: Boolean read GetBool;
  end;

  /// a reference pointer to a Name/Value RawUTF8 pairs storage
  PSynNameValue = ^TSynNameValue;

/// allocate and initialize a TSynLocker instance
// - caller should call result^.DoneAndFreemem when not used any more
function NewSynLocker: PSynLocker;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to add an item to a array of pointer dynamic array storage
function PtrArrayAdd(var aPtrArray; aItem: pointer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to add once an item to a array of pointer dynamic array storage
function PtrArrayAddOnce(var aPtrArray; aItem: pointer): integer;

/// wrapper to delete an item from a array of pointer dynamic array storage
function PtrArrayDelete(var aPtrArray; aItem: pointer; aCount: PInteger=nil): integer; overload;

/// wrapper to delete an item from a array of pointer dynamic array storage
procedure PtrArrayDelete(var aPtrArray; aIndex: integer; aCount: PInteger=nil); overload;

/// wrapper to find an item to a array of pointer dynamic array storage
function PtrArrayFind(var aPtrArray; aItem: pointer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to add an item to a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - could be used as such (note the T*ObjArray type naming convention):
// ! TUserObjArray = array of TUser;
// ! ...
// ! var arr: TUserObjArray;
// !     user: TUser;
// ! ..
// ! try
// !   user := TUser.Create;
// !   user.Name := 'Name';
// !   index := ObjArrayAdd(arr,user);
// ! ...
// ! finally
// !   ObjArrayClear(arr); // release all items
// ! end;
// - return the index of the item in the dynamic array
function ObjArrayAdd(var aObjArray; aItem: TObject): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to add items to a T*ObjArray dynamic array storage
// - aSourceObjArray[] items are just copied to aDestObjArray, which remains untouched
// - return the new number of the items in aDestObjArray
function ObjArrayAddFrom(var aDestObjArray; const aSourceObjArray): PtrInt;

/// wrapper to add and move items to a T*ObjArray dynamic array storage
// - aSourceObjArray[] items will be owned by aDestObjArray[], therefore
// aSourceObjArray is set to nil
// - return the new number of the items in aDestObjArray
function ObjArrayAppend(var aDestObjArray, aSourceObjArray): PtrInt;

/// wrapper to add an item to a T*ObjArray dynamic array storage
// - this overloaded function will use a separated variable to store the items
// count, so will be slightly faster: but you should call SetLength() when done,
// to have an array as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - return the index of the item in the dynamic array
function ObjArrayAddCount(var aObjArray; aItem: TObject; var aObjArrayCount: integer): PtrInt;

/// wrapper to add once an item to a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - if the object is already in the array (searching by address/reference,
// not by content), return its current index in the dynamic array
// - if the object does not appear in the array, add it at the end
procedure ObjArrayAddOnce(var aObjArray; aItem: TObject);

// - aSourceObjArray[] items are just copied to aDestObjArray, which remains untouched
// - will first check if aSourceObjArray[] items are not already in aDestObjArray
// - return the new number of the items in aDestObjArray
function ObjArrayAddOnceFrom(var aDestObjArray; const aSourceObjArray): PtrInt;

/// wrapper to set the length of a T*ObjArray dynamic array storage
// - could be used as an alternative to SetLength() when you do not
// know the exact T*ObjArray type
procedure ObjArraySetLength(var aObjArray; aLength: integer);
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to search an item in a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - search is performed by address/reference, not by content
// - returns -1 if the item is not found in the dynamic array
function ObjArrayFind(const aObjArray; aItem: TObject): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to search an item in a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - search is performed by address/reference, not by content
// - returns -1 if the item is not found in the dynamic array
function ObjArrayFind(const aObjArray; aCount: integer; aItem: TObject): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to count all not nil items in a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
function ObjArrayCount(const aObjArray): integer;

/// wrapper to delete an item in a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - do nothing if the index is out of range in the dynamic array
procedure ObjArrayDelete(var aObjArray; aItemIndex: PtrInt;
  aContinueOnException: boolean=false; aCount: PInteger=nil); overload;

/// wrapper to delete an item in a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - search is performed by address/reference, not by content
// - do nothing if the item is not found in the dynamic array
function ObjArrayDelete(var aObjArray; aItem: TObject): PtrInt; overload;

/// wrapper to delete an item in a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - search is performed by address/reference, not by content
// - do nothing if the item is not found in the dynamic array
function ObjArrayDelete(var aObjArray; aCount: integer; aItem: TObject): PtrInt; overload;

/// wrapper to sort the items stored in a T*ObjArray dynamic array
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
procedure ObjArraySort(var aObjArray; Compare: TDynArraySortCompare);

/// wrapper to release all items stored in a T*ObjArray dynamic array
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - you should always use ObjArrayClear() before the array storage is released,
// e.g. in the owner class destructor
// - will also set the dynamic array length to 0, so could be used to re-use
// an existing T*ObjArray
procedure ObjArrayClear(var aObjArray); overload;

/// wrapper to release all items stored in a T*ObjArray dynamic array
// - this overloaded function will use the supplied array length as parameter
// - you should always use ObjArrayClear() before the array storage is released,
// e.g. in the owner class destructor
// - will also set the dynamic array length to 0, so could be used to re-use
// an existing T*ObjArray
procedure ObjArrayClear(var aObjArray; aCount: integer); overload;

/// wrapper to release all items stored in a T*ObjArray dynamic array
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - you should always use ObjArrayClear() before the array storage is released,
// e.g. in the owner class destructor
// - will also set the dynamic array length to 0, so could be used to re-use
// an existing T*ObjArray
procedure ObjArrayClear(var aObjArray; aContinueOnException: boolean;
  aCount: PInteger=nil); overload;

/// wrapper to release all items stored in an array of T*ObjArray dynamic array
// - e.g. aObjArray may be defined as "array of array of TSynFilter"
procedure ObjArrayObjArrayClear(var aObjArray);

/// wrapper to release all items stored in several T*ObjArray dynamic arrays
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
procedure ObjArraysClear(const aObjArray: array of pointer);

/// low-level function calling FreeAndNil(o^) successively n times
procedure RawObjectsClear(o: PObject; n: integer);

{$ifndef DELPHI5OROLDER}

/// wrapper to add an item to a T*InterfaceArray dynamic array storage
function InterfaceArrayAdd(var aInterfaceArray; const aItem: IUnknown): PtrInt;

/// wrapper to add once an item to a T*InterfaceArray dynamic array storage
procedure InterfaceArrayAddOnce(var aInterfaceArray; const aItem: IUnknown);

/// wrapper to search an item in a T*InterfaceArray dynamic array storage
// - search is performed by address/reference, not by content
// - return -1 if the item is not found in the dynamic array, or the index of
// the matching entry otherwise
function InterfaceArrayFind(const aInterfaceArray; const aItem: IUnknown): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to delete an item in a T*InterfaceArray dynamic array storage
// - search is performed by address/reference, not by content
// - do nothing if the item is not found in the dynamic array
function InterfaceArrayDelete(var aInterfaceArray; const aItem: IUnknown): PtrInt; overload;

/// wrapper to delete an item in a T*InterfaceArray dynamic array storage
// - do nothing if the item is not found in the dynamic array
procedure InterfaceArrayDelete(var aInterfaceArray; aItemIndex: PtrInt); overload;

{$endif DELPHI5OROLDER}


/// helper to retrieve the text of an enumerate item
// - see also RTTI related classes of mORMot.pas unit, e.g. TEnumType
function GetEnumName(aTypeInfo: pointer; aIndex: integer): PShortString;

/// helper to retrieve all texts of an enumerate
// - may be used as cache for overloaded ToText() content
procedure GetEnumNames(aTypeInfo: pointer; aDest: PPShortString);

/// helper to retrieve all trimmed texts of an enumerate
// - may be used as cache to retrieve UTF-8 text without lowercase 'a'..'z' chars
procedure GetEnumTrimmedNames(aTypeInfo: pointer; aDest: PRawUTF8); overload;

/// helper to retrieve all trimmed texts of an enumerate as UTF-8 strings
function GetEnumTrimmedNames(aTypeInfo: pointer): TRawUTF8DynArray; overload;

/// helper to retrieve all (translated) caption texts of an enumerate
// - may be used as cache for overloaded ToCaption() content
procedure GetEnumCaptions(aTypeInfo: pointer; aDest: PString);

/// UnCamelCase and translate the enumeration item
function GetCaptionFromEnum(aTypeInfo: pointer; aIndex: integer): string;

/// low-level helper to retrieve a (translated) caption from a PShortString
// - as used e.g. by GetEnumCaptions or GetCaptionFromEnum
procedure GetCaptionFromTrimmed(PS: PShortString; var result: string);

/// helper to retrieve the index of an enumerate item from its text
// - returns -1 if aValue was not found
// - will search for the exact text and also trim the lowercase 'a'..'z' chars on
// left side of the text if no exact match is found and AlsoTrimLowerCase is TRUE
// - see also RTTI related classes of mORMot.pas unit, e.g. TEnumType
function GetEnumNameValue(aTypeInfo: pointer; aValue: PUTF8Char; aValueLen: PtrInt;
  AlsoTrimLowerCase: boolean=false): Integer; overload;

/// retrieve the index of an enumerate item from its left-trimmed text
// - text comparison is case-insensitive for A-Z characters
// - will trim the lowercase 'a'..'z' chars on left side of the supplied aValue text
// - returns -1 if aValue was not found
function GetEnumNameValueTrimmed(aTypeInfo: pointer; aValue: PUTF8Char; aValueLen: PtrInt): integer;

/// retrieve the index of an enumerate item from its left-trimmed text
// - text comparison is case-sensitive for A-Z characters
// - will trim the lowercase 'a'..'z' chars on left side of the supplied aValue text
// - returns -1 if aValue was not found
function GetEnumNameValueTrimmedExact(aTypeInfo: pointer; aValue: PUTF8Char; aValueLen: PtrInt): integer;

/// helper to retrieve the index of an enumerate item from its text
function GetEnumNameValue(aTypeInfo: pointer; const aValue: RawUTF8;
  AlsoTrimLowerCase: boolean=false): Integer; overload;

/// helper to retrieve the bit mapped integer value of a set from its JSON text
// - if supplied P^ is a JSON integer number, will read it directly
// - if P^ maps some ["item1","item2"] content, would fill all matching bits
// - if P^ contains ['*'], would fill all bits
// - returns P=nil if reached prematurly the end of content, or returns
// the value separator (e.g. , or }) in EndOfObject (like GetJsonField)
function GetSetNameValue(aTypeInfo: pointer; var P: PUTF8Char;
  out EndOfObject: AnsiChar): cardinal;

/// helper to retrieve the CSV text of all enumerate items defined in a set
// - you'd better use RTTI related classes of mORMot.pas unit, e.g. TEnumType
function GetSetName(aTypeInfo: pointer; const value): RawUTF8;

/// helper to retrieve the CSV text of all enumerate items defined in a set
// - you'd better use RTTI related classes of mORMot.pas unit, e.g. TEnumType
procedure GetSetNameShort(aTypeInfo: pointer; const value; out result: ShortString;
  trimlowercase: boolean=false);

/// low-level helper to retrive the base enumeration RTTI of a given set
function GetSetBaseEnum(aTypeInfo: pointer): pointer;

/// fast append some UTF-8 text into a shortstring, with an ending ','
procedure AppendShortComma(text: PAnsiChar; len: PtrInt; var result: shortstring;
  trimlowercase: boolean);

/// fast search of an exact case-insensitive match of a RTTI's PShortString array
function FindShortStringListExact(List: PShortString; MaxValue: integer;
  aValue: PUTF8Char; aValueLen: PtrInt): integer;

/// fast case-insensitive search of a left-trimmed lowercase match
// of a RTTI's PShortString array
function FindShortStringListTrimLowerCase(List: PShortString; MaxValue: integer;
  aValue: PUTF8Char; aValueLen: PtrInt): integer;

/// fast case-sensitive search of a left-trimmed lowercase match
// of a RTTI's PShortString array
function FindShortStringListTrimLowerCaseExact(List: PShortString; MaxValue: integer;
  aValue: PUTF8Char; aValueLen: PtrInt): integer;

/// retrieve the type name from its low-level RTTI
function TypeInfoToName(aTypeInfo: pointer): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the type name from its low-level RTTI
procedure TypeInfoToName(aTypeInfo: pointer; var result: RawUTF8;
  const default: RawUTF8=''); overload;

/// retrieve the unit name and type name from its low-level RTTI
procedure TypeInfoToQualifiedName(aTypeInfo: pointer; var result: RawUTF8;
  const default: RawUTF8='');

/// compute a crc32c-based hash of the RTTI for a managed given type
// - can be used to ensure that the RecordSave/TDynArray.SaveTo binary layout
// is compatible accross executables, even between FPC and Delphi
// - will ignore the type names, but will check the RTTI type kind and any
// nested fields (for records or arrays) - for a record/object type, will use
// TTextWriter.RegisterCustomJSONSerializerFromText definition, if available
function TypeInfoToHash(aTypeInfo: pointer): cardinal;

/// retrieve the record size from its low-level RTTI
function RecordTypeInfoSize(aRecordTypeInfo: pointer): integer;

/// retrieve the item type information of a dynamic array low-level RTTI
function DynArrayTypeInfoToRecordInfo(aDynArrayTypeInfo: pointer;
  aDataSize: PInteger=nil): pointer;

/// sort any dynamic array, via an external array of indexes
// - this function will use the supplied TSynTempBuffer for index storage,
// so use PIntegerArray(Indexes.buf) to access the values
// - caller should always make Indexes.Done once done
procedure DynArraySortIndexed(Values: pointer; ElemSize, Count: Integer;
  out Indexes: TSynTempBuffer; Compare: TDynArraySortCompare);

/// compare two TGUID values
// - this version is faster than the one supplied by SysUtils
function IsEqualGUID(const guid1, guid2: TGUID): Boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// compare two TGUID values
// - this version is faster than the one supplied by SysUtils
function IsEqualGUID(guid1, guid2: PGUID): Boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns the index of a matching TGUID in an array
// - returns -1 if no item matched
function IsEqualGUIDArray(const guid: TGUID; const guids: array of TGUID): integer;

/// check if a TGUID value contains only 0 bytes
// - this version is faster than the one supplied by SysUtils
function IsNullGUID({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// append one TGUID item to a TGUID dynamic array
// - returning the newly inserted index in guids[], or an existing index in
// guids[] if NoDuplicates is TRUE and TGUID already exists
function AddGUID(var guids: TGUIDDynArray; const guid: TGUID;
  NoDuplicates: boolean=false): integer;

/// append a TGUID binary content as text
// - will store e.g. '3F2504E0-4F89-11D3-9A0C-0305E82C3301' (without any {})
// - this will be the format used for JSON encoding, e.g.
// $ { "UID": "C9A646D3-9C61-4CB7-BFCD-EE2522C8F633" }
function GUIDToText(P: PUTF8Char; guid: PByteArray): PUTF8Char;

/// convert a TGUID into UTF-8 encoded text
// - will return e.g. '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}' (with the {})
// - if you do not need the embracing { }, use ToUTF8() overloaded function
function GUIDToRawUTF8({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): RawUTF8;

/// convert a TGUID into text
// - will return e.g. '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}' (with the {})
// - this version is faster than the one supplied by SysUtils
function GUIDToString({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): string;

type
  /// low-level object implementing a 32-bit Pierre L'Ecuyer software generator
  // - as used by Random32gsl, and Random32 if no RDRAND hardware is available
  // - is not thread-safe by itself, but cross-compiler and cross-platform, still
  // very fast with a much better distribution than Delphi system's Random() function
  // - Random32gsl/Random32 will use a threadvar to have thread safety
  TLecuyer = object
  public
    rs1, rs2, rs3, seedcount: cardinal;
    /// force an immediate seed of the generator from current system state
    // - should be called before any call to the Next method
    procedure Seed(entropy: PByteArray; entropylen: PtrInt);
    /// compute the next 32-bit generated value
    // - will automatically reseed after around 65,000 generated values
    function Next: cardinal; overload;
    /// compute the next 32-bit generated value, in range [0..max-1]
    // - will automatically reseed after around 65,000 generated values
    function Next(max: cardinal): cardinal; overload;
  end;

/// fast compute of some 32-bit random value
// - will use (slow but) hardware-derivated RDRAND Intel x86/x64 opcode if
// available, or fast gsl_rng_taus2 generator by Pierre L'Ecuyer (which period
// is 2^88, i.e. about 10^26) if the CPU doesn't support it
// - will detect known AMD CPUs RDRAND bugs, and fallback to gsl_rng_taus2
// - consider Random32gsl to avoid slow RDRAND call (up to 1500 cycles needed!)
// - use rather TAESPRNG.Main.FillRandom() for cryptographic-level randomness
// - thread-safe function: each thread will maintain its own TLecuyer table
function Random32: cardinal; overload;

/// fast compute of some 32-bit random value, with a maximum (excluded) upper value
// - i.e. returns a value in range [0..max-1]
// - calls internally the overloaded Random32 function
function Random32(max: cardinal): cardinal; overload;

/// fast compute of some 32-bit random value, using the gsl_rng_taus2 generator
// - Random32 may call RDRAND opcode on Intel CPUs, wherease this function will use
// well documented, much faster, and proven Pierre L'Ecuyer software generator
// - may be used if you don't want/trust RDRAND, if you expect a well defined
// cross-platform generator, or have higher performance expectations
// - use rather TAESPRNG.Main.FillRandom() for cryptographic-level randomness
// - thread-safe function: each thread will maintain its own TLecuyer table
function Random32gsl: cardinal; overload;

/// fast compute of bounded 32-bit random value, using the gsl_rng_taus2 generator
// - calls internally the overloaded Random32gsl function
function Random32gsl(max: cardinal): cardinal; overload;

/// seed the gsl_rng_taus2 Random32/Random32gsl generator
// - this seeding won't affect RDRAND Intel x86/x64 opcode generation
// - by default, gsl_rng_taus2 generator is re-seeded every 256KB, much more
// often than the Pierre L'Ecuyer's algorithm period of 2^88
// - you can specify some additional entropy buffer; note that calling this
// function with the same entropy again WON'T seed the generator with the same
// sequence (as with RTL's RandomSeed function), but initiate a new one
// - thread-specific function: each thread will maintain its own seed table
procedure Random32Seed(entropy: pointer=nil; entropylen: PtrInt=0);

/// fill some memory buffer with random values
// - the destination buffer is expected to be allocated as 32-bit items
// - use internally crc32c() with some rough entropy source, and Random32
// gsl_rng_taus2 generator or hardware RDRAND Intel x86/x64 opcode if available
// (and ForceGsl is kept to its default false)
// - consider using instead the cryptographic secure TAESPRNG.Main.FillRandom()
// method from the SynCrypto unit, or set ForceGsl=true - in particular, RDRAND
// is reported as very slow: see https://en.wikipedia.org/wiki/RdRand#Performance
procedure FillRandom(Dest: PCardinalArray; CardinalCount: integer; ForceGsl: boolean=false);

/// compute a random GUID value
procedure RandomGUID(out result: TGUID); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// compute a random GUID value
function RandomGUID: TGUID; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill a GUID with 0
procedure FillZero(var result: TGUID); overload; {$ifdef HASINLINE}inline;{$endif}

type
  /// stack-allocated ASCII string, used by GUIDToShort() function
  TGUIDShortString = string[38];

const
  /// a TGUID containing '{00000000-0000-0000-0000-00000000000}'
  GUID_NULL: TGUID = ();

/// convert a TGUID into text
// - will return e.g. '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}' (with the {})
// - using a shortstring will allow fast allocation on the stack, so is
// preferred e.g. when providing a GUID to a ESynException.CreateUTF8()
function GUIDToShort({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF}
  guid: TGUID): TGUIDShortString; overload; {$ifdef HASINLINE}inline;{$endif}

/// convert a TGUID into text
// - will return e.g. '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}' (with the {})
// - using a shortstring will allow fast allocation on the stack, so is
// preferred e.g. when providing a GUID to a ESynException.CreateUTF8()
procedure GUIDToShort({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF}
  guid: TGUID; out dest: TGUIDShortString); overload;

/// convert some text into its TGUID binary value
// - expect e.g. '3F2504E0-4F89-11D3-9A0C-0305E82C3301' (without any {})
// - return nil if the supplied text buffer is not a valid TGUID
// - this will be the format used for JSON encoding, e.g.
// $ { "UID": "C9A646D3-9C61-4CB7-BFCD-EE2522C8F633" }
function TextToGUID(P: PUTF8Char; guid: PByteArray): PUTF8Char;

/// convert some text into a TGUID
// - expect e.g. '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}' (with the {})
// - return {00000000-0000-0000-0000-000000000000} if the supplied text buffer
// is not a valid TGUID
function StringToGUID(const text: string): TGUID;

/// convert some UTF-8 encoded text into a TGUID
// - expect e.g. '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}' (with the {})
// - return {00000000-0000-0000-0000-000000000000} if the supplied text buffer
// is not a valid TGUID
function RawUTF8ToGUID(const text: RawByteString): TGUID;


/// check equality of two records by content
// - will handle packed records, with binaries (byte, word, integer...) and
// string types properties
// - will use binary-level comparison: it could fail to match two floating-point
// values because of rounding issues (Currency won't have this problem)
function RecordEquals(const RecA, RecB; TypeInfo: pointer;
  PRecSize: PInteger=nil): boolean;

/// save a record content into a RawByteString
// - will handle packed records, with binaries (byte, word, integer...) and
// string types properties (but not with internal raw pointers, of course)
// - will use a proprietary binary format, with some variable-length encoding
// of the string length - note that if you change the type definition, any
// previously-serialized content will fail, maybe triggering unexpected GPF: you
// may use TypeInfoToHash() if you share this binary data accross executables
// - warning: will encode generic string fields as AnsiString (one byte per char)
// prior to Delphi 2009, and as UnicodeString (two bytes per char) since Delphi
// 2009: if you want to use this function between UNICODE and NOT UNICODE
// versions of Delphi, you should use some explicit types like RawUTF8,
// WinAnsiString, SynUnicode or even RawUnicode/WideString
function RecordSave(const Rec; TypeInfo: pointer): RawByteString; overload;

/// save a record content into a TBytes dynamic array
// - could be used as an alternative to RawByteString's RecordSave()
function RecordSaveBytes(const Rec; TypeInfo: pointer): TBytes;

/// save a record content into a destination memory buffer
// - Dest must be at least RecordSaveLength() bytes long
// - will return the Rec size, in bytes, into Len reference variable
// - will handle packed records, with binaries (byte, word, integer...) and
// string types properties (but not with internal raw pointers, of course)
// - will use a proprietary binary format, with some variable-length encoding
// of the string length - note that if you change the type definition, any
// previously-serialized content will fail, maybe triggering unexpected GPF: you
// may use TypeInfoToHash() if you share this binary data accross executables
// - warning: will encode generic string fields as AnsiString (one byte per char)
// prior to Delphi 2009, and as UnicodeString (two bytes per char) since Delphi
// 2009: if you want to use this function between UNICODE and NOT UNICODE
// versions of Delphi, you should use some explicit types like RawUTF8,
// WinAnsiString, SynUnicode or even RawUnicode/WideString
function RecordSave(const Rec; Dest: PAnsiChar; TypeInfo: pointer;
  out Len: integer): PAnsiChar; overload;

/// save a record content into a destination memory buffer
// - Dest must be at least RecordSaveLength() bytes long
// - will handle packed records, with binaries (byte, word, integer...) and
// string types properties (but not with internal raw pointers, of course)
// - will use a proprietary binary format, with some variable-length encoding
// of the string length - note that if you change the type definition, any
// previously-serialized content will fail, maybe triggering unexpected GPF: you
// may use TypeInfoToHash() if you share this binary data accross executables
// - warning: will encode generic string fields as AnsiString (one byte per char)
// prior to Delphi 2009, and as UnicodeString (two bytes per char) since Delphi
// 2009: if you want to use this function between UNICODE and NOT UNICODE
// versions of Delphi, you should use some explicit types like RawUTF8,
// WinAnsiString, SynUnicode or even RawUnicode/WideString
function RecordSave(const Rec; Dest: PAnsiChar; TypeInfo: pointer): PAnsiChar; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// save a record content into a destination memory buffer
// - caller should make Dest.Done once finished with Dest.buf/Dest.len buffer
procedure RecordSave(const Rec; var Dest: TSynTempBuffer; TypeInfo: pointer); overload;

/// save a record content into a Base-64 encoded UTF-8 text content
// - will use RecordSave() format, with a left-sided binary CRC32C
function RecordSaveBase64(const Rec; TypeInfo: pointer; UriCompatible: boolean=false): RawUTF8;

/// compute the number of bytes needed to save a record content
// using the RecordSave() function
// - will return 0 in case of an invalid (not handled) record type (e.g. if
// it contains an unknown variant)
// - optional Len parameter will contain the Rec memory buffer length, in bytes
function RecordSaveLength(const Rec; TypeInfo: pointer; Len: PInteger=nil): integer;

/// save record into its JSON serialization as saved by TTextWriter.AddRecordJSON
// - will use default Base64 encoding over RecordSave() binary - or custom true
// JSON format (as set by TTextWriter.RegisterCustomJSONSerializer or via
// enhanced RTTI), if available (following EnumSetsAsText optional parameter
// for nested enumerates and sets)
function RecordSaveJSON(const Rec; TypeInfo: pointer;
  EnumSetsAsText: boolean=false): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// fill a record content from a memory buffer as saved by RecordSave()
// - return nil if the Source buffer is incorrect
// - in case of success, return the memory buffer pointer just after the
// read content, and set the Rec size, in bytes, into Len reference variable
// - will use a proprietary binary format, with some variable-length encoding
// of the string length - note that if you change the type definition, any
// previously-serialized content will fail, maybe triggering unexpected GPF: you
// may use TypeInfoToHash() if you share this binary data accross executables
// - you can optionally provide in SourceMax the first byte after the input
// memory buffer, which will be used to avoid any unexpected buffer overflow -
// would be mandatory when decoding the content from any external process
// (e.g. a maybe-forged client) - only with slightly performance penalty
function RecordLoad(var Rec; Source: PAnsiChar; TypeInfo: pointer;
  Len: PInteger=nil; SourceMax: PAnsiChar=nil): PAnsiChar; overload;

/// fill a record content from a memory buffer as saved by RecordSave()
// - will use the Source length to detect and avoid any buffer overlow
// - returns false if the Source buffer was incorrect, true on success
function RecordLoad(var Res; const Source: RawByteString; TypeInfo: pointer): boolean; overload;

/// read a record content from a Base-64 encoded content
// - expects RecordSaveBase64() format, with a left-sided binary CRC
function RecordLoadBase64(Source: PAnsiChar; Len: PtrInt; var Rec; TypeInfo: pointer;
  UriCompatible: boolean=false): boolean;

/// fill a record content from a JSON serialization as saved by
// TTextWriter.AddRecordJSON / RecordSaveJSON
// - will use default Base64 encoding over RecordSave() binary - or custom true
// JSON format (as set by TTextWriter.RegisterCustomJSONSerializer or via
// enhanced RTTI), if available
// - returns nil on error, or the end of buffer on success
// - warning: the JSON buffer will be modified in-place during process - use
// a temporary copy if you need to access it later or if the string comes from
// a constant (refcount=-1) - see e.g. the overloaded RecordLoadJSON()
function RecordLoadJSON(var Rec; JSON: PUTF8Char; TypeInfo: pointer;
  EndOfObject: PUTF8Char=nil{$ifndef NOVARIANTS};
  CustomVariantOptions: PDocVariantOptions=nil{$endif}): PUTF8Char; overload;

/// fill a record content from a JSON serialization as saved by
// TTextWriter.AddRecordJSON / RecordSaveJSON
// - this overloaded function will make a private copy before parsing it,
// so is safe with a read/only or shared string - but slightly slower
// - will use default Base64 encoding over RecordSave() binary - or custom true
// JSON format (as set by TTextWriter.RegisterCustomJSONSerializer or via
// enhanced RTTI), if available
function RecordLoadJSON(var Rec; const JSON: RawUTF8; TypeInfo: pointer{$ifndef NOVARIANTS};
  CustomVariantOptions: PDocVariantOptions=nil{$endif}): boolean; overload;

/// copy a record content from source to Dest
// - this unit includes a fast optimized asm version for x86 on Delphi
procedure RecordCopy(var Dest; const Source; TypeInfo: pointer); {$ifdef FPC}inline;{$endif}

/// clear a record content
// - this unit includes a fast optimized asm version for x86 on Delphi
procedure RecordClear(var Dest; TypeInfo: pointer); {$ifdef FPC}inline;{$endif}

/// initialize a record content
// - calls RecordClear() and FillCharFast() with 0
// - do nothing if the TypeInfo is not from a record/object
procedure RecordZero(var Dest; TypeInfo: pointer);

/// low-level finalization of a dynamic array of variants
// - faster than RTL Finalize() or setting nil
procedure FastDynArrayClear(Value: PPointer; ElemTypeInfo: pointer);

/// low-level finalization of a dynamic array of RawUTF8
// - faster than RTL Finalize() or setting nil
procedure RawUTF8DynArrayClear(var Value: TRawUTF8DynArray);
  {$ifdef HASINLINE}inline;{$endif}

{$ifndef DELPHI5OROLDER}
/// copy a dynamic array content from source to Dest
// - uses internally the TDynArray.CopyFrom() method and two temporary
// TDynArray wrappers
procedure DynArrayCopy(var Dest; const Source; SourceMaxElem: integer;
  TypeInfo: pointer);
{$endif DELPHI5OROLDER}

/// fill a dynamic array content from a binary serialization as saved by
// DynArraySave() / TDynArray.Save()
// - Value shall be set to the target dynamic array field
// - just a function helper around TDynArray.Init + TDynArray.*
function DynArrayLoad(var Value; Source: PAnsiChar; TypeInfo: pointer): PAnsiChar;

/// serialize a dynamic array content as binary, ready to be loaded by
// DynArrayLoad() / TDynArray.Load()
// - Value shall be set to the source dynamic arry field
// - just a function helper around TDynArray.Init + TDynArray.SaveTo
function DynArraySave(var Value; TypeInfo: pointer): RawByteString;

/// fill a dynamic array content from a JSON serialization as saved by
// TTextWriter.AddDynArrayJSON
// - Value shall be set to the target dynamic array field
// - is just a wrapper around TDynArray.LoadFromJSON(), creating a temporary
// TDynArray wrapper on the stack
// - return a pointer at the end of the data read from JSON, nil in case
// of an invalid input buffer
// - to be used e.g. for custom record JSON unserialization, within a
// TDynArrayJSONCustomReader callback
// - warning: the JSON buffer will be modified in-place during process - use
// a temporary copy if you need to access it later or if the string comes from
// a constant (refcount=-1) - see e.g. the overloaded DynArrayLoadJSON()
function DynArrayLoadJSON(var Value; JSON: PUTF8Char; TypeInfo: pointer;
  EndOfObject: PUTF8Char=nil): PUTF8Char; overload;

/// fill a dynamic array content from a JSON serialization as saved by
// TTextWriter.AddDynArrayJSON, which won't be modified
// - this overloaded function will make a private copy before parsing it,
// so is safe with a read/only or shared string - but slightly slower
function DynArrayLoadJSON(var Value; const JSON: RawUTF8; TypeInfo: pointer): boolean; overload;

/// serialize a dynamic array content as JSON
// - Value shall be set to the source dynamic array field
// - is just a wrapper around TTextWriter.AddDynArrayJSON(), creating
// a temporary TDynArray wrapper on the stack
// - to be used e.g. for custom record JSON serialization, within a
// TDynArrayJSONCustomWriter callback or RegisterCustomJSONSerializerFromText()
// (following EnumSetsAsText optional parameter for nested enumerates and sets)
function DynArraySaveJSON(const Value; TypeInfo: pointer;
  EnumSetsAsText: boolean=false): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

{$ifndef DELPHI5OROLDER}
/// compare two dynamic arrays by calling TDynArray.Equals
function DynArrayEquals(TypeInfo: pointer; var Array1, Array2;
  Array1Count: PInteger=nil; Array2Count: PInteger=nil): boolean;
{$endif DELPHI5OROLDER}

/// serialize a dynamic array content, supplied as raw binary buffer, as JSON
// - Value shall be set to the source dynamic array field
// - is just a wrapper around TTextWriter.AddDynArrayJSON(), creating
// a temporary TDynArray wrapper on the stack
// - to be used e.g. for custom record JSON serialization, within a
// TDynArrayJSONCustomWriter callback or RegisterCustomJSONSerializerFromText()
function DynArrayBlobSaveJSON(TypeInfo, BlobValue: pointer): RawUTF8;

/// compute a dynamic array element information
// - will raise an exception if the supplied RTTI is not a dynamic array
// - will return the element type name and set ElemTypeInfo otherwise
// - if there is no element type information, an approximative element type name
// will be returned (e.g. 'byte' for an array of 1 byte items), and ElemTypeInfo
// will be set to nil
// - this low-level function is used e.g. by mORMotWrappers unit
function DynArrayElementTypeName(TypeInfo: pointer; ElemTypeInfo: PPointer=nil;
  ExactType: boolean=false): RawUTF8;

/// trim ending 'DynArray' or 's' chars from a dynamic array type name
// - used internally to guess the associated item type name
function DynArrayItemTypeLen(const aDynArrayTypeName: RawUTF8): PtrInt;

/// was dynamic array item after RegisterCustomJSONSerializerFromTextBinaryType()
// - calls DynArrayItemTypeLen() to guess the internal type name
function DynArrayItemTypeIsSimpleBinary(const aDynArrayTypeName: RawUTF8): boolean;


/// compare two "array of boolean" elements
function SortDynArrayBoolean(const A,B): integer;

/// compare two "array of shortint" elements
function SortDynArrayShortint(const A,B): integer;

/// compare two "array of byte" elements
function SortDynArrayByte(const A,B): integer;

/// compare two "array of smallint" elements
function SortDynArraySmallint(const A,B): integer;

/// compare two "array of word" elements
function SortDynArrayWord(const A,B): integer;

/// compare two "array of integer" elements
function SortDynArrayInteger(const A,B): integer;

/// compare two "array of cardinal" elements
function SortDynArrayCardinal(const A,B): integer;

/// compare two "array of Int64" or "array of Currency" elements
function SortDynArrayInt64(const A,B): integer;

/// compare two "array of QWord" elements
// - note that QWord(A)>QWord(B) is wrong on older versions of Delphi, so you
// should better use this function or CompareQWord() to properly compare two
// QWord values over CPUX86
function SortDynArrayQWord(const A,B): integer;

/// compare two "array of THash128" elements
function SortDynArray128(const A,B): integer;

/// compare two "array of THash256" elements
function SortDynArray256(const A,B): integer;

/// compare two "array of THash512" elements
function SortDynArray512(const A,B): integer;

/// compare two "array of TObject/pointer" elements
function SortDynArrayPointer(const A,B): integer;

/// compare two "array of single" elements
function SortDynArraySingle(const A,B): integer;

/// compare two "array of double" elements
function SortDynArrayDouble(const A,B): integer;

/// compare two "array of AnsiString" elements, with case sensitivity
function SortDynArrayAnsiString(const A,B): integer;

/// compare two "array of RawByteString" elements, with case sensitivity
// - can't use StrComp() or similar functions since RawByteString may contain #0
function SortDynArrayRawByteString(const A,B): integer;

/// compare two "array of AnsiString" elements, with no case sensitivity
function SortDynArrayAnsiStringI(const A,B): integer;

/// compare two "array of PUTF8Char/PAnsiChar" elements, with case sensitivity
function SortDynArrayPUTF8Char(const A,B): integer;

/// compare two "array of PUTF8Char/PAnsiChar" elements, with no case sensitivity
function SortDynArrayPUTF8CharI(const A,B): integer;

/// compare two "array of WideString/UnicodeString" elements, with case sensitivity
function SortDynArrayUnicodeString(const A,B): integer;

/// compare two "array of WideString/UnicodeString" elements, with no case sensitivity
function SortDynArrayUnicodeStringI(const A,B): integer;

/// compare two "array of generic string" elements, with case sensitivity
// - the expected string type is the generic VCL string
function SortDynArrayString(const A,B): integer;

/// compare two "array of generic string" elements, with no case sensitivity
// - the expected string type is the generic VCL string
function SortDynArrayStringI(const A,B): integer;

/// compare two "array of TFileName" elements, as file names
// - i.e. with no case sensitivity, and grouped by file extension
// - the expected string type is the generic RTL string, i.e. TFileName
// - calls internally GetFileNameWithoutExt() and AnsiCompareFileName()
function SortDynArrayFileName(const A,B): integer;

{$ifndef NOVARIANTS}
/// compare two "array of variant" elements, with case sensitivity
function SortDynArrayVariant(const A,B): integer;

/// compare two "array of variant" elements, with no case sensitivity
function SortDynArrayVariantI(const A,B): integer;

/// compare two "array of variant" elements, with or without case sensitivity
// - this low-level function is called by SortDynArrayVariant/VariantCompare
// - more optimized than the RTL function if A and B share the same type
function SortDynArrayVariantComp(const A,B: TVarData; caseInsensitive: boolean): integer;
{$endif NOVARIANTS}


{$ifdef CPU32DELPHI}
const
  /// defined for inlining bitwise division in TDynArrayHasher.HashTableIndex
  // - HashTableSize<=HASH_PO2 is expected to be a power of two (fast binary op);
  // limit is set to 262,144 hash table slots (=1MB), for Capacity=131,072 items
  // - above this limit, a set of increasing primes is used; using a prime as
  // hashtable modulo enhances its distribution, especially for a weak hash function
  // - 64-bit CPU and FPC can efficiently compute a prime reduction using Lemire
  // algorithm, so no power of two is defined on those targets
  HASH_PO2 = 1 shl 18;
{$endif CPU32DELPHI}

/// compute the 32-bit default hash of a file content
// - you can specify your own hashing function if DefaultHasher is not what you expect
function HashFile(const FileName: TFileName; Hasher: THasher=nil): cardinal;

/// hash one AnsiString content with the suppplied Hasher() function
function HashAnsiString(const Elem; Hasher: THasher): cardinal;

/// case-insensitive hash one AnsiString content with the suppplied Hasher() function
function HashAnsiStringI(const Elem; Hasher: THasher): cardinal;

/// hash one SynUnicode content with the suppplied Hasher() function
// - work with WideString for all Delphi versions, or UnicodeString in Delphi 2009+
function HashSynUnicode(const Elem; Hasher: THasher): cardinal;

/// case-insensitive hash one SynUnicode content with the suppplied Hasher() function
// - work with WideString for all Delphi versions, or UnicodeString in Delphi 2009+
function HashSynUnicodeI(const Elem; Hasher: THasher): cardinal;

/// hash one WideString content with the suppplied Hasher() function
// - work with WideString for all Delphi versions
function HashWideString(const Elem; Hasher: THasher): cardinal;

/// case-insensitive hash one WideString content with the suppplied Hasher() function
// - work with WideString for all Delphi versions
function HashWideStringI(const Elem; Hasher: THasher): cardinal;

{$ifdef UNICODE}
/// hash one UnicodeString content with the suppplied Hasher() function
// - work with UnicodeString in Delphi 2009+
function HashUnicodeString(const Elem; Hasher: THasher): cardinal;

/// case-insensitive hash one UnicodeString content with the suppplied Hasher() function
// - work with UnicodeString in Delphi 2009+
function HashUnicodeStringI(const Elem; Hasher: THasher): cardinal;
{$endif UNICODE}

{$ifndef NOVARIANTS}
/// case-sensitive hash one variant content with the suppplied Hasher() function
function HashVariant(const Elem; Hasher: THasher): cardinal;

/// case-insensitive hash one variant content with the suppplied Hasher() function
function HashVariantI(const Elem; Hasher: THasher): cardinal;
{$endif NOVARIANTS}

/// hash one PtrUInt (=NativeUInt) value with the suppplied Hasher() function
function HashPtrUInt(const Elem; Hasher: THasher): cardinal;

/// hash one Byte value
function HashByte(const Elem; Hasher: THasher): cardinal;

/// hash one Word value
function HashWord(const Elem; Hasher: THasher): cardinal;

/// hash one Integer/cardinal value - simply return the value ignore Hasher() parameter
function HashInteger(const Elem; Hasher: THasher): cardinal;

/// hash one Int64/Qword value with the suppplied Hasher() function
function HashInt64(const Elem; Hasher: THasher): cardinal;

/// hash one THash128 value with the suppplied Hasher() function
function Hash128(const Elem; Hasher: THasher): cardinal;

/// hash one THash256 value with the suppplied Hasher() function
function Hash256(const Elem; Hasher: THasher): cardinal;

/// hash one THash512 value with the suppplied Hasher() function
function Hash512(const Elem; Hasher: THasher): cardinal;

/// hash one pointer value with the suppplied Hasher() function
// - this version is not the same as HashPtrUInt, since it will always
// use the hasher function
function HashPointer(const Elem; Hasher: THasher): cardinal;

var
  /// helper array to get the comparison function corresponding to a given
  // standard array type
  // - e.g. as DYNARRAY_SORTFIRSTFIELD[CaseInSensitive,djRawUTF8]
  // - not to be used as such, but e.g. when inlining TDynArray methods
  DYNARRAY_SORTFIRSTFIELD: array[boolean,TDynArrayKind] of TDynArraySortCompare = (
    (nil, SortDynArrayBoolean, SortDynArrayByte, SortDynArrayWord,
    SortDynArrayInteger, SortDynArrayCardinal, SortDynArraySingle,
    SortDynArrayInt64, SortDynArrayQWord, SortDynArrayDouble,
    SortDynArrayInt64, SortDynArrayInt64, SortDynArrayDouble, SortDynArrayDouble,
    SortDynArrayAnsiString, SortDynArrayAnsiString, SortDynArrayString,
    SortDynArrayRawByteString, SortDynArrayUnicodeString,
    SortDynArrayUnicodeString, SortDynArray128, SortDynArray256,
    SortDynArray512, SortDynArrayPointer,
    {$ifndef NOVARIANTS}SortDynArrayVariant,{$endif} nil),
    (nil, SortDynArrayBoolean, SortDynArrayByte, SortDynArrayWord,
    SortDynArrayInteger, SortDynArrayCardinal, SortDynArraySingle,
    SortDynArrayInt64, SortDynArrayQWord, SortDynArrayDouble,
    SortDynArrayInt64, SortDynArrayInt64, SortDynArrayDouble, SortDynArrayDouble,
    SortDynArrayAnsiStringI, SortDynArrayAnsiStringI, SortDynArrayStringI,
    SortDynArrayRawByteString, SortDynArrayUnicodeStringI,
    SortDynArrayUnicodeStringI, SortDynArray128, SortDynArray256,
    SortDynArray512, SortDynArrayPointer,
    {$ifndef NOVARIANTS}SortDynArrayVariantI,{$endif} nil));

  /// helper array to get the hashing function corresponding to a given
  // standard array type
  // - e.g. as DYNARRAY_HASHFIRSTFIELD[CaseInSensitive,djRawUTF8]
  // - not to be used as such, but e.g. when inlining TDynArray methods
  DYNARRAY_HASHFIRSTFIELD: array[boolean,TDynArrayKind] of TDynArrayHashOne = (
    (nil, HashByte, HashByte, HashWord, HashInteger,
    HashInteger, HashInteger, HashInt64, HashInt64, HashInt64,
    HashInt64, HashInt64, HashInt64, HashInt64,
    HashAnsiString, HashAnsiString,
    {$ifdef UNICODE}HashUnicodeString{$else}HashAnsiString{$endif},
    HashAnsiString, HashWideString, HashSynUnicode, Hash128,
    Hash256, Hash512, HashPointer,
    {$ifndef NOVARIANTS}HashVariant,{$endif} nil),
    (nil, HashByte, HashByte, HashWord, HashInteger,
    HashInteger, HashInteger, HashInt64, HashInt64, HashInt64,
    HashInt64, HashInt64, HashInt64, HashInt64,
    HashAnsiStringI, HashAnsiStringI,
    {$ifdef UNICODE}HashUnicodeStringI{$else}HashAnsiStringI{$endif},
    HashAnsiStringI, HashWideStringI, HashSynUnicodeI, Hash128,
    Hash256, Hash512, HashPointer,
    {$ifndef NOVARIANTS}HashVariantI,{$endif} nil));


/// initialize the structure with a one-dimension dynamic array
// - the dynamic array must have been defined with its own type
// (e.g. TIntegerDynArray = array of Integer)
// - if aCountPointer is set, it will be used instead of length() to store
// the dynamic array items count - it will be much faster when adding
// elements to the array, because the dynamic array won't need to be
// resized each time - but in this case, you should use the Count property
// instead of length(array) or high(array) when accessing the data: in fact
// length(array) will store the memory size reserved, not the items count
// - if aCountPointer is set, its content will be set to 0, whatever the
// array length is, or the current aCountPointer^ value is
// - a typical usage could be:
// !var IntArray: TIntegerDynArray;
// !begin
// !  with DynArray(TypeInfo(TIntegerDynArray),IntArray) do
// !  begin
// !    (...)
// !  end;
// ! (...)
// ! DynArray(TypeInfo(TIntegerDynArray),IntArrayA).SaveTo
function DynArray(aTypeInfo: pointer; var aValue; aCountPointer: PInteger=nil): TDynArray;
  {$ifdef HASINLINE}inline;{$endif}

/// wrap a simple dynamic array BLOB content as stored by TDynArray.SaveTo
// - a "simple" dynamic array contains data with no reference count, e.g. byte,
// word, integer, cardinal, Int64, double or Currency
// - same as TDynArray.LoadFrom() with no memory allocation nor memory copy: so
// is much faster than creating a temporary dynamic array to load the data
// - will return nil if no or invalid data, or a pointer to the data
// array otherwise, with the items number stored in Count and the individual
// element size in ElemSize (e.g. 2 for a TWordDynArray)
function SimpleDynArrayLoadFrom(Source: PAnsiChar; aTypeInfo: pointer;
  var Count, ElemSize: integer; NoHash32Check: boolean=false): pointer;

/// wrap an Integer dynamic array BLOB content as stored by TDynArray.SaveTo
// - same as TDynArray.LoadFrom() with no memory allocation nor memory copy: so
// is much faster than creating a temporary dynamic array to load the data
// - will return nil if no or invalid data, or a pointer to the integer
// array otherwise, with the items number stored in Count
// - sligtly faster than SimpleDynArrayLoadFrom(Source,TypeInfo(TIntegerDynArray),Count)
function IntegerDynArrayLoadFrom(Source: PAnsiChar; var Count: integer;
  NoHash32Check: boolean=false): PIntegerArray;

/// search in a RawUTF8 dynamic array BLOB content as stored by TDynArray.SaveTo
// - same as search within TDynArray.LoadFrom() with no memory allocation nor
// memory copy: so is much faster
// - will return -1 if no match or invalid data, or the matched entry index
function RawUTF8DynArrayLoadFromContains(Source: PAnsiChar;
  Value: PUTF8Char; ValueLen: PtrInt; CaseSensitive: boolean): PtrInt;


{ ****************** text buffer and JSON functions and classes ************ }

const
  /// maximum number of fields in a database Table
  // - is included in SynCommons so that all DB-related work will be able to
  // share the same low-level types and functions (e.g. TSQLFieldBits,
  // TJSONWriter, TSynTableStatement, TSynTable, TSQLRecordProperties)
  // - default is 64, but can be set to any value (64, 128, 192 and 256 optimized)
  // changing the source below or using MAX_SQLFIELDS_128, MAX_SQLFIELDS_192 or
  // MAX_SQLFIELDS_256 conditional directives for your project
  // - this constant is used internaly to optimize memory usage in the
  // generated asm code, and statically allocate some arrays for better speed
  // - note that due to compiler restriction, 256 is the maximum value
  // (this is the maximum number of items in a Delphi/FPC set)
  {$ifdef MAX_SQLFIELDS_128}
  MAX_SQLFIELDS = 128;
  {$else}
  {$ifdef MAX_SQLFIELDS_192}
  MAX_SQLFIELDS = 192;
  {$else}
  {$ifdef MAX_SQLFIELDS_256}
  MAX_SQLFIELDS = 256;
  {$else}
  MAX_SQLFIELDS = 64;
  {$endif}
  {$endif}
  {$endif}

  /// sometimes, the ID field is included in a bits set
  MAX_SQLFIELDS_INCLUDINGID = MAX_SQLFIELDS+1;

  /// UTF-8 encoded \uFFF0 special code to mark Base64 binary content in JSON
  // - Unicode special char U+FFF0 is UTF-8 encoded as EF BF B0 bytes
  // - as generated by BinToBase64WithMagic() functions, and expected by
  // SQLParamContent() and ExtractInlineParameters() functions
  // - used e.g. when transmitting TDynArray.SaveTo() content
  JSON_BASE64_MAGIC = $b0bfef;

  /// '"' + UTF-8 encoded \uFFF0 special code to mark Base64 binary in JSON
  JSON_BASE64_MAGIC_QUOTE = ord('"')+cardinal(JSON_BASE64_MAGIC) shl 8;

  /// '"' + UTF-8 encoded \uFFF0 special code to mark Base64 binary in JSON
  // - defined as a cardinal variable to be used as:
  // ! AddNoJSONEscape(@JSON_BASE64_MAGIC_QUOTE_VAR,4);
  JSON_BASE64_MAGIC_QUOTE_VAR: cardinal = JSON_BASE64_MAGIC_QUOTE;

  /// UTF-8 encoded \uFFF1 special code to mark ISO-8601 SQLDATE in JSON
  // - e.g. '"\uFFF12012-05-04"' pattern
  // - Unicode special char U+FFF1 is UTF-8 encoded as EF BF B1 bytes
  // - as generated by DateToSQL/DateTimeToSQL/TimeLogToSQL functions, and
  // expected by SQLParamContent() and ExtractInlineParameters() functions
  JSON_SQLDATE_MAGIC = $b1bfef;

  /// '"' + UTF-8 encoded \uFFF1 special code to mark ISO-8601 SQLDATE in JSON
  JSON_SQLDATE_MAGIC_QUOTE = ord('"')+cardinal(JSON_SQLDATE_MAGIC) shl 8;

  ///'"' +  UTF-8 encoded \uFFF1 special code to mark ISO-8601 SQLDATE in JSON
  // - defined as a cardinal variable to be used as:
  // ! AddNoJSONEscape(@JSON_SQLDATE_MAGIC_QUOTE_VAR,4);
  JSON_SQLDATE_MAGIC_QUOTE_VAR: cardinal = JSON_SQLDATE_MAGIC_QUOTE;


type
  TTextWriter = class;
  TTextWriterWithEcho = class;

  /// method prototype for custom serialization of a dynamic array item
  // - each element of the dynamic array will be called as aValue parameter
  // of this callback
  // - can be used also at record level, if the record has a type information
  // (i.e. shall contain a managed type within its fields)
  // - to be used with TTextWriter.RegisterCustomJSONSerializer() method
  // - note that the generated JSON content will be appended after a '[' and
  // before a ']' as a normal JSON arrray, but each item can be any JSON
  // structure (i.e. a number, a string, but also an object or an array)
  // - implementation code could call aWriter.Add/AddJSONEscapeString...
  // - implementation code shall follow the same exact format for the
  // associated TDynArrayJSONCustomReader callback
  TDynArrayJSONCustomWriter = procedure(const aWriter: TTextWriter; const aValue) of object;

  /// method prototype for custom unserialization of a dynamic array item
  // - each element of the dynamic array will be called as aValue parameter
  // of this callback
  // - can be used also at record level, if the record has a type information
  // (i.e. shall contain a managed type within its fields)
  // - to be used with TTextWriter.RegisterCustomJSONSerializer() method
  // - implementation code could call e.g. GetJSONField() low-level function, and
  // returns a pointer to the last handled element of the JSON input buffer,
  // as such (aka EndOfBuffer variable as expected by GetJSONField):
  // ! var V: TFV absolute aValue;
  // ! begin
  // !   (...)
  // !   V.Detailed := UTF8ToString(GetJSONField(P,P));
  // !   if P=nil then
  // !     exit;
  // !   aValid := true;
  // !   result := P; // ',' or ']' for last item of array
  // ! end;
  // - implementation code shall follow the same exact format for the
  // associated TDynArrayJSONCustomWriter callback
  TDynArrayJSONCustomReader = function(P: PUTF8Char; var aValue; out aValid: Boolean
    {$ifndef NOVARIANTS}; CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char of object;

  /// the kind of variables handled by TJSONCustomParser
  // - the last item should be ptCustom, for non simple types
  TJSONCustomParserRTTIType = (
    ptArray, ptBoolean, ptByte, ptCardinal, ptCurrency, ptDouble, ptExtended,
    ptInt64, ptInteger, ptQWord, ptRawByteString, ptRawJSON, ptRawUTF8, ptRecord,
    ptSingle, ptString, ptSynUnicode, ptDateTime, ptDateTimeMS, ptGUID,
    ptID, ptTimeLog, {$ifdef HASVARUSTRING} ptUnicodeString, {$endif}
    {$ifndef NOVARIANTS} ptVariant, {$endif} ptWideString, ptWord, ptCustom);

  /// how TJSONCustomParser would serialize/unserialize JSON content
  TJSONCustomParserSerializationOption = (
    soReadIgnoreUnknownFields, soWriteHumanReadable,
    soCustomVariantCopiedByReference, soWriteIgnoreDefault);

  /// how TJSONCustomParser would serialize/unserialize JSON content
  // - by default, during reading any unexpected field will stop and fail the
  // process - if soReadIgnoreUnknownFields is defined, such properties will
  // be ignored (can be very handy when parsing JSON from a remote service)
  // - by default, JSON content will be written in its compact standard form,
  // ready to be parsed by any client - you can specify soWriteHumanReadable
  // so that some line feeds and indentation will make the content more readable
  // - by default, internal TDocVariant variants will be copied by-value from
  // one instance to another, to ensure proper safety - but it may be too slow:
  // if you set soCustomVariantCopiedByReference, any internal
  // TDocVariantData.VValue/VName instances will be copied by-reference,
  // to avoid memory allocations, BUT it may break internal process if you change
  // some values in place (since VValue/VName and VCount won't match) - as such,
  // if you set this option, ensure that you use the content as read-only
  // - by default, all fields are persistented, unless soWriteIgnoreDefault is
  // defined and void values (e.g. "" or 0) won't be written
  // - you may use TTextWriter.RegisterCustomJSONSerializerSetOptions() class
  // method to customize the serialization for a given type
  TJSONCustomParserSerializationOptions = set of TJSONCustomParserSerializationOption;

  TJSONCustomParserRTTI = class;

  /// an array of RTTI properties information
  // - we use dynamic arrays, since all the information is static and we
  // do not need to remove any RTTI information
  TJSONCustomParserRTTIs = array of TJSONCustomParserRTTI;

  /// used to store additional RTTI in TJSONCustomParser internal structures
  TJSONCustomParserRTTI = class
  protected
    fPropertyName: RawUTF8;
    fFullPropertyName: RawUTF8;
    fPropertyType: TJSONCustomParserRTTIType;
    fCustomTypeName: RawUTF8;
    fNestedProperty: TJSONCustomParserRTTIs;
    fDataSize: integer;
    fNestedDataSize: integer;
    procedure ComputeDataSizeAfterAdd; virtual;
    procedure ComputeNestedDataSize;
    procedure ComputeFullPropertyName;
    procedure FinalizeNestedRecord(var Data: PByte);
    procedure FinalizeNestedArray(var Data: PtrUInt);
    procedure AllocateNestedArray(var Data: PtrUInt; NewLength: integer);
    procedure ReAllocateNestedArray(var Data: PtrUInt; NewLength: integer);
    function IfDefaultSkipped(var Value: PByte): boolean;
    procedure WriteOneSimpleValue(aWriter: TTextWriter; var Value: PByte;
      Options: TJSONCustomParserSerializationOptions);
  public
    /// initialize the instance
    constructor Create(const aPropertyName: RawUTF8;
      aPropertyType: TJSONCustomParserRTTIType);
    /// initialize an instance from the RTTI type information
    // - will return an instance of this class of any inherited class
    class function CreateFromRTTI(const PropertyName: RawUTF8;
      Info: pointer; ItemSize: integer): TJSONCustomParserRTTI;
    /// create an instance from a specified type name
    // - will return an instance of this class of any inherited class
    class function CreateFromTypeName(const aPropertyName,
      aCustomRecordTypeName: RawUTF8): TJSONCustomParserRTTI;
    /// recognize a simple type from a supplied type name
    // - will return ptCustom for any unknown type
    // - see also TypeInfoToRttiType() function
    class function TypeNameToSimpleRTTIType(
      const TypeName: RawUTF8): TJSONCustomParserRTTIType; overload;
    /// recognize a simple type from a supplied type name
    // - will return ptCustom for any unknown type
    // - see also TypeInfoToRttiType() function
    class function TypeNameToSimpleRTTIType(
      TypeName: PShortString): TJSONCustomParserRTTIType; overload;
    /// recognize a simple type from a supplied type name
    // - will return ptCustom for any unknown type
    // - see also TypeInfoToRttiType() function
    class function TypeNameToSimpleRTTIType(TypeName: PUTF8Char; TypeNameLen: PtrInt;
      ItemTypeName: PRawUTF8): TJSONCustomParserRTTIType; overload;
    /// recognize a simple type from a supplied type information
    // - to be called if TypeNameToSimpleRTTIType() did fail, i.e. return ptCustom
    // - will return ptCustom for any complex type (e.g. a record)
    // - see also TypeInfoToRttiType() function
    class function TypeInfoToSimpleRTTIType(Info: pointer): TJSONCustomParserRTTIType;
    /// recognize a ktBinary simple type from a supplied type name
    // - as registered by TTextWriter.RegisterCustomJSONSerializerFromTextBinaryType
    class function TypeNameToSimpleBinary(const aTypeName: RawUTF8;
      out aDataSize, aFieldSize: integer): boolean;
    /// unserialize some JSON content into its binary internal representation
    // - on error, returns false and P should point to the faulty text input
    function ReadOneLevel(var P: PUTF8Char; var Data: PByte;
      Options: TJSONCustomParserSerializationOptions{$ifndef NOVARIANTS};
      CustomVariantOptions: PDocVariantOptions{$endif}): boolean; virtual;
    /// serialize a binary internal representation into JSON content
    // - this method won't append a trailing ',' character
    procedure WriteOneLevel(aWriter: TTextWriter; var P: PByte;
      Options: TJSONCustomParserSerializationOptions); virtual;
    /// the associated type name, e.g. for a record
    property CustomTypeName: RawUTF8 read fCustomTypeName;
    /// the property name
    // - may be void for the Root element
    // - e.g. 'SubProp'
    property PropertyName: RawUTF8 read fPropertyName;
    /// the property name, including all parent elements
    // - may be void for the Root element
    // - e.g. 'MainProp.SubProp'
    property FullPropertyName: RawUTF8 read fFullPropertyName;
    /// the property type
    // - support only a limited set of simple types, or ptRecord for a nested
    // record, or ptArray for a nested array
    property PropertyType: TJSONCustomParserRTTIType read fPropertyType;
    /// the nested array of properties (if any)
    // - assigned only if PropertyType is [ptRecord,ptArray]
    // - is either the record type of each ptArray item:
    // ! SubProp: array of record ...
    // - or one NestedProperty[0] entry with PropertyName='' and PropertyType
    // not in [ptRecord,ptArray]:
    // ! SubPropNumber: array of integer;
    // ! SubPropText: array of RawUTF8;
    property NestedProperty: TJSONCustomParserRTTIs read fNestedProperty;
  end;

  /// used to store additional RTTI as a ptCustom kind of property
  TJSONCustomParserCustom = class(TJSONCustomParserRTTI)
  protected
    fCustomTypeInfo: pointer;
  public
    /// initialize the instance
    constructor Create(const aPropertyName, aCustomTypeName: RawUTF8); virtual;
    /// abstract method to write the instance as JSON
    procedure CustomWriter(const aWriter: TTextWriter; const aValue); virtual; abstract;
    /// abstract method to read the instance from JSON
    // - should return nil on parsing error
    function CustomReader(P: PUTF8Char; var aValue; out EndOfObject: AnsiChar{$ifndef NOVARIANTS};
      CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char; virtual; abstract;
    /// release any memory used by the instance
    procedure FinalizeItem(Data: Pointer); virtual;
    /// the associated RTTI structure
    property CustomTypeInfo: pointer read fCustomTypeInfo;
  end;

  /// which kind of property does TJSONCustomParserCustomSimple refer to
  TJSONCustomParserCustomSimpleKnownType = (
    ktNone, ktEnumeration, ktSet, ktGUID,
    ktFixedArray, ktStaticArray, ktDynamicArray, ktBinary);

  /// used to store additional RTTI for simple type as a ptCustom kind
  // - this class handle currently enumerate, TGUID or static/dynamic arrays
  TJSONCustomParserCustomSimple = class(TJSONCustomParserCustom)
  protected
    fKnownType: TJSONCustomParserCustomSimpleKnownType;
    fTypeData: pointer;
    fFixedSize: integer;
    fNestedArray: TJSONCustomParserRTTI;
  public
    /// initialize the instance from the given RTTI structure
    constructor Create(const aPropertyName, aCustomTypeName: RawUTF8;
      aCustomType: pointer); reintroduce;
    /// initialize the instance for a static array
    constructor CreateFixedArray(const aPropertyName: RawUTF8;
      aFixedSize: cardinal);
    /// initialize the instance for a binary blob
    constructor CreateBinary(const aPropertyName: RawUTF8;
      aDataSize, aFixedSize: cardinal);
    /// released used memory
    destructor Destroy; override;
    /// method to write the instance as JSON
    procedure CustomWriter(const aWriter: TTextWriter; const aValue); override;
    /// method to read the instance from JSON
    function CustomReader(P: PUTF8Char; var aValue; out EndOfObject: AnsiChar{$ifndef NOVARIANTS};
      CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char; override;
    /// which kind of simple property this instance does refer to
    property KnownType: TJSONCustomParserCustomSimpleKnownType read fKnownType;
    /// the element type for ktStaticArray and ktDynamicArray
    property NestedArray: TJSONCustomParserRTTI read fNestedArray;
  end;

  /// implement a reference to a registered record type
  // - i.e. ptCustom kind of property, handled by the
  // TTextWriter.RegisterCustomJSONSerializer*() internal list
  TJSONCustomParserCustomRecord = class(TJSONCustomParserCustom)
  protected
    fCustomTypeIndex: integer;
    function GetJSONCustomParserRegistration: pointer;
  public
    /// initialize the instance from the given record custom serialization index
    constructor Create(const aPropertyName: RawUTF8;
      aCustomTypeIndex: integer); reintroduce; overload;
    /// method to write the instance as JSON
    procedure CustomWriter(const aWriter: TTextWriter; const aValue); override;
    /// method to read the instance from JSON
    function CustomReader(P: PUTF8Char; var aValue; out EndOfObject: AnsiChar{$ifndef NOVARIANTS};
      CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char; override;
    /// release any memory used by the instance
    procedure FinalizeItem(Data: Pointer); override;
  end;

  /// how an RTTI expression is expected to finish
  TJSONCustomParserRTTIExpectedEnd = (eeNothing, eeSquare, eeCurly, eeEndKeyWord);

  TJSONRecordAbstract = class;

  /// used to handle additional RTTI for JSON record serialization
  // - this class is used to define how a record is defined, and will work
  // with any version of Delphi
  // - this Abstract class is not to be used as-this, but contains all
  // needed information to provide CustomWriter/CustomReader methods
  // - you can use e.g. TJSONRecordTextDefinition for text-based RTTI
  // manual definition, or (not yet provided) a version based on Delphi 2010+
  // new RTTI information
  TJSONRecordAbstract = class
  protected
    /// internal storage of TJSONCustomParserRTTI instances
    fItems: TSynObjectList;
    fRoot: TJSONCustomParserRTTI;
    fOptions: TJSONCustomParserSerializationOptions;
    function AddItem(const aPropertyName: RawUTF8; aPropertyType: TJSONCustomParserRTTIType;
      const aCustomRecordTypeName: RawUTF8): TJSONCustomParserRTTI;
  public
    /// initialize the class instance
    constructor Create;
    /// callback for custom JSON serialization
    // - will follow the RTTI textual information as supplied to the constructor
    procedure CustomWriter(const aWriter: TTextWriter; const aValue);
    /// callback for custom JSON unserialization
    // - will follow the RTTI textual information as supplied to the constructor
    function CustomReader(P: PUTF8Char; var aValue; out aValid: Boolean{$ifndef NOVARIANTS};
      CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char;
    /// release used memory
    // - when created via Compute() call, instances of this class are managed
    // via a GarbageCollector() global list, so you do not need to free them
    destructor Destroy; override;
    /// store the RTTI information of properties at root level
    // - is one instance with PropertyType=ptRecord and PropertyName=''
    property Root: TJSONCustomParserRTTI read fRoot;
    /// how this class would serialize/unserialize JSON content
    // - by default, no option is defined
    // - you can customize the expected options with the instance returned by
    // TTextWriter.RegisterCustomJSONSerializerFromText() method, or via the
    // TTextWriter.RegisterCustomJSONSerializerSetOptions() overloaded methods
    property Options: TJSONCustomParserSerializationOptions read fOptions write fOptions;
  end;

  /// used to handle JSON record serialization using RTTI
  // - is able to handle any kind of record since Delphi 2010, thanks to
  // enhanced RTTI
  TJSONRecordRTTI = class(TJSONRecordAbstract)
  protected
    fRecordTypeInfo: pointer;
    function AddItemFromRTTI(const PropertyName: RawUTF8;
      Info: pointer; ItemSize: integer): TJSONCustomParserRTTI;
    {$ifdef ISDELPHI2010}
    procedure FromEnhancedRTTI(Props: TJSONCustomParserRTTI; Info: pointer);
    {$endif}
  public
    /// initialize the instance
    // - you should NOT use this constructor directly, but let e.g.
    // TJSONCustomParsers.TryToGetFromRTTI() create it for you
    constructor Create(aRecordTypeInfo: pointer; aRoot: TJSONCustomParserRTTI); reintroduce;
    /// the low-level address of the enhanced RTTI
    property RecordTypeInfo: pointer read fRecordTypeInfo;
  end;

  /// used to handle text-defined additional RTTI for JSON record serialization
  // - is used by TTextWriter.RegisterCustomJSONSerializerFromText() method
  TJSONRecordTextDefinition = class(TJSONRecordAbstract)
  protected
     fDefinition: RawUTF8;
    procedure Parse(Props: TJSONCustomParserRTTI; var P: PUTF8Char;
      PEnd: TJSONCustomParserRTTIExpectedEnd);
  public
    /// initialize a custom JSON serializer/unserializer from pseudo RTTI
    // - you should NOT use this constructor directly, but call the FromCache()
    // class function, which will use an internal definition cache
    constructor Create(aRecordTypeInfo: pointer; const aDefinition: RawUTF8); reintroduce;
    /// retrieve a custom cached JSON serializer/unserializer from pseudo RTTI
    // - returned class instance will be cached for any further use
    // - the record where the data will be stored should be defined as PACKED:
    // ! type TMyRecord = packed record
    // !   A,B,C: integer;
    // !   D: RawUTF8;
    // !   E: record; // or array of record/integer/string/...
    // !     E1,E2: double;
    // !   end;
    // ! end;
    // - only known sub types are integer, cardinal, Int64, single, double,
    // currency, TDateTime, TTimeLog, RawUTF8, String, WideString, SynUnicode,
    // or a nested record or dynamic array
    // - RTTI textual information shall be supplied as text, with the
    // same format as with a pascal record, or with some shorter variations:
    // ! FromCache('A,B,C: integer; D: RawUTF8; E: record E1,E2: double; end;');
    // ! FromCache('A,B,C: integer; D: RawUTF8; E: array of record E1,E2: double; end;');
    // ! 'A,B,C: integer; D: RawUTF8; E: array of SynUnicode; F: array of integer'
    // or a shorter alternative syntax for records and arrays:
    // ! FromCache('A,B,C: integer; D: RawUTF8; E: {E1,E2: double}');
    // ! FromCache('A,B,C: integer; D: RawUTF8; E: [E1,E2: double]');
    // in fact ; could be ignored:
    // ! FromCache('A,B,C:integer D:RawUTF8 E:{E1,E2:double}');
    // ! FromCache('A,B,C:integer D:RawUTF8 E:[E1,E2:double]');
    // or even : could be ignored:
    // ! FromCache('A,B,C integer D RawUTF8 E{E1,E2 double}');
    // ! FromCache('A,B,C integer D RawUTF8 E[E1,E2 double]');
    class function FromCache(aTypeInfo: pointer;
      const aDefinition: RawUTF8): TJSONRecordTextDefinition;
    /// the textual definition of this RTTI information
    property Definition: RawUTF8 read fDefinition;
  end;

  /// the available logging events, as handled by TSynLog
  // - defined in SynCommons so that it may be used with TTextWriter.AddEndOfLine
  // - sllInfo will log general information events
  // - sllDebug will log detailed debugging information
  // - sllTrace will log low-level step by step debugging information
  // - sllWarning will log unexpected values (not an error)
  // - sllError will log errors
  // - sllEnter will log every method start
  // - sllLeave will log every method exit
  // - sllLastError will log the GetLastError OS message
  // - sllException will log all exception raised - available since Windows XP
  // - sllExceptionOS will log all OS low-level exceptions (EDivByZero,
  // ERangeError, EAccessViolation...)
  // - sllMemory will log memory statistics
  // - sllStackTrace will log caller's stack trace (it's by default part of
  // TSynLogFamily.LevelStackTrace like sllError, sllException, sllExceptionOS,
  // sllLastError and sllFail)
  // - sllFail was defined for TSynTestsLogged.Failed method, and can be used
  // to log some customer-side assertions (may be notifications, not errors)
  // - sllSQL is dedicated to trace the SQL statements
  // - sllCache should be used to trace the internal caching mechanism
  // - sllResult could trace the SQL results, JSON encoded
  // - sllDB is dedicated to trace low-level database engine features
  // - sllHTTP could be used to trace HTTP process
  // - sllClient/sllServer could be used to trace some Client or Server process
  // - sllServiceCall/sllServiceReturn to trace some remote service or library
  // - sllUserAuth to trace user authentication (e.g. for individual requests)
  // - sllCustom* items can be used for any purpose
  // - sllNewRun will be written when a process opens a rotated log
  // - sllDDDError will log any DDD-related low-level error information
  // - sllDDDInfo will log any DDD-related low-level debugging information
  // - sllMonitoring will log the statistics information (if available),
  // or may be used for real-time chat among connected people to ToolsAdmin
  TSynLogInfo = (
    sllNone, sllInfo, sllDebug, sllTrace, sllWarning, sllError,
    sllEnter, sllLeave,
    sllLastError, sllException, sllExceptionOS, sllMemory, sllStackTrace,
    sllFail, sllSQL, sllCache, sllResult, sllDB, sllHTTP, sllClient, sllServer,
    sllServiceCall, sllServiceReturn, sllUserAuth,
    sllCustom1, sllCustom2, sllCustom3, sllCustom4, sllNewRun,
    sllDDDError, sllDDDInfo, sllMonitoring);

  /// used to define a set of logging level abilities
  // - i.e. a combination of none or several logging event
  // - e.g. use LOG_VERBOSE constant to log all events, or LOG_STACKTRACE
  // to log all errors and exceptions
  TSynLogInfos = set of TSynLogInfo;

  /// a dynamic array of logging event levels
  TSynLogInfoDynArray = array of TSynLogInfo;


  /// event signature for TTextWriter.OnFlushToStream callback
  TOnTextWriterFlush = procedure(Text: PUTF8Char; Len: PtrInt) of object;

  /// available options for TTextWriter.WriteObject() method
  // - woHumanReadable will add some line feeds and indentation to the content,
  // to make it more friendly to the human eye
  // - woDontStoreDefault (which is set by default for WriteObject method) will
  // avoid serializing properties including a default value (JSONToObject function
  // will set the default values, so it may help saving some bandwidth or storage)
  // - woFullExpand will generate a debugger-friendly layout, including instance
  // class name, sets/enumerates as text, and reference pointer - as used by
  // TSynLog and ObjectToJSONFull()
  // - woStoreClassName will add a "ClassName":"TMyClass" field
  // - woStorePointer will add a "Address":"0431298A" field, and .map/.mab
  // source code line number corresponding to ESynException.RaisedAt
  // - woStoreStoredFalse will write the 'stored false' properties, even
  // if they are marked as such (used e.g. to persist all settings on file,
  // but disallow the sensitive - password - fields be logged)
  // - woHumanReadableFullSetsAsStar will store an human-readable set with
  // all its enumerates items set to be stored as ["*"]
  // - woHumanReadableEnumSetAsComment will add a comment at the end of the
  // line, containing all available values of the enumaration or set, e.g:
  // $ "Enum": "Destroying", // Idle,Started,Finished,Destroying
  // - woEnumSetsAsText will store sets and enumerables as text (is also
  // included in woFullExpand or woHumanReadable)
  // - woDateTimeWithMagic will append the JSON_SQLDATE_MAGIC (i.e. U+FFF1)
  // before the ISO-8601 encoded TDateTime value
  // - woDateTimeWithZSuffix will append the Z suffix to the ISO-8601 encoded
  // TDateTime value, to identify the content as strict UTC value
  // - TTimeLog would be serialized as Int64, unless woTimeLogAsText is defined
  // - since TSQLRecord.ID could be huge Int64 numbers, they may be truncated
  // on client side, e.g. to 53-bit range in JavaScript: you could define
  // woIDAsIDstr to append an additional "ID_str":"##########" field
  // - by default, TSQLRawBlob properties are serialized as null, unless
  // woSQLRawBlobAsBase64 is defined
  // - if woHideSynPersistentPassword is set, TSynPersistentWithPassword.Password
  // field will be serialized as "***" to prevent security issues (e.g. in log)
  // - by default, TObjectList will set the woStoreClassName for its nested
  // objects, unless woObjectListWontStoreClassName is defined
  // - void strings would be serialized as "", unless woDontStoreEmptyString
  // is defined so that such properties would not be written
  // - all inherited properties would be serialized, unless woDontStoreInherited
  // is defined, and only the topmost class level properties would be serialized
  // - woInt64AsHex will force Int64/QWord to be written as hexadecimal string -
  // see j2oAllowInt64Hex reverse option fot Json2Object
  // - woDontStore0 will avoid serializating number properties equal to 0
  TTextWriterWriteObjectOption = (
    woHumanReadable, woDontStoreDefault, woFullExpand,
    woStoreClassName, woStorePointer, woStoreStoredFalse,
    woHumanReadableFullSetsAsStar, woHumanReadableEnumSetAsComment,
    woEnumSetsAsText, woDateTimeWithMagic, woDateTimeWithZSuffix, woTimeLogAsText,
    woIDAsIDstr, woSQLRawBlobAsBase64, woHideSynPersistentPassword,
    woObjectListWontStoreClassName, woDontStoreEmptyString,
    woDontStoreInherited, woInt64AsHex, woDontStore0);
  /// options set for TTextWriter.WriteObject() method
  TTextWriterWriteObjectOptions = set of TTextWriterWriteObjectOption;

  /// callback used to echo each line of TTextWriter class
  // - should return TRUE on success, FALSE if the log was not echoed: but
  // TSynLog will continue logging, even if this event returned FALSE
  TOnTextWriterEcho = function(Sender: TTextWriter; Level: TSynLogInfo;
    const Text: RawUTF8): boolean of object;
  /// callback used by TTextWriter.WriteObject to customize class instance
  // serialization
  // - should return TRUE if the supplied property has been written (including
  // the property name and the ending ',' character), and doesn't need to be
  // processed with the default RTTI-based serializer
  TOnTextWriterObjectProp = function(Sender: TTextWriter; Value: TObject;
    PropInfo: pointer; Options: TTextWriterWriteObjectOptions): boolean of object;

  /// the potential places were TTextWriter.AddHtmlEscape should process
  // proper HTML string escaping, unless hfNone is used
  // $  < > & "  ->   &lt; &gt; &amp; &quote;
  // by default (hfAnyWhere)
  // $  < > &  ->   &lt; &gt; &amp;
  // outside HTML attributes (hfOutsideAttributes)
  // $  & "  ->   &amp; &quote;
  // within HTML attributes (hfWithinAttributes)
  TTextWriterHTMLFormat = (
    hfNone, hfAnyWhere, hfOutsideAttributes, hfWithinAttributes);

  /// available global options for a TTextWriter instance
  // - TTextWriter.WriteObject() method behavior would be set via their own
  // TTextWriterWriteObjectOptions, and work in conjunction with those settings
  // - twoStreamIsOwned would be set if the associated TStream is owned by
  // the TTextWriter instance
  // - twoFlushToStreamNoAutoResize would forbid FlushToStream to resize the
  // internal memory buffer when it appears undersized - FlushFinal will set it
  // before calling a last FlushToStream
  // - by default, custom serializers defined via RegisterCustomJSONSerializer()
  // would let AddRecordJSON() and AddDynArrayJSON() write enumerates and sets
  // as integer numbers, unless twoEnumSetsAsTextInRecord or
  // twoEnumSetsAsBooleanInRecord (exclusively) are set - for Mustache data
  // context, twoEnumSetsAsBooleanInRecord will return a JSON object with
  // "setname":true/false fields
  // - variants and nested objects would be serialized with their default
  // JSON serialization options, unless twoForceJSONExtended or
  // twoForceJSONStandard is defined
  // - when enumerates and sets are serialized as text into JSON, you may force
  // the identifiers to be left-trimed for all their lowercase characters
  // (e.g. sllError -> 'Error') by setting twoTrimLeftEnumSets: this option
  // would default to the global TTextWriter.SetDefaultEnumTrim setting
  // - twoEndOfLineCRLF would reflect the TTextWriter.EndOfLineCRLF property
  // - twoBufferIsExternal would be set if the temporary buffer is not handled
  // by the instance, but specified at constructor, maybe from the stack
  // - twoIgnoreDefaultInRecord will force custom record serialization to avoid
  // writing the fields with default values, i.e. enable soWriteIgnoreDefault
  // when TJSONCustomParserRTTI.WriteOneLevel is called
  TTextWriterOption = (
    twoStreamIsOwned,
    twoFlushToStreamNoAutoResize,
    twoEnumSetsAsTextInRecord,
    twoEnumSetsAsBooleanInRecord,
    twoFullSetsAsStar,
    twoTrimLeftEnumSets,
    twoForceJSONExtended,
    twoForceJSONStandard,
    twoEndOfLineCRLF,
    twoBufferIsExternal,
    twoIgnoreDefaultInRecord);
  /// options set for a TTextWriter instance
  // - allows to override e.g. AddRecordJSON() and AddDynArrayJSON() behavior;
  // or set global process customization for a TTextWriter
  TTextWriterOptions = set of TTextWriterOption;

  /// may be used to allocate on stack a 8KB work buffer for a TTextWriter
  // - via the TTextWriter.CreateOwnedStream overloaded constructor
  TTextWriterStackBuffer = array[0..8191] of AnsiChar;
  PTextWriterStackBuffer = ^TTextWriterStackBuffer;

  /// simple writer to a Stream, specialized for the TEXT format
  // - use an internal buffer, faster than string+string
  // - some dedicated methods is able to encode any data with JSON/XML escape
  // - see TTextWriterWithEcho below for optional output redirection (for TSynLog)
  // - see SynTable.pas for SQL resultset export via TJSONWriter
  // - see mORMot.pas for proper class serialization via TJSONSerializer.WriteObject
  TTextWriter = class
  protected
    B, BEnd: PUTF8Char;
    fStream: TStream;
    fInitialStreamPosition: PtrUInt;
    fTotalFileSize: PtrUInt;
    fCustomOptions: TTextWriterOptions;
    // internal temporary buffer
    fTempBufSize: Integer;
    fTempBuf: PUTF8Char;
    fOnFlushToStream: TOnTextWriterFlush;
    fOnWriteObject: TOnTextWriterObjectProp;
    /// used by WriteObjectAsString/AddDynArrayJSONAsString methods
    fInternalJSONWriter: TTextWriter;
    fHumanReadableLevel: integer;
    procedure WriteToStream(data: pointer; len: PtrUInt); virtual;
    function GetTextLength: PtrUInt;
    procedure SetStream(aStream: TStream);
    procedure SetBuffer(aBuf: pointer; aBufSize: integer);
    procedure InternalAddFixedAnsi(Source: PAnsiChar; SourceChars: Cardinal;
      AnsiToWide: PWordArray; Escape: TTextWriterKind);
  public
    /// the data will be written to the specified Stream
    // - aStream may be nil: in this case, it MUST be set before using any
    // Add*() method
    // - default internal buffer size if 8192
    constructor Create(aStream: TStream; aBufSize: integer=8192); overload;
    /// the data will be written to the specified Stream
    // - aStream may be nil: in this case, it MUST be set before using any
    // Add*() method
    // - will use an external buffer (which may be allocated on stack)
    constructor Create(aStream: TStream; aBuf: pointer; aBufSize: integer); overload;
    /// the data will be written to an internal TRawByteStringStream
    // - TRawByteStringStream.DataString method will be used by TTextWriter.Text
    // to retrieve directly the content without any data move nor allocation
    // - default internal buffer size if 4096 (enough for most JSON objects)
    // - consider using a stack-allocated buffer and the overloaded method
    constructor CreateOwnedStream(aBufSize: integer=4096); overload;
    /// the data will be written to an internal TRawByteStringStream
    // - will use an external buffer (which may be allocated on stack)
    // - TRawByteStringStream.DataString method will be used by TTextWriter.Text
    // to retrieve directly the content without any data move nor allocation
    constructor CreateOwnedStream(aBuf: pointer; aBufSize: integer); overload;
    /// the data will be written to an internal TRawByteStringStream
    // - will use the stack-allocated TTextWriterStackBuffer if possible
    // - TRawByteStringStream.DataString method will be used by TTextWriter.Text
    // to retrieve directly the content without any data move nor allocation
    constructor CreateOwnedStream(var aStackBuf: TTextWriterStackBuffer;
      aBufSize: integer=SizeOf(TTextWriterStackBuffer)); overload;
    /// the data will be written to an external file
    // - you should call explicitly FlushFinal or FlushToStream to write
    // any pending data to the file
    constructor CreateOwnedFileStream(const aFileName: TFileName; aBufSize: integer=8192);
    /// release all internal structures
    // - e.g. free fStream if the instance was owned by this class
    destructor Destroy; override;
    /// allow to override the default JSON serialization of enumerations and
    // sets as text, which would write the whole identifier (e.g. 'sllError')
    // - calling SetDefaultEnumTrim(true) would force the enumerations to
    // be trimmed for any lower case char, e.g. sllError -> 'Error'
    // - this is global to the current process, and should be use mainly for
    // compatibility purposes for the whole process
    // - you may change the default behavior by setting twoTrimLeftEnumSets
    // in the TTextWriter.CustomOptions property of a given serializer
    // - note that unserialization process would recognize both formats
    class procedure SetDefaultEnumTrim(aShouldTrimEnumsAsText: boolean);

    /// retrieve the data as a string
    function Text: RawUTF8;
      {$ifdef HASINLINE}inline;{$endif}
    /// retrieve the data as a string
    // - will avoid creation of a temporary RawUTF8 variable as for Text function
    procedure SetText(var result: RawUTF8; reformat: TTextWriterJSONFormat=jsonCompact);
    /// set the internal stream content with the supplied UTF-8 text
    procedure ForceContent(const text: RawUTF8);
    /// write pending data to the Stream, with automatic buffer resizal
    // - you should not have to call FlushToStream in most cases, but FlushFinal
    // at the end of the process, just before using the resulting Stream
    // - FlushToStream may be used to force immediate writing of the internal
    // memory buffer to the destination Stream
    // - you can set FlushToStreamNoAutoResize=true or call FlushFinal if you
    // do not want the automatic memory buffer resizal to take place
    procedure FlushToStream; virtual;
    /// write pending data to the Stream, without automatic buffer resizal
    // - will append the internal memory buffer to the Stream
    // - in short, FlushToStream may be called during the adding process, and
    // FlushFinal at the end of the process, just before using the resulting Stream
    // - if you don't call FlushToStream or FlushFinal, some pending characters
    // may not be copied to the Stream: you should call it before using the Stream
    procedure FlushFinal;
    /// gives access to an internal temporary TTextWriter
    // - may be used to escape some JSON espaced value (i.e. escape it twice),
    // in conjunction with AddJSONEscape(Source: TTextWriter)
    function InternalJSONWriter: TTextWriter;

    /// append one ASCII char to the buffer
    procedure Add(c: AnsiChar); overload; {$ifdef HASINLINE}inline;{$endif}
    /// append one ASCII char to the buffer, if not already there as LastChar
    procedure AddOnce(c: AnsiChar); overload; {$ifdef HASINLINE}inline;{$endif}
    /// append two chars to the buffer
    procedure Add(c1,c2: AnsiChar); overload; {$ifdef HASINLINE}inline;{$endif}
    {$ifndef CPU64} // already implemented by Add(Value: PtrInt) method
    /// append a 64-bit signed Integer Value as text
    procedure Add(Value: Int64); overload;
    {$endif}
    /// append a 32-bit signed Integer Value as text
    procedure Add(Value: PtrInt); overload;
    /// append a boolean Value as text
    // - write either 'true' or 'false'
    procedure Add(Value: boolean); overload; {$ifdef HASINLINE}inline;{$endif}
    /// append a Currency from its Int64 in-memory representation
    procedure AddCurr64(const Value: Int64); overload;
    /// append a Currency from its Int64 in-memory representation
    procedure AddCurr64(const Value: currency); overload; {$ifdef HASINLINE}inline;{$endif}
    /// append a TTimeLog value, expanded as Iso-8601 encoded text
    procedure AddTimeLog(Value: PInt64);
    /// append a TUnixTime value, expanded as Iso-8601 encoded text
    procedure AddUnixTime(Value: PInt64);
    /// append a TUnixMSTime value, expanded as Iso-8601 encoded text
    procedure AddUnixMSTime(Value: PInt64; WithMS: boolean=false);
    /// append a TDateTime value, expanded as Iso-8601 encoded text
    // - use 'YYYY-MM-DDThh:mm:ss' format (with FirstChar='T')
    // - if WithMS is TRUE, will append '.sss' for milliseconds resolution
    // - if QuoteChar is not #0, it will be written before and after the date
    procedure AddDateTime(Value: PDateTime; FirstChar: AnsiChar='T'; QuoteChar: AnsiChar=#0;
      WithMS: boolean=false); overload;
    /// append a TDateTime value, expanded as Iso-8601 encoded text
    // - use 'YYYY-MM-DDThh:mm:ss' format
    // - append nothing if Value=0
    // - if WithMS is TRUE, will append '.sss' for milliseconds resolution
    procedure AddDateTime(const Value: TDateTime; WithMS: boolean=false); overload;
    /// append a TDateTime value, expanded as Iso-8601 text with milliseconds
    // and Time Zone designator
    // - i.e. 'YYYY-MM-DDThh:mm:ss.sssZ' format
    // - TZD is the ending time zone designator ('', 'Z' or '+hh:mm' or '-hh:mm')
    procedure AddDateTimeMS(const Value: TDateTime; Expanded: boolean=true;
      FirstTimeChar: AnsiChar = 'T'; const TZD: RawUTF8='Z');
    /// append an Unsigned 32-bit Integer Value as a String
    procedure AddU(Value: cardinal);
    /// append an Unsigned 64-bit Integer Value as a String
    procedure AddQ(Value: QWord);
    /// append an Unsigned 64-bit Integer Value as a quoted hexadecimal String
    procedure AddQHex(Value: Qword); {$ifdef HASINLINE}inline;{$endif}
    /// append a GUID value, encoded as text without any {}
    // - will store e.g. '3F2504E0-4F89-11D3-9A0C-0305E82C3301'
    procedure Add({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID); overload;
    /// append a floating-point Value as a String
    // - write "Infinity", "-Infinity", and "NaN" for corresponding IEEE values
    // - noexp=true will call ExtendedToShortNoExp() to avoid any scientific
    // notation in the resulting text
    procedure AddDouble(Value: double; noexp: boolean=false); {$ifdef HASINLINE}inline;{$endif}
    /// append a floating-point Value as a String
    // - write "Infinity", "-Infinity", and "NaN" for corresponding IEEE values
    // - noexp=true will call ExtendedToShortNoExp() to avoid any scientific
    // notation in the resulting text
    procedure AddSingle(Value: single; noexp: boolean=false); {$ifdef HASINLINE}inline;{$endif}
    /// append a floating-point Value as a String
    // - write "Infinity", "-Infinity", and "NaN" for corresponding IEEE values
    // - noexp=true will call ExtendedToShortNoExp() to avoid any scientific
    // notation in the resulting text
    procedure Add(Value: Extended; precision: integer; noexp: boolean=false); overload;
    /// append a floating-point text buffer
    // - will correct on the fly '.5' -> '0.5' and '-.5' -> '-0.5'
    // - will end not only on #0 but on any char not matching 1[.2[e[-]3]] pattern
    // - is used when the input comes from a third-party source with no regular
    // output, e.g. a database driver
    procedure AddFloatStr(P: PUTF8Char);
    /// append strings or integers with a specified format
    // - % = #37 marks a string, integer, floating-point, or class parameter
    // to be appended as text (e.g. class name)
    // - if StringEscape is false (by default), the text won't be escaped before
    // adding; but if set to true text will be JSON escaped at writing
    // - note that due to a limitation of the "array of const" format, cardinal
    // values should be type-casted to Int64() - otherwise the integer mapped
    // value will be transmitted, therefore wrongly
    {$ifdef OLDTEXTWRITERFORMAT}
    // - $ dollar = #36 indicates an integer to be written with 2 digits and a comma
    // - | vertical = #124 will write the next char e.g. Add('%|$',[10]) will write '10$'
    // - pound = #163 indicates an integer to be written with 4 digits and a comma
    // - micro = #181 indicates an integer to be written with 3 digits without any comma
    // - currency = #164 indicates CR+LF chars
    // - section = #167 indicates to trim last comma
    // - since some of this characters above are > #127, they are not UTF-8
    // ready, so we expect the input format to be WinAnsi, i.e. mostly English
    // text (with chars < #128) with some values to be inserted inside
    {$endif}
    procedure Add(const Format: RawUTF8; const Values: array of const;
      Escape: TTextWriterKind=twNone; WriteObjectOptions: TTextWriterWriteObjectOptions=[woFullExpand]); overload;
    /// append some values at once
    // - text values (e.g. RawUTF8) will be escaped as JSON
    procedure Add(const Values: array of const); overload;
    /// append CR+LF (#13#10) chars
    // - this method won't call EchoAdd() registered events - use AddEndOfLine()
    // method instead
    // - AddEndOfLine() will append either CR+LF (#13#10) or LF (#10) depending
    // on a flag
    procedure AddCR;
    /// append CR+LF (#13#10) chars and #9 indentation
    // - indentation depth is defined by fHumanReadableLevel protected field
    procedure AddCRAndIndent;
    /// write the same character multiple times
    procedure AddChars(aChar: AnsiChar; aCount: integer);
    /// append an Integer Value as a 2 digits String with comma
    procedure Add2(Value: PtrUInt);
    /// append the current UTC date and time, in our log-friendly format
    // - e.g. append '20110325 19241502' - with no trailing space nor tab
    // - you may set LocalTime=TRUE to write the local date and time instead
    // - this method is very fast, and avoid most calculation or API calls
    procedure AddCurrentLogTime(LocalTime: boolean);
    /// append the current UTC date and time, in our log-friendly format
    // - e.g. append '19/Feb/2019:06:18:55 ' - including a trailing space
    // - you may set LocalTime=TRUE to write the local date and time instead
    // - this method is very fast, and avoid most calculation or API calls
    procedure AddCurrentNCSALogTime(LocalTime: boolean);
    /// append a time period, specified in micro seconds, in 00.000.000 TSynLog format
    procedure AddMicroSec(MS: cardinal);
    /// append an Integer Value as a 4 digits String with comma
    procedure Add4(Value: PtrUInt);
    /// append an Integer Value as a 3 digits String without any added comma
    procedure Add3(Value: PtrUInt);
    /// append a line of text with CR+LF at the end
    procedure AddLine(const Text: shortstring);
    /// append an UTF-8 String, with no JSON escaping
    procedure AddString(const Text: RawUTF8);
    /// append several UTF-8 strings
    procedure AddStrings(const Text: array of RawUTF8); overload;
    /// append an UTF-8 string several times
    procedure AddStrings(const Text: RawUTF8; count: integer); overload;
    /// append a ShortString
    procedure AddShort(const Text: ShortString);
    /// append a sub-part of an UTF-8  String
    // - emulates AddString(copy(Text,start,len))
    procedure AddStringCopy(const Text: RawUTF8; start,len: PtrInt);
    /// append after trim first lowercase chars ('otDone' will add 'Done' e.g.)
    procedure AddTrimLeftLowerCase(Text: PShortString);
    /// append a UTF-8 String excluding any space or control char
    // - this won't escape the text as expected by JSON
    procedure AddTrimSpaces(const Text: RawUTF8); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// append a UTF-8 String excluding any space or control char
    // - this won't escape the text as expected by JSON
    procedure AddTrimSpaces(P: PUTF8Char); overload;
    /// append a property name, as '"PropName":'
    // - PropName content should not need to be JSON escaped (e.g. no " within,
    // and only ASCII 7-bit characters)
    // - if twoForceJSONExtended is defined in CustomOptions, it would append
    // 'PropName:' without the double quotes
    procedure AddProp(PropName: PUTF8Char; PropNameLen: PtrInt);
    /// append a ShortString property name, as '"PropName":'
    // - PropName content should not need to be JSON escaped (e.g. no " within,
    // and only ASCII 7-bit characters)
    // - if twoForceJSONExtended is defined in CustomOptions, it would append
    // 'PropName:' without the double quotes
    // - is a wrapper around AddProp()
    procedure AddPropName(const PropName: ShortString);
      {$ifdef HASINLINE}inline;{$endif}
    /// append a JSON field name, followed by an escaped UTF-8 JSON String and
    // a comma (',')
    procedure AddPropJSONString(const PropName: shortstring; const Text: RawUTF8);
    /// append a JSON field name, followed by a number value and a comma (',')
    procedure AddPropJSONInt64(const PropName: shortstring; Value: Int64);
    /// append a RawUTF8 property name, as '"FieldName":'
    // - FieldName content should not need to be JSON escaped (e.g. no " within)
    // - if twoForceJSONExtended is defined in CustomOptions, it would append
    // 'PropName:' without the double quotes
    // - is a wrapper around AddProp()
    procedure AddFieldName(const FieldName: RawUTF8);
      {$ifdef HASINLINE}inline;{$endif}
    /// append the class name of an Object instance as text
    // - aClass must be not nil
    procedure AddClassName(aClass: TClass);
    /// append an Instance name and pointer, as '"TObjectList(00425E68)"'+SepChar
    // - Instance must be not nil
    procedure AddInstanceName(Instance: TObject; SepChar: AnsiChar);
    /// append an Instance name and pointer, as 'TObjectList(00425E68)'+SepChar
    // - Instance must be not nil
    // - overriden version in TJSONSerializer would implement IncludeUnitName
    procedure AddInstancePointer(Instance: TObject; SepChar: AnsiChar;
      IncludeUnitName, IncludePointer: boolean); virtual;
    /// append a quoted string as JSON, with in-place decoding
    // - if QuotedString does not start with ' or ", it will written directly
    // (i.e. expects to be a number, or null/true/false constants)
    // - as used e.g. by TJSONObjectDecoder.EncodeAsJSON method and
    // JSONEncodeNameSQLValue() function
    procedure AddQuotedStringAsJSON(const QuotedString: RawUTF8);
    /// append an array of integers as CSV
    procedure AddCSVInteger(const Integers: array of Integer); overload;
    /// append an array of doubles as CSV
    procedure AddCSVDouble(const Doubles: array of double); overload;
    /// append an array of RawUTF8 as CSV of JSON strings
    procedure AddCSVUTF8(const Values: array of RawUTF8); overload;
    /// append an array of const as CSV of JSON values
    procedure AddCSVConst(const Values: array of const);
    /// write some data Base64 encoded
    // - if withMagic is TRUE, will write as '"\uFFF0base64encodedbinary"'
    procedure WrBase64(P: PAnsiChar; Len: PtrUInt; withMagic: boolean);
    /// write some record content as binary, Base64 encoded with our magic prefix
    procedure WrRecord(const Rec; TypeInfo: pointer);
    /// write some #0 ended UTF-8 text, according to the specified format
    // - if Escape is a constant, consider calling directly AddNoJSONEscape,
    // AddJSONEscape or AddOnSameLine methods
    procedure Add(P: PUTF8Char; Escape: TTextWriterKind); overload;
    /// write some #0 ended UTF-8 text, according to the specified format
    // - if Escape is a constant, consider calling directly AddNoJSONEscape,
    // AddJSONEscape or AddOnSameLine methods
    procedure Add(P: PUTF8Char; Len: PtrInt; Escape: TTextWriterKind); overload;
    /// write some #0 ended Unicode text as UTF-8, according to the specified format
    // - if Escape is a constant, consider calling directly AddNoJSONEscapeW,
    // AddJSONEscapeW or AddOnSameLineW methods
    procedure AddW(P: PWord; Len: PtrInt; Escape: TTextWriterKind);
    /// append some UTF-8 encoded chars to the buffer, from the main AnsiString type
    // - use the current system code page for AnsiString parameter
    procedure AddAnsiString(const s: AnsiString; Escape: TTextWriterKind); overload;
    /// append some UTF-8 encoded chars to the buffer, from any AnsiString value
    // - if CodePage is left to its default value of -1, it will assume
    // CurrentAnsiConvert.CodePage prior to Delphi 2009, but newer UNICODE
    // versions of Delphi will retrieve the code page from string
    // - if CodePage is defined to a >= 0 value, the encoding will take place
    procedure AddAnyAnsiString(const s: RawByteString; Escape: TTextWriterKind;
      CodePage: Integer=-1);
    /// append some UTF-8 encoded chars to the buffer, from any Ansi buffer
    // - the codepage should be specified, e.g. CP_UTF8, CP_RAWBYTESTRING,
    // CODEPAGE_US, or any version supported by the Operating System
    // - if codepage is 0, the current CurrentAnsiConvert.CodePage would be used
    // - will use TSynAnsiConvert to perform the conversion to UTF-8
    procedure AddAnyAnsiBuffer(P: PAnsiChar; Len: PtrInt;
      Escape: TTextWriterKind; CodePage: Integer);
    /// append some UTF-8 chars to the buffer
    // - input length is calculated from zero-ended char
    // - don't escapes chars according to the JSON RFC
    procedure AddNoJSONEscape(P: Pointer); overload;
    /// append some UTF-8 chars to the buffer
    // - don't escapes chars according to the JSON RFC
    procedure AddNoJSONEscape(P: Pointer; Len: PtrInt); overload;
    /// append some UTF-8 chars to the buffer
    // - don't escapes chars according to the JSON RFC
    procedure AddNoJSONEscapeUTF8(const text: RawByteString);
      {$ifdef HASINLINE}inline;{$endif}
    /// flush a supplied TTextWriter, and write pending data as JSON escaped text
    // - may be used with InternalJSONWriter, as a faster alternative to
    // ! AddNoJSONEscapeUTF8(Source.Text);
    procedure AddNoJSONEscape(Source: TTextWriter); overload;
    /// append some UTF-8 chars to the buffer
    // - if supplied json is '', will write 'null'
    procedure AddRawJSON(const json: RawJSON);
    /// append some UTF-8 text, quoting all " chars
    // - same algorithm than AddString(QuotedStr()) - without memory allocation,
    // and with an optional maximum text length (truncated with ending '...')
    // - this function implements what is specified in the official SQLite3
    // documentation: "A string constant is formed by enclosing the string in single
    // quotes ('). A single quote within the string can be encoded by putting two
    // single quotes in a row - as in Pascal."
    procedure AddQuotedStr(Text: PUTF8Char; Quote: AnsiChar; TextMaxLen: PtrInt=0);
    /// append some chars, escaping all HTML special chars as expected
    procedure AddHtmlEscape(Text: PUTF8Char; Fmt: TTextWriterHTMLFormat=hfAnyWhere); overload;
    /// append some chars, escaping all HTML special chars as expected
    procedure AddHtmlEscape(Text: PUTF8Char; TextLen: PtrInt;
      Fmt: TTextWriterHTMLFormat=hfAnyWhere); overload;
    /// append some chars, escaping all HTML special chars as expected
    procedure AddHtmlEscapeString(const Text: string;
      Fmt: TTextWriterHTMLFormat=hfAnyWhere);
    /// append some chars, escaping all HTML special chars as expected
    procedure AddHtmlEscapeUTF8(const Text: RawUTF8;
      Fmt: TTextWriterHTMLFormat=hfAnyWhere);
    /// append some chars, escaping all XML special chars as expected
    // - i.e.   < > & " '  as   &lt; &gt; &amp; &quote; &apos;
    // - and all control chars (i.e. #1..#31) as &#..;
    // - see @http://www.w3.org/TR/xml/#syntax
    procedure AddXmlEscape(Text: PUTF8Char);
    /// append some chars, replacing a given character with another
    procedure AddReplace(Text: PUTF8Char; Orig,Replaced: AnsiChar);
    /// append some binary data as hexadecimal text conversion
    procedure AddBinToHex(Bin: Pointer; BinBytes: integer);
    /// fast conversion from binary data into hexa chars, ready to be displayed
    // - using this function with Bin^ as an integer value will serialize it
    // in big-endian order (most-significant byte first), as used by humans
    // - up to the internal buffer bytes may be converted
    procedure AddBinToHexDisplay(Bin: pointer; BinBytes: integer);
    /// fast conversion from binary data into MSB hexa chars
    // - up to the internal buffer bytes may be converted
    procedure AddBinToHexDisplayLower(Bin: pointer; BinBytes: integer);
    /// fast conversion from binary data into quoted MSB lowercase hexa chars
    // - up to the internal buffer bytes may be converted
    procedure AddBinToHexDisplayQuoted(Bin: pointer; BinBytes: integer);
    /// append a Value as significant hexadecimal text
    // - append its minimal size, i.e. excluding highest bytes containing 0
    // - use GetNextItemHexa() to decode such a text value
    procedure AddBinToHexDisplayMinChars(Bin: pointer; BinBytes: PtrInt);
    /// add the pointer into significant hexa chars, ready to be displayed
    procedure AddPointer(P: PtrUInt);    {$ifdef HASINLINE}inline;{$endif}
    /// write a byte as hexa chars
    procedure AddByteToHex(Value: byte);
    /// write a Int18 value (0..262143) as 3 chars
    // - this encoding is faster than Base64, and has spaces on the left side
    // - use function Chars3ToInt18() to decode the textual content
    procedure AddInt18ToChars3(Value: cardinal);
    /// append some unicode chars to the buffer
    // - WideCharCount is the unicode chars count, not the byte size
    // - don't escapes chars according to the JSON RFC
    // - will convert the Unicode chars into UTF-8
    procedure AddNoJSONEscapeW(WideChar: PWord; WideCharCount: integer);
    /// append some UTF-8 encoded chars to the buffer
    // - escapes chars according to the JSON RFC
    // - if Len is 0, writing will stop at #0 (default Len=0 is slightly faster
    // than specifying Len>0 if you are sure P is zero-ended - e.g. from RawUTF8)
    procedure AddJSONEscape(P: Pointer; Len: PtrInt=0); overload;
    /// append some UTF-8 encoded chars to the buffer, from a generic string type
    // - faster than AddJSONEscape(pointer(StringToUTF8(string))
    // - escapes chars according to the JSON RFC
    procedure AddJSONEscapeString(const s: string);  {$ifdef HASINLINE}inline;{$endif}
    /// append some UTF-8 encoded chars to the buffer, from the main AnsiString type
    // - escapes chars according to the JSON RFC
    procedure AddJSONEscapeAnsiString(const s: AnsiString);
    /// append some UTF-8 encoded chars to the buffer, from a generic string type
    // - faster than AddNoJSONEscape(pointer(StringToUTF8(string))
    // - don't escapes chars according to the JSON RFC
    // - will convert the Unicode chars into UTF-8
    procedure AddNoJSONEscapeString(const s: string);  {$ifdef UNICODE}inline;{$endif}
    /// append some Unicode encoded chars to the buffer
    // - if Len is 0, Len is calculated from zero-ended widechar
    // - escapes chars according to the JSON RFC
    procedure AddJSONEscapeW(P: PWord; Len: PtrInt=0);
    /// append an open array constant value to the buffer
    // - "" will be added if necessary
    // - escapes chars according to the JSON RFC
    // - very fast (avoid most temporary storage)
    procedure AddJSONEscape(const V: TVarRec); overload;
    /// flush a supplied TTextWriter, and write pending data as JSON escaped text
    // - may be used with InternalJSONWriter, as a faster alternative to
    // ! AddJSONEscape(Pointer(fInternalJSONWriter.Text),0);
    procedure AddJSONEscape(Source: TTextWriter); overload;
    /// append a UTF-8 JSON String, between double quotes and with JSON escaping
    procedure AddJSONString(const Text: RawUTF8);
    /// append an open array constant value to the buffer
    // - "" won't be added for string values
    // - string values may be escaped, depending on the supplied parameter
    // - very fast (avoid most temporary storage)
    procedure Add(const V: TVarRec; Escape: TTextWriterKind=twNone;
      WriteObjectOptions: TTextWriterWriteObjectOptions=[woFullExpand]); overload;
    /// encode the supplied data as an UTF-8 valid JSON object content
    // - data must be supplied two by two, as Name,Value pairs, e.g.
    // ! aWriter.AddJSONEscape(['name','John','year',1972]);
    // will append to the buffer:
    // ! '{"name":"John","year":1972}'
    // - or you can specify nested arrays or objects with '['..']' or '{'..'}':
    // ! aWriter.AddJSONEscape(['doc','{','name','John','ab','[','a','b']','}','id',123]);
    // will append to the buffer:
    // ! '{"doc":{"name":"John","abc":["a","b"]},"id":123}'
    // - note that, due to a Delphi compiler limitation, cardinal values should be
    // type-casted to Int64() (otherwise the integer mapped value will be converted)
    // - you can pass nil as parameter for a null JSON value
    procedure AddJSONEscape(const NameValuePairs: array of const); overload;
    {$ifndef NOVARIANTS}
    /// encode the supplied (extended) JSON content, with parameters,
    // as an UTF-8 valid JSON object content
    // - in addition to the JSON RFC specification strict mode, this method will
    // handle some BSON-like extensions, e.g. unquoted field names:
    // ! aWriter.AddJSON('{id:?,%:{name:?,birthyear:?}}',['doc'],[10,'John',1982]);
    // - you can use nested _Obj() / _Arr() instances
    // ! aWriter.AddJSON('{%:{$in:[?,?]}}',['type'],['food','snack']);
    // ! aWriter.AddJSON('{type:{$in:?}}',[],[_Arr(['food','snack'])]);
    // ! // which are the same as:
    // ! aWriter.AddShort('{"type":{"$in":["food","snack"]}}');
    // - if the SynMongoDB unit is used in the application, the MongoDB Shell
    // syntax will also be recognized to create TBSONVariant, like
    // ! new Date()   ObjectId()   MinKey   MaxKey  /<jRegex>/<jOptions>
    // see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
    // !  aWriter.AddJSON('{name:?,field:/%/i}',['acme.*corp'],['John']))
    // ! // will write
    // ! '{"name":"John","field":{"$regex":"acme.*corp","$options":"i"}}'
    // - will call internally _JSONFastFmt() to create a temporary TDocVariant
    // with all its features - so is slightly slower than other AddJSON* methods
    procedure AddJSON(const Format: RawUTF8; const Args,Params: array of const);
    {$endif}
    /// append two JSON arrays of keys and values as one JSON object
    // - i.e. makes the following transformation:
    // $ [key1,key2...] + [value1,value2...] -> {key1:value1,key2,value2...}
    // - this method won't allocate any memory during its process, nor
    // modify the keys and values input buffers
    // - is the reverse of the JSONObjectAsJSONArrays() function
    procedure AddJSONArraysAsJSONObject(keys,values: PUTF8Char);
    /// append a dynamic array content as UTF-8 encoded JSON array
    // - expect a dynamic array TDynArray wrapper as incoming parameter
    // - TIntegerDynArray, TInt64DynArray, TCardinalDynArray, TDoubleDynArray,
    // TCurrencyDynArray, TWordDynArray and TByteDynArray will be written as
    // numerical JSON values
    // - TRawUTF8DynArray, TWinAnsiDynArray, TRawByteStringDynArray,
    // TStringDynArray, TWideStringDynArray, TSynUnicodeDynArray, TTimeLogDynArray,
    // and TDateTimeDynArray will be written as escaped UTF-8 JSON strings
    // (and Iso-8601 textual encoding if necessary)
    // - you can add some custom serializers via RegisterCustomJSONSerializer()
    // class method, to serialize any dynamic array as valid JSON
    // - any other non-standard or non-registered kind of dynamic array (including
    // array of records) will be written as Base64 encoded binary stream, with a
    // JSON_BASE64_MAGIC prefix (UTF-8 encoded \uFFF0 special code) - this will
    // include TBytes (i.e. array of bytes) content, which is a good candidate
    // for BLOB stream
    // - typical content could be
    // ! '[1,2,3,4]' or '["\uFFF0base64encodedbinary"]'
    // - by default, custom serializers defined via RegisterCustomJSONSerializer()
    // would write enumerates and sets as integer numbers, unless
    // twoEnumSetsAsTextInRecord is set in the instance Options
    procedure AddDynArrayJSON(var aDynArray: TDynArray); overload;
    /// append a dynamic array content as UTF-8 encoded JSON array
    // - expect a dynamic array TDynArrayHashed wrapper as incoming parameter
    procedure AddDynArrayJSON(var aDynArray: TDynArrayHashed); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// append a dynamic array content as UTF-8 encoded JSON array
    // - just a wrapper around the other overloaded method, creating a
    // temporary TDynArray wrapper on the stack
    // - to be used e.g. for custom record JSON serialization, within a
    // TDynArrayJSONCustomWriter callback
    procedure AddDynArrayJSON(aTypeInfo: pointer; const aValue); overload;
    /// same as AddDynArrayJSON(), but will double all internal " and bound with "
    // - this implementation will avoid most memory allocations
    procedure AddDynArrayJSONAsString(aTypeInfo: pointer; var aValue);
    /// append a T*ObjArray dynamic array as a JSON array
    // - as expected by TJSONSerializer.RegisterObjArrayForJSON()
    procedure AddObjArrayJSON(const aObjArray;
      aOptions: TTextWriterWriteObjectOptions=[woDontStoreDefault]);
    /// append a record content as UTF-8 encoded JSON or custom serialization
    // - default serialization will use Base64 encoded binary stream, or
    // a custom serialization, in case of a previous registration via
    // RegisterCustomJSONSerializer() class method - from a dynamic array
    // handling this kind of records, or directly from TypeInfo() of the record
    // - by default, custom serializers defined via RegisterCustomJSONSerializer()
    // would write enumerates and sets as integer numbers, unless
    // twoEnumSetsAsTextInRecord or twoEnumSetsAsBooleanInRecord is set in
    // the instance CustomOptions
    procedure AddRecordJSON(const Rec; TypeInfo: pointer);
    {$ifndef NOVARIANTS}
    /// append a variant content as number or string
    // - default Escape=twJSONEscape will create valid JSON content, which
    // can be converted back to a variant value using VariantLoadJSON()
    // - default JSON serialization options would apply, unless
    // twoForceJSONExtended or twoForceJSONStandard is defined
    // - note that before Delphi 2009, any varString value is expected to be
    // a RawUTF8 instance - which does make sense in the mORMot context
    procedure AddVariant(const Value: variant; Escape: TTextWriterKind=twJSONEscape);
    {$endif}
    /// append a void record content as UTF-8 encoded JSON or custom serialization
    // - this method will first create a void record (i.e. filled with #0 bytes)
    // then save its content with default or custom serialization
    procedure AddVoidRecordJSON(TypeInfo: pointer);
    /// append a JSON value from its RTTI type
    // - handle tkClass,tkEnumeration,tkSet,tkRecord,tkDynArray,tkVariant types
    // - write null for other types
    procedure AddTypedJSON(aTypeInfo: pointer; const aValue);
    /// serialize as JSON the given object
    // - this default implementation will write null, or only write the
    // class name and pointer if FullExpand is true - use
    // TJSONSerializer.WriteObject method for full RTTI handling
    // - default implementation will write TList/TCollection/TStrings/TRawUTF8List
    // as appropriate array of class name/pointer (if woFullExpand is set)
    procedure WriteObject(Value: TObject;
      Options: TTextWriterWriteObjectOptions=[woDontStoreDefault]); virtual;
    /// same as WriteObject(), but will double all internal " and bound with "
    // - this implementation will avoid most memory allocations
    procedure WriteObjectAsString(Value: TObject;
      Options: TTextWriterWriteObjectOptions=[woDontStoreDefault]);
    /// append a JSON value, array or document as simple XML content
    // - you can use JSONBufferToXML() and JSONToXML() functions as wrappers
    // - this method is called recursively to handle all kind of JSON values
    // - WARNING: the JSON buffer is decoded in-place, so will be changed
    // - returns the end of the current JSON converted level, or nil if the
    // supplied content was not correct JSON
    function AddJSONToXML(JSON: PUTF8Char; ArrayName: PUTF8Char=nil;
      EndOfObject: PUTF8Char=nil): PUTF8Char;
    /// append a JSON value, array or document, in a specified format
    // - will parse the JSON buffer and write its content with proper line
    // feeds and indentation, according to the supplied TTextWriterJSONFormat
    // - see also JSONReformat() and JSONBufferReformat() wrappers
    // - this method is called recursively to handle all kind of JSON values
    // - WARNING: the JSON buffer is decoded in-place, so will be changed
    // - returns the end of the current JSON converted level, or nil if the
    // supplied content was not valid JSON
    function AddJSONReformat(JSON: PUTF8Char; Format: TTextWriterJSONFormat;
       EndOfObject: PUTF8Char): PUTF8Char;

    /// define a custom serialization for a given dynamic array or record
    // - expects TypeInfo() from a dynamic array or a record (will raise an
    // exception otherwise)
    // - for a dynamic array, the associated item record RTTI will be registered
    // - for a record, any matching dynamic array will also be registered
    // - by default, TIntegerDynArray and such known classes are processed as
    // true JSON arrays: but you can specify here some callbacks to perform
    // the serialization process for any kind of dynamic array
    // - any previous registration is overridden
    // - setting both aReader=aWriter=nil will return back to the default
    // binary + Base64 encoding serialization (i.e. undefine custom serializer)
    class procedure RegisterCustomJSONSerializer(aTypeInfo: pointer;
      aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
    {$ifndef NOVARIANTS}
    /// define a custom serialization for a given variant custom type
    // - used e.g. to serialize TBCD values
    class procedure RegisterCustomJSONSerializerForVariant(aClass: TCustomVariantType;
      aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
    /// define a custom serialization for a given variant custom type
    // - used e.g. to serialize TBCD values
    class procedure RegisterCustomJSONSerializerForVariantByType(aVarType: TVarType;
      aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
    {$endif NOVARIANTS}
    /// define a custom serialization for a given dynamic array or record
    // - the RTTI information will here be defined as plain text
    // - since Delphi 2010, you can call directly
    // RegisterCustomJSONSerializerFromTextSimpleType()
    // - aTypeInfo may be valid TypeInfo(), or any fixed pointer value if the
    // record does not have any RTTI (e.g. a record without any nested reference-
    // counted types)
    // - the record where the data will be stored should be defined as PACKED:
    // ! type TMyRecord = packed record
    // !   A,B,C: integer;
    // !   D: RawUTF8;
    // !   E: record; // or array of record/integer/string/...
    // !     E1,E2: double;
    // !   end;
    // ! end;
    // - call this method with aRTTIDefinition='' to return back to the default
    // binary + Base64 encoding serialization (i.e. undefine custom serializer)
    // - only known sub types are byte, word, integer, cardinal, Int64, single,
    // double, currency, TDateTime, TTimeLog, RawUTF8, String, WideString,
    // SynUnicode, TGUID (encoded via GUIDToText) or a nested record or dynamic
    // array of the same simple types or record
    // - RTTI textual information shall be supplied as text, with the
    // same format as with a pascal record:
    // ! 'A,B,C: integer; D: RawUTF8; E: record E1,E2: double;'
    // ! 'A,B,C: integer; D: RawUTF8; E: array of record E1,E2: double;'
    // ! 'A,B,C: integer; D: RawUTF8; E: array of SynUnicode; F: array of TGUID'
    // or a shorter alternative syntax for records and arrays:
    // ! 'A,B,C: integer; D: RawUTF8; E: {E1,E2: double}'
    // ! 'A,B,C: integer; D: RawUTF8; E: [E1,E2: double]'
    // in fact ; could be ignored:
    // ! 'A,B,C:integer D:RawUTF8 E:{E1,E2:double}'
    // ! 'A,B,C:integer D:RawUTF8 E:[E1,E2:double]'
    // or even : could be ignored:
    // ! 'A,B,C integer D RawUTF8 E{E1,E2 double}'
    // ! 'A,B,C integer D RawUTF8 E[E1,E2 double]'
    // - it will return the cached TJSONRecordTextDefinition
    // instance corresponding to the supplied RTTI text definition
    class function RegisterCustomJSONSerializerFromText(aTypeInfo: pointer;
      const aRTTIDefinition: RawUTF8): TJSONRecordAbstract; overload;
    /// define a custom serialization for several dynamic arrays or records
    // - the TypeInfo() and textual RTTI information will here be defined as
    // ([TypeInfo(TType1),_TType1,TypeInfo(TType2),_TType2]) pairs
    // - a wrapper around the overloaded RegisterCustomJSONSerializerFromText()
    class procedure RegisterCustomJSONSerializerFromText(
      const aTypeInfoTextDefinitionPairs: array of const); overload;
    /// change options for custom serialization of dynamic array or record
    // - will return TRUE if the options have been changed, FALSE if the
    // supplied type info was not previously registered
    // - if AddIfNotExisting is TRUE, and enhanced RTTI is available (since
    // Delphi 2010), you would be able to customize the options of this type
    class function RegisterCustomJSONSerializerSetOptions(aTypeInfo: pointer;
      aOptions: TJSONCustomParserSerializationOptions;
      aAddIfNotExisting: boolean=false): boolean; overload;
    /// change options for custom serialization of dynamic arrays or records
    // - will return TRUE if the options have been changed, FALSE if the
    // supplied type info was not previously registered for at least one type
    // - if AddIfNotExisting is TRUE, and enhanced RTTI is available (since
    // Delphi 2010), you would be able to customize the options of this type
    class function RegisterCustomJSONSerializerSetOptions(
      const aTypeInfo: array of pointer; aOptions: TJSONCustomParserSerializationOptions;
      aAddIfNotExisting: boolean=false): boolean; overload;
    /// retrieve a previously registered custom parser instance from its type
    // - will return nil if the type info was not available, or defined just
    // with some callbacks
    // - if AddIfNotExisting is TRUE, and enhanced RTTI is available (since
    // Delphi 2010), you would be able to retrieve this type's parser even
    // if the record type has not been previously used
    class function RegisterCustomJSONSerializerFindParser(
      aTypeInfo: pointer; aAddIfNotExisting: boolean=false): TJSONRecordAbstract;
    /// define a custom serialization for a given simple type
    // - you should be able to use this type in the RTTI text definition
    // of any further RegisterCustomJSONSerializerFromText() call
    // - the RTTI information should be enough to serialize the type from
    // its name (e.g. an enumeration for older Delphi revision, but all records
    // since Delphi 2010)
    // - you can supply a custom type name, which will be registered in addition
    // to the "official" name defined at RTTI level
    // - on older Delphi versions (up to Delphi 2009), it will handle only
    // enumerations, which will be transmitted as JSON string instead of numbers
    // - since Delphi 2010, any record type can be supplied - which is more
    // convenient than calling RegisterCustomJSONSerializerFromText()
    class procedure RegisterCustomJSONSerializerFromTextSimpleType(aTypeInfo: pointer;
      const aTypeName: RawUTF8=''); overload;
    /// define a custom binary serialization for a given simple type
    // - you should be able to use this type in the RTTI text definition
    // of any further RegisterCustomJSONSerializerFromText() call
    // - data will be serialized as BinToHexDisplayLower() JSON hexadecimal string
    // - you can truncate the original data size (e.g. if all bits of an integer
    // are not used) by specifying the aFieldSize optional parameter
    class procedure RegisterCustomJSONSerializerFromTextBinaryType(aTypeInfo: pointer;
      aDataSize: integer; aFieldSize: integer=0); overload;
    /// define custom binary serialization for several simple types
    // - data will be serialized as BinToHexDisplayLower() JSON hexadecimal string
    // - the TypeInfo() and associated size information will here be defined as triplets:
    // ([TypeInfo(TType1),SizeOf(TType1),TYPE1_BYTES,TypeInfo(TType2),SizeOf(TType2),TYPE2_BYTES])
    // - a wrapper around the overloaded RegisterCustomJSONSerializerFromTextBinaryType()
    class procedure RegisterCustomJSONSerializerFromTextBinaryType(
      const aTypeInfoDataFieldSize: array of const); overload;
    /// define a custom serialization for several simple types
    // - will call the overloaded RegisterCustomJSONSerializerFromTextSimpleType
    // method for each supplied type information
    class procedure RegisterCustomJSONSerializerFromTextSimpleType(
       const aTypeInfos: array of pointer); overload;
    /// undefine a custom serialization for a given dynamic array or record
    // - it will un-register any callback or text-based custom serialization
    // i.e. any previous RegisterCustomJSONSerializer() or
    // RegisterCustomJSONSerializerFromText() call
    // - expects TypeInfo() from a dynamic array or a record (will raise an
    // exception otherwise)
    // - it will set back to the default binary + Base64 encoding serialization
    class procedure UnRegisterCustomJSONSerializer(aTypeInfo: pointer);
    /// retrieve low-level custom serialization callbaks for a dynamic array
    // - returns TRUE if this array has a custom JSON parser, and set the
    // corresponding serialization/unserialization callbacks
    class function GetCustomJSONParser(var DynArray: TDynArray;
      out CustomReader: TDynArrayJSONCustomReader;
      out CustomWriter: TDynArrayJSONCustomWriter): boolean;

    /// append some chars to the buffer in one line
    // - P should be ended with a #0
    // - will write #1..#31 chars as spaces (so content will stay on the same line)
    procedure AddOnSameLine(P: PUTF8Char); overload;
    /// append some chars to the buffer in one line
    // - will write #0..#31 chars as spaces (so content will stay on the same line)
    procedure AddOnSameLine(P: PUTF8Char; Len: PtrInt); overload;
    /// append some wide chars to the buffer in one line
    // - will write #0..#31 chars as spaces (so content will stay on the same line)
    procedure AddOnSameLineW(P: PWord; Len: PtrInt);

    /// return the last char appended
    // - returns #0 if no char has been written yet
    function LastChar: AnsiChar;
    /// how many bytes are currently in the internal buffer and not on disk
    // - see TextLength for the total number of bytes, on both disk and memory
    function PendingBytes: PtrUInt;
      {$ifdef HASINLINE}inline;{$endif}
    /// how many bytes were currently written on disk
    // - excluding the bytes in the internal buffer
    // - see TextLength for the total number of bytes, on both disk and memory
    property WrittenBytes: PtrUInt read fTotalFileSize;
    /// low-level access to the current indentation level
    property HumanReadableLevel: integer read fHumanReadableLevel write fHumanReadableLevel;
    /// the last char appended is canceled
    // - only one char cancelation is allowed at the same position: don't call
    // CancelLastChar/CancelLastComma more than once without appending text inbetween
    procedure CancelLastChar; overload; {$ifdef HASINLINE}inline;{$endif}
    /// the last char appended is canceled, if match the supplied one
    // - only one char cancelation is allowed at the same position: don't call
    // CancelLastChar/CancelLastComma more than once without appending text inbetween
    procedure CancelLastChar(aCharToCancel: AnsiChar); overload; {$ifdef HASINLINE}inline;{$endif}
    /// the last char appended is canceled if it was a ','
    // - only one char cancelation is allowed at the same position: don't call
    // CancelLastChar/CancelLastComma more than once without appending text inbetween
    procedure CancelLastComma; {$ifdef HASINLINE}inline;{$endif}
    /// rewind the Stream to the position when Create() was called
    // - note that this does not clear the Stream content itself, just
    // move back its writing position to its initial place
    procedure CancelAll;

    /// count of added bytes to the stream
    // - see PendingBytes for the number of bytes currently in the memory buffer
    // or WrittenBytes for the number of bytes already written to disk
    property TextLength: PtrUInt read GetTextLength;
    /// optional event called before FlushToStream method process
    property OnFlushToStream: TOnTextWriterFlush read fOnFlushToStream write fOnFlushToStream;
    /// allows to override default WriteObject property JSON serialization
    property OnWriteObject: TOnTextWriterObjectProp read fOnWriteObject write fOnWriteObject;
    /// the internal TStream used for storage
    // - you should call the FlushFinal (or FlushToStream) methods before using
    // this TStream content, to flush all pending characters
    // - if the TStream instance has not been specified when calling the
    // TTextWriter constructor, it can be forced via this property, before
    // any writting
    property Stream: TStream read fStream write SetStream;
    /// global options to customize this TTextWriter instance process
    // - allows to override e.g. AddRecordJSON() and AddDynArrayJSON() behavior
    property CustomOptions: TTextWriterOptions read fCustomOptions write fCustomOptions;
  end;

  /// class of our simple TEXT format writer to a Stream, with echoing
  // - as used by TSynLog for writing its content
  // - see TTextWriterWithEcho.SetAsDefaultJSONClass
  TTextWriterClass = class of TTextWriterWithEcho;

  /// Stream TEXT writer, with optional echoing of the lines
  // - as used e.g. by TSynLog writer for log optional redirection
  // - is defined as a sub-class to reduce plain TTextWriter scope
  // - see SynTable.pas for SQL resultset export via TJSONWriter
  // - see mORMot.pas for proper class serialization via TJSONSerializer.WriteObject
  TTextWriterWithEcho = class(TTextWriter)
  protected
    fEchoStart: PtrInt;
    fEchoBuf: RawUTF8;
    fEchos: array of TOnTextWriterEcho;
    function EchoFlush: PtrInt;
    function GetEndOfLineCRLF: boolean; {$ifdef HASINLINE}inline;{$endif}
    procedure SetEndOfLineCRLF(aEndOfLineCRLF: boolean);
  public
    /// write pending data to the Stream, with automatic buffer resizal and echoing
    // - this overriden method will handle proper echoing
    procedure FlushToStream; override;
    /// mark an end of line, ready to be "echoed" to registered listeners
    // - append a LF (#10) char or CR+LF (#13#10) chars to the buffer, depending
    // on the EndOfLineCRLF property value (default is LF, to minimize storage)
    // - any callback registered via EchoAdd() will monitor this line
    // - used e.g. by TSynLog for console output, as stated by Level parameter
    procedure AddEndOfLine(aLevel: TSynLogInfo=sllNone);
    /// add a callback to echo each line written by this class
    // - this class expects AddEndOfLine to mark the end of each line
    procedure EchoAdd(const aEcho: TOnTextWriterEcho);
    /// remove a callback to echo each line written by this class
    // - event should have been previously registered by a EchoAdd() call
    procedure EchoRemove(const aEcho: TOnTextWriterEcho);
    /// reset the internal buffer used for echoing content
    procedure EchoReset;
    /// define how AddEndOfLine method stores its line feed characters
    // - by default (FALSE), it will append a LF (#10) char to the buffer
    // - you can set this property to TRUE, so that CR+LF (#13#10) chars will
    // be appended instead
    // - is just a wrapper around twoEndOfLineCRLF item in CustomOptions
    property EndOfLineCRLF: boolean read GetEndOfLineCRLF write SetEndOfLineCRLF;
  end;

var
  /// contains the default JSON serialization class for WriteObject
  // - if only SynCommons.pas is used, it will be TTextWriterWithEcho
  // - mORMot.pas will assign TJSONSerializer which uses RTTI to serialize
  // TSQLRecord and any class published properties as JSON
  DefaultTextWriterSerializer: TTextWriterClass = TTextWriterWithEcho;

/// recognize a simple type from a supplied type information
// - first try by name via TJSONCustomParserRTTI.TypeNameToSimpleRTTIType,
// then from RTTI via TJSONCustomParserRTTI.TypeInfoToSimpleRTTIType
// - will return ptCustom for any unknown type
function TypeInfoToRttiType(aTypeInfo: pointer): TJSONCustomParserRTTIType;

/// serialize most kind of content as JSON, using its RTTI
// - is just a wrapper around TTextWriter.AddTypedJSON()
// - so would handle tkClass, tkEnumeration, tkSet, tkRecord, tkDynArray,
// tkVariant kind of content - other kinds would return 'null'
// - you can override serialization options if needed
procedure SaveJSON(const Value; TypeInfo: pointer;
  Options: TTextWriterOptions; var result: RawUTF8); overload;

/// serialize most kind of content as JSON, using its RTTI
// - is just a wrapper around TTextWriter.AddTypedJSON()
// - so would handle tkClass, tkEnumeration, tkSet, tkRecord, tkDynArray,
// tkVariant kind of content - other kinds would return 'null'
function SaveJSON(const Value; TypeInfo: pointer;
  EnumSetsAsText: boolean=false): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// will serialize any TObject into its UTF-8 JSON representation
/// - serialize as JSON the published integer, Int64, floating point values,
// TDateTime (stored as ISO 8601 text), string, variant and enumerate
// (e.g. boolean) properties of the object (and its parents)
// - would set twoForceJSONStandard to force standard (non-extended) JSON
// - the enumerates properties are stored with their integer index value
// - will write also the properties published in the parent classes
// - nested properties are serialized as nested JSON objects
// - any TCollection property will also be serialized as JSON arrays
// - you can add some custom serializers for ANY Delphi class, via mORMot.pas'
// TJSONSerializer.RegisterCustomSerializer() class method
// - call internaly TJSONSerializer.WriteObject() method (or fallback to
// TJSONWriter if mORMot.pas is not linked to the executable)
function ObjectToJSON(Value: TObject;
  Options: TTextWriterWriteObjectOptions=[woDontStoreDefault]): RawUTF8;

/// will serialize set of TObject into its UTF-8 JSON representation
// - follows ObjectToJSON()/TTextWriter.WriterObject() functions output
// - if Names is not supplied, the corresponding class names would be used
function ObjectsToJSON(const Names: array of RawUTF8; const Values: array of TObject;
  Options: TTextWriterWriteObjectOptions=[woDontStoreDefault]): RawUTF8;


type
  /// abstract ancestor to manage a dynamic array of TObject
  // - do not use this abstract class directly, but rather the inherited
  // TObjectListHashed and TObjectListPropertyHashed
  TObjectListHashedAbstract = class
  protected
    fList: TObjectDynArray;
    fCount: integer;
    fHash: TDynArrayHashed;
  public
    /// initialize the class instance
    // - if aFreeItems is TRUE (default), will behave like a TObjectList
    // - if aFreeItems is FALSE, will behave like a TList
    constructor Create(aFreeItems: boolean=true); reintroduce;
    /// release used memory
    destructor Destroy; override;
    /// search and add an object reference to the list
    // - returns the found/added index
    function Add(aObject: TObject; out wasAdded: boolean): integer; virtual; abstract;
    /// retrieve an object index within the list, using a fast hash table
    // - returns -1 if not found
    function IndexOf(aObject: TObject): integer; virtual; abstract;
    /// delete an object from the list
    // - the internal hash table is not recreated, just invalidated
    // (i.e. this method calls HashInvalidate not FindHashedAndDelete)
    // - will invalide the whole hash table
    procedure Delete(aIndex: integer); overload;
    /// delete an object from the list
    // - will invalide the whole hash table
    procedure Delete(aObject: TObject); overload; virtual;
    /// direct access to the items list array
    property List: TObjectDynArray read fList;
    /// returns the count of stored objects
    property Count: integer read fCount;
    /// direct access to the underlying hashing engine
    property Hash: TDynArrayHashed read fHash;
  end;

  /// this class behaves like TList/TObjectList, but will use hashing
  // for (much) faster IndexOf() method
  TObjectListHashed = class(TObjectListHashedAbstract)
  public
    /// search and add an object reference to the list
    // - returns the found/added index
    // - if added, hash is stored and Items[] := aObject
    function Add(aObject: TObject; out wasAdded: boolean): integer; override;
    /// retrieve an object index within the list, using a fast hash table
    // - returns -1 if not found
    function IndexOf(aObject: TObject): integer; override;
    /// delete an object from the list
    // - overriden method won't invalidate the whole hash table, but refresh it
    procedure Delete(aObject: TObject); override;
  end;

  /// function prototype used to retrieve a pointer to the hashed property
  // value of a TObjectListPropertyHashed list
  TObjectListPropertyHashedAccessProp = function(aObject: TObject): pointer;

  /// this class will hash and search for a sub property of the stored objects
  TObjectListPropertyHashed = class(TObjectListHashedAbstract)
  protected
    fSubPropAccess: TObjectListPropertyHashedAccessProp;
    function IntHash(const Elem): cardinal;
    function IntComp(const A,B): integer;
  public
    /// initialize the class instance with the corresponding callback in order
    // to handle sub-property hashing and search
    // - see TSetWeakZeroClass in mORMot.pas unit as example:
    // !  function WeakZeroClassSubProp(aObject: TObject): TObject;
    // !  begin
    // !    result := TSetWeakZeroInstance(aObject).fInstance;
    // !  end;
    // - by default, aHashElement/aCompare will hash/search for pointers:
    // you can specify the hash/search methods according to your sub property
    // (e.g. HashAnsiStringI/SortDynArrayAnsiStringI for a RawUTF8)
    // - if aFreeItems is TRUE (default), will behave like a TObjectList;
    // if aFreeItems is FALSE, will behave like a TList
    constructor Create(aSubPropAccess: TObjectListPropertyHashedAccessProp;
      aHashElement: TDynArrayHashOne=nil; aCompare: TDynArraySortCompare=nil;
      aFreeItems: boolean=true); reintroduce;
    /// search and add an object reference to the list
    // - returns the found/added index
    // - if added, only the hash is stored: caller has to set List[i]
    function Add(aObject: TObject; out wasAdded: boolean): integer; override;
    /// retrieve an object index within the list, using a fast hash table
    // - returns -1 if not found
    function IndexOf(aObject: TObject): integer; override;
  end;

  /// abstract class stored by a TPointerClassHash list
  TPointerClassHashed = class
  protected
    fInfo: pointer;
  public
    /// initialize the instance
    constructor Create(aInfo: pointer);
    /// the associated information of this instance
    // - may be e.g. a PTypeInfo value, when caching RTTI information
    property Info: pointer read fInfo write fInfo;
  end;
  /// a reference to a TPointerClassHashed instance
  PPointerClassHashed = ^TPointerClassHashed;

  /// handle a O(1) hashed-based storage of TPointerClassHashed, from a pointer
  // - used e.g. to store RTTI information from its PTypeInfo value
  // - if not thread safe, but could be used to store RTTI, since all type
  // information should have been initialized before actual process
  TPointerClassHash = class(TObjectListPropertyHashed)
  public
    /// initialize the storage list
    constructor Create;
    /// try to add an entry to the storage
    // - returns nil if the supplied information is already in the list
    // - returns a pointer to where a newly created TPointerClassHashed
    // instance should be stored
    // - this method is not thread-safe
    function TryAdd(aInfo: pointer): PPointerClassHashed;
    /// search for a stored instance, from its supplied pointer reference
    // - returns nil if aInfo was not previously added by FindOrAdd()
    // - this method is not thread-safe
    function Find(aInfo: pointer): TPointerClassHashed;
  end;

  /// handle a O(1) hashed-based storage of TPointerClassHashed, from a pointer
  // - this inherited class add a mutex to be thread-safe
  TPointerClassHashLocked = class(TPointerClassHash)
  protected
    fSafe: TSynLocker;
  public
    /// initialize the storage list
    constructor Create;
    /// finalize the storage list
    destructor Destroy; override;
    /// try to add an entry to the storage
    // - returns false if the supplied information is already in the list
    // - returns true, and a pointer to where a newly created TPointerClassHashed
    // instance should be stored: in this case, you should call UnLock once set
    // - could be used as such:
    // !var entry: PPointerClassHashed;
    // !...
    // !  if HashList.TryAddLocked(aTypeInfo,entry) then
    // !  try
    // !    entry^ := TMyCustomPointerClassHashed.Create(aTypeInfo,...);
    // !  finally
    // !    HashList.Unlock;
    // !  end;
    // !...
    function TryAddLocked(aInfo: pointer; out aNewEntry: PPointerClassHashed): boolean;
    /// release the lock after a previous TryAddLocked()=true call
    procedure Unlock;
    /// search for a stored instance, from its supplied pointer reference
    // - returns nil if aInfo was not previously added by FindOrAdd()
    // - this overriden method is thread-safe, unless returned TPointerClassHashed
    // instance is deleted in-between
    function FindLocked(aInfo: pointer): TPointerClassHashed;
  end;

  /// add locking methods to a TSynObjectList
  // - this class overrides the regular TSynObjectList, and do not share any
  // code with the TObjectListHashedAbstract/TObjectListHashed classes
  // - you need to call the Safe.Lock/Unlock methods by hand to protect the
  // execution of index-oriented methods (like Delete/Items/Count...): the
  // list content may change in the background, so using indexes is thread-safe
  // - on the other hand, Add/Clear/ClearFromLast/Remove stateless methods have
  // been overriden in this class to call Safe.Lock/Unlock, and therefore are
  // thread-safe and protected to any background change
  TSynObjectListLocked = class(TSynObjectList)
  protected
    fSafe: TSynLocker;
  public
    /// initialize the list instance
    // - the stored TObject instances will be owned by this TSynObjectListLocked,
    // unless AOwnsObjects is set to false
    constructor Create(aOwnsObjects: boolean=true); reintroduce;
    /// release the list instance (including the locking resource)
    destructor Destroy; override;
    /// add one item to the list using the global critical section
    function Add(item: pointer): integer; override;
    /// delete all items of the list using the global critical section
    procedure Clear; override;
    /// delete all items of the list in reverse order, using the global critical section
    procedure ClearFromLast; override;
    /// fast delete one item in the list
    function Remove(item: pointer): integer; override;
    /// check an item using the global critical section
    function Exists(item: pointer): boolean; override;
    /// the critical section associated to this list instance
    // - could be used to protect shared resources within the internal process,
    // for index-oriented methods like Delete/Items/Count...
    // - use Safe.Lock/TryLock with a try ... finally Safe.Unlock block
    property Safe: TSynLocker read fSafe;
  end;

  /// deprecated class name, for backward compatibility only
  TObjectListLocked = TSynObjectListLocked;

  /// possible values used by TRawUTF8List.Flags
  TRawUTF8ListFlags = set of (
    fObjectsOwned, fCaseSensitive, fNoDuplicate, fOnChangeTrigerred);

  /// TStringList-class optimized to work with our native UTF-8 string type
  // - can optionally store associated some TObject instances
  // - high-level methods of this class are thread-safe
  // - if fNoDuplicate flag is defined, an internal hash table will be
  // maintained to perform IndexOf() lookups in O(1) linear way
  TRawUTF8List = class
  protected
    fCount: PtrInt;
    fValue: TRawUTF8DynArray;
    fValues: TDynArrayHashed;
    fObjects: TObjectDynArray;
    fFlags: TRawUTF8ListFlags;
    fNameValueSep: AnsiChar;
    fOnChange, fOnChangeBackupForBeginUpdate: TNotifyEvent;
    fOnChangeLevel: integer;
    fSafe: TSynLocker;
    function GetCount: PtrInt; {$ifdef HASINLINE}inline;{$endif}
    procedure SetCapacity(const capa: PtrInt);
    function GetCapacity: PtrInt;
    function Get(Index: PtrInt): RawUTF8; {$ifdef HASINLINE}inline;{$endif}
    procedure Put(Index: PtrInt; const Value: RawUTF8);
    function GetObject(Index: PtrInt): pointer; {$ifdef HASINLINE}inline;{$endif}
    procedure PutObject(Index: PtrInt; Value: pointer);
    function GetName(Index: PtrInt): RawUTF8;
    function GetValue(const Name: RawUTF8): RawUTF8;
    procedure SetValue(const Name, Value: RawUTF8);
    function GetTextCRLF: RawUTF8;
    procedure SetTextCRLF(const Value: RawUTF8);
    procedure SetTextPtr(P,PEnd: PUTF8Char; const Delimiter: RawUTF8);
    function GetTextPtr: PPUtf8CharArray; {$ifdef HASINLINE}inline;{$endif}
    function GetNoDuplicate: boolean;     {$ifdef HASINLINE}inline;{$endif}
    function GetObjectPtr: PPointerArray; {$ifdef HASINLINE}inline;{$endif}
    function GetCaseSensitive: boolean;   {$ifdef HASINLINE}inline;{$endif}
    procedure SetCaseSensitive(Value: boolean); virtual;
    procedure Changed; virtual;
    procedure InternalDelete(Index: PtrInt);
    procedure OnChangeHidden(Sender: TObject);
  public
    /// initialize the RawUTF8/Objects storage
    // - by default, any associated Objects[] are just weak references;
    // you may supply fOwnObjects flag to force object instance management
    // - if you want the stored text items to be unique, set fNoDuplicate
    // and then an internal hash table will be maintained for fast IndexOf()
    // - you can unset fCaseSensitive to let the UTF-8 lookup be case-insensitive
    constructor Create(aFlags: TRawUTF8ListFlags=[fCaseSensitive]); overload;
    /// backward compatiliby overloaded constructor
    // - please rather use the overloaded Create(TRawUTF8ListFlags)
    constructor Create(aOwnObjects: boolean; aNoDuplicate: boolean=false;
      aCaseSensitive: boolean=true); overload;
    /// finalize the internal objects stored
    // - if instance was created with fOwnObjects flag
    destructor Destroy; override;
    /// get a stored Object item by its associated UTF-8 text
    // - returns nil and raise no exception if aText doesn't exist
    // - thread-safe method, unless returned TObject is deleted in the background
    function GetObjectFrom(const aText: RawUTF8): pointer;
    /// store a new RawUTF8 item
    // - without the fNoDuplicate flag, it will always add the supplied value
    // - if fNoDuplicate was set and aText already exists (using the internal
    // hash table), it will return -1 unless aRaiseExceptionIfExisting is forced
    // - thread-safe method
    function Add(const aText: RawUTF8; aRaiseExceptionIfExisting: boolean=false): PtrInt; {$ifdef HASINLINE}inline;{$endif}
    /// store a new RawUTF8 item, and its associated TObject
    // - without the fNoDuplicate flag, it will always add the supplied value
    // - if fNoDuplicate was set and aText already exists (using the internal hash
    // table), it will return -1 unless aRaiseExceptionIfExisting is forced;
    // optionally freeing the supplied aObject if aFreeAndReturnExistingObject
    // is true, in which pointer the existing Objects[] is copied (see
    // AddObjectUnique as a convenient wrapper around this behavior)
    // - thread-safe method
    function AddObject(const aText: RawUTF8; aObject: TObject;
      aRaiseExceptionIfExisting: boolean=false; aFreeAndReturnExistingObject: PPointer=nil): PtrInt;
    /// try to store a new RawUTF8 item and its associated TObject
    // - fNoDuplicate should have been specified in the list flags
    // - if aText doesn't exist, will add the values
    // - if aText exist, will call aObjectToAddOrFree.Free and set the value
    // already stored in Objects[] into aObjectToAddOrFree - allowing dual
    // commit thread-safe update of the list, e.g. after a previous unsuccessful
    // call to GetObjectFrom(aText)
    // - thread-safe method, using an internal Hash Table to speedup IndexOf()
    // - in fact, this method is just a wrapper around
    // ! AddObject(aText,aObjectToAddOrFree^,false,@aObjectToAddOrFree);
    procedure AddObjectUnique(const aText: RawUTF8; aObjectToAddOrFree: PPointer);
      {$ifdef HASINLINE}inline;{$endif}
    /// append a specified list to the current content
    // - thread-safe method
    procedure AddRawUTF8List(List: TRawUTF8List);
    /// delete a stored RawUTF8 item, and its associated TObject
    // - raise no exception in case of out of range supplied index
    // - this method is not thread-safe: use Safe.Lock/UnLock if needed
    procedure Delete(Index: PtrInt); overload;
    /// delete a stored RawUTF8 item, and its associated TObject
    // - will search for the value using IndexOf(aText), and returns its index
    // - returns -1 if no entry was found and deleted
    // - thread-safe method, using the internal Hash Table if fNoDuplicate is set
    function Delete(const aText: RawUTF8): PtrInt; overload;
    /// delete a stored RawUTF8 item, and its associated TObject, from
    // a given Name when stored as 'Name=Value' pairs
    // - raise no exception in case of out of range supplied index
    // - thread-safe method, but not using the internal Hash Table
    // - consider using TSynNameValue if you expect efficient name/value process
    function DeleteFromName(const Name: RawUTF8): PtrInt; virtual;
    /// find the index of a given Name when stored as 'Name=Value' pairs
    // - search on Name is case-insensitive with 'Name=Value' pairs
    // - this method is not thread-safe, and won't use the internal Hash Table
    // - consider using TSynNameValue if you expect efficient name/value process
    function IndexOfName(const Name: RawUTF8): PtrInt;
    /// access to the Value of a given 'Name=Value' pair at a given position
    // - this method is not thread-safe
    // - consider using TSynNameValue if you expect efficient name/value process
    function GetValueAt(Index: PtrInt): RawUTF8;
    /// retrieve Value from an existing Name=Value, then optinally delete the entry
    // - if Name is found, will fill Value with the stored content and return true
    // - if Name is not found, Value is not modified, and false is returned
    // - thread-safe method, but not using the internal Hash Table
    // - consider using TSynNameValue if you expect efficient name/value process
    function UpdateValue(const Name: RawUTF8; var Value: RawUTF8; ThenDelete: boolean): boolean;
    /// retrieve and delete the first RawUTF8 item in the list
    // - could be used as a FIFO, calling Add() as a "push" method
    // - thread-safe method
    function PopFirst(out aText: RawUTF8; aObject: PObject=nil): boolean;
    /// retrieve and delete the last RawUTF8 item in the list
    // - could be used as a FILO, calling Add() as a "push" method
    // - thread-safe method
    function PopLast(out aText: RawUTF8; aObject: PObject=nil): boolean;
    /// erase all stored RawUTF8 items
    // - and corresponding objects (if aOwnObjects was true at constructor)
    // - thread-safe method, also clearing the internal Hash Table
    procedure Clear; virtual;
    /// find a RawUTF8 item in the stored Strings[] list
    // - this search is case sensitive if fCaseSensitive flag was set (which
    // is the default)
    // - this method is not thread-safe since the internal list may change
    // and the returned index may not be accurate any more
    // - see also GetObjectFrom()
    // - uses the internal Hash Table if fNoDuplicate was set
    function IndexOf(const aText: RawUTF8): PtrInt;
    /// find a TObject item index in the stored Objects[] list
    // - this method is not thread-safe since the internal list may change
    // and the returned index may not be accurate any more
    // - aObject lookup won't use the internal Hash Table
    function IndexOfObject(aObject: TObject): PtrInt;
    /// search for any RawUTF8 item containing some text
    // - uses PosEx() on the stored lines
    // - this method is not thread-safe since the internal list may change
    // and the returned index may not be accurate any more
    // - by design, aText lookup can't use the internal Hash Table
    function Contains(const aText: RawUTF8; aFirstIndex: integer=0): PtrInt;
    /// retrieve the all lines, separated by the supplied delimiter
    // - this method is thread-safe
    function GetText(const Delimiter: RawUTF8=#13#10): RawUTF8;
    /// the OnChange event will be raised only when EndUpdate will be called
    // - this method will also call Safe.Lock for thread-safety
    procedure BeginUpdate;
    /// call the OnChange event if changes occured
    // - this method will also call Safe.UnLock for thread-safety
    procedure EndUpdate;
    /// set low-level text and objects from existing arrays
    procedure SetFrom(const aText: TRawUTF8DynArray; const aObject: TObjectDynArray);
    /// set all lines, separated by the supplied delimiter
    // - this method is thread-safe
    procedure SetText(const aText: RawUTF8; const Delimiter: RawUTF8=#13#10);
    /// set all lines from an UTF-8 text file
    // - expect the file is explicitly an UTF-8 file
    // - will ignore any trailing UTF-8 BOM in the file content, but will not
    // expect one either
    // - this method is thread-safe
    procedure LoadFromFile(const FileName: TFileName);
    /// write all lines into the supplied stream
    // - this method is thread-safe
    procedure SaveToStream(Dest: TStream; const Delimiter: RawUTF8=#13#10);
    /// write all lines into a new file
    // - this method is thread-safe
    procedure SaveToFile(const FileName: TFileName; const Delimiter: RawUTF8=#13#10);
    /// return the count of stored RawUTF8
    // - reading this property is not thread-safe, since size may change
    property Count: PtrInt read GetCount;
    /// set or retrieve the current memory capacity of the RawUTF8 list
    // - reading this property is not thread-safe, since size may change
    property Capacity: PtrInt read GetCapacity write SetCapacity;
    /// set if IndexOf() shall be case sensitive or not
    // - default is TRUE
    // - matches fCaseSensitive in Flags
    property CaseSensitive: boolean read GetCaseSensitive write SetCaseSensitive;
    /// set if the list doesn't allow duplicated UTF-8 text
    // - if true, an internal hash table is maintained for faster IndexOf()
    // - matches fNoDuplicate in Flags
    property NoDuplicate: boolean read GetNoDuplicate;
    /// access to the low-level flags of this list
    property Flags: TRawUTF8ListFlags read fFlags write fFlags;
    /// get or set a RawUTF8 item
    // - returns '' and raise no exception in case of out of range supplied index
    // - if you want to use it with the VCL, use UTF8ToString() function
    // - reading this property is not thread-safe, since content may change
    property Strings[Index: PtrInt]: RawUTF8 read Get write Put; default;
    /// get or set a Object item
    // - returns nil and raise no exception in case of out of range supplied index
    // - reading this property is not thread-safe, since content may change
    property Objects[Index: PtrInt]: pointer read GetObject write PutObject;
    /// retrieve the corresponding Name when stored as 'Name=Value' pairs
    // - reading this property is not thread-safe, since content may change
    // - consider TSynNameValue if you expect more efficient name/value process
    property Names[Index: PtrInt]: RawUTF8 read GetName;
    /// access to the corresponding 'Name=Value' pairs
    // - search on Name is case-insensitive with 'Name=Value' pairs
    // - reading this property is thread-safe, but won't use the hash table
    // - consider TSynNameValue if you expect more efficient name/value process
    property Values[const Name: RawUTF8]: RawUTF8 read GetValue write SetValue;
    /// the char separator between 'Name=Value' pairs
    // - equals '=' by default
    // - consider TSynNameValue if you expect more efficient name/value process
    property NameValueSep: AnsiChar read fNameValueSep write fNameValueSep;
    /// set or retrieve all items as text lines
    // - lines are separated by #13#10 (CRLF) by default; use GetText and
    // SetText methods if you want to use another line delimiter (even a comma)
    // - this property is thread-safe
    property Text: RawUTF8 read GetTextCRLF write SetTextCRLF;
    /// Event triggered when an entry is modified
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
    /// direct access to the memory of the TRawUTF8DynArray items
    // - reading this property is not thread-safe, since content may change
    property TextPtr: PPUtf8CharArray read GetTextPtr;
    /// direct access to the memory of the TObjectDynArray items
    // - reading this property is not thread-safe, since content may change
    property ObjectPtr: PPointerArray read GetObjectPtr;
    /// direct access to the TRawUTF8DynArray items dynamic array wrapper
    // - using this property is not thread-safe, since content may change
    property ValuesArray: TDynArrayHashed read fValues;
    /// access to the locking methods of this instance
    // - use Safe.Lock/TryLock with a try ... finally Safe.Unlock block
    property Safe: TSynLocker read fSafe;
  end;

  // some declarations used for backward compatibility only
  TRawUTF8ListLocked = type TRawUTF8List;
  TRawUTF8ListHashed = type TRawUTF8List;
  TRawUTF8ListHashedLocked = type TRawUTF8ListHashed;
  // deprecated TRawUTF8MethodList should be replaced by a TSynDictionary

  /// define the implemetation used by TAlgoCompress.Decompress()
  TAlgoCompressLoad = (aclNormal, aclSafeSlow, aclNoCrcFast);

  /// abstract low-level parent class for generic compression/decompression algorithms
  // - will encapsulate the compression algorithm with crc32c hashing
  // - all Algo* abstract methods should be overriden by inherited classes
  TAlgoCompress = class(TSynPersistent)
  public
    /// should return a genuine byte identifier
    // - 0 is reserved for stored, 1 for TAlgoSynLz, 2/3 for TAlgoDeflate/Fast
    // (in mORMot.pas), 4/5/6 for TAlgoLizard/Fast/Huffman (in SynLizard.pas)
    function AlgoID: byte; virtual; abstract;
    /// computes by default the crc32c() digital signature of the buffer
    function AlgoHash(Previous: cardinal; Data: pointer; DataLen: integer): cardinal; virtual;
    /// get maximum possible (worse) compressed size for the supplied length
    function AlgoCompressDestLen(PlainLen: integer): integer; virtual; abstract;
    /// this method will compress the supplied data
    function AlgoCompress(Plain: pointer; PlainLen: integer; Comp: pointer): integer; virtual; abstract;
    /// this method will return the size of the decompressed data
    function AlgoDecompressDestLen(Comp: pointer): integer; virtual; abstract;
    /// this method will decompress the supplied data
    function AlgoDecompress(Comp: pointer; CompLen: integer; Plain: pointer): integer; virtual; abstract;
    /// this method will partially and safely decompress the supplied data
    // - expects PartialLen <= result < PartialLenMax, depending on the algorithm
    function AlgoDecompressPartial(Comp: pointer; CompLen: integer;
      Partial: pointer; PartialLen, PartialLenMax: integer): integer; virtual; abstract;
  public
    /// will register AlgoID in the global list, for Algo() class methods
    // - no need to free this instance, since it will be owned by the global list
    // - raise a ESynException if the class or its AlgoID are already registered
    // - you should never have to call this constructor, but define a global
    // variable holding a reference to a shared instance
    constructor Create; override;
    /// get maximum possible (worse) compressed size for the supplied length
    // - including the crc32c + algo 9 bytes header
    function CompressDestLen(PlainLen: integer): integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// compress a memory buffer with crc32c hashing to a RawByteString
    function Compress(const Plain: RawByteString; CompressionSizeTrigger: integer=100;
      CheckMagicForCompressed: boolean=false; BufferOffset: integer=0): RawByteString; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// compress a memory buffer with crc32c hashing to a RawByteString
    function Compress(Plain: PAnsiChar; PlainLen: integer; CompressionSizeTrigger: integer=100;
      CheckMagicForCompressed: boolean=false; BufferOffset: integer=0): RawByteString; overload;
    /// compress a memory buffer with crc32c hashing
    // - supplied Comp buffer should contain at least CompressDestLen(PlainLen) bytes
    function Compress(Plain, Comp: PAnsiChar; PlainLen, CompLen: integer;
      CompressionSizeTrigger: integer=100; CheckMagicForCompressed: boolean=false): integer; overload;
    /// compress a memory buffer with crc32c hashing to a TByteDynArray
    function CompressToBytes(const Plain: RawByteString; CompressionSizeTrigger: integer=100;
      CheckMagicForCompressed: boolean=false): TByteDynArray; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// compress a memory buffer with crc32c hashing to a TByteDynArray
    function CompressToBytes(Plain: PAnsiChar; PlainLen: integer; CompressionSizeTrigger: integer=100;
      CheckMagicForCompressed: boolean=false): TByteDynArray; overload;
    /// uncompress a RawByteString memory buffer with crc32c hashing
    function Decompress(const Comp: RawByteString; Load: TAlgoCompressLoad=aclNormal;
      BufferOffset: integer=0): RawByteString; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// uncompress a RawByteString memory buffer with crc32c hashing
    // - returns TRUE on success
    function TryDecompress(const Comp: RawByteString; out Dest: RawByteString;
      Load: TAlgoCompressLoad=aclNormal): boolean;
    /// uncompress a memory buffer with crc32c hashing
    procedure Decompress(Comp: PAnsiChar; CompLen: integer; out Result: RawByteString;
      Load: TAlgoCompressLoad=aclNormal; BufferOffset: integer=0); overload;
    /// uncompress a RawByteString memory buffer with crc32c hashing
    function Decompress(const Comp: TByteDynArray): RawByteString; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// uncompress a RawByteString memory buffer with crc32c hashing
    // - returns nil if crc32 hash failed, i.e. if the supplied Comp is not correct
    // - returns a pointer to the uncompressed data and fill PlainLen variable,
    // after crc32c hash
    // - avoid any memory allocation in case of a stored content - otherwise, would
    // uncompress to the tmp variable, and return pointer(tmp) and length(tmp)
    function Decompress(const Comp: RawByteString; out PlainLen: integer;
      var tmp: RawByteString; Load: TAlgoCompressLoad=aclNormal): pointer; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// uncompress a RawByteString memory buffer with crc32c hashing
    // - returns nil if crc32 hash failed, i.e. if the supplied Data is not correct
    // - returns a pointer to an uncompressed data buffer of PlainLen bytes
    // - avoid any memory allocation in case of a stored content - otherwise, would
    // uncompress to the tmp variable, and return pointer(tmp) and length(tmp)
    function Decompress(Comp: PAnsiChar; CompLen: integer; out PlainLen: integer;
      var tmp: RawByteString; Load: TAlgoCompressLoad=aclNormal): pointer; overload;
    /// decode the header of a memory buffer compressed via the Compress() method
    // - validates the crc32c of the compressed data (unless Load=aclNoCrcFast),
    // then return the uncompressed size in bytes, or 0 if the crc32c does not match
    // - should call DecompressBody() later on to actually retrieve the content
    function DecompressHeader(Comp: PAnsiChar; CompLen: integer;
      Load: TAlgoCompressLoad=aclNormal): integer;
    /// decode the content of a memory buffer compressed via the Compress() method
    // - PlainLen has been returned by a previous call to DecompressHeader()
    function DecompressBody(Comp,Plain: PAnsiChar; CompLen,PlainLen: integer;
      Load: TAlgoCompressLoad=aclNormal): boolean;
    /// partial decoding of a memory buffer compressed via the Compress() method
    // - returns 0 on error, or how many bytes have been written to Partial
    // - will call virtual AlgoDecompressPartial() which is slower, but expected
    // to avoid any buffer overflow on the Partial destination buffer
    // - some algorithms (e.g. Lizard) may need some additional bytes in the
    // decode buffer, so PartialLenMax bytes should be allocated in Partial^,
    // with PartialLenMax > expected PartialLen, and returned bytes may be >
    // PartialLen, but always <= PartialLenMax
    function DecompressPartial(Comp,Partial: PAnsiChar; CompLen,PartialLen,PartialLenMax: integer): integer;
    /// get the TAlgoCompress instance corresponding to the AlgoID stored
    // in the supplied compressed buffer
    // - returns nil if no algorithm was identified
    class function Algo(Comp: PAnsiChar; CompLen: integer): TAlgoCompress; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// get the TAlgoCompress instance corresponding to the AlgoID stored
    // in the supplied compressed buffer
    // - returns nil if no algorithm was identified
    // - also identifies "stored" content in IsStored variable
    class function Algo(Comp: PAnsiChar; CompLen: integer; out IsStored: boolean): TAlgoCompress; overload;
    /// get the TAlgoCompress instance corresponding to the AlgoID stored
    // in the supplied compressed buffer
    // - returns nil if no algorithm was identified
    class function Algo(const Comp: RawByteString): TAlgoCompress; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// get the TAlgoCompress instance corresponding to the AlgoID stored
    // in the supplied compressed buffer
    // - returns nil if no algorithm was identified
    class function Algo(const Comp: TByteDynArray): TAlgoCompress; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// get the TAlgoCompress instance corresponding to the supplied AlgoID
    // - returns nil if no algorithm was identified
    // - stored content is identified as TAlgoSynLZ
    class function Algo(AlgoID: byte): TAlgoCompress; overload;
    /// quickly validate a compressed buffer content, without uncompression
    // - extract the TAlgoCompress, and call DecompressHeader() to check the
    // hash of the compressed data, and return then uncompressed size
    // - returns 0 on error (e.g. unknown algorithm or incorrect hash)
    class function UncompressedSize(const Comp: RawByteString): integer;
    /// returns the algorithm name, from its classname
    // - e.g. TAlgoSynLZ->'synlz' TAlgoLizard->'lizard' nil->'none'
    function AlgoName: TShort16;
  end;

  /// implement our fast SynLZ compression as a TAlgoCompress class
  // - please use the AlgoSynLZ global variable methods instead of the deprecated
  // SynLZCompress/SynLZDecompress wrapper functions
  TAlgoSynLZ = class(TAlgoCompress)
  public
    /// returns 1 as genuine byte identifier for SynLZ
    function AlgoID: byte; override;
    /// get maximum possible (worse) SynLZ compressed size for the supplied length
    function AlgoCompressDestLen(PlainLen: integer): integer; override;
    /// compress the supplied data using SynLZ
    function AlgoCompress(Plain: pointer; PlainLen: integer; Comp: pointer): integer; override;
    /// return the size of the SynLZ decompressed data
    function AlgoDecompressDestLen(Comp: pointer): integer; override;
    /// decompress the supplied data using SynLZ
    function AlgoDecompress(Comp: pointer; CompLen: integer; Plain: pointer): integer; override;
    /// partial (and safe) decompression of the supplied data using SynLZ
    function AlgoDecompressPartial(Comp: pointer; CompLen: integer;
      Partial: pointer; PartialLen, PartialLenMax: integer): integer; override;
  end;

  TAlgoCompressWithNoDestLenProcess = (doCompress, doUnCompress, doUncompressPartial);

  /// abstract class storing the plain length before calling compression API
  // - some libraries (e.g. Deflate or Lizard) don't provide the uncompressed
  // length from its output buffer - inherit from this class to store this value
  // as ToVarUInt32, and override the RawProcess abstract protected method
  TAlgoCompressWithNoDestLen = class(TAlgoCompress)
  protected
    /// inherited classes should implement this single method for the actual process
    // - dstMax is oinly used for doUncompressPartial
    function RawProcess(src,dst: pointer; srcLen,dstLen,dstMax: integer;
      process: TAlgoCompressWithNoDestLenProcess): integer; virtual; abstract;
  public
    /// performs the compression, storing PlainLen and calling protected RawProcess
    function AlgoCompress(Plain: pointer; PlainLen: integer; Comp: pointer): integer; override;
    /// return the size of the decompressed data (using FromVarUInt32)
    function AlgoDecompressDestLen(Comp: pointer): integer; override;
    /// performs the decompression, retrieving PlainLen and calling protected RawProcess
    function AlgoDecompress(Comp: pointer; CompLen: integer; Plain: pointer): integer; override;
    /// performs the decompression, retrieving PlainLen and calling protected RawProcess
    function AlgoDecompressPartial(Comp: pointer; CompLen: integer;
      Partial: pointer; PartialLen, PartialLenMax: integer): integer; override;
  end;

  // internal flag, used only by TSynDictionary.InArray protected method
  TSynDictionaryInArray = (
    iaFind, iaFindAndDelete, iaFindAndUpdate, iaFindAndAddIfNotExisting, iaAdd);

  /// event called by TSynDictionary.ForEach methods to iterate over stored items
  // - if the implementation method returns TRUE, will continue the loop
  // - if the implementation method returns FALSE, will stop values browsing
  // - aOpaque is a custom value specified at ForEach() method call
  TSynDictionaryEvent = function(const aKey; var aValue; aIndex,aCount: integer;
    aOpaque: pointer): boolean of object;

  /// event called by TSynDictionary.DeleteDeprecated
  // - called just before deletion: return false to by-pass this item
  TSynDictionaryCanDeleteEvent = function(const aKey, aValue; aIndex: integer): boolean of object;

  /// thread-safe dictionary to store some values from associated keys
  // - will maintain a dynamic array of values, associated with a hash table
  // for the keys, so that setting or retrieving values would be O(1)
  // - all process is protected by a TSynLocker, so will be thread-safe
  // - TDynArray is a wrapper which do not store anything, whereas this class
  // is able to store both keys and values, and provide convenient methods to
  // access the stored data, including JSON serialization and binary storage
  TSynDictionary = class(TSynPersistentLock)
  protected
    fKeys: TDynArrayHashed;
    fValues: TDynArray;
    fTimeOut: TCardinalDynArray;
    fTimeOuts: TDynArray;
    fCompressAlgo: TAlgoCompress;
    fOnCanDelete: TSynDictionaryCanDeleteEvent;
    function InArray(const aKey,aArrayValue; aAction: TSynDictionaryInArray): boolean;
    procedure SetTimeouts;
    function ComputeNextTimeOut: cardinal;
    function KeyFullHash(const Elem): cardinal;
    function KeyFullCompare(const A,B): integer;
    function GetCapacity: integer;
    procedure SetCapacity(const Value: integer);
    function GetTimeOutSeconds: cardinal;
  public
    /// initialize the dictionary storage, specifyng dynamic array keys/values
    // - aKeyTypeInfo should be a dynamic array TypeInfo() RTTI pointer, which
    // would store the keys within this TSynDictionary instance
    // - aValueTypeInfo should be a dynamic array TypeInfo() RTTI pointer, which
    // would store the values within this TSynDictionary instance
    // - by default, string keys would be searched following exact case, unless
    // aKeyCaseInsensitive is TRUE
    // - you can set an optional timeout period, in seconds - you should call
    // DeleteDeprecated periodically to search for deprecated items
    constructor Create(aKeyTypeInfo,aValueTypeInfo: pointer;
      aKeyCaseInsensitive: boolean=false; aTimeoutSeconds: cardinal=0;
      aCompressAlgo: TAlgoCompress=nil); reintroduce; virtual;
    /// finalize the storage
    // - would release all internal stored values
    destructor Destroy; override;
    /// try to add a value associated with a primary key
    // - returns the index of the inserted item, -1 if aKey is already existing
    // - this method is thread-safe, since it will lock the instance
    function Add(const aKey, aValue): integer;
    /// store a value associated with a primary key
    // - returns the index of the matching item
    // - if aKey does not exist, a new entry is added
    // - if aKey does exist, the existing entry is overriden with aValue
    // - this method is thread-safe, since it will lock the instance
    function AddOrUpdate(const aKey, aValue): integer;
    /// clear the value associated via aKey
    // - does not delete the entry, but reset its value
    // - returns the index of the matching item, -1 if aKey was not found
    // - this method is thread-safe, since it will lock the instance
    function Clear(const aKey): integer;
    /// delete all key/value stored in the current instance
    procedure DeleteAll;
    /// delete a key/value association from its supplied aKey
    // - this would delete the entry, i.e. matching key and value pair
    // - returns the index of the deleted item, -1 if aKey was not found
    // - this method is thread-safe, since it will lock the instance
    function Delete(const aKey): integer;
    /// delete a key/value association from its internal index
    // - this method is not thread-safe: you should use fSafe.Lock/Unlock
    // e.g. then Find/FindValue to retrieve the index value
    function DeleteAt(aIndex: integer): boolean;
    /// search and delete all deprecated items according to TimeoutSeconds
    // - returns how many items have been deleted
    // - you can call this method very often: it will ensure that the
    // search process will take place at most once every second
    // - this method is thread-safe, but blocking during the process
    function DeleteDeprecated: integer;
    /// search of a primary key within the internal hashed dictionary
    // - returns the index of the matching item, -1 if aKey was not found
    // - if you want to access the value, you should use fSafe.Lock/Unlock:
    // consider using Exists or FindAndCopy thread-safe methods instead
    // - aUpdateTimeOut will update the associated timeout value of the entry
    function Find(const aKey; aUpdateTimeOut: boolean=false): integer;
    /// search of a primary key within the internal hashed dictionary
    // - returns a pointer to the matching item, nil if aKey was not found
    // - if you want to access the value, you should use fSafe.Lock/Unlock:
    // consider using Exists or FindAndCopy thread-safe methods instead
    // - aUpdateTimeOut will update the associated timeout value of the entry
    function FindValue(const aKey; aUpdateTimeOut: boolean=false; aIndex: PInteger=nil): pointer;
    /// search of a primary key within the internal hashed dictionary
    // - returns a pointer to the matching or already existing item
    // - if you want to access the value, you should use fSafe.Lock/Unlock:
    // consider using Exists or FindAndCopy thread-safe methods instead
    // - will update the associated timeout value of the entry, if applying
    function FindValueOrAdd(const aKey; var added: boolean; aIndex: PInteger=nil): pointer;
    /// search of a stored value by its primary key, and return a local copy
    // - so this method is thread-safe
    // - returns TRUE if aKey was found, FALSE if no match exists
    // - will update the associated timeout value of the entry, unless
    // aUpdateTimeOut is set to false
    function FindAndCopy(const aKey; out aValue; aUpdateTimeOut: boolean=true): boolean;
    /// search of a stored value by its primary key, then delete and return it
    // - returns TRUE if aKey was found, fill aValue with its content,
    // and delete the entry in the internal storage
    // - so this method is thread-safe
    // - returns FALSE if no match exists
    function FindAndExtract(const aKey; out aValue): boolean;
    /// search for a primary key presence
    // - returns TRUE if aKey was found, FALSE if no match exists
    // - this method is thread-safe
    function Exists(const aKey): boolean;
    /// apply a specified event over all items stored in this dictionnary
    // - would browse the list in the adding order
    // - returns the number of times OnEach has been called
    // - this method is thread-safe, since it will lock the instance
    function ForEach(const OnEach: TSynDictionaryEvent; Opaque: pointer=nil): integer; overload;
    /// apply a specified event over matching items stored in this dictionnary
    // - would browse the list in the adding order, comparing each key and/or
    // value item with the supplied comparison functions and aKey/aValue content
    // - returns the number of times OnMatch has been called, i.e. how many times
    // KeyCompare(aKey,Keys[#])=0 or ValueCompare(aValue,Values[#])=0
    // - this method is thread-safe, since it will lock the instance
    function ForEach(const OnMatch: TSynDictionaryEvent;
      KeyCompare,ValueCompare: TDynArraySortCompare; const aKey,aValue;
      Opaque: pointer=nil): integer; overload;
    /// touch the entry timeout field so that it won't be deprecated sooner
    // - this method is not thread-safe, and is expected to be execute e.g.
    // from a ForEach() TSynDictionaryEvent callback
    procedure SetTimeoutAtIndex(aIndex: integer);
    /// search aArrayValue item in a dynamic-array value associated via aKey
    // - expect the stored value to be a dynamic array itself
    // - would search for aKey as primary key, then use TDynArray.Find
    // to delete any aArrayValue match in the associated dynamic array
    // - returns FALSE if Values is not a tkDynArray, or if aKey or aArrayValue
    // were not found
    // - this method is thread-safe, since it will lock the instance
    function FindInArray(const aKey, aArrayValue): boolean;
    /// search of a stored key by its associated key, and return a key local copy
    // - won't use any hashed index but TDynArray.IndexOf over fValues,
    // so is much slower than FindAndCopy()
    // - will update the associated timeout value of the entry, unless
    // aUpdateTimeOut is set to false
    // - so this method is thread-safe
    // - returns TRUE if aValue was found, FALSE if no match exists
    function FindKeyFromValue(const aValue; out aKey; aUpdateTimeOut: boolean=true): boolean;
    /// add aArrayValue item within a dynamic-array value associated via aKey
    // - expect the stored value to be a dynamic array itself
    // - would search for aKey as primary key, then use TDynArray.Add
    // to add aArrayValue to the associated dynamic array
    // - returns FALSE if Values is not a tkDynArray, or if aKey was not found
    // - this method is thread-safe, since it will lock the instance
    function AddInArray(const aKey, aArrayValue): boolean;
    /// add once aArrayValue within a dynamic-array value associated via aKey
    // - expect the stored value to be a dynamic array itself
    // - would search for aKey as primary key, then use
    // TDynArray.FindAndAddIfNotExisting to add once aArrayValue to the
    // associated dynamic array
    // - returns FALSE if Values is not a tkDynArray, or if aKey was not found
    // - this method is thread-safe, since it will lock the instance
    function AddOnceInArray(const aKey, aArrayValue): boolean;
    /// clear aArrayValue item of a dynamic-array value associated via aKey
    // - expect the stored value to be a dynamic array itself
    // - would search for aKey as primary key, then use TDynArray.FindAndDelete
    // to delete any aArrayValue match in the associated dynamic array
    // - returns FALSE if Values is not a tkDynArray, or if aKey or aArrayValue were
    // not found
    // - this method is thread-safe, since it will lock the instance
    function DeleteInArray(const aKey, aArrayValue): boolean;
    /// replace aArrayValue item of a dynamic-array value associated via aKey
    // - expect the stored value to be a dynamic array itself
    // - would search for aKey as primary key, then use TDynArray.FindAndUpdate
    // to delete any aArrayValue match in the associated dynamic array
    // - returns FALSE if Values is not a tkDynArray, or if aKey or aArrayValue were
    // not found
    // - this method is thread-safe, since it will lock the instance
    function UpdateInArray(const aKey, aArrayValue): boolean;
    {$ifndef DELPHI5OROLDER}
    /// make a copy of the stored values
    // - this method is thread-safe, since it will lock the instance during copy
    // - resulting length(Dest) will match the exact values count
    // - T*ObjArray will be reallocated and copied by content (using a temporary
    // JSON serialization), unless ObjArrayByRef is true and pointers are copied
    procedure CopyValues(out Dest; ObjArrayByRef: boolean=false);
    {$endif DELPHI5OROLDER}
    /// serialize the content as a "key":value JSON object
    procedure SaveToJSON(W: TTextWriter; EnumSetsAsText: boolean=false); overload;
    /// serialize the content as a "key":value JSON object
    function SaveToJSON(EnumSetsAsText: boolean=false): RawUTF8; overload;
    /// serialize the Values[] as a JSON array
    function SaveValuesToJSON(EnumSetsAsText: boolean=false): RawUTF8;
    /// unserialize the content from "key":value JSON object
    // - if the JSON input may not be correct (i.e. if not coming from SaveToJSON),
    // you may set EnsureNoKeyCollision=TRUE for a slow but safe keys validation
    function LoadFromJSON(const JSON: RawUTF8 {$ifndef NOVARIANTS};
      CustomVariantOptions: PDocVariantOptions=nil{$endif}): boolean; overload;
    /// unserialize the content from "key":value JSON object
    // - note that input JSON buffer is not modified in place: no need to create
    // a temporary copy if the buffer is about to be re-used
    function LoadFromJSON(JSON: PUTF8Char {$ifndef NOVARIANTS};
      CustomVariantOptions: PDocVariantOptions=nil{$endif}): boolean; overload;
    /// save the content as SynLZ-compressed raw binary data
    // - warning: this format is tied to the values low-level RTTI, so if you
    // change the value/key type definitions, LoadFromBinary() would fail
    function SaveToBinary(NoCompression: boolean=false): RawByteString;
    /// load the content from SynLZ-compressed raw binary data
    // - as previously saved by SaveToBinary method
    function LoadFromBinary(const binary: RawByteString): boolean;
    /// can be assigned to OnCanDeleteDeprecated to check TSynPersistentLock(aValue).Safe.IsLocked
    class function OnCanDeleteSynPersistentLock(const aKey, aValue; aIndex: integer): boolean;
    /// can be assigned to OnCanDeleteDeprecated to check TSynPersistentLock(aValue).Safe.IsLocked
    class function OnCanDeleteSynPersistentLocked(const aKey, aValue; aIndex: integer): boolean;
    /// returns how many items are currently stored in this dictionary
    // - this method is thread-safe
    function Count: integer;
    /// fast returns how many items are currently stored in this dictionary
    // - this method is NOT thread-safe so should be protected by fSafe.Lock/UnLock
    function RawCount: integer; {$ifdef HASINLINE}inline;{$endif}
    /// direct access to the primary key identifiers
    // - if you want to access the keys, you should use fSafe.Lock/Unlock
    property Keys: TDynArrayHashed read fKeys;
    /// direct access to the associated stored values
    // - if you want to access the values, you should use fSafe.Lock/Unlock
    property Values: TDynArray read fValues;
    /// defines how many items are currently stored in Keys/Values internal arrays
    property Capacity: integer read GetCapacity write SetCapacity;
    /// direct low-level access to the internal access tick (GetTickCount64 shr 10)
    // - may be nil if TimeOutSeconds=0
    property TimeOut: TCardinalDynArray read fTimeOut;
    /// returns the aTimeOutSeconds parameter value, as specified to Create()
    property TimeOutSeconds: cardinal read GetTimeOutSeconds;
    /// the compression algorithm used for binary serialization
    property CompressAlgo: TAlgoCompress read fCompressAlgo write fCompressAlgo;
    /// callback to by-pass DeleteDeprecated deletion by returning false
    // - can be assigned e.g. to OnCanDeleteSynPersistentLock if Value is a
    // TSynPersistentLock instance, to avoid any potential access violation
    property OnCanDeleteDeprecated: TSynDictionaryCanDeleteEvent read fOnCanDelete write fOnCanDelete;
  end;

  /// event signature to locate a service for a given string key
  // - used e.g. by TRawUTF8ObjectCacheList.OnKeyResolve property
  TOnKeyResolve = function(const aInterface: TGUID; const Key: RawUTF8; out Obj): boolean of object;
  /// event signature to notify a given string key
  TOnKeyNotify = procedure(Sender: TObject; const Key: RawUTF8) of object;
  
var
  /// mORMot.pas will registry here its T*ObjArray serialization process
  // - will be used by TDynArray.GetIsObjArray
  DynArrayIsObjArray: function(aDynArrayTypeInfo: Pointer): TPointerClassHashed;

type
  /// handle memory mapping of a file content
  TMemoryMap = object
  protected
    fBuf: PAnsiChar;
    fBufSize: PtrUInt;
    fFile: THandle;
    {$ifdef MSWINDOWS}
    fMap: THandle;
    {$endif}
    fFileSize: Int64;
    fFileLocal: boolean;
  public
    /// map the corresponding file handle
    // - if aCustomSize and aCustomOffset are specified, the corresponding
    // map view if created (by default, will map whole file)
    function Map(aFile: THandle; aCustomSize: PtrUInt=0; aCustomOffset: Int64=0): boolean; overload;
    /// map the file specified by its name
    // - file will be closed when UnMap will be called
    function Map(const aFileName: TFileName): boolean; overload;
    /// set a fixed buffer for the content
    // - emulated a memory-mapping from an existing buffer
    procedure Map(aBuffer: pointer; aBufferSize: PtrUInt); overload;
    /// unmap the file
    procedure UnMap;
    /// retrieve the memory buffer mapped to the file content
    property Buffer: PAnsiChar read fBuf;
    /// retrieve the buffer size
    property Size: PtrUInt read fBufSize;
    /// retrieve the mapped file size
    property FileSize: Int64 read fFileSize;
    /// access to the low-level associated File handle (if any)
    property FileHandle: THandle read fFile;
  end;

  {$M+}
  /// able to read a UTF-8 text file using memory map
  // - much faster than TStringList.LoadFromFile()
  // - will ignore any trailing UTF-8 BOM in the file content, but will not
  // expect one either
  TMemoryMapText = class
  protected
    fLines: PPointerArray;
    fLinesMax: integer;
    fCount: integer;
    fMapEnd: PUTF8Char;
    fMap: TMemoryMap;
    fFileName: TFileName;
    fAppendedLines: TRawUTF8DynArray;
    fAppendedLinesCount: integer;
    function GetLine(aIndex: integer): RawUTF8; {$ifdef HASINLINE}inline;{$endif}
    function GetString(aIndex: integer): string; {$ifdef HASINLINE}inline;{$endif}
    /// call once by Create constructors when fMap has been initialized
    procedure LoadFromMap(AverageLineLength: integer=32); virtual;
    /// call once per line, from LoadFromMap method
    // - default implementation will set  fLines[fCount] := LineBeg;
    // - override this method to add some per-line process at loading: it will
    // avoid reading the entire file more than once
    procedure ProcessOneLine(LineBeg, LineEnd: PUTF8Char); virtual;
  public
    /// initialize the memory mapped text file
    // - this default implementation just do nothing but is called by overloaded
    // constructors so may be overriden to initialize an inherited class
    constructor Create; overload; virtual;
    /// read an UTF-8 encoded text file
    // - every line beginning is stored into LinePointers[]
    constructor Create(const aFileName: TFileName); overload;
    /// read an UTF-8 encoded text file content
    // - every line beginning is stored into LinePointers[]
    // - this overloaded constructor accept an existing memory buffer (some
    // uncompressed data e.g.)
    constructor Create(aFileContent: PUTF8Char; aFileSize: integer); overload;
    /// release the memory map and internal LinePointers[]
    destructor Destroy; override;
    /// save the whole content into a specified stream
    // - including any runtime appended values via AddInMemoryLine()
    procedure SaveToStream(Dest: TStream; const Header: RawUTF8);
    /// save the whole content into a specified file
    // - including any runtime appended values via AddInMemoryLine()
    // - an optional header text can be added to the beginning of the file
    procedure SaveToFile(FileName: TFileName; const Header: RawUTF8='');
    /// add a new line to the already parsed content
    // - this line won't be stored in the memory mapped file, but stay in memory
    // and appended to the existing lines, until this instance is released
    procedure AddInMemoryLine(const aNewLine: RawUTF8); virtual;
    /// clear all in-memory appended rows
    procedure AddInMemoryLinesClear; virtual;
    /// retrieve the number of UTF-8 chars of the given line
    // - warning: no range check is performed about supplied index
    function LineSize(aIndex: integer): integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// check if there is at least a given number of UTF-8 chars in the given line
    // - this is faster than LineSize(aIndex)<aMinimalCount for big lines
    function LineSizeSmallerThan(aIndex, aMinimalCount: integer): boolean;
      {$ifdef HASINLINE}inline;{$endif}
    /// returns TRUE if the supplied text is contained in the corresponding line
    function LineContains(const aUpperSearch: RawUTF8; aIndex: Integer): Boolean; virtual;
    /// retrieve a line content as UTF-8
    // - a temporary UTF-8 string is created
    // - will return '' if aIndex is out of range
    property Lines[aIndex: integer]: RawUTF8 read GetLine;
    /// retrieve a line content as generic VCL string type
    // - a temporary VCL string is created (after conversion for UNICODE Delphi)
    // - will return '' if aIndex is out of range
    property Strings[aIndex: integer]: string read GetString;
    /// direct access to each text line
    // - use LineSize() method to retrieve line length, since end of line will
    // NOT end with #0, but with #13 or #10
    // - warning: no range check is performed about supplied index
    property LinePointers: PPointerArray read fLines;
    /// the memory map used to access the raw file content
    property Map: TMemoryMap read fMap;
  published
    /// the file name which was opened by this instance
    property FileName: TFileName read fFileName write fFileName;
    /// the number of text lines
    property Count: integer read fCount;
  end;
  {$M-}

  /// a fake TStream, which will just count the number of bytes written
  TFakeWriterStream = class(TStream)
  public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
  end;

  /// a TStream using a RawByteString as internal storage
  // - default TStringStream uses WideChars since Delphi 2009, so it is
  // not compatible with previous versions, and it does make sense to
  // work with RawByteString in our UTF-8 oriented framework
  // - jus tlike TStringSTream, is designed for appending data, not modifying
  // in-place, as requested e.g. by TTextWriter or TFileBufferWriter classes
  TRawByteStringStream = class(TStream)
  protected
    fDataString: RawByteString;
    fPosition: Integer;
    procedure SetSize(NewSize: Longint); override;
  public
    /// initialize the storage, optionally with some RawByteString content
    constructor Create(const aString: RawByteString=''); overload;
    /// read some bytes from the internal storage
    // - returns the number of bytes filled into Buffer (<=Count)
    function Read(var Buffer; Count: Longint): Longint; override;
    /// change the current Read/Write position, within current stored range
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    /// append some data to the buffer
    // - will resize the buffer, i.e. will replace the end of the string from
    // the current position with the supplied data
    function Write(const Buffer; Count: Longint): Longint; override;
    /// direct low-level access to the internal RawByteString storage
    property DataString: RawByteString read fDataString write fDataString;
  end;

  /// a TStream pointing to some in-memory data, for instance UTF-8 text
  // - warning: there is no local copy of the supplied content: the
  // source data must be available during all the TSynMemoryStream usage
  TSynMemoryStream = class(TCustomMemoryStream)
  public
    /// create a TStream with the supplied text data
    // - warning: there is no local copy of the supplied content: the aText
    // variable must be available during all the TSynMemoryStream usage:
    // don't release aText before calling TSynMemoryStream.Free
    // - aText can be on any AnsiString format, e.g. RawUTF8 or RawByteString
    constructor Create(const aText: RawByteString); overload;
    /// create a TStream with the supplied data buffer
    // - warning: there is no local copy of the supplied content: the
    // Data/DataLen buffer must be available during all the TSynMemoryStream usage:
    // don't release the source Data before calling TSynMemoryStream.Free
    constructor Create(Data: pointer; DataLen: PtrInt); overload;
    /// this TStream is read-only: calling this method will raise an exception
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

  /// a TStream created from a file content, using fast memory mapping
  TSynMemoryStreamMapped = class(TSynMemoryStream)
  protected
    fMap: TMemoryMap;
    fFileStream: TFileStream;
    fFileName: TFileName;
  public
    /// create a TStream from a file content using fast memory mapping
    // - if aCustomSize and aCustomOffset are specified, the corresponding
    // map view if created (by default, will map whole file)
    constructor Create(const aFileName: TFileName;
      aCustomSize: PtrUInt=0; aCustomOffset: Int64=0); overload;
    /// create a TStream from a file content using fast memory mapping
    // - if aCustomSize and aCustomOffset are specified, the corresponding
    // map view if created (by default, will map whole file)
    constructor Create(aFile: THandle;
      aCustomSize: PtrUInt=0; aCustomOffset: Int64=0); overload;
    /// release any internal mapped file instance
    destructor Destroy; override;
    /// the file name, if created from such Create(aFileName) constructor
    property FileName: TFileName read fFileName;
  end;

/// FileSeek() overloaded function, working with huge files
// - Delphi FileSeek() is buggy -> use this function to safe access files > 2 GB
// (thanks to sanyin for the report)
function FileSeek64(Handle: THandle; const Offset: Int64; Origin: cardinal): Int64;

/// wrapper to serialize a T*ObjArray dynamic array as JSON
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
function ObjArrayToJSON(const aObjArray;
  aOptions: TTextWriterWriteObjectOptions=[woDontStoreDefault]): RawUTF8;

/// encode the supplied data as an UTF-8 valid JSON object content
// - data must be supplied two by two, as Name,Value pairs, e.g.
// ! JSONEncode(['name','John','year',1972]) = '{"name":"John","year":1972}'
// - or you can specify nested arrays or objects with '['..']' or '{'..'}':
// ! J := JSONEncode(['doc','{','name','John','abc','[','a','b','c',']','}','id',123]);
// ! assert(J='{"doc":{"name":"John","abc":["a","b","c"]},"id":123}');
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
// - you can pass nil as parameter for a null JSON value
function JSONEncode(const NameValuePairs: array of const): RawUTF8; overload;

{$ifndef NOVARIANTS}
/// encode the supplied (extended) JSON content, with parameters,
// as an UTF-8 valid JSON object content
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names:
// ! aJSON := JSONEncode('{id:?,%:{name:?,birthyear:?}}',['doc'],[10,'John',1982]);
// - you can use nested _Obj() / _Arr() instances
// ! aJSON := JSONEncode('{%:{$in:[?,?]}}',['type'],['food','snack']);
// ! aJSON := JSONEncode('{type:{$in:?}}',[],[_Arr(['food','snack'])]);
// ! // will both return
// ! '{"type":{"$in":["food","snack"]}}')
// - if the SynMongoDB unit is used in the application, the MongoDB Shell
// syntax will also be recognized to create TBSONVariant, like
// ! new Date()   ObjectId()   MinKey   MaxKey  /<jRegex>/<jOptions>
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
// !  aJSON := JSONEncode('{name:?,field:/%/i}',['acme.*corp'],['John']))
// ! // will return
// ! '{"name":"John","field":{"$regex":"acme.*corp","$options":"i"}}'
// - will call internally _JSONFastFmt() to create a temporary TDocVariant with
// all its features - so is slightly slower than other JSONEncode* functions
function JSONEncode(const Format: RawUTF8; const Args,Params: array of const): RawUTF8; overload;
{$endif}

/// encode the supplied RawUTF8 array data as an UTF-8 valid JSON array content
function JSONEncodeArrayUTF8(const Values: array of RawUTF8): RawUTF8; overload;

/// encode the supplied integer array data as a valid JSON array
function JSONEncodeArrayInteger(const Values: array of integer): RawUTF8; overload;

/// encode the supplied floating-point array data as a valid JSON array
function JSONEncodeArrayDouble(const Values: array of double): RawUTF8; overload;

/// encode the supplied array data as a valid JSON array content
// - if WithoutBraces is TRUE, no [ ] will be generated
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
function JSONEncodeArrayOfConst(const Values: array of const;
  WithoutBraces: boolean=false): RawUTF8; overload;

/// encode the supplied array data as a valid JSON array content
// - if WithoutBraces is TRUE, no [ ] will be generated
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
procedure JSONEncodeArrayOfConst(const Values: array of const;
  WithoutBraces: boolean; var result: RawUTF8); overload;

/// encode as JSON {"name":value} object, from a potential SQL quoted value
// - will unquote the SQLValue using TTextWriter.AddQuotedStringAsJSON()
procedure JSONEncodeNameSQLValue(const Name,SQLValue: RawUTF8; var result: RawUTF8);

type
  /// points to one value of raw UTF-8 content, decoded from a JSON buffer
  // - used e.g. by JSONDecode() overloaded function to returns names/values
  TValuePUTF8Char = object
  public
    /// a pointer to the actual UTF-8 text
    Value: PUTF8Char;
    /// how many UTF-8 bytes are stored in Value
    ValueLen: PtrInt;
    /// convert the value into a UTF-8 string
    procedure ToUTF8(var Text: RawUTF8); overload; {$ifdef HASINLINE}inline;{$endif}
    /// convert the value into a UTF-8 string
    function ToUTF8: RawUTF8; overload; {$ifdef HASINLINE}inline;{$endif}
    /// convert the value into a VCL/generic string
    function ToString: string;
    /// convert the value into a signed integer
    function ToInteger: PtrInt; {$ifdef HASINLINE}inline;{$endif}
    /// convert the value into an unsigned integer
    function ToCardinal: PtrUInt; {$ifdef HASINLINE}inline;{$endif}
    /// will call IdemPropNameU() over the stored text Value
    function Idem(const Text: RawUTF8): boolean; {$ifdef HASINLINE}inline;{$endif}
  end;
  /// used e.g. by JSONDecode() overloaded function to returns values
  TValuePUTF8CharArray = array[0..maxInt div SizeOf(TValuePUTF8Char)-1] of TValuePUTF8Char;
  PValuePUTF8CharArray = ^TValuePUTF8CharArray;

  /// store one name/value pair of raw UTF-8 content, from a JSON buffer
  // - used e.g. by JSONDecode() overloaded function or UrlEncodeJsonObject()
  // to returns names/values
  TNameValuePUTF8Char = record
    /// a pointer to the actual UTF-8 name text
    Name: PUTF8Char;
    /// a pointer to the actual UTF-8 value text
    Value: PUTF8Char;
    /// how many UTF-8 bytes are stored in Name (should be integer, not PtrInt)
    NameLen: integer;
    /// how many UTF-8 bytes are stored in Value
    ValueLen: integer;
  end;
  /// used e.g. by JSONDecode() overloaded function to returns name/value pairs
  TNameValuePUTF8CharDynArray = array of TNameValuePUTF8Char;

/// decode the supplied UTF-8 JSON content for the supplied names
// - data will be set in Values, according to the Names supplied e.g.
// ! JSONDecode(JSON,['name','year'],@Values) -> Values[0].Value='John'; Values[1].Value='1972';
// - if any supplied name wasn't found its corresponding Values[] will be nil
// - this procedure will decode the JSON content in-memory, i.e. the PUtf8Char
// array is created inside JSON, which is therefore modified: make a private
// copy first if you want to reuse the JSON content
// - if HandleValuesAsObjectOrArray is TRUE, then this procedure will handle
// JSON arrays or objects
// - support enhanced JSON syntax, e.g. '{name:'"John",year:1972}' is decoded
// just like '{"name":'"John","year":1972}'
procedure JSONDecode(var JSON: RawUTF8; const Names: array of RawUTF8;
  Values: PValuePUTF8CharArray; HandleValuesAsObjectOrArray: Boolean=false); overload;

/// decode the supplied UTF-8 JSON content for the supplied names
// - an overloaded function when the JSON is supplied as a RawJSON variable
procedure JSONDecode(var JSON: RawJSON; const Names: array of RawUTF8;
  Values: PValuePUTF8CharArray; HandleValuesAsObjectOrArray: Boolean=false); overload;

/// decode the supplied UTF-8 JSON content for the supplied names
// - data will be set in Values, according to the Names supplied e.g.
// ! JSONDecode(P,['name','year'],Values) -> Values[0]^='John'; Values[1]^='1972';
// - if any supplied name wasn't found its corresponding Values[] will be nil
// - this procedure will decode the JSON content in-memory, i.e. the PUtf8Char
// array is created inside P, which is therefore modified: make a private
// copy first if you want to reuse the JSON content
// - if HandleValuesAsObjectOrArray is TRUE, then this procedure will handle
// JSON arrays or objects
// - if ValuesLen is set, ValuesLen[] will contain the length of each Values[]
// - returns a pointer to the next content item in the JSON buffer
function JSONDecode(P: PUTF8Char; const Names: array of RawUTF8;
  Values: PValuePUTF8CharArray; HandleValuesAsObjectOrArray: Boolean=false): PUTF8Char; overload;

/// decode the supplied UTF-8 JSON content into an array of name/value pairs
// - this procedure will decode the JSON content in-memory, i.e. the PUtf8Char
// array is created inside JSON, which is therefore modified: make a private
// copy first if you want to reuse the JSON content
// - the supplied JSON buffer should stay available until Name/Value pointers
// from returned Values[] are accessed
// - if HandleValuesAsObjectOrArray is TRUE, then this procedure will handle
// JSON arrays or objects
// - support enhanced JSON syntax, e.g. '{name:'"John",year:1972}' is decoded
// just like '{"name":'"John","year":1972}'
function JSONDecode(P: PUTF8Char; out Values: TNameValuePUTF8CharDynArray;
  HandleValuesAsObjectOrArray: Boolean=false): PUTF8Char; overload;

/// decode the supplied UTF-8 JSON content for the one supplied name
// - this function will decode the JSON content in-memory, so will unescape it
// in-place: it must be called only once with the same JSON data
function JSONDecode(var JSON: RawUTF8; const aName: RawUTF8='result';
  wasString: PBoolean=nil; HandleValuesAsObjectOrArray: Boolean=false): RawUTF8; overload;

/// retrieve a pointer to JSON string field content
// - returns either ':' for name field, either '}',',' for value field
// - returns nil on JSON content error
// - this function won't touch the JSON buffer, so you can call it before
// using in-place escape process via JSONDecode() or GetJSONField()
function JSONRetrieveStringField(P: PUTF8Char; out Field: PUTF8Char;
  out FieldLen: integer; ExpectNameField: boolean): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// efficient JSON field in-place decoding, within a UTF-8 encoded buffer
// - this function decodes in the P^ buffer memory itself (no memory allocation
// or copy), for faster process - so take care that P^ is not shared
// - PDest points to the next field to be decoded, or nil on JSON parsing error
// - EndOfObject (if not nil) is set to the JSON value char (',' ':' or '}' e.g.)
// - optional wasString is set to true if the JSON value was a JSON "string"
// - returns a PUTF8Char to the decoded value, with its optional length in Len^
// - '"strings"' are decoded as 'strings', with wasString=true, properly JSON
// unescaped (e.g. any \u0123 pattern would be converted into UTF-8 content)
// - null is decoded as nil, with wasString=false
// - true/false boolean values are returned as 'true'/'false', with wasString=false
// - any number value is returned as its ascii representation, with wasString=false
// - works for both field names or values (e.g. '"FieldName":' or 'Value,')
function GetJSONField(P: PUTF8Char; out PDest: PUTF8Char;
  wasString: PBoolean=nil; EndOfObject: PUTF8Char=nil; Len: PInteger=nil): PUTF8Char;

/// decode a JSON field name in an UTF-8 encoded buffer
// - this function decodes in the P^ buffer memory itself (no memory allocation
// or copy), for faster process - so take care that P^ is not shared
// - it will return the property name (with an ending #0) or nil on error
// - this function will handle strict JSON property name (i.e. a "string"), but
// also MongoDB extended syntax, e.g. {age:{$gt:18}} or {'people.age':{$gt:18}}
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
function GetJSONPropName(var P: PUTF8Char; Len: PInteger=nil): PUTF8Char; overload;

/// decode a JSON field name in an UTF-8 encoded shortstring variable
// - this function would left the P^ buffer memory untouched, so may be safer
// than the overloaded GetJSONPropName() function in some cases
// - it will return the property name as a local UTF-8 encoded shortstring,
// or PropName='' on error
// - this function won't unescape the property name, as strict JSON (i.e. a "st\"ring")
// - but it will handle MongoDB syntax, e.g. {age:{$gt:18}} or {'people.age':{$gt:18}}
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
procedure GetJSONPropName(var P: PUTF8Char; out PropName: shortstring); overload;

/// decode a JSON content in an UTF-8 encoded buffer
// - GetJSONField() will only handle JSON "strings" or numbers - if
// HandleValuesAsObjectOrArray is TRUE, this function will process JSON {
// objects } or [ arrays ] and add a #0 at the end of it
// - this function decodes in the P^ buffer memory itself (no memory allocation
// or copy), for faster process - so take care that it is an unique string
// - returns a pointer to the value start, and moved P to the next field to
// be decoded, or P=nil in case of any unexpected input
// - wasString is set to true if the JSON value was a "string"
// - EndOfObject (if not nil) is set to the JSON value end char (',' ':' or '}')
// - if Len is set, it will contain the length of the returned pointer value
function GetJSONFieldOrObjectOrArray(var P: PUTF8Char; wasString: PBoolean=nil;
  EndOfObject: PUTF8Char=nil; HandleValuesAsObjectOrArray: Boolean=false;
  NormalizeBoolean: Boolean=true; Len: PInteger=nil): PUTF8Char;

/// retrieve the next JSON item as a RawJSON variable
// - buffer can be either any JSON item, i.e. a string, a number or even a
// JSON array (ending with ]) or a JSON object (ending with })
// - EndOfObject (if not nil) is set to the JSON value end char (',' ':' or '}')
procedure GetJSONItemAsRawJSON(var P: PUTF8Char; var result: RawJSON;
  EndOfObject: PAnsiChar=nil);

/// retrieve the next JSON item as a RawUTF8 decoded buffer
// - buffer can be either any JSON item, i.e. a string, a number or even a
// JSON array (ending with ]) or a JSON object (ending with })
// - EndOfObject (if not nil) is set to the JSON value end char (',' ':' or '}')
// - just call GetJSONField(), and create a new RawUTF8 from the returned value,
// after proper unescape if wasString^=true
function GetJSONItemAsRawUTF8(var P: PUTF8Char; var output: RawUTF8;
  wasString: PBoolean=nil; EndOfObject: PUTF8Char=nil): boolean;

/// test if the supplied buffer is a "string" value or a numerical value
// (floating point or integer), according to the characters within
// - this version will recognize null/false/true as strings
// - e.g. IsString('0')=false, IsString('abc')=true, IsString('null')=true
function IsString(P: PUTF8Char): boolean;

/// test if the supplied buffer is a "string" value or a numerical value
// (floating or integer), according to the JSON encoding schema
// - this version will NOT recognize JSON null/false/true as strings
// - e.g. IsStringJSON('0')=false, IsStringJSON('abc')=true,
// but IsStringJSON('null')=false
// - will follow the JSON definition of number, i.e. '0123' is a string (i.e.
// '0' is excluded at the begining of a number) and '123' is not a string
function IsStringJSON(P: PUTF8Char): boolean;

/// test if the supplied buffer is a correct JSON value
function IsValidJSON(P: PUTF8Char; len: PtrInt): boolean; overload;

/// test if the supplied buffer is a correct JSON value
function IsValidJSON(const s: RawUTF8): boolean; overload;

/// reach positon just after the current JSON item in the supplied UTF-8 buffer
// - buffer can be either any JSON item, i.e. a string, a number or even a
// JSON array (ending with ]) or a JSON object (ending with })
// - returns nil if the specified buffer is not valid JSON content
// - returns the position in buffer just after the item excluding the separator
// character - i.e. result^ may be ',','}',']'
function GotoEndJSONItem(P: PUTF8Char; strict: boolean=false): PUTF8Char;

/// reach the positon of the next JSON item in the supplied UTF-8 buffer
// - buffer can be either any JSON item, i.e. a string, a number or even a
// JSON array (ending with ]) or a JSON object (ending with })
// - returns nil if the specified number of items is not available in buffer
// - returns the position in buffer after the item including the separator
// character (optionally in EndOfObject) - i.e. result will be at the start of
// the next object, and EndOfObject may be ',','}',']'
function GotoNextJSONItem(P: PUTF8Char; NumberOfItemsToJump: cardinal=1;
  EndOfObject: PAnsiChar=nil): PUTF8Char;

/// read the position of the JSON value just after a property identifier
// - this function will handle strict JSON property name (i.e. a "string"), but
// also MongoDB extended syntax, e.g. {age:{$gt:18}} or {'people.age':{$gt:18}}
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
function GotoNextJSONPropName(P: PUTF8Char): PUTF8Char;

/// reach the position of the next JSON object of JSON array
// - first char is expected to be either '[' or '{'
// - will return nil in case of parsing error or unexpected end (#0)
// - will return the next character after ending ] or } - i.e. may be , } ]
function GotoNextJSONObjectOrArray(P: PUTF8Char): PUTF8Char; overload;
  {$ifdef FPC}inline;{$endif}

/// reach the position of the next JSON object of JSON array
// - first char is expected to be just after the initial '[' or '{'
// - specify ']' or '}' as the expected EndChar
// - will return nil in case of parsing error or unexpected end (#0)
// - will return the next character after ending ] or } - i.e. may be , } ]
function GotoNextJSONObjectOrArray(P: PUTF8Char; EndChar: AnsiChar): PUTF8Char; overload;
  {$ifdef FPC}inline;{$endif}

/// reach the position of the next JSON object of JSON array
// - first char is expected to be either '[' or '{'
// - this version expects a maximum position in PMax: it may be handy to break
// the parsing for HUGE content - used e.g. by JSONArrayCount(P,PMax)
// - will return nil in case of parsing error or if P reached PMax limit
// - will return the next character after ending ] or { - i.e. may be , } ]
function GotoNextJSONObjectOrArrayMax(P,PMax: PUTF8Char): PUTF8Char;

/// compute the number of elements of a JSON array
// - this will handle any kind of arrays, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first char AFTER the initial '[' (which
// may be a closing ']')
// - returns -1 if the supplied input is invalid, or the number of identified
// items in the JSON array buffer
function JSONArrayCount(P: PUTF8Char): integer; overload;

/// compute the number of elements of a JSON array
// - this will handle any kind of arrays, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first char after the initial '[' (which
// may be a closing ']')
// - this overloaded method will abort if P reaches a certain position: for
// really HUGE arrays, it is faster to allocate the content within the loop,
// not ahead of time
function JSONArrayCount(P,PMax: PUTF8Char): integer; overload;

/// go to the #nth item of a JSON array
// - implemented via a fast SAX-like approach: the input buffer is not changed,
// nor no memory buffer allocated neither content copied
// - returns nil if the supplied index is out of range
// - returns a pointer to the index-nth item in the JSON array (first index=0)
// - this will handle any kind of arrays, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first initial '[' char
function JSONArrayItem(P: PUTF8Char; Index: integer): PUTF8Char;

/// retrieve all elements of a JSON array
// - this will handle any kind of arrays, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first char AFTER the initial '[' (which
// may be a closing ']')
// - returns false if the supplied input is invalid
// - returns true on success, with Values[] pointing to each unescaped value,
// may be a JSON string, object, array of constant
function JSONArrayDecode(P: PUTF8Char; out Values: TPUTF8CharDynArray): boolean;

/// compute the number of fields in a JSON object
// - this will handle any kind of objects, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first char after the initial '{' (which
// may be a closing '}')
function JSONObjectPropCount(P: PUTF8Char): integer;

/// go to a named property of a JSON object
// - implemented via a fast SAX-like approach: the input buffer is not changed,
// nor no memory buffer allocated neither content copied
// - returns nil if the supplied property name does not exist
// - returns a pointer to the matching item in the JSON object
// - this will handle any kind of objects, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first initial '{' char
function JsonObjectItem(P: PUTF8Char; const PropName: RawUTF8;
  PropNameFound: PRawUTF8=nil): PUTF8Char;

/// go to a property of a JSON object, by its full path, e.g. 'parent.child'
// - implemented via a fast SAX-like approach: the input buffer is not changed,
// nor no memory buffer allocated neither content copied
// - returns nil if the supplied property path does not exist
// - returns a pointer to the matching item in the JSON object
// - this will handle any kind of objects, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first initial '{' char
function JsonObjectByPath(JsonObject,PropPath: PUTF8Char): PUTF8Char;

/// return all matching properties of a JSON object
// - here the PropPath could be a comma-separated list of full paths,
// e.g. 'Prop1,Prop2' or 'Obj1.Obj2.Prop1,Obj1.Prop2'
// - returns '' if no property did match
// - returns a JSON object of all matching properties
// - this will handle any kind of objects, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first initial '{' char
function JsonObjectsByPath(JsonObject,PropPath: PUTF8Char): RawUTF8;

/// convert one JSON object into two JSON arrays of keys and values
// - i.e. makes the following transformation:
// $ {key1:value1,key2,value2...} -> [key1,key2...] + [value1,value2...]
// - this function won't allocate any memory during its process, nor
// modify the JSON input buffer
// - is the reverse of the TTextWriter.AddJSONArraysAsJSONObject() method
function JSONObjectAsJSONArrays(JSON: PUTF8Char; out keys,values: RawUTF8): boolean;

/// remove comments and trailing commas from a text buffer before passing it to JSON parser
// - handle two types of comments: starting from // till end of line
// or /* ..... */ blocks anywhere in the text content
// - trailing commas is replaced by ' ', so resulting JSON is valid for parsers
// what not allows trailing commas (browsers for example)
// - may be used to prepare configuration files before loading;
// for example we store server configuration in file config.json and
// put some comments in this file then code for loading is:
// !var cfg: RawUTF8;
// !  cfg := StringFromFile(ExtractFilePath(paramstr(0))+'Config.json');
// !  RemoveCommentsFromJSON(@cfg[1]);
// !  pLastChar := JSONToObject(sc,pointer(cfg),configValid);
procedure RemoveCommentsFromJSON(P: PUTF8Char);

const
  /// standard header for an UTF-8 encoded XML file
  XMLUTF8_HEADER = '<?xml version="1.0" encoding="UTF-8"?>'#13#10;

  /// standard namespace for a generic XML File
  XMLUTF8_NAMESPACE = '<contents xmlns="http://www.w3.org/2001/XMLSchema-instance">';

/// convert a JSON array or document into a simple XML content
// - just a wrapper around TTextWriter.AddJSONToXML, with an optional
// header before the XML converted data (e.g. XMLUTF8_HEADER), and an optional
// name space content node which will nest the generated XML data (e.g.
// '<contents xmlns="http://www.w3.org/2001/XMLSchema-instance">') - the
// corresponding ending token will be appended after (e.g. '</contents>')
// - WARNING: the JSON buffer is decoded in-place, so P^ WILL BE modified
procedure JSONBufferToXML(P: PUTF8Char; const Header,NameSpace: RawUTF8; out result: RawUTF8);

/// convert a JSON array or document into a simple XML content
// - just a wrapper around TTextWriter.AddJSONToXML, making a private copy
// of the supplied JSON buffer using TSynTempBuffer (so that JSON content
// would stay untouched)
// - the optional header is added at the beginning of the resulting string
// - an optional name space content node could be added around the generated XML,
// e.g. '<content>'
function JSONToXML(const JSON: RawUTF8; const Header: RawUTF8=XMLUTF8_HEADER;
  const NameSpace: RawUTF8=''): RawUTF8;

/// formats and indents a JSON array or document to the specified layout
// - just a wrapper around TTextWriter.AddJSONReformat() method
// - WARNING: the JSON buffer is decoded in-place, so P^ WILL BE modified
procedure JSONBufferReformat(P: PUTF8Char; out result: RawUTF8;
  Format: TTextWriterJSONFormat=jsonHumanReadable);

/// formats and indents a JSON array or document to the specified layout
// - just a wrapper around TTextWriter.AddJSONReformat, making a private
// of the supplied JSON buffer (so that JSON content  would stay untouched)
function JSONReformat(const JSON: RawUTF8;
  Format: TTextWriterJSONFormat=jsonHumanReadable): RawUTF8;

/// formats and indents a JSON array or document as a file
// - just a wrapper around TTextWriter.AddJSONReformat() method
// - WARNING: the JSON buffer is decoded in-place, so P^ WILL BE modified
function JSONBufferReformatToFile(P: PUTF8Char; const Dest: TFileName;
  Format: TTextWriterJSONFormat=jsonHumanReadable): boolean;

/// formats and indents a JSON array or document as a file
// - just a wrapper around TTextWriter.AddJSONReformat, making a private
// of the supplied JSON buffer (so that JSON content  would stay untouched)
function JSONReformatToFile(const JSON: RawUTF8; const Dest: TFileName;
  Format: TTextWriterJSONFormat=jsonHumanReadable): boolean;


const
  /// map a PtrInt type to the TJSONCustomParserRTTIType set
  ptPtrInt  = {$ifdef CPU64}ptInt64{$else}ptInteger{$endif};
  /// map a PtrUInt type to the TJSONCustomParserRTTIType set
  ptPtrUInt = {$ifdef CPU64}ptQWord{$else}ptCardinal{$endif};
  /// which TJSONCustomParserRTTIType types are not simple types
  // - ptTimeLog is complex, since could be also TCreateTime or TModTime
  PT_COMPLEXTYPES = [ptArray, ptRecord, ptCustom, ptTimeLog];
  /// could be used to compute the index in a pointer list from its position
  POINTERSHR = {$ifdef CPU64}3{$else}2{$endif};
  /// could be used to compute the bitmask of a pointer integer
  POINTERAND = {$ifdef CPU64}7{$else}3{$endif};
  /// could be used to check all bits on a pointer
  POINTERBITS = {$ifdef CPU64}64{$else}32{$endif};


{ ************ some other common types and conversion routines ************** }

type
  /// timestamp stored as second-based Unix Time
  // - i.e. the number of seconds since 1970-01-01 00:00:00 UTC
  // - is stored as 64-bit value, so that it won't be affected by the
  // "Year 2038" overflow issue
  // - see TUnixMSTime for a millisecond resolution Unix Timestamp
  // - use UnixTimeToDateTime/DateTimeToUnixTime functions to convert it to/from
  // a regular TDateTime
  // - use UnixTimeUTC to return the current timestamp, using fast OS API call
  // - also one of the encodings supported by SQLite3 date/time functions
  TUnixTime = type Int64;

  /// timestamp stored as millisecond-based Unix Time
  // - i.e. the number of milliseconds since 1970-01-01 00:00:00 UTC
  // - see TUnixTime for a second resolution Unix Timestamp
  // - use UnixMSTimeToDateTime/DateTimeToUnixMSTime functions to convert it
  // to/from a regular TDateTime
  // - also one of the JavaScript date encodings
  TUnixMSTime = type Int64;

  /// pointer to a timestamp stored as second-based Unix Time
  PUnixTime = ^TUnixTime;
  /// pointer to a timestamp stored as millisecond-based Unix Time
  PUnixMSTime = ^TUnixMSTime;
  /// dynamic array of timestamps stored as second-based Unix Time
  TUnixTimeDynArray = array of TUnixTime;
  /// dynamic array of timestamps stored as millisecond-based Unix Time
  TUnixMSTimeDynArray = array of TUnixMSTime;

type
  /// calling context of TSynLogExceptionToStr callbacks
  TSynLogExceptionContext = record
    /// the raised exception class
    EClass: ExceptClass;
    /// the Delphi Exception instance
    // - may be nil for external/OS exceptions
    EInstance: Exception;
    /// the OS-level exception code
    // - could be $0EEDFAE0 of $0EEDFADE for Delphi-generated exceptions
    ECode: DWord;
    /// the address where the exception occured
    EAddr: PtrUInt;
    /// the optional stack trace
    EStack: PPtrUInt;
    /// = FPC's RaiseProc() FrameCount if EStack is Frame: PCodePointer
    EStackCount: integer;
    /// the timestamp of this exception, as number of seconds since UNIX Epoch
    // - UnixTimeUTC is faster than NowUTC or GetSystemTime
    // - use UnixTimeToDateTime() to convert it into a regular TDateTime
    ETimestamp: TUnixTime;
    /// the logging level corresponding to this exception
    // - may be either sllException or sllExceptionOS
    ELevel: TSynLogInfo;
  end;

  /// global hook callback to customize exceptions logged by TSynLog
  // - should return TRUE if all needed information has been logged by the
  // event handler
  // - should return FALSE if Context.EAddr and Stack trace is to be appended
  TSynLogExceptionToStr = function(WR: TTextWriter; const Context: TSynLogExceptionContext): boolean;

  {$M+}
  /// generic parent class of all custom Exception types of this unit
  // - all our classes inheriting from ESynException are serializable,
  // so you could use ObjectToJSONDebug(anyESynException) to retrieve some
  // extended information
  ESynException = class(Exception)
  protected
    fRaisedAt: pointer;
  public
    /// constructor which will use FormatUTF8() instead of Format()
    // - expect % as delimiter, so is less error prone than %s %d %g
    // - will handle vtPointer/vtClass/vtObject/vtVariant kind of arguments,
    // appending class name for any class or object, the hexa value for a
    // pointer, or the JSON representation of any supplied TDocVariant
    constructor CreateUTF8(const Format: RawUTF8; const Args: array of const);
    /// constructor appending some FormatUTF8() content to the GetLastError
    // - message will contain GetLastError value followed by the formatted text
    // - expect % as delimiter, so is less error prone than %s %d %g
    // - will handle vtPointer/vtClass/vtObject/vtVariant kind of arguments,
    // appending class name for any class or object, the hexa value for a
    // pointer, or the JSON representation of any supplied TDocVariant
    constructor CreateLastOSError(const Format: RawUTF8; const Args: array of const);
    {$ifndef NOEXCEPTIONINTERCEPT}
    /// can be used to customize how the exception is logged
    // - this default implementation will call the DefaultSynLogExceptionToStr()
    // function or the TSynLogExceptionToStrCustom global callback, if defined
    // - override this method to provide a custom logging content
    // - should return TRUE if Context.EAddr and Stack trace is not to be
    // written (i.e. as for any TSynLogExceptionToStr callback)
    function CustomLog(WR: TTextWriter; const Context: TSynLogExceptionContext): boolean; virtual;
    {$endif}
    /// the code location when this exception was triggered
    // - populated by SynLog unit, during interception - so may be nil
    // - you can use TSynMapFile.FindLocation(ESynException) class function to
    // guess the corresponding source code line
    // - will be serialized as "Address": hexadecimal and source code location
    // (using TSynMapFile .map/.mab information) in TJSONSerializer.WriteObject
    // when woStorePointer option is defined - e.g. with ObjectToJSONDebug()
    property RaisedAt: pointer read fRaisedAt write fRaisedAt;
  published
    property Message;
  end;
  {$M-}
  ESynExceptionClass = class of ESynException;

  /// exception class associated to TDocVariant JSON/BSON document
  EDocVariant = class(ESynException);

  /// exception raised during TFastReader decoding
  EFastReader = class(ESynException);

var
  /// allow to customize the ESynException logging message
  TSynLogExceptionToStrCustom: TSynLogExceptionToStr = nil;

  {$ifndef NOEXCEPTIONINTERCEPT}
  /// default exception logging callback - will be set by the SynLog unit
  // - will add the default Exception details, including any Exception.Message
  // - if the exception inherits from ESynException
  // - returns TRUE: caller will then append ' at EAddr' and the stack trace
  DefaultSynLogExceptionToStr: TSynLogExceptionToStr = nil;
  {$endif}


/// convert a string into its INTEGER Curr64 (value*10000) representation
// - this type is compatible with Delphi currency memory map with PInt64(@Curr)^
// - fast conversion, using only integer operations
// - if NoDecimal is defined, will be set to TRUE if there is no decimal, AND
// the returned value will be an Int64 (not a PInt64(@Curr)^)
function StrToCurr64(P: PUTF8Char; NoDecimal: PBoolean=nil): Int64;

/// convert a string into its currency representation
// - will call StrToCurr64()
function StrToCurrency(P: PUTF8Char): currency;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a currency value into a string
// - fast conversion, using only integer operations
// - decimals are joined by 2 (no decimal, 2 decimals, 4 decimals)
function CurrencyToStr(Value: currency): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an INTEGER Curr64 (value*10000) into a string
// - this type is compatible with Delphi currency memory map with PInt64(@Curr)^
// - fast conversion, using only integer operations
// - decimals are joined by 2 (no decimal, 2 decimals, 4 decimals)
function Curr64ToStr(const Value: Int64): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an INTEGER Curr64 (value*10000) into a string
// - this type is compatible with Delphi currency memory map with PInt64(@Curr)^
// - fast conversion, using only integer operations
// - decimals are joined by 2 (no decimal, 2 decimals, 4 decimals)
procedure Curr64ToStr(const Value: Int64; var result: RawUTF8); overload;

/// convert an INTEGER Curr64 (value*10000) into a string
// - this type is compatible with Delphi currency memory map with PInt64(@Curr)^
// - fast conversion, using only integer operations
// - decimals are joined by 2 (no decimal, 2 decimals, 4 decimals)
// - return the number of chars written to Dest^
function Curr64ToPChar(const Value: Int64; Dest: PUTF8Char): PtrInt;

/// internal fast INTEGER Curr64 (value*10000) value to text conversion
// - expect the last available temporary char position in P
// - return the last written char position (write in reverse order in P^)
// - will return 0 for Value=0, or a string representation with always 4 decimals
//   (e.g. 1->'0.0001' 500->'0.0500' 25000->'2.5000' 30000->'3.0000')
// - is called by Curr64ToPChar() and Curr64ToStr() functions
function StrCurr64(P: PAnsiChar; const Value: Int64): PAnsiChar;

/// truncate a Currency value to only 2 digits
// - implementation will use fast Int64 math to avoid any precision loss due to
// temporary floating-point conversion
function TruncTo2Digits(Value: Currency): Currency;

/// truncate a Currency value, stored as Int64, to only 2 digits
// - implementation will use fast Int64 math to avoid any precision loss due to
// temporary floating-point conversion
procedure TruncTo2DigitsCurr64(var Value: Int64);
  {$ifdef HASINLINE}inline;{$endif}

/// truncate a Currency value, stored as Int64, to only 2 digits
// - implementation will use fast Int64 math to avoid any precision loss due to
// temporary floating-point conversion
function TruncTo2Digits64(Value: Int64): Int64;
  {$ifdef HASINLINE}inline;{$endif}

/// simple, no banker rounding of a Currency value to only 2 digits
// - #.##51 will round to #.##+0.01 and #.##50 will be truncated to #.##
// - implementation will use fast Int64 math to avoid any precision loss due to
// temporary floating-point conversion
function SimpleRoundTo2Digits(Value: Currency): Currency;

/// simple, no banker rounding of a Currency value, stored as Int64, to only 2 digits
// - #.##51 will round to #.##+0.01 and #.##50 will be truncated to #.##
// - implementation will use fast Int64 math to avoid any precision loss due to
// temporary floating-point conversion
procedure SimpleRoundTo2DigitsCurr64(var Value: Int64);

var
  /// a conversion table from hexa chars into binary data
  // - returns 255 for any character out of 0..9,A..Z,a..z range
  // - used e.g. by HexToBin() function
  // - is defined globally, since may be used from an inlined function
  ConvertHexToBin: TNormTableByte;

  /// naive but efficient cache to avoid string memory allocation for
  // 0..999 small numbers by Int32ToUTF8/UInt32ToUTF8
  // - use around 16KB of heap (since each item consumes 16 bytes), but increase
  // overall performance and reduce memory allocation (and fragmentation),
  // especially during multi-threaded execution
  // - noticeable when strings are used as array indexes (e.g. in SynMongoDB BSON)
  // - is defined globally, since may be used from an inlined function
  SmallUInt32UTF8: array[0..999] of RawUTF8;

/// fast conversion from hexa chars into binary data
// - BinBytes contain the bytes count to be converted: Hex^ must contain
//  at least BinBytes*2 chars to be converted, and Bin^ enough space
// - if Bin=nil, no output data is written, but the Hex^ format is checked
// - return false if any invalid (non hexa) char is found in Hex^
// - using this function with Bin^ as an integer value will decode in big-endian
// order (most-signignifican byte first)
function HexToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: Integer): boolean; overload;

/// fast conversion with no validity check from hexa chars into binary data
procedure HexToBinFast(Hex: PAnsiChar; Bin: PByte; BinBytes: Integer);

/// conversion from octal C-like escape into binary data
// - \xxx is converted into a single xxx byte from octal, and \\ into \
// - will stop the conversion when Oct^=#0 or when invalid \xxx is reached 
// - returns the number of bytes written to Bin^
function OctToBin(Oct: PAnsiChar; Bin: PByte): PtrInt; overload;

/// conversion from octal C-like escape into binary data
// - \xxx is converted into a single xxx byte from octal, and \\ into \
function OctToBin(const Oct: RawUTF8): RawByteString; overload;

/// fast conversion from one hexa char pair into a 8 bit AnsiChar
// - return false if any invalid (non hexa) char is found in Hex^
// - similar to HexToBin(Hex,nil,1)
function HexToCharValid(Hex: PAnsiChar): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// fast check if the supplied Hex buffer is an hexadecimal representation
// of a binary buffer of a given number of bytes
function IsHex(const Hex: RawByteString; BinBytes: integer): boolean;

/// fast conversion from one hexa char pair into a 8 bit AnsiChar
// - return false if any invalid (non hexa) char is found in Hex^
// - similar to HexToBin(Hex,Bin,1) but with Bin<>nil
// - use HexToCharValid if you want to check a hexadecimal char content
function HexToChar(Hex: PAnsiChar; Bin: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from two hexa bytes into a 16 bit UTF-16 WideChar
// - similar to HexToBin(Hex,@wordvar,2) + bswap(wordvar)
function HexToWideChar(Hex: PAnsiChar): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from binary data into hexa chars
// - BinBytes contain the bytes count to be converted: Hex^ must contain
// enough space for at least BinBytes*2 chars
// - using this function with BinBytes^ as an integer value will encode it
// in low-endian order (less-signignifican byte first): don't use it for display
procedure BinToHex(Bin, Hex: PAnsiChar; BinBytes: integer); overload;

/// fast conversion from hexa chars into binary data
function HexToBin(const Hex: RawUTF8): RawByteString; overload;

/// fast conversion from binary data into hexa chars
function BinToHex(const Bin: RawByteString): RawUTF8; overload;

/// fast conversion from binary data into hexa chars
function BinToHex(Bin: PAnsiChar; BinBytes: integer): RawUTF8; overload;

/// fast conversion from binary data into hexa chars, ready to be displayed
// - BinBytes contain the bytes count to be converted: Hex^ must contain
// enough space for at least BinBytes*2 chars
// - using this function with Bin^ as an integer value will encode it
// in big-endian order (most-signignifican byte first): use it for display
procedure BinToHexDisplay(Bin, Hex: PAnsiChar; BinBytes: integer); overload;

/// fast conversion from binary data into hexa chars, ready to be displayed
function BinToHexDisplay(Bin: PAnsiChar; BinBytes: integer): RawUTF8; overload;

/// fast conversion from binary data into lowercase hexa chars
// - BinBytes contain the bytes count to be converted: Hex^ must contain
// enough space for at least BinBytes*2 chars
// - using this function with BinBytes^ as an integer value will encode it
// in low-endian order (less-signignifican byte first): don't use it for display
procedure BinToHexLower(Bin, Hex: PAnsiChar; BinBytes: integer); overload;

/// fast conversion from binary data into lowercase hexa chars
function BinToHexLower(const Bin: RawByteString): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from binary data into lowercase hexa chars
function BinToHexLower(Bin: PAnsiChar; BinBytes: integer): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from binary data into lowercase hexa chars
procedure BinToHexLower(Bin: PAnsiChar; BinBytes: integer; var result: RawUTF8); overload;

/// fast conversion from binary data into lowercase hexa chars
// - BinBytes contain the bytes count to be converted: Hex^ must contain
// enough space for at least BinBytes*2 chars
// - using this function with Bin^ as an integer value will encode it
// in big-endian order (most-signignifican byte first): use it for display
procedure BinToHexDisplayLower(Bin, Hex: PAnsiChar; BinBytes: PtrInt); overload;

/// fast conversion from binary data into lowercase hexa chars
function BinToHexDisplayLower(Bin: PAnsiChar; BinBytes: integer): RawUTF8; overload;

/// fast conversion from up to 127 bytes of binary data into lowercase hexa chars
function BinToHexDisplayLowerShort(Bin: PAnsiChar; BinBytes: integer): shortstring;

/// fast conversion from up to 64-bit of binary data into lowercase hexa chars
function BinToHexDisplayLowerShort16(Bin: Int64; BinBytes: integer): TShort16;

/// fast conversion from binary data into hexa lowercase chars, ready to be
// used as a convenient TFileName prefix
function BinToHexDisplayFile(Bin: PAnsiChar; BinBytes: integer): TFileName;

/// append one byte as hexadecimal char pairs, into a text buffer
function ByteToHex(P: PAnsiChar; Value: byte): PAnsiChar;

/// fast conversion from binary data to escaped text
// - non printable characters will be written as $xx hexadecimal codes
// - will be #0 terminated, with '...' characters trailing on overflow
// - ensure the destination buffer contains at least max*3+3 bytes, which is
// always the case when using LogEscape() and its local TLogEscape variable
function EscapeBuffer(s,d: PAnsiChar; len,max: integer): PAnsiChar;

const
  /// maximum size, in bytes, of a TLogEscape / LogEscape() buffer
  LOGESCAPELEN = 200;
type
  /// buffer to be allocated on stack when using LogEscape()
  TLogEscape = array[0..LOGESCAPELEN*3+5] of AnsiChar;

/// fill TLogEscape stack buffer with the (hexadecimal) chars of the input binary
// - up to LOGESCAPELEN (i.e. 200) bytes will be escaped and appended to a
// Local temp: TLogEscape variable, using the EscapeBuffer() low-level function
// - you can then log the resulting escaped text by passing the returned
// PAnsiChar as % parameter to a TSynLog.Log() method
// - the "enabled" parameter can be assigned from a process option, avoiding to
// process the escape if verbose logs are disabled
// - used e.g. to implement logBinaryFrameContent option for WebSockets
function LogEscape(source: PAnsiChar; sourcelen: integer; var temp: TLogEscape;
  enabled: boolean=true): PAnsiChar;
  {$ifdef HASINLINE}inline;{$endif}

/// returns a text buffer with the (hexadecimal) chars of the input binary
// - is much slower than LogEscape/EscapeToShort, but has no size limitation
function LogEscapeFull(source: PAnsiChar; sourcelen: integer): RawUTF8; overload;

/// returns a text buffer with the (hexadecimal) chars of the input binary
// - is much slower than LogEscape/EscapeToShort, but has no size limitation
function LogEscapeFull(const source: RawByteString): RawUTF8; overload;

/// fill a shortstring with the (hexadecimal) chars of the input text/binary
function EscapeToShort(source: PAnsiChar; sourcelen: integer): shortstring; overload;

/// fill a shortstring with the (hexadecimal) chars of the input text/binary
function EscapeToShort(const source: RawByteString): shortstring; overload;

/// fast conversion from a pointer data into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
function PointerToHex(aPointer: Pointer): RawUTF8; overload;

/// fast conversion from a pointer data into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
procedure PointerToHex(aPointer: Pointer; var result: RawUTF8); overload;

/// fast conversion from a pointer data into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - such result type would avoid a string allocation on heap
function PointerToHexShort(aPointer: Pointer): TShort16; overload;

/// fast conversion from a Cardinal value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - reverse function of HexDisplayToCardinal()
function CardinalToHex(aCardinal: Cardinal): RawUTF8;

/// fast conversion from a Cardinal value into hexa chars, ready to be displayed
// - use internally BinToHexDisplayLower()
// - reverse function of HexDisplayToCardinal()
function CardinalToHexLower(aCardinal: Cardinal): RawUTF8;

/// fast conversion from a Cardinal value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - such result type would avoid a string allocation on heap
function CardinalToHexShort(aCardinal: Cardinal): TShort16;

/// fast conversion from a Int64 value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - reverse function of HexDisplayToInt64()
function Int64ToHex(aInt64: Int64): RawUTF8; overload;

/// fast conversion from a Int64 value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - reverse function of HexDisplayToInt64()
procedure Int64ToHex(aInt64: Int64; var result: RawUTF8); overload;

/// fast conversion from a Int64 value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - such result type would avoid a string allocation on heap
procedure Int64ToHexShort(aInt64: Int64; out result: TShort16); overload;

/// fast conversion from a Int64 value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - such result type would avoid a string allocation on heap
function Int64ToHexShort(aInt64: Int64): TShort16; overload;

/// fast conversion from a Int64 value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - reverse function of HexDisplayToInt64()
function Int64ToHexString(aInt64: Int64): string;

/// fast conversion from hexa chars into a binary buffer
function HexDisplayToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: integer): boolean;

/// fast conversion from hexa chars into a cardinal
// - reverse function of CardinalToHex()
// - returns false and set aValue=0 if Hex is not a valid hexadecimal 32-bit
// unsigned integer
// - returns true and set aValue with the decoded number, on success
function HexDisplayToCardinal(Hex: PAnsiChar; out aValue: cardinal): boolean;
    {$ifndef FPC}{$ifdef HASINLINE}inline;{$endif}{$endif}
    // inline gives an error under release conditions with FPC

/// fast conversion from hexa chars into a cardinal
// - reverse function of Int64ToHex()
// - returns false and set aValue=0 if Hex is not a valid hexadecimal 64-bit
// signed integer
// - returns true and set aValue with the decoded number, on success
function HexDisplayToInt64(Hex: PAnsiChar; out aValue: Int64): boolean; overload;
    {$ifndef FPC}{$ifdef HASINLINE}inline;{$endif}{$endif}
    { inline gives an error under release conditions with FPC }

/// fast conversion from hexa chars into a cardinal
// - reverse function of Int64ToHex()
// - returns 0 if the supplied text buffer is not a valid hexadecimal 64-bit
// signed integer
function HexDisplayToInt64(const Hex: RawByteString): Int64; overload;
  {$ifdef HASINLINE}inline;{$endif}


/// fast conversion from binary data into Base64 encoded UTF-8 text
function BinToBase64(const s: RawByteString): RawUTF8; overload;

/// fast conversion from binary data into Base64 encoded UTF-8 text
function BinToBase64(Bin: PAnsiChar; BinBytes: integer): RawUTF8; overload;

/// fast conversion from a small binary data into Base64 encoded UTF-8 text
function BinToBase64Short(const s: RawByteString): shortstring; overload;

/// fast conversion from a small binary data into Base64 encoded UTF-8 text
function BinToBase64Short(Bin: PAnsiChar; BinBytes: integer): shortstring; overload;

/// fast conversion from binary data into prefixed/suffixed Base64 encoded UTF-8 text
// - with optional JSON_BASE64_MAGIC prefix (UTF-8 encoded \uFFF0 special code)
function BinToBase64(const data, Prefix, Suffix: RawByteString; WithMagic: boolean): RawUTF8; overload;

/// fast conversion from binary data into Base64 encoded UTF-8 text
// with JSON_BASE64_MAGIC prefix (UTF-8 encoded \uFFF0 special code)
function BinToBase64WithMagic(const data: RawByteString): RawUTF8; overload;

/// fast conversion from binary data into Base64 encoded UTF-8 text
// with JSON_BASE64_MAGIC prefix (UTF-8 encoded \uFFF0 special code)
function BinToBase64WithMagic(Data: pointer; DataLen: integer): RawUTF8; overload;

/// fast conversion from Base64 encoded text into binary data
// - is now just an alias to Base64ToBinSafe() overloaded function
// - returns '' if s was not a valid Base64-encoded input
function Base64ToBin(const s: RawByteString): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64 encoded text into binary data
// - is now just an alias to Base64ToBinSafe() overloaded function
// - returns '' if sp/len buffer was not a valid Base64-encoded input
function Base64ToBin(sp: PAnsiChar; len: PtrInt): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64 encoded text into binary data
// - is now just an alias to Base64ToBinSafe() overloaded function
// - returns false and data='' if sp/len buffer was invalid
function Base64ToBin(sp: PAnsiChar; len: PtrInt; var data: RawByteString): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64 encoded text into binary data
// - returns TRUE on success, FALSE if sp/len buffer was invvalid
function Base64ToBin(sp: PAnsiChar; len: PtrInt; var Blob: TSynTempBuffer): boolean; overload;

/// fast conversion from Base64 encoded text into binary data
// - returns TRUE on success, FALSE if base64 does not match binlen
// - nofullcheck is deprecated and not used any more, since nofullcheck=false
// is now processed with no performance cost
function Base64ToBin(base64, bin: PAnsiChar; base64len, binlen: PtrInt;
  nofullcheck: boolean=true): boolean; overload;

/// fast conversion from Base64 encoded text into binary data
// - returns TRUE on success, FALSE if base64 does not match binlen
// - nofullcheck is deprecated and not used any more, since nofullcheck=false
// is now processed with no performance cost
function Base64ToBin(const base64: RawByteString; bin: PAnsiChar; binlen: PtrInt;
  nofullcheck: boolean=true): boolean; overload;

/// fast conversion from Base64 encoded text into binary data
// - will check supplied text is a valid Base64 encoded stream
function Base64ToBinSafe(const s: RawByteString): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64 encoded text into binary data
// - will check supplied text is a valid Base64 encoded stream
function Base64ToBinSafe(sp: PAnsiChar; len: PtrInt): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64 encoded text into binary data
// - will check supplied text is a valid Base64 encoded stream
function Base64ToBinSafe(sp: PAnsiChar; len: PtrInt; var data: RawByteString): boolean; overload;

/// just a wrapper around Base64ToBin() for in-place decode of JSON_BASE64_MAGIC
// '\uFFF0base64encodedbinary' content into binary
// - input ParamValue shall have been checked to match the expected pattern
procedure Base64MagicDecode(var ParamValue: RawUTF8);

/// check and decode '\uFFF0base64encodedbinary' content into binary
// - this method will check the supplied value to match the expected
// JSON_BASE64_MAGIC pattern, decode and set Blob and return TRUE
function Base64MagicCheckAndDecode(Value: PUTF8Char; var Blob: RawByteString): boolean; overload;

/// check and decode '\uFFF0base64encodedbinary' content into binary
// - this method will check the supplied value to match the expected
// JSON_BASE64_MAGIC pattern, decode and set Blob and return TRUE
function Base64MagicCheckAndDecode(Value: PUTF8Char; ValueLen: Integer;
  var Blob: RawByteString): boolean; overload;

/// check and decode '\uFFF0base64encodedbinary' content into binary
// - this method will check the supplied value to match the expected
// JSON_BASE64_MAGIC pattern, decode and set Blob and return TRUE
function Base64MagicCheckAndDecode(Value: PUTF8Char; var Blob: TSynTempBuffer): boolean; overload;

/// check if the supplied text is a valid Base64 encoded stream
function IsBase64(const s: RawByteString): boolean; overload;

/// check if the supplied text is a valid Base64 encoded stream
function IsBase64(sp: PAnsiChar; len: PtrInt): boolean; overload;

/// retrieve the expected encoded length after Base64 process
function BinToBase64Length(len: PtrUInt): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the expected undecoded length of a Base64 encoded buffer
// - here len is the number of bytes in sp
function Base64ToBinLength(sp: PAnsiChar; len: PtrInt): PtrInt;

/// retrieve the expected undecoded length of a Base64 encoded buffer
// - here len is the number of bytes in sp
// - will check supplied text is a valid Base64 encoded stream
function Base64ToBinLengthSafe(sp: PAnsiChar; len: PtrInt): PtrInt;

/// direct low-level decoding of a Base64 encoded buffer
// - here len is the number of 4 chars chunks in sp input
// - deprecated low-level function: use Base64ToBin/Base64ToBinSafe instead
function Base64Decode(sp,rp: PAnsiChar; len: PtrInt): boolean;

/// fast conversion from binary data into Base64-like URI-compatible encoded text
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function BinToBase64uri(const s: RawByteString): RawUTF8; overload;

/// fast conversion from a binary buffer into Base64-like URI-compatible encoded text
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function BinToBase64uri(Bin: PAnsiChar; BinBytes: integer): RawUTF8; overload;

/// fast conversion from a binary buffer into Base64-like URI-compatible encoded shortstring
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
// - returns '' if BinBytes void or too big for the resulting shortstring
function BinToBase64uriShort(Bin: PAnsiChar; BinBytes: integer): shortstring;

/// conversion from any Base64 encoded value into URI-compatible encoded text
// - warning: will modify the supplied base64 string in-place
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
procedure Base64ToURI(var base64: RawUTF8);

/// low-level conversion from a binary buffer into Base64-like URI-compatible encoded text
// - you should rather use the overloaded BinToBase64uri() functions
procedure Base64uriEncode(rp, sp: PAnsiChar; len: cardinal);

/// retrieve the expected encoded length after Base64-URI process
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function BinToBase64uriLength(len: PtrUInt): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the expected undecoded length of a Base64-URI encoded buffer
// - here len is the number of bytes in sp
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function Base64uriToBinLength(len: PtrInt): PtrInt;

/// fast conversion from Base64-URI encoded text into binary data
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function Base64uriToBin(sp: PAnsiChar; len: PtrInt): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64-URI encoded text into binary data
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
procedure Base64uriToBin(sp: PAnsiChar; len: PtrInt; var result: RawByteString); overload;

/// fast conversion from Base64-URI encoded text into binary data
// - caller should always execute temp.Done when finished with the data
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function Base64uriToBin(sp: PAnsiChar; len: PtrInt; var temp: TSynTempBuffer): boolean; overload;

/// fast conversion from Base64-URI encoded text into binary data
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function Base64uriToBin(const s: RawByteString): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64-URI encoded text into binary data
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
// - will check supplied text is a valid Base64-URI encoded stream
function Base64uriToBin(base64, bin: PAnsiChar; base64len, binlen: PtrInt): boolean; overload;

/// fast conversion from Base64-URI encoded text into binary data
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
// - will check supplied text is a valid Base64-URI encoded stream
function Base64uriToBin(const base64: RawByteString; bin: PAnsiChar; binlen: PtrInt): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct low-level decoding of a Base64-URI encoded buffer
// - the buffer is expected to be at least Base64uriToBinLength() bytes long
// - returns true if the supplied sp[] buffer has been successfully decoded
// into rp[] - will break at any invalid character, so is always safe to use
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
// - you should better not use this, but Base64uriToBin() overloaded functions
function Base64uriDecode(sp,rp: PAnsiChar; len: PtrInt): boolean;


/// generate some pascal source code holding some data binary as constant
// - can store sensitive information (e.g. certificates) within the executable
// - generates a source code snippet of the following format:
// ! const
// !   // Comment
// !   ConstName: array[0..2] of byte = (
// !     $01,$02,$03);
procedure BinToSource(Dest: TTextWriter; const ConstName, Comment: RawUTF8;
  Data: pointer; Len: integer; PerLine: integer=16); overload;

/// generate some pascal source code holding some data binary as constant
// - can store sensitive information (e.g. certificates) within the executable
// - generates a source code snippet of the following format:
// ! const
// !   // Comment
// !   ConstName: array[0..2] of byte = (
// !     $01,$02,$03);
function BinToSource(const ConstName, Comment: RawUTF8; Data: pointer;
  Len: integer; PerLine: integer=16; const Suffix: RawUTF8=''): RawUTF8; overload;


/// revert the value as encoded by TTextWriter.AddInt18ToChars3() or Int18ToChars3()
// - no range check is performed: you should ensure that the incoming text
// follows the expected 3-chars layout
function Chars3ToInt18(P: pointer): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// compute the value as encoded by TTextWriter.AddInt18ToChars3() method
function Int18ToChars3(Value: cardinal): RawUTF8; overload;

/// compute the value as encoded by TTextWriter.AddInt18ToChars3() method
procedure Int18ToChars3(Value: cardinal; var result: RawUTF8); overload;

/// add the 4 digits of integer Y to P^ as '0000'..'9999'
procedure YearToPChar(Y: PtrUInt; P: PUTF8Char);
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// creates a 3 digits string from a 0..999 value as '000'..'999'
// - consider using UInt3DigitsToShort() to avoid temporary memory allocation,
// e.g. when used as FormatUTF8() parameter
function UInt3DigitsToUTF8(Value: Cardinal): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// creates a 4 digits string from a 0..9999 value as '0000'..'9999'
// - consider using UInt4DigitsToShort() to avoid temporary memory allocation,
// e.g. when used as FormatUTF8() parameter
function UInt4DigitsToUTF8(Value: Cardinal): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

type
  /// used e.g. by UInt4DigitsToShort/UInt3DigitsToShort/UInt2DigitsToShort
  // - such result type would avoid a string allocation on heap
  TShort4 = string[4];

/// creates a 4 digits short string from a 0..9999 value
// - using TShort4 as returned string would avoid a string allocation on heap
// - could be used e.g. as parameter to FormatUTF8()
function UInt4DigitsToShort(Value: Cardinal): TShort4;
  {$ifdef HASINLINE}inline;{$endif}

/// creates a 3 digits short string from a 0..999 value
// - using TShort4 as returned string would avoid a string allocation on heap
// - could be used e.g. as parameter to FormatUTF8()
function UInt3DigitsToShort(Value: Cardinal): TShort4;
  {$ifdef HASINLINE}inline;{$endif}

/// creates a 2 digits short string from a 0..99 value
// - using TShort4 as returned string would avoid a string allocation on heap
// - could be used e.g. as parameter to FormatUTF8()
function UInt2DigitsToShort(Value: byte): TShort4;
  {$ifdef HASINLINE}inline;{$endif}

/// creates a 2 digits short string from a 0..99 value
// - won't test Value>99 as UInt2DigitsToShort()
function UInt2DigitsToShortFast(Value: byte): TShort4;
  {$ifdef HASINLINE}inline;{$endif}


/// compute CRC16-CCITT checkum on the supplied buffer
// - i.e. 16-bit CRC-CCITT, with polynomial x^16 + x^12 + x^5 + 1 ($1021)
// and $ffff as initial value
// - this version is not optimized for speed, but for correctness
function crc16(Data: PAnsiChar; Len: integer): cardinal;

// our custom efficient 32-bit hash/checksum function
// - a Fletcher-like checksum algorithm, not a hash function: has less colisions
// than Adler32 for short strings, but more than xxhash32 or crc32/crc32c
// - written in simple plain pascal, with no L1 CPU cache pollution, but we
// also provide optimized x86/x64 assembly versions, since the algorithm is used
// heavily e.g. for TDynArray binary serialization, TSQLRestStorageInMemory
// binary persistence, or CompressSynLZ/StreamSynLZ/FileSynLZ
// - some numbers on Linux x86_64:
// $ 2500 hash32 in 707us i.e. 3536067/s or 7.3 GB/s
// $ 2500 xxhash32 in 1.34ms i.e. 1861504/s or 3.8 GB/s
// $ 2500 crc32c in 943us i.e. 2651113/s or 5.5 GB/s  (SSE4.2 disabled)
// $ 2500 crc32c in 387us i.e. 6459948/s or 13.4 GB/s (SSE4.2 enabled)
function Hash32(Data: PCardinalArray; Len: integer): cardinal; overload;

// our custom efficient 32-bit hash/checksum function
// - a Fletcher-like checksum algorithm, not a hash function: has less colisions
// than Adler32 for short strings, but more than xxhash32 or crc32/crc32c
// - overloaded function using RawByteString for binary content hashing,
// whatever the codepage is
function Hash32(const Text: RawByteString): cardinal; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// standard Kernighan & Ritchie hash from "The C programming Language", 3rd edition
// - simple and efficient code, but too much collisions for THasher
// - kr32() is 898.8 MB/s - crc32cfast() 1.7 GB/s, crc32csse42() 4.3 GB/s
function kr32(crc: cardinal; buf: PAnsiChar; len: PtrInt): cardinal;

/// simple FNV-1a hashing function
// - when run over our regression suite, is similar to crc32c() about collisions,
// and 4 times better than kr32(), but also slower than the others
// - fnv32() is 715.5 MB/s - kr32() 898.8 MB/s
// - this hash function should not be usefull, unless you need several hashing
// algorithms at once (e.g. if crc32c with diverse seeds is not enough)
function fnv32(crc: cardinal; buf: PAnsiChar; len: PtrInt): cardinal;

/// perform very fast xxHash hashing in 32-bit mode
// - will use optimized asm for x86/x64, or a pascal version on other CPUs
function xxHash32(crc: cardinal; P: PAnsiChar; len: integer): cardinal;

type
  TCrc32tab = array[0..7,byte] of cardinal;
  PCrc32tab = ^TCrc32tab;

var
  /// tables used by crc32cfast() function
  // - created with a polynom diverse from zlib's crc32() algorithm, but
  // compatible with SSE 4.2 crc32 instruction
  // - tables content is created from code in initialization section below
  // - will also be used internally by SymmetricEncrypt, FillRandom and
  // TSynUniqueIdentifierGenerator as 1KB master/reference key tables
  crc32ctab: TCrc32tab;

/// compute CRC32C checksum on the supplied buffer on processor-neutral code
// - result is compatible with SSE 4.2 based hardware accelerated instruction
// - will use fast x86/x64 asm or efficient pure pascal implementation on ARM
// - result is not compatible with zlib's crc32() - not the same polynom
// - crc32cfast() is 1.7 GB/s, crc32csse42() is 4.3 GB/s
// - you should use crc32c() function instead of crc32cfast() or crc32csse42()
function crc32cfast(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;

/// compute CRC32C checksum on the supplied buffer using inlined code
// - if the compiler supports inlining, will compute a slow but safe crc32c
// checksum of the binary buffer, without calling the main crc32c() function
// - may be used e.g. to identify patched executable at runtime, for a licensing
// protection system
function crc32cinlined(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// compute CRC64C checksum on the supplied buffer, cascading two crc32c
// - will use SSE 4.2 hardware accelerated instruction, if available
// - will combine two crc32c() calls into a single Int64 result
// - by design, such combined hashes cannot be cascaded
function crc64c(buf: PAnsiChar; len: cardinal): Int64;

/// compute CRC63C checksum on the supplied buffer, cascading two crc32c
// - similar to crc64c, but with 63-bit, so no negative value: may be used
// safely e.g. as mORMot's TID source
// - will use SSE 4.2 hardware accelerated instruction, if available
// - will combine two crc32c() calls into a single Int64 result
// - by design, such combined hashes cannot be cascaded
function crc63c(buf: PAnsiChar; len: cardinal): Int64;

type
  /// binary access to an unsigned 32-bit value (4 bytes in memory)
  TDWordRec = record
    case integer of
    0: (V: DWord);
    1: (L,H: word);
    2: (B: array[0..3] of byte);
  end;
  /// points to the binary of an unsigned 32-bit value
  PDWordRec = ^TDWordRec;

  /// binary access to an unsigned 64-bit value (8 bytes in memory)
  TQWordRec = record
    case integer of
    0: (V: Qword);
    1: (L,H: cardinal);
    2: (W: array[0..3] of word);
    3: (B: array[0..7] of byte);
  end;
  /// points to the binary of an unsigned 64-bit value
  PQWordRec = ^TQWordRec;

  /// store a 128-bit hash value
  // - e.g. a MD5 digest, or array[0..3] of cardinal (TBlock128)
  // - consumes 16 bytes of memory
  THash128 = array[0..15] of byte;
  /// pointer to a 128-bit hash value
  PHash128 = ^THash128;
  /// store a 160-bit hash value
  // - e.g. a SHA-1 digest
  // - consumes 20 bytes of memory
  THash160 = array[0..19] of byte;
  /// pointer to a 160-bit hash value
  PHash160 = ^THash160;
  /// store a 192-bit hash value
  // - consumes 24 bytes of memory
  THash192 = array[0..23] of byte;
  /// pointer to a 192-bit hash value
  PHash192 = ^THash192;
  /// store a 256-bit hash value
  // - e.g. a SHA-256 digest, a TECCSignature result, or array[0..7] of cardinal
  // - consumes 32 bytes of memory
  THash256 = array[0..31] of byte;
  /// pointer to a 256-bit hash value
  PHash256 = ^THash256;
  /// store a 384-bit hash value
  // - e.g. a SHA-384 digest
  // - consumes 48 bytes of memory
  THash384 = array[0..47] of byte;
  /// pointer to a 384-bit hash value
  PHash384 = ^THash384;
  /// store a 512-bit hash value
  // - e.g. a SHA-512 digest, a TECCSignature result, or array[0..15] of cardinal
  // - consumes 64 bytes of memory
  THash512 = array[0..63] of byte;
  /// pointer to a 512-bit hash value
  PHash512 = ^THash512;

  /// store a 128-bit buffer
  // - e.g. an AES block
  // - consumes 16 bytes of memory
  TBlock128 = array[0..3] of cardinal;
  /// pointer to a 128-bit buffer
  PBlock128 = ^TBlock128;

  /// map an infinite array of 128-bit hash values
  // - each item consumes 16 bytes of memory
  THash128Array = array[0..(maxInt div SizeOf(THash128))-1] of THash128;
  /// pointer to an infinite array of 128-bit hash values
  PHash128Array = ^THash128Array;
  /// store several 128-bit hash values
  // - e.g. MD5 digests
  // - consumes 16 bytes of memory per item
  THash128DynArray = array of THash128;
  /// map a 128-bit hash as an array of lower bit size values
  // - consumes 16 bytes of memory
  THash128Rec = packed record
  case integer of
  0: (Lo,Hi: Int64);
  1: (L,H: QWord);
  2: (i0,i1,i2,i3: integer);
  3: (c0,c1,c2,c3: cardinal);
  4: (c: TBlock128);
  5: (b: THash128);
  6: (w: array[0..7] of word);
  7: (l64,h64: Int64Rec);
  end;
  /// pointer to 128-bit hash map variable record
  PHash128Rec = ^THash128Rec;

  /// map an infinite array of 256-bit hash values
  // - each item consumes 32 bytes of memory
  THash256Array = array[0..(maxInt div SizeOf(THash256))-1] of THash256;
  /// pointer to an infinite array of 256-bit hash values
  PHash256Array = ^THash256Array;
  /// store several 256-bit hash values
  // - e.g. SHA-256 digests, TECCSignature results, or array[0..7] of cardinal
  // - consumes 32 bytes of memory per item
  THash256DynArray = array of THash256;
  /// map a 256-bit hash as an array of lower bit size values
  // - consumes 32 bytes of memory
  THash256Rec = packed record
  case integer of
  0: (Lo,Hi: THash128);
  1: (d0,d1,d2,d3: Int64);
  2: (i0,i1,i2,i3,i4,i5,i6,i7: integer);
  3: (c0,c1: TBlock128);
  4: (b: THash256);
  5: (q: array[0..3] of QWord);
  6: (c: array[0..7] of cardinal);
  7: (w: array[0..15] of word);
  8: (l,h: THash128Rec);
  end;
  /// pointer to 256-bit hash map variable record
  PHash256Rec = ^THash256Rec;

  /// map an infinite array of 512-bit hash values
  // - each item consumes 64 bytes of memory
  THash512Array = array[0..(maxInt div SizeOf(THash512))-1] of THash512;
  /// pointer to an infinite array of 512-bit hash values
  PHash512Array = ^THash512Array;
  /// store several 512-bit hash values
  // - e.g. SHA-512 digests, or array[0..15] of cardinal
  // - consumes 64 bytes of memory per item
  THash512DynArray = array of THash512;
  /// map a 512-bit hash as an array of lower bit size values
  // - consumes 64 bytes of memory
  THash512Rec = packed record
  case integer of
  0: (Lo,Hi: THash256);
  1: (h0,h1,h2,h3: THash128);
  2: (d0,d1,d2,d3,d4,d5,d6,d7: Int64);
  3: (i0,i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14,i15: integer);
  4: (c0,c1,c2,c3: TBlock128);
  5: (b: THash512);
  6: (b160: THash160);
  7: (b384: THash384);
  8: (w: array[0..31] of word);
  9: (c: array[0..15] of cardinal);
  10: (i: array[0..7] of Int64);
  11: (r: array[0..3] of THash128Rec);
  12: (l,h: THash256Rec);
  end;
  /// pointer to 512-bit hash map variable record
  PHash512Rec = ^THash512Rec;

/// compute a 128-bit checksum on the supplied buffer, cascading two crc32c
// - will use SSE 4.2 hardware accelerated instruction, if available
// - will combine two crc32c() calls into a single TAESBlock result
// - by design, such combined hashes cannot be cascaded
procedure crc128c(buf: PAnsiChar; len: cardinal; out crc: THash128);

/// compute a proprietary 128-bit CRC of 128-bit binary buffers
// - to be used for regression tests only: crcblocks will use the fastest
// implementation available on the current CPU (e.g. with SSE 4.2 opcodes)
procedure crcblocksfast(crc128, data128: PBlock128; count: integer);

/// compute a proprietary 128-bit CRC of 128-bit binary buffers
// - apply four crc32c() calls on the 128-bit input chunks, into a 128-bit crc
// - its output won't match crc128c() value, which works on 8-bit input
// - will use SSE 4.2 hardware accelerated instruction, if available
// - is used e.g. by SynEcc's TECDHEProtocol.ComputeMAC for macCrc128c
var crcblocks: procedure(crc128, data128: PBlock128; count: integer)=crcblocksfast;

/// computation of our 128-bit CRC of a 128-bit binary buffer without SSE4.2
// - to be used for regression tests only: crcblock will use the fastest
// implementation available on the current CPU (e.g. with SSE 4.2 opcodes)
procedure crcblockNoSSE42(crc128, data128: PBlock128);

/// compute a proprietary 128-bit CRC of a 128-bit binary buffer
// - apply four crc32c() calls on the 128-bit input chunk, into a 128-bit crc
// - its output won't match crc128c() value, which works on 8-bit input
// - will use SSE 4.2 hardware accelerated instruction, if available
// - is used e.g. by SynCrypto's TAESCFBCRC to check for data integrity
var crcblock: procedure(crc128, data128: PBlock128)  = crcblockNoSSE42;

/// returns TRUE if all 16 bytes of this 128-bit buffer equal zero
// - e.g. a MD5 digest, or an AES block
function IsZero(const dig: THash128): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all 16 bytes of both 128-bit buffers do match
// - e.g. a MD5 digest, or an AES block
// - this function is not sensitive to any timing attack, so is designed
// for cryptographic purpose - and it is also branchless therefore fast
function IsEqual(const A,B: THash128): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill all 16 bytes of this 128-bit buffer with zero
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(digest); end;
procedure FillZero(out dig: THash128); overload;

/// fast O(n) search of a 128-bit item in an array of such values
function Hash128Index(P: PHash128Rec; Count: integer; h: PHash128Rec): integer;
  {$ifdef CPU64} inline; {$endif}

/// convert a 32-bit integer (storing a IP4 address) into its full notation
// - returns e.g. '1.2.3.4' for any valid address, or '' if ip4=0
function IP4Text(ip4: cardinal): shortstring; overload;

/// convert a 128-bit buffer (storing an IP6 address) into its full notation
// - returns e.g. '2001:0db8:0a0b:12f0:0000:0000:0000:0001'
function IP6Text(ip6: PHash128): shortstring; overload; {$ifdef HASINLINE}inline;{$endif}

/// convert a 128-bit buffer (storing an IP6 address) into its full notation
// - returns e.g. '2001:0db8:0a0b:12f0:0000:0000:0000:0001'
procedure IP6Text(ip6: PHash128; result: PShortString); overload;

/// compute a 256-bit checksum on the supplied buffer using crc32c
// - will use SSE 4.2 hardware accelerated instruction, if available
// - will combine two crc32c() calls into a single THash256 result
// - by design, such combined hashes cannot be cascaded
procedure crc256c(buf: PAnsiChar; len: cardinal; out crc: THash256);

/// returns TRUE if all 20 bytes of this 160-bit buffer equal zero
// - e.g. a SHA-1 digest
function IsZero(const dig: THash160): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all 20 bytes of both 160-bit buffers do match
// - e.g. a SHA-1 digest
// - this function is not sensitive to any timing attack, so is designed
// for cryptographic purpose
function IsEqual(const A,B: THash160): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill all 20 bytes of this 160-bit buffer with zero
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(digest); end;
procedure FillZero(out dig: THash160); overload;

/// returns TRUE if all 32 bytes of this 256-bit buffer equal zero
// - e.g. a SHA-256 digest, or a TECCSignature result
function IsZero(const dig: THash256): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all 32 bytes of both 256-bit buffers do match
// - e.g. a SHA-256 digest, or a TECCSignature result
// - this function is not sensitive to any timing attack, so is designed
// for cryptographic purpose
function IsEqual(const A,B: THash256): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill all 32 bytes of this 256-bit buffer with zero
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(digest); end;
procedure FillZero(out dig: THash256); overload;

/// fast O(n) search of a 256-bit item in an array of such values
function Hash256Index(P: PHash256Rec; Count: integer; h: PHash256Rec): integer; overload;

/// returns TRUE if all 48 bytes of this 384-bit buffer equal zero
// - e.g. a SHA-384 digest
function IsZero(const dig: THash384): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all 48 bytes of both 384-bit buffers do match
// - e.g. a SHA-384 digest
// - this function is not sensitive to any timing attack, so is designed
// for cryptographic purpose
function IsEqual(const A,B: THash384): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill all 32 bytes of this 384-bit buffer with zero
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(digest); end;
procedure FillZero(out dig: THash384); overload;

/// returns TRUE if all 64 bytes of this 512-bit buffer equal zero
// - e.g. a SHA-512 digest
function IsZero(const dig: THash512): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all 64 bytes of both 512-bit buffers do match
// - e.g. two SHA-512 digests
// - this function is not sensitive to any timing attack, so is designed
// for cryptographic purpose
function IsEqual(const A,B: THash512): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill all 64 bytes of this 512-bit buffer with zero
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(digest); end;
procedure FillZero(out dig: THash512); overload;

/// compute a 512-bit checksum on the supplied buffer using crc32c
// - will use SSE 4.2 hardware accelerated instruction, if available
// - will combine two crc32c() calls into a single THash512 result
// - by design, such combined hashes cannot be cascaded
procedure crc512c(buf: PAnsiChar; len: cardinal; out crc: THash512);

/// fill all bytes of this memory buffer with zeros, i.e. 'toto' -> #0#0#0#0
// - will write the memory buffer directly, so if this string instance is shared
// (i.e. has refcount>1), all other variables will contains zeros
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(secret); end;
procedure FillZero(var secret: RawByteString); overload;
  {$ifdef FPC}inline;{$endif}

/// fill all bytes of this UTF-8 string with zeros, i.e. 'toto' -> #0#0#0#0
// - will write the memory buffer directly, so if this string instance is shared
// (i.e. has refcount>1), all other variables will contains zeros
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(secret); end;
procedure FillZero(var secret: RawUTF8); overload;
  {$ifdef FPC}inline;{$endif}

/// fill all bytes of a memory buffer with zero
// - just redirect to FillCharFast(..,...,0)
procedure FillZero(var dest; count: PtrInt); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all bytes of both buffers do match
// - this function is not sensitive to any timing attack, so is designed
// for cryptographic purposes - use CompareMem/CompareMemSmall/CompareMemFixed
// as faster alternatives for general-purpose code
function IsEqual(const A,B; count: PtrInt): boolean; overload;

/// fast computation of two 64-bit unsigned integers into a 128-bit value
procedure mul64x64(const left, right: QWord; out product: THash128Rec);
  {$ifndef CPUINTEL}inline;{$endif}

type
  /// the potential features, retrieved from an Intel CPU
  // - see https://en.wikipedia.org/wiki/CPUID#EAX.3D1:_Processor_Info_and_Feature_Bits
  // - is defined on all platforms, since an ARM desktop could browse Intel logs
  TIntelCpuFeature = (
   { CPUID 1 in EDX }
   cfFPU,  cfVME,   cfDE,   cfPSE,   cfTSC,  cfMSR, cfPAE,  cfMCE,
   cfCX8,  cfAPIC,  cf_d10, cfSEP,   cfMTRR, cfPGE, cfMCA,  cfCMOV,
   cfPAT,  cfPSE36, cfPSN,  cfCLFSH, cf_d20, cfDS,  cfACPI, cfMMX,
   cfFXSR, cfSSE,   cfSSE2, cfSS,    cfHTT,  cfTM,  cfIA64, cfPBE,
   { CPUID 1 in ECX }
   cfSSE3, cfCLMUL, cfDS64, cfMON,   cfDSCPL, cfVMX,  cfSMX,   cfEST,
   cfTM2,  cfSSSE3, cfCID,  cfSDBG,  cfFMA,   cfCX16, cfXTPR,  cfPDCM,
   cf_c16, cfPCID,  cfDCA,  cfSSE41, cfSSE42, cfX2A,  cfMOVBE, cfPOPCNT,
   cfTSC2, cfAESNI, cfXS,   cfOSXS,  cfAVX,   cfF16C, cfRAND,  cfHYP,
   { extended features CPUID 7 in EBX, ECX, EDX }
   cfFSGS, cfTSCADJ, cfSGX,     cfBMI1,  cfHLE, cfAVX2, cfFDPEO, cfSMEP,
   cfBMI2, cfERMS,   cfINVPCID, cfRTM,   cfPQM, cf_b13, cfMPX,   cfPQE,
   cfAVX512F, cfAVX512DQ, cfRDSEED, cfADX, cfSMAP, cfAVX512IFMA, cfPCOMMIT, cfCLFLUSH,
   cfCLWB,  cfIPT, cfAVX512PF, cfAVX512ER, cfAVX512CD, cfSHA, cfAVX512BW, cfAVX512VL,
   cfPREFW1, cfAVX512VBMI, cfUMIP, cfPKU, cfOSPKE, cf_c05, cfAVX512VBMI2, cfCETSS,
   cfGFNI, cfVAES, cfVCLMUL, cfAVX512NNI, cfAVX512BITALG, cf_c13, cfAVX512VPC, cf_c15,
   cfFLP, cf_c17, cf_c18, cf_c19, cf_c20, cf_c21, cfRDPID, cf_c23,
   cf_c24, cfCLDEMOTE, cf_c26, cfMOVDIRI, cfMOVDIR64B, cfENQCMD, cfSGXLC, cfPKS,
   cf_d0, cf_d1, cfAVX512NNIW, cfAVX512MAPS, cfFSRM, cf_d5, cf_d6, cf_d7,
   cfAVX512VP2I, cfSRBDS, cfMDCLR, cf_d11, cf_d12, cfTSXFA, cfSER, cfHYBRID,
   cfTSXLDTRK,   cf_d17,  cfPCFG,  cfLBR,  cfIBT,  cf_d21,  cfAMXBF16, cf_d23,
   cfAMXTILE, cfAMXINT8, cfIBRSPB, cfSTIBP, cfL1DFL, cfARCAB, cfCORCAB, cfSSBD);

  /// all features, as retrieved from an Intel CPU
  TIntelCpuFeatures = set of TIntelCpuFeature;

/// convert Intel CPU features as plain CSV text
function ToText(const aIntelCPUFeatures: TIntelCpuFeatures;
  const Sep: RawUTF8=','): RawUTF8; overload;

{$ifdef CPUINTEL}
var
  /// the available CPU features, as recognized at program startup
  CpuFeatures: TIntelCpuFeatures;

/// compute CRC32C checksum on the supplied buffer using SSE 4.2
// - use Intel Streaming SIMD Extensions 4.2 hardware accelerated instruction
// - SSE 4.2 shall be available on the processor (i.e. cfSSE42 in CpuFeatures)
// - result is not compatible with zlib's crc32() - not the same polynom
// - crc32cfast() is 1.7 GB/s, crc32csse42() is 4.3 GB/s
// - you should use crc32c() function instead of crc32cfast() or crc32csse42()
function crc32csse42(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$endif CPUINTEL}

/// naive symmetric encryption scheme using a 32-bit key
// - fast, but not very secure, since uses crc32ctab[] content as master cypher
// key: consider using SynCrypto proven AES-based algorithms instead
procedure SymmetricEncrypt(key: cardinal; var data: RawByteString);

type
  TCrc32cBy4 = function(crc, value: cardinal): cardinal;

var
  /// compute CRC32C checksum on the supplied buffer
  // - result is not compatible with zlib's crc32() - Intel/SCSI CRC32C is not
  // the same polynom - but will use the fastest mean available, e.g. SSE 4.2,
  // to achieve up to 16GB/s with the optimized implementation from SynCrypto.pas
  // - you should use this function instead of crc32cfast() or crc32csse42()
  crc32c: THasher;
  /// compute CRC32C checksum on one 32-bit unsigned integer
  // - can be used instead of crc32c() for inlined process during data acquisition
  // - doesn't make "crc := not crc" before and after the computation: caller has
  // to start with "crc := cardinal(not 0)" and make "crc := not crc" at the end,
  // to compute the very same hash value than regular crc32c()
  // - this variable will use the fastest mean available, e.g. SSE 4.2
  crc32cBy4: TCrc32cBy4;

/// compute the hexadecimal representation of the crc32 checkum of a given text
// - wrapper around CardinalToHex(crc32c(...))
function crc32cUTF8ToHex(const str: RawUTF8): RawUTF8;

var
  /// the default hasher used by TDynArrayHashed
  // - set to crc32csse42() if SSE4.2 instructions are available on this CPU,
  // or fallback to xxHash32() which performs better than crc32cfast()
  DefaultHasher: THasher;

  /// the hash function used by TRawUTF8Interning
  // - set to crc32csse42() if SSE4.2 instructions are available on this CPU,
  // or fallback to xxHash32() which performs better than crc32cfast()
  InterningHasher: THasher;

/// retrieve a particular bit status from a bit array
// - this function can't be inlined, whereas GetBitPtr() function can
function GetBit(const Bits; aIndex: PtrInt): boolean;

/// set a particular bit into a bit array
// - this function can't be inlined, whereas SetBitPtr() function can
procedure SetBit(var Bits; aIndex: PtrInt);

/// unset/clear a particular bit into a bit array
// - this function can't be inlined, whereas UnSetBitPtr() function can
procedure UnSetBit(var Bits; aIndex: PtrInt);

/// retrieve a particular bit status from a bit array
// - GetBit() can't be inlined, whereas this pointer-oriented function can
function GetBitPtr(Bits: pointer; aIndex: PtrInt): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// set a particular bit into a bit array
// - SetBit() can't be inlined, whereas this pointer-oriented function can
procedure SetBitPtr(Bits: pointer; aIndex: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// unset/clear a particular bit into a bit array
// - UnSetBit() can't be inlined, whereas this pointer-oriented function can
procedure UnSetBitPtr(Bits: pointer; aIndex: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// compute the number of bits set in a bit array
// - Count is the bit count, not byte size
// - will use fast SSE4.2 popcnt instruction if available on the CPU
function GetBitsCount(const Bits; Count: PtrInt): PtrInt;

/// pure pascal version of GetBitsCountPtrInt()
// - defined just for regression tests - call GetBitsCountPtrInt() instead
// - has optimized asm on x86_64 and i386
function GetBitsCountPas(value: PtrInt): PtrInt;

/// compute how many bits are set in a given pointer-sized integer
// - the PopCnt() intrinsic under FPC doesn't have any fallback on older CPUs,
// and default implementation is 5 times slower than our GetBitsCountPas() on x64
// - this redirected function will use fast SSE4.2 popcnt opcode, if available
var GetBitsCountPtrInt: function(value: PtrInt): PtrInt = GetBitsCountPas;

const
  /// constant array used by GetAllBits() function (when inlined)
  ALLBITS_CARDINAL: array[1..32] of Cardinal = (
    1 shl 1-1, 1 shl 2-1, 1 shl 3-1, 1 shl 4-1, 1 shl 5-1, 1 shl 6-1,
    1 shl 7-1, 1 shl 8-1, 1 shl 9-1, 1 shl 10-1, 1 shl 11-1, 1 shl 12-1,
    1 shl 13-1, 1 shl 14-1, 1 shl 15-1, 1 shl 16-1, 1 shl 17-1, 1 shl 18-1,
    1 shl 19-1, 1 shl 20-1, 1 shl 21-1, 1 shl 22-1, 1 shl 23-1, 1 shl 24-1,
    1 shl 25-1, 1 shl 26-1, 1 shl 27-1, 1 shl 28-1, 1 shl 29-1, 1 shl 30-1,
    $7fffffff, $ffffffff);

/// returns TRUE if all BitCount bits are set in the input 32-bit cardinal
function GetAllBits(Bits, BitCount: cardinal): boolean;
  {$ifdef HASINLINE}inline;{$endif}

type
  /// fast access to 8-bit integer bits
  // - the compiler will generate bt/btr/bts opcodes
  TBits8 = set of 0..7;
  PBits8 = ^TBits8;
  TBits8Array = array[0..maxInt-1] of TBits8;
  /// fast access to 32-bit integer bits
  // - the compiler will generate bt/btr/bts opcodes
  TBits32 = set of 0..31;
  PBits32 = ^TBits32;
  /// fast access to 64-bit integer bits
  // - the compiler will generate bt/btr/bts opcodes
  // - as used by GetBit64/SetBit64/UnSetBit64
  TBits64 = set of 0..63;
  PBits64 = ^TBits64;

/// retrieve a particular bit status from a 64-bit integer bits (max aIndex is 63)
function GetBit64(const Bits: Int64; aIndex: PtrInt): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// set a particular bit into a 64-bit integer bits (max aIndex is 63)
procedure SetBit64(var Bits: Int64; aIndex: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// unset/clear a particular bit into a 64-bit integer bits (max aIndex is 63)
procedure UnSetBit64(var Bits: Int64; aIndex: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// logical OR of two memory buffers
// - will perform on all buffer bytes:
// ! Dest[i] := Dest[i] or Source[i];
procedure OrMemory(Dest,Source: PByteArray; size: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// logical XOR of two memory buffers
// - will perform on all buffer bytes:
// ! Dest[i] := Dest[i] xor Source[i];
procedure XorMemory(Dest,Source: PByteArray; size: PtrInt); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// logical XOR of two memory buffers into a third
// - will perform on all buffer bytes:
// ! Dest[i] := Source1[i] xor Source2[i];
procedure XorMemory(Dest,Source1,Source2: PByteArray; size: PtrInt); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// logical AND of two memory buffers
// - will perform on all buffer bytes:
// ! Dest[i] := Dest[i] and Source[i];
procedure AndMemory(Dest,Source: PByteArray; size: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all bytes equal zero
function IsZero(P: pointer; Length: integer): boolean; overload;

/// returns TRUE if all of a few bytes equal zero
// - to be called instead of IsZero() e.g. for 1..8 bytes
function IsZeroSmall(P: pointer; Length: PtrInt): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if Value is nil or all supplied Values[] equal ''
function IsZero(const Values: TRawUTF8DynArray): boolean; overload;

/// returns TRUE if Value is nil or all supplied Values[] equal 0
function IsZero(const Values: TIntegerDynArray): boolean; overload;

/// returns TRUE if Value is nil or all supplied Values[] equal 0
function IsZero(const Values: TInt64DynArray): boolean; overload;

/// fill all entries of a supplied array of RawUTF8 with ''
procedure FillZero(var Values: TRawUTF8DynArray); overload;

/// fill all entries of a supplied array of 32-bit integers with 0
procedure FillZero(var Values: TIntegerDynArray); overload;

/// fill all entries of a supplied array of 64-bit integers with 0
procedure FillZero(var Values: TInt64DynArray); overload;


/// name the current thread so that it would be easily identified in the IDE debugger
procedure SetCurrentThreadName(const Format: RawUTF8; const Args: array of const);

/// name a thread so that it would be easily identified in the IDE debugger
// - you can force this function to do nothing by setting the NOSETTHREADNAME
// conditional, if you have issues with this feature when debugging your app
// - most meanling less characters (like 'TSQL') are trimmed to reduce the
// resulting length - which is convenient e.g. with POSIX truncation to 16 chars
procedure SetThreadName(ThreadID: TThreadID; const Format: RawUTF8;
  const Args: array of const);

/// could be used to override SetThreadNameInternal()
// - under Linux/FPC, calls pthread_setname_np API which truncates to 16 chars
procedure SetThreadNameDefault(ThreadID: TThreadID; const Name: RawUTF8);

var
  /// is overriden e.g. by mORMot.pas to log the thread name
  SetThreadNameInternal: procedure(ThreadID: TThreadID; const Name: RawUTF8) = SetThreadNameDefault;



/// low-level wrapper to add a callback to a dynamic list of events
// - by default, you can assign only one callback to an Event: but by storing
// it as a dynamic array of events, you can use this wrapper to add one callback
// to this list of events
// - if the event was already registered, do nothing (i.e. won't call it twice)
// - since this function uses an unsafe typeless EventList parameter, you should
// not use it in high-level code, but only as wrapper within dedicated methods
// - will add Event to EventList[] unless Event is already registered
// - is used e.g. by TTextWriter as such:
// ! ...
// !   fEchos: array of TOnTextWriterEcho;
// ! ...
// !   procedure EchoAdd(const aEcho: TOnTextWriterEcho);
// ! ...
// ! procedure TTextWriter.EchoAdd(const aEcho: TOnTextWriterEcho);
// ! begin
// !   MultiEventAdd(fEchos,TMethod(aEcho));
// ! end;
// then callbacks are then executed as such:
// ! if fEchos<>nil then
// !   for i := 0 to length(fEchos)-1 do
// !     fEchos[i](self,fEchoBuf);
// - use MultiEventRemove() to un-register a callback from the list
function MultiEventAdd(var EventList; const Event: TMethod): boolean;

/// low-level wrapper to remove a callback from a dynamic list of events
// - by default, you can assign only one callback to an Event: but by storing
// it as a dynamic array of events, you can use this wrapper to remove one
// callback already registered by MultiEventAdd() to this list of events
// - since this function uses an unsafe typeless EventList parameter, you should
// not use it in high-level code, but only as wrapper within dedicated methods
// - is used e.g. by TTextWriter as such:
// ! ...
// !   fEchos: array of TOnTextWriterEcho;
// ! ...
// !   procedure EchoRemove(const aEcho: TOnTextWriterEcho);
// ! ...
// ! procedure TTextWriter.EchoRemove(const aEcho: TOnTextWriterEcho);
// ! begin
// !   MultiEventRemove(fEchos,TMethod(aEcho));
// ! end;
procedure MultiEventRemove(var EventList; const Event: TMethod); overload;

/// low-level wrapper to remove a callback from a dynamic list of events
// - same as the same overloaded procedure, but accepting an EventList[] index
// to identify the Event to be suppressed
procedure MultiEventRemove(var EventList; Index: Integer); overload;

/// low-level wrapper to check if a callback is in a dynamic list of events
// - by default, you can assign only one callback to an Event: but by storing
// it as a dynamic array of events, you can use this wrapper to check if
// a callback has already been registered to this list of events
// - used internally by MultiEventAdd() and MultiEventRemove() functions
function MultiEventFind(const EventList; const Event: TMethod): integer;

/// low-level wrapper to add one or several callbacks from another list of events
// - all events of the ToBeAddedList would be added to DestList
// - the list is not checked for duplicates
procedure MultiEventMerge(var DestList; const ToBeAddedList);

/// compare two TMethod instances
function EventEquals(const eventA,eventB): boolean;


{ ************ fast ISO-8601 types and conversion routines ***************** }

type
  /// a type alias, which will be serialized as ISO-8601 with milliseconds
  // - i.e. 'YYYY-MM-DD hh:mm:ss.sss' or 'YYYYMMDD hhmmss.sss' format
  TDateTimeMS = type TDateTime;

  /// a dynamic array of TDateTimeMS values
  TDateTimeMSDynArray = array of TDateTimeMS;
  PDateTimeMSDynArray = ^TDateTimeMSDynArray;

  {$A-}
  /// a simple way to store a date as Year/Month/Day
  // - with no needed computation as with TDate/TUnixTime values
  // - consider using TSynSystemTime if you need to handle both Date and Time
  // - match the first 4 fields of TSynSystemTime - so PSynDate(@aSynSystemTime)^
  // is safe to be used
  // - DayOfWeek field is not handled by its methods by default, but could be
  // filled on demand via ComputeDayOfWeek - making this record 64-bit long
  // - some Delphi revisions have trouble with "object" as own method parameters
  // (e.g. IsEqual) so we force to use "record" type if possible
  {$ifdef USERECORDWITHMETHODS}TSynDate = record{$else}
  TSynDate = object{$endif}
    Year, Month, DayOfWeek, Day: word;
    /// set all fields to 0
    procedure Clear; {$ifdef HASINLINE}inline;{$endif}
    /// set internal date to 9999-12-31
    procedure SetMax; {$ifdef HASINLINE}inline;{$endif}
    /// returns true if all fields are zero
    function IsZero: boolean; {$ifdef HASINLINE}inline;{$endif}
    /// try to parse a YYYY-MM-DD or YYYYMMDD ISO-8601 date from the supplied buffer
    // - on success, move P^ just after the date, and return TRUE
    function ParseFromText(var P: PUTF8Char): boolean; {$ifdef HASINLINE}inline;{$endif}
    /// fill fields with the current UTC/local date, using a 8-16ms thread-safe cache
    procedure FromNow(localtime: boolean=false);
    /// fill fields with the supplied date
    procedure FromDate(date: TDate);
    /// returns true if all fields do match - ignoring DayOfWeek field value
    function IsEqual({$ifdef FPC}constref{$else}const{$endif} another{$ifndef DELPHI5OROLDER}: TSynDate{$endif}): boolean;
    /// compare the stored value to a supplied value
    // - returns <0 if the stored value is smaller than the supplied value,
    // 0 if both are equals, and >0 if the stored value is bigger
    // - DayOfWeek field value is not compared
    function Compare({$ifdef FPC}constref{$else}const{$endif} another{$ifndef DELPHI5OROLDER}: TSynDate{$endif}): integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// fill the DayOfWeek field from the stored Year/Month/Day
    // - by default, most methods will just store 0 in the DayOfWeek field
    // - sunday is DayOfWeek 1, saturday is 7
    procedure ComputeDayOfWeek;
    /// convert the stored date into a Delphi TDate floating-point value
    function ToDate: TDate; {$ifdef HASINLINE}inline;{$endif}
    /// encode the stored date as ISO-8601 text
    // - returns '' if the stored date is 0 (i.e. after Clear)
    function ToText(Expanded: boolean=true): RawUTF8;
  end;
  /// store several dates as Year/Month/Day
  TSynDateDynArray = array of TSynDate;
  /// a pointer to a TSynDate instance
  PSynDate = ^TSynDate;

  /// a cross-platform and cross-compiler TSystemTime 128-bit structure
  // - FPC's TSystemTime in datih.inc does NOT match Windows TSystemTime fields!
  // - also used to store a Date/Time in TSynTimeZone internal structures, or
  // for fast conversion from TDateTime to its ready-to-display members
  // - DayOfWeek field is not handled by most methods by default (left as 0),
  // but could be filled on demand via ComputeDayOfWeek into its 1..7 value
  // - some Delphi revisions have trouble with "object" as own method parameters
  // (e.g. IsEqual) so we force to use "record" type if possible
  {$ifdef USERECORDWITHMETHODS}TSynSystemTime = record{$else}
  TSynSystemTime = object{$endif}
  public
    Year, Month, DayOfWeek, Day,
    Hour, Minute, Second, MilliSecond: word;
    /// set all fields to 0
    procedure Clear; {$ifdef HASINLINE}inline;{$endif}
    /// returns true if all fields are zero
    function IsZero: boolean; {$ifdef HASINLINE}inline;{$endif}
    /// returns true if all fields do match
    function IsEqual(const another{$ifndef DELPHI5OROLDER}: TSynSystemTime{$endif}): boolean;
    /// returns true if date fields do match (ignoring DayOfWeek)
    function IsDateEqual(const date{$ifndef DELPHI5OROLDER}: TSynDate{$endif}): boolean;
    /// used by TSynTimeZone
    function EncodeForTimeChange(const aYear: word): TDateTime;
    /// fill fields with the current UTC time, using a 8-16ms thread-safe cache
    procedure FromNowUTC;
    /// fill fields with the current Local time, using a 8-16ms thread-safe cache
    procedure FromNowLocal;
    /// fill fields from the given value - but not DayOfWeek
    procedure FromDateTime(const dt: TDateTime);
    /// fill Year/Month/Day fields from the given value - but not DayOfWeek
    // - faster than the RTL DecodeDate() function
    procedure FromDate(const dt: TDateTime);
    /// fill Hour/Minute/Second/Millisecond fields from the given number of milliseconds
    // - faster than the RTL DecodeTime() function
    procedure FromMS(ms: PtrUInt);
    /// fill Hour/Minute/Second/Millisecond fields from the given number of seconds
    // - faster than the RTL DecodeTime() function
    procedure FromSec(s: PtrUInt);
    /// fill Hour/Minute/Second/Millisecond fields from the given TDateTime value
    // - faster than the RTL DecodeTime() function
    procedure FromTime(const dt: TDateTime);
    /// fill Year/Month/Day and Hour/Minute/Second fields from the given ISO-8601 text
    // - returns true on success
    function FromText(const iso: RawUTF8): boolean;
    /// encode the stored date/time as ISO-8601 text with Milliseconds
    function ToText(Expanded: boolean=true; FirstTimeChar: AnsiChar='T'; const TZD: RawUTF8=''): RawUTF8;
    /// append the stored date and time, in a log-friendly format
    // - e.g. append '20110325 19241502' - with no trailing space nor tab
    // - as called by TTextWriter.AddCurrentLogTime()
    procedure AddLogTime(WR: TTextWriter);
    /// append the stored date and time, in apache-like format, to a TTextWriter
    // - e.g. append '19/Feb/2019:06:18:55 ' - including a trailing space
    procedure AddNCSAText(WR: TTextWriter);
    /// append the stored date and time, in apache-like format, to a memory buffer
    // - e.g. append '19/Feb/2019:06:18:55 ' - including a trailing space
    // - returns the number of chars added to P, i.e. always 21
    function ToNCSAText(P: PUTF8Char): PtrInt;
    /// convert the stored date and time to its text in HTTP-like format
    // - i.e. "Tue, 15 Nov 1994 12:45:26 GMT" to be used as a value of
    // "Date", "Expires" or "Last-Modified" HTTP header
    // - handle UTC/GMT time zone by default
    procedure ToHTTPDate(out text: RawUTF8; const tz: RawUTF8='GMT');
    /// convert the stored date and time into its Iso-8601 text, with no Milliseconds
    procedure ToIsoDateTime(out text: RawUTF8; const FirstTimeChar: AnsiChar='T');
    /// convert the stored date into its Iso-8601 text with no time part
    procedure ToIsoDate(out text: RawUTF8);
    /// convert the stored time into its Iso-8601 text with no date part nor Milliseconds
    procedure ToIsoTime(out text: RawUTF8; const FirstTimeChar: RawUTF8='T');
    /// convert the stored time into a TDateTime
    function ToDateTime: TDateTime;
    /// copy Year/Month/DayOfWeek/Day fields to a TSynDate
    procedure ToSynDate(out date: TSynDate); {$ifdef HASINLINE}inline;{$endif}
    /// fill the DayOfWeek field from the stored Year/Month/Day
    // - by default, most methods will just store 0 in the DayOfWeek field
    // - sunday is DayOfWeek 1, saturday is 7
    procedure ComputeDayOfWeek; {$ifdef HASINLINE}inline;{$endif}
    /// add some 1..999 milliseconds to the stored time
    // - not to be used for computation, but e.g. for fast AddLogTime generation
    procedure IncrementMS(ms: integer);
  end;
  PSynSystemTime = ^TSynSystemTime;
  {$A+}

  /// fast bit-encoded date and time value
  // - faster than Iso-8601 text and TDateTime, e.g. can be used as published
  // property field in mORMot's TSQLRecord (see also TModTime and TCreateTime)
  // - use internally for computation an abstract "year" of 16 months of 32 days
  // of 32 hours of 64 minutes of 64 seconds - same as Iso8601ToTimeLog()
  // - use TimeLogFromDateTime/TimeLogToDateTime/TimeLogNow functions, or
  // type-cast any TTimeLog value with the TTimeLogBits memory structure for
  // direct access to its bit-oriented content (or via PTimeLogBits pointer)
  // - since TTimeLog type is bit-oriented, you can't just add or substract two
  // TTimeLog values when doing date/time computation: use a TDateTime temporary
  // conversion in such case:
  // ! aTimestamp := TimeLogFromDateTime(IncDay(TimeLogToDateTime(aTimestamp)));
  TTimeLog = type Int64;

  /// dynamic array of TTimeLog
  // - used by TDynArray JSON serialization to handle textual serialization
  TTimeLogDynArray = array of TTimeLog;

  /// pointer to a memory structure for direct access to a TTimeLog type value
  PTimeLogBits = ^TTimeLogBits;

  /// internal memory structure for direct access to a TTimeLog type value
  // - most of the time, you should not use this object, but higher level
  // TimeLogFromDateTime/TimeLogToDateTime/TimeLogNow/Iso8601ToTimeLog functions
  // - since TTimeLogBits.Value is bit-oriented, you can't just add or substract
  // two TTimeLog values when doing date/time computation: use a TDateTime
  // temporary conversion in such case
  // - TTimeLogBits.Value needs up to 40-bit precision, so features exact
  // representation as JavaScript numbers (stored in a 52-bit mantissa)
  TTimeLogBits = object
  public
    /// the bit-encoded value itself, which follows an abstract "year" of 16
    // months of 32 days of 32 hours of 64 minutes of 64 seconds
    // - bits 0..5   = Seconds (0..59)
    // - bits 6..11  = Minutes (0..59)
    // - bits 12..16 = Hours   (0..23)
    // - bits 17..21 = Day-1   (0..31)
    // - bits 22..25 = Month-1 (0..11)
    // - bits 26..40 = Year    (0..9999)
    Value: Int64;
    /// extract the date and time content in Value into individual values
    procedure Expand(out Date: TSynSystemTime);
    /// convert to Iso-8601 encoded text, truncated to date/time only if needed
    function Text(Expanded: boolean; FirstTimeChar: AnsiChar = 'T'): RawUTF8; overload;
    /// convert to Iso-8601 encoded text, truncated to date/time only if needed
    function Text(Dest: PUTF8Char; Expanded: boolean;
      FirstTimeChar: AnsiChar = 'T'): integer; overload;
    /// convert to Iso-8601 encoded text with date and time part
    // - never truncate to date/time nor return '' as Text() does
    function FullText(Expanded: boolean; FirstTimeChar: AnsiChar = 'T';
      QuotedChar: AnsiChar = #0): RawUTF8; overload;
      {$ifdef FPC}inline;{$endif} //  URW1111 on Delphi 2010 and URW1136 on XE
    /// convert to Iso-8601 encoded text with date and time part
    // - never truncate to date/time or return '' as Text() does
    function FullText(Dest: PUTF8Char; Expanded: boolean;
      FirstTimeChar: AnsiChar = 'T'; QuotedChar: AnsiChar = #0): PUTF8Char; overload;
    /// convert to ready-to-be displayed text
    // - using i18nDateText global event, if set (e.g. by mORMoti18n.pas)
    function i18nText: string;
    /// convert to a Delphi Time
    function ToTime: TDateTime;
    /// convert to a Delphi Date
    // - will return 0 if the stored value is not a valid date
    function ToDate: TDateTime;
    /// convert to a Delphi Date and Time
    // - will return 0 if the stored value is not a valid date
    function ToDateTime: TDateTime;
    /// convert to a second-based c-encoded time (from Unix epoch 1/1/1970)
    function ToUnixTime: TUnixTime;
    /// convert to a millisecond-based c-encoded time (from Unix epoch 1/1/1970)
    // - of course, milliseconds will be 0 due to TTimeLog second resolution
    function ToUnixMSTime: TUnixMSTime;
    /// fill Value from specified Date and Time
    procedure From(Y,M,D, HH,MM,SS: cardinal); overload;
    /// fill Value from specified TDateTime
    procedure From(DateTime: TDateTime; DateOnly: Boolean=false); overload;
    /// fill Value from specified File Date
    procedure From(FileDate: integer); overload;
    /// fill Value from Iso-8601 encoded text
    procedure From(P: PUTF8Char; L: integer); overload; {$ifdef HASINLINE}inline;{$endif}
    /// fill Value from Iso-8601 encoded text
    procedure From(const S: RawUTF8); overload;
    /// fill Value from specified Date/Time individual fields
    procedure From(Time: PSynSystemTime); overload;
    /// fill Value from second-based c-encoded time (from Unix epoch 1/1/1970)
    procedure FromUnixTime(const UnixTime: TUnixTime);
    /// fill Value from millisecond-based c-encoded time (from Unix epoch 1/1/1970)
    // - of course, millisecond resolution will be lost during conversion
    procedure FromUnixMSTime(const UnixMSTime: TUnixMSTime);
    /// fill Value from current local system Date and Time
    procedure FromNow;
    /// fill Value from current UTC system Date and Time
    // - FromNow uses local time: this function retrieves the system time
    // expressed in Coordinated Universal Time (UTC)
    procedure FromUTCTime;
    /// get the year (e.g. 2015) of the TTimeLog value
    function Year: Integer; {$ifdef HASINLINE}inline;{$endif}
    /// get the month (1..12) of the TTimeLog value
    function Month: Integer; {$ifdef HASINLINE}inline;{$endif}
    /// get the day (1..31) of the TTimeLog value
    function Day: Integer; {$ifdef HASINLINE}inline;{$endif}
    /// get the hour (0..23) of the TTimeLog value
    function Hour: integer; {$ifdef HASINLINE}inline;{$endif}
    /// get the minute (0..59) of the TTimeLog value
    function Minute: integer; {$ifdef HASINLINE}inline;{$endif}
    /// get the second (0..59) of the TTimeLog value
    function Second: integer; {$ifdef HASINLINE}inline;{$endif}
  end;

/// get TTimeLog value from current local system date and time
// - handle TTimeLog bit-encoded Int64 format
function TimeLogNow: TTimeLog;
  {$ifdef HASINLINE}inline;{$endif}

/// get TTimeLog value from current UTC system Date and Time
// - handle TTimeLog bit-encoded Int64 format
function TimeLogNowUTC: TTimeLog;
  {$ifdef HASINLINE}inline;{$endif}

/// get TTimeLog value from a file date and time
// - handle TTimeLog bit-encoded Int64 format
function TimeLogFromFile(const FileName: TFileName): TTimeLog;

/// get TTimeLog value from a given Delphi date and time
// - handle TTimeLog bit-encoded Int64 format
// - just a wrapper around PTimeLogBits(@aTime)^.From()
// - we defined such a function since TTimeLogBits(aTimeLog).From() won't change
// the aTimeLog variable content
function TimeLogFromDateTime(const DateTime: TDateTime): TTimeLog;
  {$ifdef HASINLINE}inline;{$endif}

/// get TTimeLog value from a given Unix seconds since epoch timestamp
// - handle TTimeLog bit-encoded Int64 format
// - just a wrapper around PTimeLogBits(@aTime)^.FromUnixTime()
function TimeLogFromUnixTime(const UnixTime: TUnixTime): TTimeLog;
  {$ifdef HASINLINE}inline;{$endif}

/// Date/Time conversion from a TTimeLog value
// - handle TTimeLog bit-encoded Int64 format
// - just a wrapper around PTimeLogBits(@Timestamp)^.ToDateTime
// - we defined such a function since TTimeLogBits(aTimeLog).ToDateTime gives an
// internall compiler error on some Delphi IDE versions (e.g. Delphi 6)
function TimeLogToDateTime(const Timestamp: TTimeLog): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// Unix seconds since epoch timestamp conversion from a TTimeLog value
// - handle TTimeLog bit-encoded Int64 format
// - just a wrapper around PTimeLogBits(@Timestamp)^.ToUnixTime
function TimeLogToUnixTime(const Timestamp: TTimeLog): TUnixTime;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a Iso8601 encoded string into a TTimeLog value
// - handle TTimeLog bit-encoded Int64 format
// - use this function only for fast comparison between two Iso8601 date/time
// - conversion is faster than Iso8601ToDateTime: use only binary integer math
// - ContainsNoTime optional pointer can be set to a boolean, which will be
// set according to the layout in P (e.g. TRUE for '2012-05-26')
// - returns 0 in case of invalid input string
function Iso8601ToTimeLogPUTF8Char(P: PUTF8Char; L: integer; ContainsNoTime: PBoolean=nil): TTimeLog;

/// convert a Iso8601 encoded string into a TTimeLog value
// - handle TTimeLog bit-encoded Int64 format
// - use this function only for fast comparison between two Iso8601 date/time
// - conversion is faster than Iso8601ToDateTime: use only binary integer math
function Iso8601ToTimeLog(const S: RawByteString): TTimeLog;
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// test if P^ contains a valid ISO-8601 text encoded value
// - calls internally Iso8601ToTimeLogPUTF8Char() and returns true if contains
// at least a valid year (YYYY)
function IsIso8601(P: PUTF8Char; L: integer): boolean;
 {$ifdef HASINLINE}inline;{$endif}

/// Date/Time conversion from ISO-8601
// - handle 'YYYYMMDDThhmmss' and 'YYYY-MM-DD hh:mm:ss' format
// - will also recognize '.sss' milliseconds suffix, if any
function Iso8601ToDateTime(const S: RawByteString): TDateTime; overload;
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// Date/Time conversion from ISO-8601
// - handle 'YYYYMMDDThhmmss' and 'YYYY-MM-DD hh:mm:ss' format
// - will also recognize '.sss' milliseconds suffix, if any
// - if L is left to default 0, it will be computed from StrLen(P)
function Iso8601ToDateTimePUTF8Char(P: PUTF8Char; L: integer=0): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// Date/Time conversion from ISO-8601
// - handle 'YYYYMMDDThhmmss' and 'YYYY-MM-DD hh:mm:ss' format, with potentially
// shorten versions has handled by the ISO-8601 standard (e.g. 'YYYY')
// - will also recognize '.sss' milliseconds suffix, if any
// - if L is left to default 0, it will be computed from StrLen(P)
procedure Iso8601ToDateTimePUTF8CharVar(P: PUTF8Char; L: integer; var result: TDateTime);

/// Date/Time conversion from strict ISO-8601 content
// - recognize 'YYYY-MM-DDThh:mm:ss[.sss]' or 'YYYY-MM-DD' or 'Thh:mm:ss[.sss]'
// patterns, as e.g. generated by TTextWriter.AddDateTime() or RecordSaveJSON()
// - will also recognize '.sss' milliseconds suffix, if any
function Iso8601CheckAndDecode(P: PUTF8Char; L: integer; var Value: TDateTime): boolean;

/// Time conversion from ISO-8601 (with no Date part)
// - handle 'hhmmss' and 'hh:mm:ss' format
// - will also recognize '.sss' milliseconds suffix, if any
// - if L is left to default 0, it will be computed from StrLen(P)
function Iso8601ToTimePUTF8Char(P: PUTF8Char; L: integer=0): TDateTime; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// Time conversion from ISO-8601 (with no Date part)
// - handle 'hhmmss' and 'hh:mm:ss' format
// - will also recognize '.sss' milliseconds suffix, if any
// - if L is left to default 0, it will be computed from StrLen(P)
procedure Iso8601ToTimePUTF8CharVar(P: PUTF8Char; L: integer; var result: TDateTime);

/// Time conversion from ISO-8601 (with no Date part)
// - recognize 'hhmmss' and 'hh:mm:ss' format into H,M,S variables
// - will also recognize '.sss' milliseconds suffix, if any, into MS
// - if L is left to default 0, it will be computed from StrLen(P)
function Iso8601ToTimePUTF8Char(P: PUTF8Char; L: integer; var H,M,S,MS: cardinal): boolean; overload;

/// Date conversion from ISO-8601 (with no Time part)
// - recognize 'YYYY-MM-DD' and 'YYYYMMDD' format into Y,M,D variables
// - if L is left to default 0, it will be computed from StrLen(P)
function Iso8601ToDatePUTF8Char(P: PUTF8Char; L: integer; var Y,M,D: cardinal): boolean;

/// Interval date/time conversion from simple text
// - expected format does not match ISO-8601 Time intervals format, but Oracle
// interval litteral representation, i.e. '+/-D HH:MM:SS'
// - e.g. IntervalTextToDateTime('+0 06:03:20') will return 0.25231481481 and
// IntervalTextToDateTime('-20 06:03:20') -20.252314815
// - as a consequence, negative intervals will be written as TDateTime values:
// !DateTimeToIso8601Text(IntervalTextToDateTime('+0 06:03:20'))='T06:03:20'
// !DateTimeToIso8601Text(IntervalTextToDateTime('+1 06:03:20'))='1899-12-31T06:03:20'
// !DateTimeToIso8601Text(IntervalTextToDateTime('-2 06:03:20'))='1899-12-28T06:03:20'
function IntervalTextToDateTime(Text: PUTF8Char): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// Interval date/time conversion from simple text
// - expected format does not match ISO-8601 Time intervals format, but Oracle
// interval litteral representation, i.e. '+/-D HH:MM:SS'
// - e.g. '+1 06:03:20' will return 1.25231481481
procedure IntervalTextToDateTimeVar(Text: PUTF8Char; var result: TDateTime);

/// basic Date/Time conversion into ISO-8601
// - use 'YYYYMMDDThhmmss' format if not Expanded
// - use 'YYYY-MM-DDThh:mm:ss' format if Expanded
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - if QuotedChar is not default #0, will (double) quote the resulted text
// - you may rather use DateTimeToIso8601Text() to handle 0 or date-only values
function DateTimeToIso8601(D: TDateTime; Expanded: boolean;
  FirstChar: AnsiChar='T'; WithMS: boolean=false; QuotedChar: AnsiChar=#0): RawUTF8; overload;

/// basic Date/Time conversion into ISO-8601
// - use 'YYYYMMDDThhmmss' format if not Expanded
// - use 'YYYY-MM-DDThh:mm:ss' format if Expanded
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - if QuotedChar is not default #0, will (double) quote the resulted text
// - you may rather use DateTimeToIso8601Text() to handle 0 or date-only values
// - returns the number of chars written to P^ buffer
function DateTimeToIso8601(P: PUTF8Char; D: TDateTime; Expanded: boolean;
  FirstChar: AnsiChar='T'; WithMS: boolean=false; QuotedChar: AnsiChar=#0): integer; overload;

/// basic Date conversion into ISO-8601
// - use 'YYYYMMDD' format if not Expanded
// - use 'YYYY-MM-DD' format if Expanded
function DateToIso8601(Date: TDateTime; Expanded: boolean): RawUTF8; overload;

/// basic Date conversion into ISO-8601
// - use 'YYYYMMDD' format if not Expanded
// - use 'YYYY-MM-DD' format if Expanded
function DateToIso8601(Y,M,D: cardinal; Expanded: boolean): RawUTF8; overload;

/// basic Date period conversion into ISO-8601
// - will convert an elapsed number of days as ISO-8601 text
// - use 'YYYYMMDD' format if not Expanded
// - use 'YYYY-MM-DD' format if Expanded
function DaysToIso8601(Days: cardinal; Expanded: boolean): RawUTF8;

/// basic Time conversion into ISO-8601
// - use 'Thhmmss' format if not Expanded
// - use 'Thh:mm:ss' format if Expanded
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
function TimeToIso8601(Time: TDateTime; Expanded: boolean; FirstChar: AnsiChar='T';
  WithMS: boolean=false): RawUTF8;

/// Write a Date to P^ Ansi buffer
// - if Expanded is false, 'YYYYMMDD' date format is used
// - if Expanded is true, 'YYYY-MM-DD' date format is used
function DateToIso8601PChar(P: PUTF8Char; Expanded: boolean; Y,M,D: PtrUInt): PUTF8Char; overload;

/// convert a date into 'YYYY-MM-DD' date format
// - resulting text is compatible with all ISO-8601 functions
function DateToIso8601Text(Date: TDateTime): RawUTF8;

/// Write a Date/Time to P^ Ansi buffer
function DateToIso8601PChar(Date: TDateTime; P: PUTF8Char; Expanded: boolean): PUTF8Char; overload;

/// Write a TDateTime value, expanded as Iso-8601 encoded text into P^ Ansi buffer
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as 'YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as 'Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as 'YYYY-MM-DDThh:mm:ss'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
function DateTimeToIso8601ExpandedPChar(const Value: TDateTime; Dest: PUTF8Char;
  FirstChar: AnsiChar='T'; WithMS: boolean=false): PUTF8Char;

/// write a TDateTime into strict ISO-8601 date and/or time text
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as 'YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as 'Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as 'YYYY-MM-DDThh:mm:ss'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - used e.g. by TPropInfo.GetValue() and TPropInfo.NormalizeValue() methods
function DateTimeToIso8601Text(DT: TDateTime; FirstChar: AnsiChar='T';
  WithMS: boolean=false): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// write a TDateTime into strict ISO-8601 date and/or time text
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as 'YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as 'Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as 'YYYY-MM-DDThh:mm:ss'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - used e.g. by TPropInfo.GetValue() and TPropInfo.NormalizeValue() methods
procedure DateTimeToIso8601TextVar(DT: TDateTime; FirstChar: AnsiChar; var result: RawUTF8;
  WithMS: boolean=false);

/// write a TDateTime into strict ISO-8601 date and/or time text
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as 'YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as 'Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as 'YYYY-MM-DDThh:mm:ss'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - used e.g. by TPropInfo.GetValue() and TPropInfo.NormalizeValue() methods
procedure DateTimeToIso8601StringVar(DT: TDateTime; FirstChar: AnsiChar; var result: string;
  WithMS: boolean=false);

/// Write a Time to P^ Ansi buffer
// - if Expanded is false, 'Thhmmss' time format is used
// - if Expanded is true, 'Thh:mm:ss' time format is used
// - you can custom the first char in from of the resulting text time
// - if WithMS is TRUE, will append MS as '.sss' for milliseconds resolution
function TimeToIso8601PChar(P: PUTF8Char; Expanded: boolean; H,M,S,MS: PtrUInt;
  FirstChar: AnsiChar = 'T'; WithMS: boolean=false): PUTF8Char; overload;

/// Write a Time to P^ Ansi buffer
// - if Expanded is false, 'Thhmmss' time format is used
// - if Expanded is true, 'Thh:mm:ss' time format is used
// - you can custom the first char in from of the resulting text time
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
function TimeToIso8601PChar(Time: TDateTime; P: PUTF8Char; Expanded: boolean;
  FirstChar: AnsiChar = 'T'; WithMS: boolean=false): PUTF8Char; overload;

var
  /// custom TTimeLog date to ready to be displayed text function
  // - you can override this pointer in order to display the text according
  // to your expected i18n settings
  // - this callback will therefore be set by the mORMoti18n.pas unit
  // - used e.g. by TTimeLogBits.i18nText and by TSQLTable.ExpandAsString()
  // methods, i.e. TSQLTableToGrid.DrawCell()
  i18nDateText: function(const Iso: TTimeLog): string = nil;
  /// custom date to ready to be displayed text function
  // - you can override this pointer in order to display the text according
  // to your expected i18n settings
  // - this callback will therefore be set by the mORMoti18n.pas unit
  // - used e.g. by TSQLTable.ExpandAsString() method,
  // i.e. TSQLTableToGrid.DrawCell()
  i18nDateTimeText: function(const DateTime: TDateTime): string = nil;

/// wrapper calling global i18nDateTimeText() callback if set,
// or returning ISO-8601 standard layout on default
function DateTimeToi18n(const DateTime: TDateTime): string;


/// fast conversion of 2 digit characters into a 0..99 value
// - returns FALSE on success, TRUE if P^ is not correct
function Char2ToByte(P: PUTF8Char; out Value: Cardinal): Boolean;

/// fast conversion of 3 digit characters into a 0..9999 value
// - returns FALSE on success, TRUE if P^ is not correct
function Char3ToWord(P: PUTF8Char; out Value: Cardinal): Boolean;

/// fast conversion of 4 digit characters into a 0..9999 value
// - returns FALSE on success, TRUE if P^ is not correct
function Char4ToWord(P: PUTF8Char; out Value: Cardinal): Boolean;

/// our own fast version of the corresponding low-level RTL function
function TryEncodeDate(Year, Month, Day: cardinal; out Date: TDateTime): Boolean;

/// our own fast version of the corresponding low-level RTL function
function IsLeapYear(Year: cardinal): boolean;
  {$ifdef HASINLINE} inline; {$endif}

/// retrieve the current Date, in the ISO 8601 layout, but expanded and
// ready to be displayed
function NowToString(Expanded: boolean=true; FirstTimeChar: AnsiChar=' '): RawUTF8;

/// retrieve the current UTC Date, in the ISO 8601 layout, but expanded and
// ready to be displayed
function NowUTCToString(Expanded: boolean=true; FirstTimeChar: AnsiChar=' '): RawUTF8;

/// convert some date/time to the ISO 8601 text layout, including milliseconds
// - i.e. 'YYYY-MM-DD hh:mm:ss.sssZ' or 'YYYYMMDD hhmmss.sssZ' format
// - TZD is the ending time zone designator ('', 'Z' or '+hh:mm' or '-hh:mm')
// - see also TTextWriter.AddDateTimeMS method
function DateTimeMSToString(DateTime: TDateTime; Expanded: boolean=true;
  FirstTimeChar: AnsiChar=' '; const TZD: RawUTF8='Z'): RawUTF8; overload;

/// convert some date/time to the ISO 8601 text layout, including milliseconds
// - i.e. 'YYYY-MM-DD hh:mm:ss.sssZ' or 'YYYYMMDD hhmmss.sssZ' format
// - TZD is the ending time zone designator ('', 'Z' or '+hh:mm' or '-hh:mm')
// - see also TTextWriter.AddDateTimeMS method
function DateTimeMSToString(HH,MM,SS,MS,Y,M,D: cardinal; Expanded: boolean;
  FirstTimeChar: AnsiChar=' '; const TZD: RawUTF8='Z'): RawUTF8; overload;

/// convert some date/time to the "HTTP-date" format as defined by RFC 7231
// - i.e. "Tue, 15 Nov 1994 12:45:26 GMT" to be used as a value of
// "Date", "Expires" or "Last-Modified" HTTP header
// - if you care about timezones Value must be converted to UTC first
// using TSynTimeZone.LocalToUtc, or tz should be properly set
function DateTimeToHTTPDate(dt: TDateTime; const tz: RawUTF8='GMT'): RawUTF8; overload;

/// convert some TDateTime to a small text layout, perfect e.g. for naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
function DateTimeToFileShort(const DateTime: TDateTime): TShort16; overload;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert some TDateTime to a small text layout, perfect e.g. for naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
procedure DateTimeToFileShort(const DateTime: TDateTime; out result: TShort16); overload;

/// retrieve the current Time (whithout Date), in the ISO 8601 layout
// - useful for direct on screen logging e.g.
function TimeToString: RawUTF8;

const
  /// a contemporary, but elapsed, TUnixTime second-based value
  // - corresponds to Thu, 08 Dec 2016 08:50:20 GMT
  // - may be used to check for a valid just-generated Unix timestamp value
  UNIXTIME_MINIMAL = 1481187020;

/// convert a second-based c-encoded time as TDateTime
//  - i.e. number of seconds elapsed since Unix epoch 1/1/1970 into TDateTime
function UnixTimeToDateTime(const UnixTime: TUnixTime): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a TDateTime into a second-based c-encoded time
//  - i.e. TDateTime into number of seconds elapsed since Unix epoch 1/1/1970
function DateTimeToUnixTime(const AValue: TDateTime): TUnixTime;
  {$ifdef HASINLINE}inline;{$endif}

/// returns the current UTC date/time as a second-based c-encoded time
// - i.e. current number of seconds elapsed since Unix epoch 1/1/1970
// - faster than NowUTC or GetTickCount64, on Windows or Unix platforms
// (will use e.g. fast clock_gettime(CLOCK_REALTIME_COARSE) under Linux,
// or GetSystemTimeAsFileTime under Windows)
// - returns a 64-bit unsigned value, so is "Year2038bug" free
function UnixTimeUTC: TUnixTime;
  {$ifndef MSWINDOWS}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// convert some second-based c-encoded time (from Unix epoch 1/1/1970) to
// the ISO 8601 text layout
// - use 'YYYYMMDDThhmmss' format if not Expanded
// - use 'YYYY-MM-DDThh:mm:ss' format if Expanded
function UnixTimeToString(const UnixTime: TUnixTime; Expanded: boolean=true;
  FirstTimeChar: AnsiChar='T'): RawUTF8;

/// convert some second-based c-encoded time (from Unix epoch 1/1/1970) to
// a small text layout, perfect e.g. for naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
procedure UnixTimeToFileShort(const UnixTime: TUnixTime; out result: TShort16); overload;

/// convert some second-based c-encoded time (from Unix epoch 1/1/1970) to
// a small text layout, perfect e.g. for naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
function UnixTimeToFileShort(const UnixTime: TUnixTime): TShort16; overload;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert some second-based c-encoded time to the ISO 8601 text layout, either
// as time or date elapsed period
// - this function won't add the Unix epoch 1/1/1970 offset to the timestamp
// - returns 'Thh:mm:ss' or 'YYYY-MM-DD' format, depending on the supplied value
function UnixTimePeriodToString(const UnixTime: TUnixTime; FirstTimeChar: AnsiChar='T'): RawUTF8;

/// returns the current UTC date/time as a millisecond-based c-encoded time
// - i.e. current number of milliseconds elapsed since Unix epoch 1/1/1970
// - faster and more accurate than NowUTC or GetTickCount64, on Windows or Unix
// - will use e.g. fast clock_gettime(CLOCK_REALTIME_COARSE) under Linux,
// or GetSystemTimeAsFileTime/GetSystemTimePreciseAsFileTime under Windows - the
// later being more accurate, but slightly slower than the former, so you may
// consider using UnixMSTimeUTCFast on Windows if its 10-16ms accuracy is enough
function UnixMSTimeUTC: TUnixMSTime;
  {$ifndef MSWINDOWS}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// returns the current UTC date/time as a millisecond-based c-encoded time
// - under Linux/POSIX, is the very same than UnixMSTimeUTC
// - under Windows 8+, will call GetSystemTimeAsFileTime instead of
// GetSystemTimePreciseAsFileTime, which has higher precision, but is slower
// - prefer it under Windows, if a dozen of ms resolution is enough for your task
function UnixMSTimeUTCFast: TUnixMSTime;
  {$ifndef MSWINDOWS}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// convert a millisecond-based c-encoded time (from Unix epoch 1/1/1970) as TDateTime
function UnixMSTimeToDateTime(const UnixMSTime: TUnixMSTime): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a TDateTime into a millisecond-based c-encoded time (from Unix epoch 1/1/1970)
// - if AValue is 0, will return 0 (since is likely to be an error constant)
function DateTimeToUnixMSTime(const AValue: TDateTime): TUnixMSTime;
  {$ifdef HASINLINE}inline;{$endif}

/// convert some millisecond-based c-encoded time (from Unix epoch 1/1/1970) to
// the ISO 8601 text layout, including milliseconds
// - i.e. 'YYYY-MM-DDThh:mm:ss.sssZ' or 'YYYYMMDDThhmmss.sssZ' format
// - TZD is the ending time zone designator ('', 'Z' or '+hh:mm' or '-hh:mm')
function UnixMSTimeToString(const UnixMSTime: TUnixMSTime; Expanded: boolean=true;
  FirstTimeChar: AnsiChar='T'; const TZD: RawUTF8=''): RawUTF8;

/// convert some milllisecond-based c-encoded time (from Unix epoch 1/1/1970) to
// a small text layout, trimming to the second resolution, perfect e.g. for
// naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
function UnixMSTimeToFileShort(const UnixMSTime: TUnixMSTime): TShort16;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert some millisecond-based c-encoded time to the ISO 8601 text layout,
// as time or date elapsed period
// - this function won't add the Unix epoch 1/1/1970 offset to the timestamp
// - returns 'Thh:mm:ss' or 'YYYY-MM-DD' format, depending on the supplied value
function UnixMSTimePeriodToString(const UnixMSTime: TUnixMSTime; FirstTimeChar: AnsiChar='T'): RawUTF8;

/// returns the current UTC system date and time
// - SysUtils.Now returns local time: this function returns the system time
// expressed in Coordinated Universal Time (UTC)
// - under Windows, will use GetSystemTimeAsFileTime() so will achieve about
// 16 ms of resolution
// - under POSIX, will call clock_gettime(CLOCK_REALTIME_COARSE)
function NowUTC: TDateTime;

{$ifndef ENHANCEDRTL}
{$ifndef LVCL} { don't define these twice }

var
  /// these procedure type must be defined if a default system.pas is used
  // - mORMoti18n.pas unit will hack default LoadResString() procedure
  // - already defined in our Extended system.pas unit
  // - needed with FPC, Delphi 2009 and up, i.e. when ENHANCEDRTL is not defined
  // - expect generic "string" type, i.e. UnicodeString for Delphi 2009+
  // - not needed with the LVCL framework (we should be on server side)
  LoadResStringTranslate: procedure(var Text: string) = nil;

  /// current LoadResString() cached entries count
  // - i.e. resourcestring caching for faster use
  // - used only if a default system.pas is used, not our Extended version
  // - defined here, but resourcestring caching itself is implemented in the
  // mORMoti18n.pas unit, if the ENHANCEDRTL conditional is not defined
  CacheResCount: integer = -1;

{$endif}
{$endif}

type
  /// a generic callback, which can be used to translate some text on the fly
  // - maps procedure TLanguageFile.Translate(var English: string) signature
  // as defined in mORMoti18n.pas
  // - can be used e.g. for TSynMustache's {{"English text}} callback
  TOnStringTranslate = procedure (var English: string) of object;


const
  /// Rotate local log file if reached this size (1MB by default)
  // - .log file will be save as .log.bak file
  // - a new .log file is created
  // - used by AppendToTextFile() and LogToTextFile() functions (not TSynLog)
  MAXLOGSIZE = 1024*1024;

/// log a message to a local text file
// - the text file is located in the executable directory, and its name is
// simply the executable file name with the '.log' extension instead of '.exe'
// - format contains the current date and time, then the Msg on one line
// - date and time format used is 'YYYYMMDD hh:mm:ss (i.e. ISO-8601)'
procedure LogToTextFile(Msg: RawUTF8);

/// log a message to a local text file
// - this version expects the filename to be specified
// - format contains the current date and time, then the Msg on one line
// - date and time format used is 'YYYYMMDD hh:mm:ss'
procedure AppendToTextFile(aLine: RawUTF8; const aFileName: TFileName; aMaxSize: Int64=MAXLOGSIZE;
  aUTCTimeStamp: boolean=false);


{ ************ fast low-level lookup types used by internal conversion routines }

{$ifndef ENHANCEDRTL}
{$ifndef LVCL} { don't define these const twice }

const
  /// fast lookup table for converting any decimal number from
  // 0 to 99 into their ASCII equivalence
  // - our enhanced SysUtils.pas (normal and LVCL) contains the same array
  TwoDigitLookup: packed array[0..99] of array[1..2] of AnsiChar =
    ('00','01','02','03','04','05','06','07','08','09',
     '10','11','12','13','14','15','16','17','18','19',
     '20','21','22','23','24','25','26','27','28','29',
     '30','31','32','33','34','35','36','37','38','39',
     '40','41','42','43','44','45','46','47','48','49',
     '50','51','52','53','54','55','56','57','58','59',
     '60','61','62','63','64','65','66','67','68','69',
     '70','71','72','73','74','75','76','77','78','79',
     '80','81','82','83','84','85','86','87','88','89',
     '90','91','92','93','94','95','96','97','98','99');

{$endif}
{$endif}

var
  /// fast lookup table for converting any decimal number from
  // 0 to 99 into their ASCII ('0'..'9') equivalence
  TwoDigitLookupW: packed array[0..99] of word absolute TwoDigitLookup;
  /// fast lookup table for converting any decimal number from
  // 0 to 99 into their byte digits (0..9) equivalence
  // - used e.g. by DoubleToAscii() implementing Grisu algorithm
  TwoDigitByteLookupW: packed array[0..99] of word;

type
  /// char categories for text line/word/identifiers/uri parsing
  TTextChar = set of (tcNot01013, tc1013, tcCtrlNotLF, tcCtrlNot0Comma,
    tcWord, tcIdentifierFirstChar, tcIdentifier, tcURIUnreserved);
  TTextCharSet = array[AnsiChar] of TTextChar;
  PTextCharSet = ^TTextCharSet;
  TTextByteSet = array[byte] of TTextChar;
  PTextByteSet = ^TTextByteSet;
var
  /// branch-less table used for text line/word/identifiers/uri parsing
  TEXT_CHARS: TTextCharSet;
  TEXT_BYTES: TTextByteSet absolute TEXT_CHARS;

{$M+} // to have existing RTTI for published properties
type
  /// used to retrieve version information from any EXE
  // - under Linux, all version numbers are set to 0 by default
  // - you should not have to use this class directly, but via the
  // ExeVersion global variable
  TFileVersion = class
  protected
    fDetailed: string;
    fFileName: TFileName;
    fBuildDateTime: TDateTime;
    /// change the version (not to be used in most cases)
    procedure SetVersion(aMajor,aMinor,aRelease,aBuild: integer);
  public
    /// executable major version number
    Major: Integer;
    /// executable minor version number
    Minor: Integer;
    /// executable release version number
    Release: Integer;
    /// executable release build number
    Build: Integer;
    /// build year of this exe file
    BuildYear: word;
    /// version info of the exe file as '3.1'
    // - return "string" type, i.e. UnicodeString for Delphi 2009+
    Main: string;
    /// associated CompanyName string version resource
    // - only available on Windows - contains '' under Linux/POSIX
    CompanyName: RawUTF8;
    /// associated FileDescription string version resource
    // - only available on Windows - contains '' under Linux/POSIX
    FileDescription: RawUTF8;
    /// associated FileVersion string version resource
    // - only available on Windows - contains '' under Linux/POSIX
    FileVersion: RawUTF8;
    /// associated InternalName string version resource
    // - only available on Windows - contains '' under Linux/POSIX
    InternalName: RawUTF8;
    /// associated LegalCopyright string version resource
    // - only available on Windows - contains '' under Linux/POSIX
    LegalCopyright: RawUTF8;
    /// associated OriginalFileName string version resource
    // - only available on Windows - contains '' under Linux/POSIX
    OriginalFilename: RawUTF8;
    /// associated ProductName string version resource
    // - only available on Windows - contains '' under Linux/POSIX
    ProductName: RawUTF8;
    /// associated ProductVersion string version resource
    // - only available on Windows - contains '' under Linux/POSIX
    ProductVersion: RawUTF8;
    /// associated Comments string version resource
    // - only available on Windows - contains '' under Linux/POSIX
    Comments: RawUTF8;
    /// retrieve application version from exe file name
    // - DefaultVersion32 is used if no information Version was included into
    // the executable resources (on compilation time)
    // - you should not have to use this constructor, but rather access the
    // ExeVersion global variable
    constructor Create(const aFileName: TFileName; aMajor: integer=0;
      aMinor: integer=0; aRelease: integer=0; aBuild: integer=0);
    /// retrieve the version as a 32-bit integer with Major.Minor.Release
    // - following Major shl 16+Minor shl 8+Release bit pattern
    function Version32: integer;
    /// build date and time of this exe file, as plain text
    function BuildDateTimeString: string;
    /// version info of the exe file as '3.1.0.123' or ''
    // - this method returns '' if Detailed is '0.0.0.0'
    function DetailedOrVoid: string;
    /// returns the version information of this exe file as text
    // - includes FileName (without path), Detailed and BuildDateTime properties
    // - e.g. 'myprogram.exe 3.1.0.123 (2016-06-14 19:07:55)'
    function VersionInfo: RawUTF8;
    /// returns a ready-to-use User-Agent header with exe name, version and OS
    // - e.g. 'myprogram/3.1.0.123W32' for myprogram running on Win32
    // - here OS_INITIAL[] character is used to identify the OS, with '32'
    // appended on Win32 only (e.g. 'myprogram/3.1.0.2W', is for Win64)
    function UserAgent: RawUTF8;
    /// returns the version information of a specified exe file as text
    // - includes FileName (without path), Detailed and BuildDateTime properties
    // - e.g. 'myprogram.exe 3.1.0.123 2016-06-14 19:07:55'
    class function GetVersionInfo(const aFileName: TFileName): RawUTF8;
  published
    /// version info of the exe file as '3.1.0.123'
    // - return "string" type, i.e. UnicodeString for Delphi 2009+
    // - under Linux, always return '0.0.0.0' if no custom version number
    // has been defined
    // - consider using DetailedOrVoid method if '0.0.0.0' is not expected
    property Detailed: string read fDetailed write fDetailed;
    /// build date and time of this exe file
    property BuildDateTime: TDateTime read fBuildDateTime write fBuildDateTime;
  end;
{$M-}


{$ifdef DELPHI6OROLDER}

// define some common constants not available prior to Delphi 7
const
  HoursPerDay   = 24;
  MinsPerHour   = 60;
  SecsPerMin    = 60;
  MSecsPerSec   = 1000;
  MinsPerDay    = HoursPerDay * MinsPerHour;
  SecsPerDay    = MinsPerDay * SecsPerMin;
  MSecsPerDay   = SecsPerDay * MSecsPerSec;
  DateDelta     = 693594;
  UnixDateDelta = 25569;

/// GetFileVersion returns the most significant 32-bit of a file's binary
// version number
// - typically, this includes the major and minor version placed
// together in one 32-bit integer
// - generally does not include the release or build numbers
// - returns Cardinal(-1) in case of failure
function GetFileVersion(const FileName: TFileName): cardinal;

{$endif DELPHI6OROLDER}

type
  /// the recognized operating systems
  // - it will also recognize some Linux distributions
  TOperatingSystem = (osUnknown, osWindows, osLinux, osOSX, osBSD, osPOSIX,
    osArch, osAurox, osDebian, osFedora, osGentoo, osKnoppix, osMint, osMandrake,
    osMandriva, osNovell, osUbuntu, osSlackware, osSolaris, osSuse, osSynology,
    osTrustix, osClear, osUnited, osRedHat, osLFS, osOracle, osMageia, osCentOS,
    osCloud, osXen, osAmazon, osCoreOS, osAlpine, osAndroid);
  /// the recognized Windows versions
  // - defined even outside MSWINDOWS to allow process e.g. from monitoring tools
  TWindowsVersion = (
    wUnknown, w2000, wXP, wXP_64, wServer2003, wServer2003_R2,
    wVista, wVista_64, wServer2008, wServer2008_64,
    wSeven, wSeven_64, wServer2008_R2, wServer2008_R2_64,
    wEight, wEight_64, wServer2012, wServer2012_64,
    wEightOne, wEightOne_64, wServer2012R2, wServer2012R2_64,
    wTen, wTen_64, wServer2016, wServer2016_64,
    wEleven, wEleven_64, wServer2019_64);
  /// the running Operating System, encoded as a 32-bit integer
  TOperatingSystemVersion = packed record
    case os: TOperatingSystem of
    osUnknown: (b: array[0..2] of byte);
    osWindows: (win: TWindowsVersion);
    osLinux:   (utsrelease: array[0..2] of byte);
  end;

const
  /// the recognized Windows versions, as plain text
  // - defined even outside MSWINDOWS to allow process e.g. from monitoring tools
  WINDOWS_NAME: array[TWindowsVersion] of RawUTF8 = (
    '', '2000', 'XP', 'XP 64bit', 'Server 2003', 'Server 2003 R2',
    'Vista', 'Vista 64bit', 'Server 2008', 'Server 2008 64bit',
    '7', '7 64bit', 'Server 2008 R2', 'Server 2008 R2 64bit',
    '8', '8 64bit', 'Server 2012', 'Server 2012 64bit',
    '8.1', '8.1 64bit', 'Server 2012 R2', 'Server 2012 R2 64bit',
    '10', '10 64bit', 'Server 2016', 'Server 2016 64bit',
    '11', '11 64bit', 'Server 2019 64bit');
  /// the recognized Windows versions which are 32-bit
  WINDOWS_32 = [w2000, wXP, wServer2003, wServer2003_R2, wVista, wServer2008,
    wSeven, wServer2008_R2, wEight, wServer2012, wEightOne, wServer2012R2,
    wTen, wServer2016, wEleven];
  /// translate one operating system (and distribution) into a single character
  // - may be used internally e.g. for a HTTP User-Agent header, as with
  // TFileVersion.UserAgent
  OS_INITIAL: array[TOperatingSystem] of AnsiChar =
    ('?', 'W', 'L', 'X', 'B', 'P', 'A', 'a', 'D', 'F', 'G', 'K', 'M', 'm',
     'n', 'N', 'U', 'S', 's', 'u', 'Y', 'T', 'C', 't', 'R', 'l', 'O', 'G',
     'c', 'd', 'x', 'Z', 'r', 'p', 'J'); // for Android ... J = Java VM
  /// the operating systems items which actually are Linux distributions
  OS_LINUX = [osLinux, osArch .. osAndroid];

  /// the compiler family used
  COMP_TEXT = {$ifdef FPC}'Fpc'{$else}'Delphi'{$endif};
  /// the target Operating System used for compilation, as text
  OS_TEXT = {$ifdef MSWINDOWS}'Win'{$else}{$ifdef DARWIN}'OSX'{$else}
  {$ifdef BSD}'BSD'{$else}{$ifdef ANDROID}'Android'{$else}{$ifdef LINUX}'Linux'{$else}'Posix'
  {$endif}{$endif}{$endif}{$endif}{$endif};
  /// the CPU architecture used for compilation
  CPU_ARCH_TEXT = {$ifdef CPUX86}'x86'{$else}{$ifdef CPUX64}'x64'{$else}
    {$ifdef CPUARM}'arm'+{$else}
    {$ifdef CPUAARCH64}'arm'+{$else}
    {$ifdef CPUPOWERPC}'ppc'+{$else}
    {$ifdef CPUSPARC}'sparc'+{$endif}{$endif}{$endif}{$endif}
    {$ifdef CPU32}'32'{$else}'64'{$endif}{$endif}{$endif};

function ToText(os: TOperatingSystem): PShortString; overload;
function ToText(const osv: TOperatingSystemVersion): ShortString; overload;
function ToTextOS(osint32: integer): RawUTF8;

var
  /// the target Operating System used for compilation, as TOperatingSystem
  // - a specific Linux distribution may be detected instead of plain osLinux
  OS_KIND: TOperatingSystem = {$ifdef MSWINDOWS}osWindows{$else}{$ifdef DARWIN}osOSX{$else}
  {$ifdef BSD}osBSD{$else}{$ifdef Android}osAndroid{$else}{$ifdef LINUX}osLinux{$else}osPOSIX
  {$endif}{$endif}{$endif}{$endif}{$endif};
  /// the current Operating System version, as retrieved for the current process
  // - contains e.g. 'Windows Seven 64 SP1 (6.1.7601)' or
  // 'Ubuntu 16.04.5 LTS - Linux 3.13.0 110 generic#157 Ubuntu SMP Mon Feb 20 11:55:25 UTC 2017'
  OSVersionText: RawUTF8;
  /// some addition system information as text, e.g. 'Wine 1.1.5'
  // - also always appended to OSVersionText high-level description
  OSVersionInfoEx: RawUTF8;
  /// some textual information about the current CPU
  CpuInfoText: RawUTF8;
  /// some textual information about the current computer hardware, from BIOS
  BiosInfoText: RawUTF8;
  /// the running Operating System
  OSVersion32: TOperatingSystemVersion;
  OSVersionInt32: integer absolute OSVersion32;

{$ifdef MSWINDOWS}
  {$ifndef UNICODE}
type
  /// low-level API structure, not defined in older Delphi versions
  TOSVersionInfoEx = record
    dwOSVersionInfoSize: DWORD;
    dwMajorVersion: DWORD;
    dwMinorVersion: DWORD;
    dwBuildNumber: DWORD;
    dwPlatformId: DWORD;
    szCSDVersion: array[0..127] of char;
    wServicePackMajor: WORD;
    wServicePackMinor: WORD;
    wSuiteMask: WORD;
    wProductType: BYTE;
    wReserved: BYTE;
  end;
  {$endif UNICODE}

var
  /// is set to TRUE if the current process is a 32-bit image running under WOW64
  // - WOW64 is the x86 emulator that allows 32-bit Windows-based applications
  // to run seamlessly on 64-bit Windows
  // - equals always FALSE if the current executable is a 64-bit image
  IsWow64: boolean;
  /// the current System information, as retrieved for the current process
  // - under a WOW64 process, it will use the GetNativeSystemInfo() new API
  // to retrieve the real top-most system information
  // - note that the lpMinimumApplicationAddress field is replaced by a
  // more optimistic/realistic value ($100000 instead of default $10000)
  // - under BSD/Linux, only contain dwPageSize and dwNumberOfProcessors fields
  SystemInfo: TSystemInfo;
  /// the current Operating System information, as retrieved for the current process
  OSVersionInfo: TOSVersionInfoEx;
  /// the current Operating System version, as retrieved for the current process
  OSVersion: TWindowsVersion;

/// this function can be used to create a GDI compatible window, able to
// receive Windows Messages for fast local communication
// - will return 0 on failure (window name already existing e.g.), or
//  the created HWND handle on success
// - it will call the supplied message handler defined for a given Windows Message:
//  for instance, define such a method in any object definition:
// !  procedure WMCopyData(var Msg : TWMCopyData); message WM_COPYDATA;
function CreateInternalWindow(const aWindowName: string; aObject: TObject): HWND;

/// delete the window resources used to receive Windows Messages
// - must be called for each CreateInternalWindow() function
// - both parameter values are then reset to ''/0
function ReleaseInternalWindow(var aWindowName: string; var aWindow: HWND): boolean;

/// under Windows 7 and later, will set an unique application-defined
// Application User Model ID (AppUserModelID) that identifies the current
// process to the taskbar
// - this identifier allows an application to group its associated processes
// and windows under a single taskbar button
// - value can have no more than 128 characters, cannot contain spaces, and
// each section should be camel-cased, as such:
// $ CompanyName.ProductName.SubProduct.VersionInformation
// CompanyName and ProductName should always be used, while the SubProduct and
// VersionInformation portions are optional and depend on the application's requirements
// - if the supplied text does not contain an '.', 'ID.ID' will be used
function SetAppUserModelID(const AppUserModelID: string): boolean;

var
  /// the number of milliseconds that have elapsed since the system was started
  // - compatibility function, to be implemented according to the running OS
  // - will use the corresponding native API function under Vista+, or
  // will emulate it for older Windows versions (XP)
  // - warning: FPC's SysUtils.GetTickCount64 or TThread.GetTickCount64 don't
  // handle properly 49 days wrapping under XP -> always use this safe version
  GetTickCount64: function: Int64; stdcall;

  /// returns the highest resolution possible UTC timestamp on this system
  // - detects newer API available since Windows 8, or fallback to good old
  // GetSystemTimeAsFileTime() which may have the resolution of the HW timer,
  // i.e. typically around 16 ms
  // - GetSystemTimeAsFileTime() is always faster, so is to be preferred
  // if second resolution is enough (e.g. for UnixTimeUTC)
  // - see http://www.windowstimestamp.com/description
  GetSystemTimePreciseAsFileTime: procedure(var ft: TFILETIME); stdcall;

/// similar to Windows sleep() API call, to be truly cross-platform
// - it should have a millisecond resolution, and handle ms=0 as a switch to
// another pending thread, i.e. under Windows will call SwitchToThread API
procedure SleepHiRes(ms: cardinal);

/// low-level wrapper to get the 64-bit value from a TFileTime
// - as recommended by MSDN to avoid dword alignment issue
procedure FileTimeToInt64(const FT: TFileTime; out I64: Int64);
  {$ifdef HASINLINE}inline;{$endif}

/// low-level conversion of a Windows 64-bit TFileTime into a Unix time seconds stamp
function FileTimeToUnixTime(const FT: TFileTime): TUnixTime;

/// low-level conversion of a Windows 64-bit TFileTime into a Unix time ms stamp
function FileTimeToUnixMSTime(const FT: TFileTime): TUnixMSTime;

type
  /// direct access to the Windows Registry
  // - could be used as alternative to TRegistry, which doesn't behave the same on
  // all Delphi versions, and is enhanced on FPC (e.g. which supports REG_MULTI_SZ)
  // - is also Unicode ready for text, using UTF-8 conversion on all compilers
  TWinRegistry = object
  public
    /// the opened HKEY handle
    key: HKEY;
    /// start low-level read access to a Windows Registry node
    // - on success (returned true), ReadClose() should be called
    function ReadOpen(root: HKEY; const keyname: RawUTF8; closefirst: boolean=false): boolean;
    /// finalize low-level read access to the Windows Registry after ReadOpen()
    procedure Close;
    /// low-level read a string from the Windows Registry after ReadOpen()
    // - in respect to Delphi's TRegistry, will properly handle REG_MULTI_SZ
    // (return the first value of the multi-list)
    function ReadString(const entry: SynUnicode; andtrim: boolean=true): RawUTF8;
    /// low-level read a Windows Registry content after ReadOpen()
    // - works with any kind of key, but was designed for REG_BINARY
    function ReadData(const entry: SynUnicode): RawByteString;
    /// low-level read a Windows Registry 32-bit REG_DWORD value after ReadOpen()
    function ReadDword(const entry: SynUnicode): cardinal;
    /// low-level read a Windows Registry 64-bit REG_QWORD value after ReadOpen()
    function ReadQword(const entry: SynUnicode): QWord;
    /// low-level enumeration of all sub-entries names of a Windows Registry key
    function ReadEnumEntries: TRawUTF8DynArray;
  end;

{$else MSWINDOWS}

var
  /// emulate only some used fields of Windows' TSystemInfo
  SystemInfo: record
    // retrieved from libc's getpagesize() - is expected to not be 0
    dwPageSize: cardinal;
    // retrieved from HW_NCPU (BSD) or /proc/cpuinfo (Linux)
    dwNumberOfProcessors: cardinal;
    // as returned by fpuname()
    uts: UtsName;
    // as from /etc/*-release
    release: RawUTF8;
  end;

{$ifdef KYLIX3}

/// compatibility function for Linux
function GetCurrentThreadID: TThreadID; cdecl;
  external 'libpthread.so.0' name 'pthread_self';

/// overloaded function using open64() to allow 64-bit positions
function FileOpen(const FileName: string; Mode: LongWord): Integer;

{$endif}

/// compatibility function, to be implemented according to the running OS
// - expect more or less the same result as the homonymous Win32 API function,
// but usually with a better resolution (Windows has only around 10-16 ms)
// - will call the corresponding function in SynKylix.pas or SynFPCLinux.pas,
// using the very fast CLOCK_MONOTONIC_COARSE if available on the kernel
function GetTickCount64: Int64;

{$endif MSWINDOWS}

/// overloaded function optimized for one pass file reading
// - will use e.g. the FILE_FLAG_SEQUENTIAL_SCAN flag under Windows, as stated
// by http://blogs.msdn.com/b/oldnewthing/archive/2012/01/20/10258690.aspx
// - note: under XP, we observed ERROR_NO_SYSTEM_RESOURCES problems when calling
// FileRead() for chunks bigger than 32MB on files opened with this flag,
// so it would use regular FileOpen() on this deprecated OS
// - under POSIX, calls plain fpOpen(FileName,O_RDONLY) which would avoid a
// syscall to fpFlock() which is not needed here
// - is used e.g. by StringFromFile() and TSynMemoryStreamMapped.Create()
function FileOpenSequentialRead(const FileName: string): Integer;
  {$ifdef HASINLINE}inline;{$endif}

/// returns a TFileStream optimized for one pass file reading
// - will use FileOpenSequentialRead(), i.e. FILE_FLAG_SEQUENTIAL_SCAN under
// Windows, and plain fpOpen(FileName, O_RDONLY) on POSIX
function FileStreamSequentialRead(const FileName: string): THandleStream;

/// check if the current timestamp, in ms, matched a given period
// - will compare the current GetTickCount64 to the supplied PreviousTix
// - returns TRUE if the Internal ms period was not elapsed
// - returns TRUE, and set PreviousTix, if the Interval ms period was elapsed
// - possible use case may be:
// !var Last: Int64;
// !...
// !  Last := GetTickCount64;
// !  repeat
// !    ...
// !    if Elapsed(Last,1000) then begin
// !      ... // do something every second
// !    end;
// !  until Terminated;
// !...
function Elapsed(var PreviousTix: Int64; Interval: Integer): Boolean;

/// thread-safe move of a 32-bit value using a simple Read-Copy-Update pattern
procedure RCU32(var src,dst);

/// thread-safe move of a 64-bit value using a simple Read-Copy-Update pattern
procedure RCU64(var src,dst);

/// thread-safe move of a 128-bit value using a simple Read-Copy-Update pattern
procedure RCU128(var src,dst);

/// thread-safe move of a pointer value using a simple Read-Copy-Update pattern
procedure RCUPtr(var src,dst);

/// thread-safe move of a memory buffer using a simple Read-Copy-Update pattern
procedure RCU(var src,dst; len: integer);

{$ifndef FPC} { FPC defines those functions as built-in }

/// compatibility function, to be implemented according to the running CPU
// - expect the same result as the homonymous Win32 API function
function InterlockedIncrement(var I: Integer): Integer;
  {$ifdef PUREPASCAL}{$ifndef MSWINDOWS}{$ifdef HASINLINE}inline;{$endif}{$endif}{$endif}

/// compatibility function, to be implemented according to the running CPU
// - expect the same result as the homonymous Win32 API function
function InterlockedDecrement(var I: Integer): Integer;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

{$endif FPC}

/// low-level string/dynarray reference counter unprocess
// - caller should have tested that refcnt>=0
// - returns true if the managed variable should be released (i.e. refcnt was 1)
// - on Delphi, RefCnt field is a 32-bit longint, whereas on FPC it is a SizeInt/PtrInt
function RefCntDecFree(var refcnt: TRefCnt): boolean;
  {$ifndef CPUINTEL}inline;{$endif}

type
  /// stores some global information about the current executable and computer
  TExeVersion = record
    /// the main executable name, without any path nor extension
    // - e.g. 'Test' for 'c:\pathto\Test.exe'
    ProgramName: RawUTF8;
    /// the main executable details, as used e.g. by TSynLog
    // - e.g. 'C:\Dev\lib\SQLite3\exe\TestSQL3.exe 1.2.3.123 (2011-03-29 11:09:06)'
    ProgramFullSpec: RawUTF8;
    /// the main executable file name (including full path)
    // - same as paramstr(0)
    ProgramFileName: TFileName;
    /// the main executable full path (excluding .exe file name)
    // - same as ExtractFilePath(paramstr(0))
    ProgramFilePath: TFileName;
    /// the full path of the running executable or library
    // - for an executable, same as paramstr(0)
    // - for a library, will contain the whole .dll file name
    InstanceFileName: TFileName;
    /// the current executable version
    Version: TFileVersion;
    /// the current computer host name
    Host: RawUTF8;
    /// the current computer user name
    User: RawUTF8;
    /// some hash representation of this information
    // - the very same executable on the very same computer run by the very
    // same user will always have the same Hash value
    // - is computed from the crc32c of this TExeVersion fields: c0 from
    // Version32, CpuFeatures and Host, c1 from User, c2 from ProgramFullSpec
    // and c3 from InstanceFileName
    // - may be used as an entropy seed, or to identify a process execution
    Hash: THash128Rec;
  end;

var
  /// global information about the current executable and computer
  // - this structure is initialized in this unit's initialization block below
  // - you can call SetExecutableVersion() with a custom version, if needed
  ExeVersion: TExeVersion;

/// initialize ExeVersion global variable, supplying a custom version number
// - by default, the version numbers will be retrieved at startup from the
// executable itself (if it was included at build time)
// - but you can use this function to set any custom version numbers
procedure SetExecutableVersion(aMajor,aMinor,aRelease,aBuild: integer); overload;

/// initialize ExeVersion global variable, supplying the version as text
// - e.g. SetExecutableVersion('7.1.2.512');
procedure SetExecutableVersion(const aVersionText: RawUTF8); overload;

type
  /// identify an operating system folder
  TSystemPath = (
    spCommonData, spUserData, spCommonDocuments, spUserDocuments, spTempFolder, spLog);

/// returns an operating system folder
// - will return the full path of a given kind of private or shared folder,
// depending on the underlying operating system
// - will use SHGetFolderPath and the corresponding CSIDL constant under Windows
// - under POSIX, will return $TMP/$TMPDIR folder for spTempFolder, ~/.cache/appname
// for spUserData, /var/log for spLog, or the $HOME folder
// - returned folder name contains the trailing path delimiter (\ or /)
function GetSystemPath(kind: TSystemPath): TFileName;

/// self-modifying code - change some memory buffer in the code segment
// - if Backup is not nil, it should point to a Size array of bytes, ready
// to contain the overridden code buffer, for further hook disabling
procedure PatchCode(Old,New: pointer; Size: integer; Backup: pointer=nil;
  LeaveUnprotected: boolean=false);

/// self-modifying code - change one PtrUInt in the code segment
procedure PatchCodePtrUInt(Code: PPtrUInt; Value: PtrUInt;
  LeaveUnprotected: boolean=false);

{$ifdef CPUINTEL}
type
  /// small memory buffer used to backup a RedirectCode() redirection hook
  TPatchCode = array[0..4] of byte;
  /// pointer to a small memory buffer used to backup a RedirectCode() hook
  PPatchCode = ^TPatchCode;

/// self-modifying code - add an asm JUMP to a redirected function
// - if Backup is not nil, it should point to a TPatchCode buffer, ready
// to contain the overridden code buffer, for further hook disabling
procedure RedirectCode(Func, RedirectFunc: Pointer; Backup: PPatchCode=nil);

/// self-modifying code - restore a code from its RedirectCode() backup
procedure RedirectCodeRestore(Func: pointer; const Backup: TPatchCode);
{$endif CPUINTEL}

type
  /// to be used instead of TMemoryStream, for speed
  // - allocates memory from Delphi heap (i.e. FastMM4/SynScaleMM)
  // and not GlobalAlloc(), as was the case for oldest versions of Delphi
  // - uses bigger growing size of the capacity
  // - consider using TRawByteStringStream, as we do in our units
{$ifdef LVCL} // LVCL already use Delphi heap instead of GlobalAlloc()
  THeapMemoryStream = TMemoryStream;
{$else}
  {$ifdef FPC} // FPC already use heap instead of GlobalAlloc()
  THeapMemoryStream = TMemoryStream;
  {$else}
  {$ifndef UNICODE} // old Delphi used GlobalAlloc()
  THeapMemoryStream = class(TMemoryStream)
  protected
    function Realloc(var NewCapacity: longint): Pointer; override;
  end;
  {$else}
  THeapMemoryStream = TMemoryStream;
  {$endif}
  {$endif}
{$endif}

var
  /// a global "Garbage collector", for some classes instances which must
  // live during whole main executable process
  // - used to avoid any memory leak with e.g. 'class var RecordProps', i.e.
  // some singleton or static objects
  // - to be used, e.g. as:
  // !  Version := TFileVersion.Create(InstanceFileName,DefaultVersion32);
  // !  GarbageCollector.Add(Version);
  // - see also GarbageCollectorFreeAndNil() as an alternative
  GarbageCollector: TSynObjectList;

  /// set to TRUE when the global "Garbage collector" are beeing freed
  GarbageCollectorFreeing: boolean;

/// a global "Garbage collector" for some TObject global variables which must
// live during whole main executable process
// - this list expects a pointer to the TObject instance variable to be
// specified, and will be set to nil (like a FreeAndNil)
// - this may be useful when used when targetting Delphi IDE packages,
// to circumvent the bug of duplicated finalization of units, in the scope
// of global variables
// - to be used, e.g. as:
// !  if SynAnsiConvertList=nil then
// !    GarbageCollectorFreeAndNil(SynAnsiConvertList,TObjectList.Create);
procedure GarbageCollectorFreeAndNil(var InstanceVariable; Instance: TObject);

/// force the global "Garbage collector" list to be released immediately
// - this function is called in the finalization section of this unit
// - you should NEVER have to call this function, unless some specific cases
// (e.g. when using Delphi packages, just before releasing the package)
procedure GarbageCollectorFree;

/// enter a giant lock for thread-safe shared process
// - shall be protected as such:
// ! GlobalLock;
// ! try
// !   .... do something thread-safe but as short as possible
// ! finally
// !  GlobalUnLock;
// ! end;
// - you should better not use such a giant-lock, but an instance-dedicated
// critical section - these functions are just here to be convenient, for
// non time-critical process
procedure GlobalLock;

/// release the giant lock for thread-safe shared process
// - you should better not use such a giant-lock, but an instance-dedicated
// critical section - these functions are just here to be convenient, for
// non time-critical process
procedure GlobalUnLock;


var
  /// JSON compatible representation of a boolean value, i.e. 'false' and 'true'
  // - can be used when a RawUTF8 string is expected
  BOOL_UTF8: array[boolean] of RawUTF8;

const
  /// JSON compatible representation of a boolean value, i.e. 'false' and 'true'
  // - can be used e.g. in logs, or anything accepting a shortstring
  BOOL_STR: array[boolean] of string[7] = ('false','true');

  /// can be used to append to most English nouns to form a plural
  // - see also the Plural function
  PLURAL_FORM: array[boolean] of RawUTF8 = ('','s');

/// write count number and append 's' (if needed) to form a plural English noun
// - for instance, Plural('row',100) returns '100 rows' with no heap allocation
function Plural(const itemname: shortstring; itemcount: cardinal): shortstring;

/// returns TRUE if the specified field name is either 'ID', either 'ROWID'
function IsRowID(FieldName: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif} overload;

/// returns TRUE if the specified field name is either 'ID', either 'ROWID'
function IsRowID(FieldName: PUTF8Char; FieldLen: integer): boolean;
  {$ifdef HASINLINE}inline;{$endif} overload;

/// returns TRUE if the specified field name is either 'ID', either 'ROWID'
function IsRowIDShort(const FieldName: shortstring): boolean;
  {$ifdef HASINLINE}inline;{$endif} overload;

/// retrieve the next SQL-like identifier within the UTF-8 buffer
// - will also trim any space (or line feeds) and trailing ';'
// - any comment like '/*nocache*/' will be ignored
// - returns true if something was set to Prop
function GetNextFieldProp(var P: PUTF8Char; var Prop: RawUTF8): boolean;

/// retrieve the next identifier within the UTF-8 buffer on the same line
// - GetNextFieldProp() will just handle line feeds (and ';') as spaces - which
// is fine e.g. for SQL, but not for regular config files with name/value pairs
// - returns true if something was set to Prop
function GetNextFieldPropSameLine(var P: PUTF8Char; var Prop: ShortString): boolean;


{ ************ variant-based process, including JSON/BSON document content }

const
  /// unsigned 64bit integer variant type
  // - currently called varUInt64 in Delphi (not defined in older versions),
  // and varQWord in FPC
  varWord64 = 21;

  /// this variant type will map the current SynUnicode type
  // - depending on the compiler version
  varSynUnicode = {$ifdef HASVARUSTRING}varUString{$else}varOleStr{$endif};

  /// this variant type will map the current string type
  // - depending on the compiler version
  varNativeString = {$ifdef UNICODE}varUString{$else}varString{$endif};

{$ifdef HASINLINE}
/// overloaded function which can be properly inlined
procedure VarClear(var v: variant); inline;
{$endif HASINLINE}

/// same as Dest := TVarData(Source) for simple values
// - will return TRUE for all simple values after varByRef unreference, and
// copying the unreferenced Source value into Dest raw storage
// - will return FALSE for not varByRef values, or complex values (e.g. string)
function SetVariantUnRefSimpleValue(const Source: variant; var Dest: TVarData): boolean;
  {$ifdef HASINLINE}inline;{$endif}

{$ifndef LVCL}

/// convert a raw binary buffer into a variant RawByteString varString
// - you can then use VariantToRawByteString() to retrieve the binary content
procedure RawByteStringToVariant(Data: PByte; DataLen: Integer; var Value: variant); overload;

/// convert a RawByteString content into a variant varString
// - you can then use VariantToRawByteString() to retrieve the binary content
procedure RawByteStringToVariant(const Data: RawByteString; var Value: variant); overload;

/// convert back a RawByteString from a variant
// - the supplied variant should have been created via a RawByteStringToVariant()
// function call
procedure VariantToRawByteString(const Value: variant; var Dest: RawByteString);

/// same as Value := Null, but slightly faster
procedure SetVariantNull(var Value: variant);
  {$ifdef HASINLINE}inline;{$endif}

const
  NullVarData: TVarData = (VType: varNull);
var
  /// a slightly faster alternative to Variants.Null function
  Null: variant absolute NullVarData;

{$endif LVCL}

/// same as VarIsEmpty(V) or VarIsEmpty(V), but faster
// - we also discovered some issues with FPC's Variants unit, so this function
// may be used even in end-user cross-compiler code
function VarIsEmptyOrNull(const V: Variant): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// same as VarIsEmpty(PVariant(V)^) or VarIsEmpty(PVariant(V)^), but faster
// - we also discovered some issues with FPC's Variants unit, so this function
// may be used even in end-user cross-compiler code
function VarDataIsEmptyOrNull(VarData: pointer): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// fastcheck if a variant hold a value
// - varEmpty, varNull or a '' string would be considered as void
// - varBoolean=false or varDate=0 would be considered as void
// - a TDocVariantData with Count=0 would be considered as void
// - any other value (e.g. integer) would be considered as not void
function VarIsVoid(const V: Variant): boolean;

/// returns a supplied string as variant, or null if v is void ('')
function VarStringOrNull(const v: RawUTF8): variant;

type
  TVarDataTypes = set of 0..255;

/// allow to check for a specific set of TVarData.VType
function VarIs(const V: Variant; const VTypes: TVarDataTypes): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

{$ifndef NOVARIANTS}

type
  /// custom variant handler with easier/faster access of variant properties,
  // and JSON serialization support
  // - default GetProperty/SetProperty methods are called via some protected
  // virtual IntGet/IntSet methods, with less overhead (to be overriden)
  // - these kind of custom variants will be faster than the default
  // TInvokeableVariantType for properties getter/setter, but you should
  // manually register each type by calling SynRegisterCustomVariantType()
  // - also feature custom JSON parsing, via TryJSONToVariant() protected method
  TSynInvokeableVariantType = class(TInvokeableVariantType)
  protected
    {$ifndef FPC}
    {$ifndef DELPHI6OROLDER}
    /// our custom call backs do not want the function names to be uppercased
    function FixupIdent(const AText: string): string; override;
    {$endif}
    {$endif}
    /// override those two abstract methods for fast getter/setter implementation
    function IntGet(var Dest: TVarData; const Instance: TVarData;
      Name: PAnsiChar; NameLen: PtrInt): boolean; virtual;
    function IntSet(const Instance, Value: TVarData;
      Name: PAnsiChar; NameLen: PtrInt): boolean; virtual;
  public
    /// search of a registered custom variant type from its low-level VarType
    // - will first compare with its own VarType for efficiency
    function FindSynVariantType(aVarType: Word; out CustomType: TSynInvokeableVariantType): boolean;
    /// customization of JSON parsing into variants
    // - will be called by e.g. by VariantLoadJSON() or GetVariantFromJSON()
    // with Options: PDocVariantOptions parameter not nil
    // - this default implementation will always returns FALSE,
    // meaning that the supplied JSON is not to be handled by this custom
    // (abstract) variant type
    // - this method could be overridden to identify any custom JSON content
    // and convert it into a dedicated variant instance, then return TRUE
    // - warning: should NOT modify JSON buffer in-place, unless it returns true
    function TryJSONToVariant(var JSON: PUTF8Char; var Value: variant;
      EndOfObject: PUTF8Char): boolean; virtual;
    /// customization of variant into JSON serialization
    procedure ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind); overload; virtual;
    /// retrieve the field/column value
    // - this method will call protected IntGet abstract method
    function GetProperty(var Dest: TVarData; const V: TVarData;
      const Name: String): Boolean; override;
    /// set the field/column value
    // - this method will call protected IntSet abstract method
    {$ifdef FPC_VARIANTSETVAR} // see http://mantis.freepascal.org/view.php?id=26773
    function SetProperty(var V: TVarData; const Name: string;
      const Value: TVarData): Boolean; override;
    {$else}
    function SetProperty(const V: TVarData; const Name: string;
      const Value: TVarData): Boolean; override;
    {$endif}
    /// clear the content
    // - this default implementation will set VType := varEmpty
    // - override it if your custom type needs to manage its internal memory
    procedure Clear(var V: TVarData); override;
    /// copy two variant content
    // - this default implementation will copy the TVarData memory
    // - override it if your custom type needs to manage its internal structure
    procedure Copy(var Dest: TVarData; const Source: TVarData;
      const Indirect: Boolean); override;
    /// copy two variant content by value
    // - this default implementation will call the Copy() method
    // - override it if your custom types may use a by reference copy pattern
    procedure CopyByValue(var Dest: TVarData; const Source: TVarData); virtual;
    /// this method will allow to look for dotted name spaces, e.g. 'parent.child'
    // - should return Unassigned if the FullName does not match any value
    // - will identify TDocVariant storage, or resolve and call the generic
    // TSynInvokeableVariantType.IntGet() method until nested value match
    procedure Lookup(var Dest: TVarData; const Instance: TVarData; FullName: PUTF8Char);
    /// will check if the value is an array, and return the number of items
    // - if the document is an array, will return the items count (0 meaning
    // void array) - used e.g. by TSynMustacheContextVariant
    // - this default implementation will return -1 (meaning this is not an array)
    // - overridden method could implement it, e.g. for TDocVariant of kind dvArray
    function IterateCount(const V: TVarData): integer; virtual;
    /// allow to loop over an array document
    // - Index should be in 0..IterateCount-1 range
    // - this default implementation will do nothing
    procedure Iterate(var Dest: TVarData; const V: TVarData; Index: integer); virtual;
    /// returns TRUE if the supplied variant is of the exact custom type
    function IsOfType(const V: variant): boolean;
      {$ifdef HASINLINE}inline;{$endif}
  end;

  /// class-reference type (metaclass) of custom variant type definition
  // - used by SynRegisterCustomVariantType() function
  TSynInvokeableVariantTypeClass = class of TSynInvokeableVariantType;

/// register a custom variant type to handle properties
// - this will implement an internal mechanism used to bypass the default
// _DispInvoke() implementation in Variant.pas, to use a faster version
// - is called in case of TSynTableVariant, TDocVariant, TBSONVariant or
// TSQLDBRowVariant
function SynRegisterCustomVariantType(aClass: TSynInvokeableVariantTypeClass): TSynInvokeableVariantType;

/// same as Dest := Source, but copying by reference
// - i.e. VType is defined as varVariant or varByRef
// - for instance, it will be used for late binding of TDocVariant properties,
// to let following statements work as expected:
// ! V := _Json('{arr:[1,2]}');
// ! V.arr.Add(3);   // will work, since V.arr will be returned by reference
// ! writeln(V);     // will write '{"arr":[1,2,3]}'
procedure SetVariantByRef(const Source: Variant; var Dest: Variant);

/// same as Dest := Source, but copying by value
// - will unreference any varByRef content
// - will convert any string value into RawUTF8 (varString) for consistency
procedure SetVariantByValue(const Source: Variant; var Dest: Variant);

/// same as FillChar(Value^,SizeOf(TVarData),0)
// - so can be used for TVarData or Variant
// - it will set V.VType := varEmpty, so Value will be Unassigned
// - it won't call VarClear(variant(Value)): it should have been cleaned before
procedure ZeroFill(Value: PVarData); {$ifdef HASINLINE}inline;{$endif}

/// fill all bytes of the value's memory buffer with zeros, i.e. 'toto' -> #0#0#0#0
// - may be used to cleanup stack-allocated content
procedure FillZero(var value: variant); overload;

/// retrieve a variant value from variable-length buffer
// - matches TFileBufferWriter.Write()
// - how custom type variants are created can be defined via CustomVariantOptions
// - is just a wrapper around VariantLoad()
procedure FromVarVariant(var Source: PByte; var Value: variant;
  CustomVariantOptions: PDocVariantOptions=nil); {$ifdef HASINLINE}inline;{$endif}

/// compute the number of bytes needed to save a Variant content
// using the VariantSave() function
// - will return 0 in case of an invalid (not handled) Variant type
function VariantSaveLength(const Value: variant): integer;

/// save a Variant content into a destination memory buffer
// - Dest must be at least VariantSaveLength() bytes long
// - will handle standard Variant types and custom types (serialized as JSON)
// - will return nil in case of an invalid (not handled) Variant type
// - will use a proprietary binary format, with some variable-length encoding
// of the string length
// - warning: will encode generic string fields as within the variant type
// itself: using this function between UNICODE and NOT UNICODE
// versions of Delphi, will propably fail - you have been warned!
function VariantSave(const Value: variant; Dest: PAnsiChar): PAnsiChar; overload;

/// save a Variant content into a binary buffer
// - will handle standard Variant types and custom types (serialized as JSON)
// - will return '' in case of an invalid (not handled) Variant type
// - just a wrapper around VariantSaveLength()+VariantSave()
// - warning: will encode generic string fields as within the variant type
// itself: using this function between UNICODE and NOT UNICODE
// versions of Delphi, will propably fail - you have been warned!
function VariantSave(const Value: variant): RawByteString; overload;

/// retrieve a variant value from our optimized binary serialization format
// - follow the data layout as used by RecordLoad() or VariantSave() function
// - return nil if the Source buffer is incorrect
// - in case of success, return the memory buffer pointer just after the
// read content
// - how custom type variants are created can be defined via CustomVariantOptions
function VariantLoad(var Value: variant; Source: PAnsiChar;
  CustomVariantOptions: PDocVariantOptions; SourceMax: PAnsiChar=nil): PAnsiChar; overload;

/// retrieve a variant value from our optimized binary serialization format
// - follow the data layout as used by RecordLoad() or VariantSave() function
// - return varEmpty if the Source buffer is incorrect
// - just a wrapper around VariantLoad()
// - how custom type variants are created can be defined via CustomVariantOptions
function VariantLoad(const Bin: RawByteString;
  CustomVariantOptions: PDocVariantOptions): variant; overload;

/// retrieve a variant value from a JSON number or string
// - follows TTextWriter.AddVariant() format (calls GetVariantFromJSON)
// - will instantiate either an Integer, Int64, currency, double or string value
// (as RawUTF8), guessing the best numeric type according to the textual content,
// and string in all other cases, except TryCustomVariants points to some options
// (e.g. @JSON_OPTIONS[true] for fast instance) and input is a known object or
// array, either encoded as strict-JSON (i.e. {..} or [..]), or with some
// extended (e.g. BSON) syntax
// - warning: the JSON buffer will be modified in-place during process - use
// a temporary copy or the overloaded functions with RawUTF8 parameter
// if you need to access it later
function VariantLoadJSON(var Value: variant; JSON: PUTF8Char;
  EndOfObject: PUTF8Char=nil; TryCustomVariants: PDocVariantOptions=nil;
  AllowDouble: boolean=false): PUTF8Char; overload;

/// retrieve a variant value from a JSON number or string
// - follows TTextWriter.AddVariant() format (calls GetVariantFromJSON)
// - will instantiate either an Integer, Int64, currency, double or string value
// (as RawUTF8), guessing the best numeric type according to the textual content,
// and string in all other cases, except TryCustomVariants points to some options
// (e.g. @JSON_OPTIONS[true] for fast instance) and input is a known object or
// array, either encoded as strict-JSON (i.e. {..} or [..]), or with some
// extended (e.g. BSON) syntax
// - this overloaded procedure will make a temporary copy before JSON parsing
// and return the variant as result
procedure VariantLoadJSON(var Value: Variant; const JSON: RawUTF8;
  TryCustomVariants: PDocVariantOptions=nil; AllowDouble: boolean=false); overload;

/// retrieve a variant value from a JSON number or string
// - follows TTextWriter.AddVariant() format (calls GetVariantFromJSON)
// - will instantiate either an Integer, Int64, currency, double or string value
// (as RawUTF8), guessing the best numeric type according to the textual content,
// and string in all other cases, except TryCustomVariants points to some options
// (e.g. @JSON_OPTIONS[true] for fast instance) and input is a known object or
// array, either encoded as strict-JSON (i.e. {..} or [..]), or with some
// extended (e.g. BSON) syntax
// - this overloaded procedure will make a temporary copy before JSON parsing
// and return the variant as result
function VariantLoadJSON(const JSON: RawUTF8;
  TryCustomVariants: PDocVariantOptions=nil; AllowDouble: boolean=false): variant; overload;

/// save a variant value into a JSON content
// - follows the TTextWriter.AddVariant() and VariantLoadJSON() format
// - is able to handle simple and custom variant types, for instance:
// !  VariantSaveJSON(1.5)='1.5'
// !  VariantSaveJSON('test')='"test"'
// !  o := _Json('{ BSON: [ "test", 5.05, 1986 ] }');
// !  VariantSaveJSON(o)='{"BSON":["test",5.05,1986]}'
// !  o := _Obj(['name','John','doc',_Obj(['one',1,'two',_Arr(['one',2])])]);
// !  VariantSaveJSON(o)='{"name":"John","doc":{"one":1,"two":["one",2]}}'
// - note that before Delphi 2009, any varString value is expected to be
// a RawUTF8 instance - which does make sense in the mORMot area
function VariantSaveJSON(const Value: variant; Escape: TTextWriterKind=twJSONEscape): RawUTF8; overload;

/// save a variant value into a JSON content
// - follows the TTextWriter.AddVariant() and VariantLoadJSON() format
// - is able to handle simple and custom variant types, for instance:
// !  VariantSaveJSON(1.5)='1.5'
// !  VariantSaveJSON('test')='"test"'
// !  o := _Json('{BSON: ["test", 5.05, 1986]}');
// !  VariantSaveJSON(o)='{"BSON":["test",5.05,1986]}'
// !  o := _Obj(['name','John','doc',_Obj(['one',1,'two',_Arr(['one',2])])]);
// !  VariantSaveJSON(o)='{"name":"John","doc":{"one":1,"two":["one",2]}}'
// - note that before Delphi 2009, any varString value is expected to be
// a RawUTF8 instance - which does make sense in the mORMot area
procedure VariantSaveJSON(const Value: variant; Escape: TTextWriterKind;
  var result: RawUTF8); overload;

/// compute the number of chars needed to save a variant value into a JSON content
// - follows the TTextWriter.AddVariant() and VariantLoadJSON() format
// - this will be much faster than length(VariantSaveJSON()) for huge content
// - note that before Delphi 2009, any varString value is expected to be
// a RawUTF8 instance - which does make sense in the mORMot area
function VariantSaveJSONLength(const Value: variant; Escape: TTextWriterKind=twJSONEscape): integer;

/// low-level function to set a variant from an unescaped JSON number or string
// - expect the JSON input buffer to be already unescaped, e.g. by GetJSONField()
// - is called e.g. by function VariantLoadJSON()
// - will instantiate either a null, boolean, Integer, Int64, currency, double
// (if AllowDouble is true or dvoAllowDoubleValue is in TryCustomVariants^) or
// string value (as RawUTF8), guessing the best numeric type according to the textual content,
// and string in all other cases, except if TryCustomVariants points to some
// options (e.g. @JSON_OPTIONS[true] for fast instance) and input is a known
// object or array, either encoded as strict-JSON (i.e. {..} or [..]),
// or with some extended (e.g. BSON) syntax
procedure GetVariantFromJSON(JSON: PUTF8Char; wasString: Boolean; var Value: variant;
  TryCustomVariants: PDocVariantOptions=nil; AllowDouble: boolean=false);

/// low-level function to set a variant from an unescaped JSON non string
// - expect the JSON input buffer to be already unescaped, e.g. by GetJSONField(),
// and having returned wasString=TRUE (i.e. not surrounded by double quotes)
// - is called e.g. by function GetVariantFromJSON()
// - will recognize null, boolean, Integer, Int64, currency, double
// (if AllowDouble is true) input, then set Value and return TRUE
// - returns FALSE if the supplied input has no expected JSON format
function GetVariantFromNotStringJSON(JSON: PUTF8Char; var Value: TVarData;
  AllowDouble: boolean): boolean;

/// identify either varInt64, varDouble, varCurrency types following JSON format
// - any non valid number is returned as varString
// - is used e.g. by GetVariantFromJSON() to guess the destination variant type
// - warning: supplied JSON is expected to be not nil
function TextToVariantNumberType(JSON: PUTF8Char): cardinal;

/// identify either varInt64 or varCurrency types following JSON format
// - this version won't return varDouble, i.e. won't handle more than 4 exact
// decimals (as varCurrency), nor scientific notation with exponent (1.314e10)
// - this will ensure that any incoming JSON will converted back with its exact
// textual representation, without digit truncation due to limited precision
// - any non valid number is returned as varString
// - is used e.g. by GetVariantFromJSON() to guess the destination variant type
// - warning: supplied JSON is expected to be not nil
function TextToVariantNumberTypeNoDouble(JSON: PUTF8Char): cardinal;

/// low-level function to set a numerical variant from an unescaped JSON number
// - returns TRUE if TextToVariantNumberType/TextToVariantNumberTypeNoDouble(JSON)
// identified it as a number and set Value to the corresponding content
// - returns FALSE if JSON is a string, or null/true/false
function GetNumericVariantFromJSON(JSON: PUTF8Char; var Value: TVarData;
  AllowVarDouble: boolean): boolean;

/// convert the next CSV item from an UTF-8 encoded text buffer
// into a variant number or RawUTF8 varString
// - first try with GetNumericVariantFromJSON(), then fallback to RawUTF8ToVariant
// - is a wrapper around GetNextItem() + TextToVariant()
function GetNextItemToVariant(var P: PUTF8Char; out Value: Variant;
  Sep: AnsiChar= ','; AllowDouble: boolean=true): boolean;

/// retrieve a variant value from a JSON buffer as per RFC 8259, RFC 7159, RFC 7158
// - follows TTextWriter.AddVariant() format (calls GetVariantFromJSON)
// - will instantiate either an Integer, Int64, currency, double or string value
// (as RawUTF8), guessing the best numeric type according to the textual content,
// and string in all other cases, except TryCustomVariants points to some options
// (e.g. @JSON_OPTIONS[true] for fast instance) and input is a known object or
// array, either encoded as strict-JSON (i.e. {..} or [..]), or with some
// extended (e.g. BSON) syntax
// - warning: the JSON buffer will be modified in-place during process - use
// a temporary copy or the overloaded functions with RawUTF8 parameter
// if you need to access it later
procedure JSONToVariantInPlace(var Value: Variant; JSON: PUTF8Char;
  Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty];
  AllowDouble: boolean=false);

/// retrieve a variant value from a JSON UTF-8 text as per RFC 8259, RFC 7159, RFC 7158
// - follows TTextWriter.AddVariant() format (calls GetVariantFromJSON)
// - will instantiate either an Integer, Int64, currency, double or string value
// (as RawUTF8), guessing the best numeric type according to the textual content,
// and string in all other cases, except TryCustomVariants points to some options
// (e.g. @JSON_OPTIONS[true] for fast instance) and input is a known object or
// array, either encoded as strict-JSON (i.e. {..} or [..]), or with some
// extended (e.g. BSON) syntax
// - this overloaded procedure will make a temporary copy before JSON parsing
// and return the variant as result
function JSONToVariant(const JSON: RawUTF8;
  Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty];
  AllowDouble: boolean=false): variant;

/// convert an UTF-8 encoded text buffer into a variant number or RawUTF8 varString
// - first try with GetNumericVariantFromJSON(), then fallback to RawUTF8ToVariant
procedure TextToVariant(const aValue: RawUTF8; AllowVarDouble: boolean;
  out aDest: variant);

/// convert an UTF-8 encoded text buffer into a variant RawUTF8 varString
procedure RawUTF8ToVariant(Txt: PUTF8Char; TxtLen: integer; var Value: variant); overload;

/// convert an UTF-8 encoded string into a variant RawUTF8 varString
procedure RawUTF8ToVariant(const Txt: RawUTF8; var Value: variant); overload;

/// convert a FormatUTF8() UTF-8 encoded string into a variant RawUTF8 varString
procedure FormatUTF8ToVariant(const Fmt: RawUTF8; const Args: array of const; var Value: variant);

/// convert an UTF-8 encoded string into a variant RawUTF8 varString
function RawUTF8ToVariant(const Txt: RawUTF8): variant; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an UTF-8 encoded text buffer into a variant RawUTF8 varString
// - this overloaded version expects a destination variant type (e.g. varString
// varOleStr / varUString) - if the type is not handled, will raise an
// EVariantTypeCastError
procedure RawUTF8ToVariant(const Txt: RawUTF8; var Value: TVarData;
  ExpectedValueType: cardinal); overload;

/// convert an open array (const Args: array of const) argument to a variant
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
procedure VarRecToVariant(const V: TVarRec; var result: variant); overload;

/// convert an open array (const Args: array of const) argument to a variant
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
function VarRecToVariant(const V: TVarRec): variant; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a variant to an open array (const Args: array of const) argument
// - will always map to a vtVariant kind of argument
procedure VariantToVarRec(const V: variant; var result: TVarRec);
  {$ifdef HASINLINE}inline;{$endif}

/// convert a dynamic array of variants into its JSON serialization
// - will use a TDocVariantData temporary storage
function VariantDynArrayToJSON(const V: TVariantDynArray): RawUTF8;

/// convert a JSON array into a dynamic array of variants
// - will use a TDocVariantData temporary storage
function JSONToVariantDynArray(const JSON: RawUTF8): TVariantDynArray;

/// convert an open array list into a dynamic array of variants
// - will use a TDocVariantData temporary storage
function ValuesToVariantDynArray(const items: array of const): TVariantDynArray;

type
  /// pointer to a TDocVariant storage
  // - since variants may be stored by reference (i.e. as varByRef), it may
  // be a good idea to use such a pointer via DocVariantData(aVariant)^ or
  // _Safe(aVariant)^ instead of TDocVariantData(aVariant),
  // if you are not sure how aVariant was allocated (may be not _Obj/_Json)
  PDocVariantData = ^TDocVariantData;

  /// a custom variant type used to store any JSON/BSON document-based content
  // - i.e. name/value pairs for objects, or an array of values (including
  // nested documents), stored in a TDocVariantData memory structure
  // - you can use _Obj()/_ObjFast() _Arr()/_ArrFast() _Json()/_JsonFast() or
  // _JsonFmt()/_JsonFastFmt() functions to create instances of such variants
  // - property access may be done via late-binding - with some restrictions
  // for older versions of FPC, e.g. allowing to write:
  // ! TDocVariant.NewFast(aVariant);
  // ! aVariant.Name := 'John';
  // ! aVariant.Age := 35;
  // ! writeln(aVariant.Name,' is ',aVariant.Age,' years old');
  // - it also supports a small set of pseudo-properties or pseudo-methods:
  // ! aVariant._Count = DocVariantData(aVariant).Count
  // ! aVariant._Kind = ord(DocVariantData(aVariant).Kind)
  // ! aVariant._JSON = DocVariantData(aVariant).JSON
  // ! aVariant._(i) = DocVariantData(aVariant).Value[i]
  // ! aVariant.Value(i) = DocVariantData(aVariant).Value[i]
  // ! aVariant.Value(aName) = DocVariantData(aVariant).Value[aName]
  // ! aVariant.Name(i) = DocVariantData(aVariant).Name[i]
  // ! aVariant.Add(aItem) = DocVariantData(aVariant).AddItem(aItem)
  // ! aVariant._ := aItem = DocVariantData(aVariant).AddItem(aItem)
  // ! aVariant.Add(aName,aValue) = DocVariantData(aVariant).AddValue(aName,aValue)
  // ! aVariant.Exists(aName) = DocVariantData(aVariant).GetValueIndex(aName)>=0
  // ! aVariant.Delete(i) = DocVariantData(aVariant).Delete(i)
  // ! aVariant.Delete(aName) = DocVariantData(aVariant).Delete(aName)
  // ! aVariant.NameIndex(aName) = DocVariantData(aVariant).GetValueIndex(aName)
  // - it features direct JSON serialization/unserialization, e.g.:
  // ! assert(_Json('["one",2,3]')._JSON='["one",2,3]');
  // - it features direct trans-typing into a string encoded as JSON, e.g.:
  // ! assert(_Json('["one",2,3]')='["one",2,3]');
  TDocVariant = class(TSynInvokeableVariantType)
  protected
    /// name and values interning are shared among all TDocVariantData instances
    fInternNames, fInternValues: TRawUTF8Interning;
    /// fast getter/setter implementation
    function IntGet(var Dest: TVarData; const Instance: TVarData;
      Name: PAnsiChar; NameLen: PtrInt): boolean; override;
    function IntSet(const Instance, Value: TVarData; Name: PAnsiChar; NameLen: PtrInt): boolean; override;
  public
    /// initialize a variant instance to store some document-based content
    // - by default, every internal value will be copied, so access of nested
    // properties can be slow - if you expect the data to be read-only or not
    // propagated into another place, set aOptions=[dvoValueCopiedByReference]
    // will increase the process speed a lot
    class procedure New(out aValue: variant;
      aOptions: TDocVariantOptions=[]); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// initialize a variant instance to store per-reference document-based content
    // - same as New(aValue,JSON_OPTIONS[true]);
    // - to be used e.g. as
    // !var v: variant;
    // !begin
    // !  TDocVariant.NewFast(v);
    // !  ...
    class procedure NewFast(out aValue: variant); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// ensure a variant is a TDocVariant instance
    // - if aValue is not a TDocVariant, will create a new JSON_OPTIONS[true]
    class procedure IsOfTypeOrNewFast(var aValue: variant);
    /// initialize several variant instances to store document-based content
    // - replace several calls to TDocVariantData.InitFast
    // - to be used e.g. as
    // !var v1,v2,v3: TDocVariantData;
    // !begin
    // !  TDocVariant.NewFast([@v1,@v2,@v3]);
    // !  ...
    class procedure NewFast(const aValues: array of PDocVariantData); overload;
    /// initialize a variant instance to store some document-based content
    // - you can use this function to create a variant, which can be nested into
    // another document, e.g.:
    // ! aVariant := TDocVariant.New;
    // ! aVariant.id := 10;
    // - by default, every internal value will be copied, so access of nested
    // properties can be slow - if you expect the data to be read-only or not
    // propagated into another place, set Options=[dvoValueCopiedByReference]
    // will increase the process speed a lot
    // - in practice, you should better use _Obj()/_ObjFast() _Arr()/_ArrFast()
    // functions or TDocVariant.NewFast()
    class function New(Options: TDocVariantOptions=[]): variant; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// initialize a variant instance to store some document-based object content
    // - object will be initialized with data supplied two by two, as Name,Value
    // pairs, e.g.
    // ! aVariant := TDocVariant.NewObject(['name','John','year',1972]);
    // which is the same as:
    // ! TDocVariant.New(aVariant);
    // ! TDocVariantData(aVariant).AddValue('name','John');
    // ! TDocVariantData(aVariant).AddValue('year',1972);
    // - by default, every internal value will be copied, so access of nested
    // properties can be slow - if you expect the data to be read-only or not
    // propagated into another place, set Options=[dvoValueCopiedByReference]
    // will increase the process speed a lot
    // - in practice, you should better use the function _Obj() which is a
    // wrapper around this class method
    class function NewObject(const NameValuePairs: array of const;
      Options: TDocVariantOptions=[]): variant;
    /// initialize a variant instance to store some document-based array content
    // - array will be initialized with data supplied as parameters, e.g.
    // ! aVariant := TDocVariant.NewArray(['one',2,3.0]);
    // which is the same as:
    // ! TDocVariant.New(aVariant);
    // ! TDocVariantData(aVariant).AddItem('one');
    // ! TDocVariantData(aVariant).AddItem(2);
    // ! TDocVariantData(aVariant).AddItem(3.0);
    // - by default, every internal value will be copied, so access of nested
    // properties can be slow - if you expect the data to be read-only or not
    // propagated into another place, set aOptions=[dvoValueCopiedByReference]
    // will increase the process speed a lot
    // - in practice, you should better use the function _Arr() which is a
    // wrapper around this class method
    class function NewArray(const Items: array of const;
      Options: TDocVariantOptions=[]): variant; overload;
    /// initialize a variant instance to store some document-based array content
    // - array will be initialized with data supplied dynamic array of variants
    class function NewArray(const Items: TVariantDynArray;
      Options: TDocVariantOptions=[]): variant; overload;
    /// initialize a variant instance to store some document-based object content
    // from a supplied (extended) JSON content
    // - in addition to the JSON RFC specification strict mode, this method will
    // handle some BSON-like extensions, e.g. unquoted field names
    // - a private copy of the incoming JSON buffer will be used, then
    // it will call the TDocVariantData.InitJSONInPlace() method
    // - to be used e.g. as:
    // ! var V: variant;
    // ! begin
    // !   V := TDocVariant.NewJSON('{"id":10,"doc":{"name":"John","birthyear":1972}}');
    // !   assert(V.id=10);
    // !   assert(V.doc.name='John');
    // !   assert(V.doc.birthYear=1972);
    // !   // and also some pseudo-properties:
    // !   assert(V._count=2);
    // !   assert(V.doc._kind=ord(dvObject));
    // - or with a JSON array:
    // !   V := TDocVariant.NewJSON('["one",2,3]');
    // !   assert(V._kind=ord(dvArray));
    // !   for i := 0 to V._count-1 do
    // !     writeln(V._(i));
    // - by default, every internal value will be copied, so access of nested
    // properties can be slow - if you expect the data to be read-only or not
    // propagated into another place, add dvoValueCopiedByReference in Options
    // will increase the process speed a lot
    // - in practice, you should better use the function _Json()/_JsonFast()
    // which are handy wrappers around this class method
    class function NewJSON(const JSON: RawUTF8;
      Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty]): variant;
      {$ifdef HASINLINE}inline;{$endif}
    /// initialize a variant instance to store some document-based object content
    // from a supplied existing TDocVariant instance
    // - use it on a value returned as varByRef (e.g. by _() pseudo-method),
    // to ensure the returned variant will behave as a stand-alone value
    // - for instance, the following:
    // !  oSeasons := TDocVariant.NewUnique(o.Seasons);
    // is the same as:
    // ! 	oSeasons := o.Seasons;
    // !  _Unique(oSeasons);
    // or even:
    // !  oSeasons := _Copy(o.Seasons);
    class function NewUnique(const SourceDocVariant: variant;
      Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty]): variant;
      {$ifdef HASINLINE}inline;{$endif}
    /// will return the unique element of a TDocVariant array or a default
    // - if the value is a dvArray with one single item, it will this value
    // - if the value is not a TDocVariant nor a dvArray with one single item,
    // it wil return the default value
    class procedure GetSingleOrDefault(const docVariantArray, default: variant;
      var result: variant);

    /// finalize the stored information
    destructor Destroy; override;
    /// used by dvoInternNames for string interning of all Names[] values
    function InternNames: TRawUTF8Interning; {$ifdef HASINLINE}inline;{$endif}
    /// used by dvoInternValues for string interning of all RawUTF8 Values[]
    function InternValues: TRawUTF8Interning; {$ifdef HASINLINE}inline;{$endif}
    // this implementation will write the content as JSON object or array
    procedure ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind); override;
    /// will check if the value is an array, and return the number of items
    // - if the document is an array, will return the items count (0 meaning
    // void array) - used e.g. by TSynMustacheContextVariant
    // - this overridden method will implement it for dvArray instance kind
    function IterateCount(const V: TVarData): integer; override;
    /// allow to loop over an array document
    // - Index should be in 0..IterateCount-1 range
    // - this default implementation will do handle dvArray instance kind
    procedure Iterate(var Dest: TVarData; const V: TVarData; Index: integer); override;
    /// low-level callback to access internal pseudo-methods
    // - mainly the _(Index: integer): variant method to retrieve an item
    // if the document is an array
    function DoFunction(var Dest: TVarData; const V: TVarData;
      const Name: string; const Arguments: TVarDataArray): Boolean; override;
    /// low-level callback to clear the content
    procedure Clear(var V: TVarData); override;
    /// low-level callback to copy two variant content
    // - such copy will by default be done by-value, for safety
    // - if you are sure you will use the variants as read-only, you can set
    // the dvoValueCopiedByReference Option to use faster by-reference copy
    procedure Copy(var Dest: TVarData; const Source: TVarData;
      const Indirect: Boolean); override;
    /// copy two variant content by value
    // - overridden method since instance may use a by-reference copy pattern
    procedure CopyByValue(var Dest: TVarData; const Source: TVarData); override;
    /// handle type conversion
    // - only types processed by now are string/OleStr/UnicodeString/date
    procedure Cast(var Dest: TVarData; const Source: TVarData); override;
    /// handle type conversion
    // - only types processed by now are string/OleStr/UnicodeString/date
    procedure CastTo(var Dest: TVarData; const Source: TVarData;
      const AVarType: TVarType); override;
    /// compare two variant values
    // - it uses case-sensitive text comparison of the JSON representation
    // of each variant (including TDocVariant instances)
    procedure Compare(const Left, Right: TVarData;
      var Relationship: TVarCompareResult); override;
  end;

  /// define the TDocVariant storage layout
  // - if it has one or more named properties, it is a dvObject
  // - if it has no name property, it is a dvArray
  TDocVariantKind = (dvUndefined, dvObject, dvArray);

  /// method used by TDocVariantData.ReduceAsArray to filter each object
  // - should return TRUE if the item match the expectations
  TOnReducePerItem = function(Item: PDocVariantData): boolean of object;

  /// method used by TDocVariantData.ReduceAsArray to filter each object
  // - should return TRUE if the item match the expectations
  TOnReducePerValue = function(const Value: variant): boolean of object;

  {$A-} { packet object not allowed since Delphi 2009 :( }
  /// memory structure used for TDocVariant storage of any JSON/BSON
  // document-based content as variant
  // - i.e. name/value pairs for objects, or an array of values (including
  // nested documents)
  // - you can use _Obj()/_ObjFast() _Arr()/_ArrFast() _Json()/_JsonFast() or
  // _JsonFmt()/_JsonFastFmt() functions to create instances of such variants
  // - you can transtype such an allocated variant into TDocVariantData
  // to access directly its internals (like Count or Values[]/Names[]):
  // ! aVariantObject := TDocVariant.NewObject(['name','John','year',1972]);
  // ! aVariantObject := _ObjFast(['name','John','year',1972]);
  // ! with _Safe(aVariantObject)^ do
  // !   for i := 0 to Count-1 do
  // !     writeln(Names[i],'=',Values[i]); // for an object
  // ! aVariantArray := TDocVariant.NewArray(['one',2,3.0]);
  // ! aVariantArray := _JsonFast('["one",2,3.0]');
  // ! with _Safe(aVariantArray)^ do
  // !   for i := 0 to Count-1 do
  // !     writeln(Values[i]); // for an array
  // - use "with _Safe(...)^ do"  and not "with TDocVariantData(...) do" as the
  // former will handle internal variant redirection (varByRef), e.g. from late
  // binding or assigned another TDocVariant
  // - Delphi "object" is buggy on stack -> also defined as record with methods
  {$ifdef USERECORDWITHMETHODS}TDocVariantData = record
  {$else}TDocVariantData = object {$endif}
  private
    VType: TVarType;
    VOptions: TDocVariantOptions;
    (* this structure uses all TVarData available space: no filler needed!
    {$HINTS OFF} // does not complain if Filler is declared but never used
    Filler: array[1..SizeOf(TVarData)-SizeOf(TVarType)-SizeOf(TDocVariantOptions)-
      SizeOf(TDocVariantKind)-SizeOf(TRawUTF8DynArray)-SizeOf(TVariantDynArray)-
      SizeOf(integer)] of byte;
    {$HINTS ON} *)
    VName: TRawUTF8DynArray;
    VValue: TVariantDynArray;
    VCount: integer;
    // retrieve the value as varByRef
    function GetValueOrItem(const aNameOrIndex: variant): variant;
    procedure SetValueOrItem(const aNameOrIndex, aValue: variant);
    function GetKind: TDocVariantKind; {$ifdef HASINLINE}inline;{$endif}
    procedure SetOptions(const opt: TDocVariantOptions); // keep dvoIsObject/Array
      {$ifdef HASINLINE}inline;{$endif}
    procedure SetCapacity(aValue: integer);
    function GetCapacity: integer;
      {$ifdef HASINLINE}inline;{$endif}
    // implement U[] I[] B[] D[] O[] O_[] A[] A_[] _[] properties
    function GetOrAddIndexByName(const aName: RawUTF8): integer;
      {$ifdef HASINLINE}inline;{$endif}
    function GetOrAddPVariantByName(const aName: RawUTF8): PVariant;
      {$ifdef HASINLINE}inline;{$endif}
    function GetPVariantByName(const aName: RawUTF8): PVariant;
    function GetRawUTF8ByName(const aName: RawUTF8): RawUTF8;
    procedure SetRawUTF8ByName(const aName, aValue: RawUTF8);
    function GetStringByName(const aName: RawUTF8): string;
    procedure SetStringByName(const aName: RawUTF8; const aValue: string);
    function GetInt64ByName(const aName: RawUTF8): Int64;
    procedure SetInt64ByName(const aName: RawUTF8; const aValue: Int64);
    function GetBooleanByName(const aName: RawUTF8): Boolean;
    procedure SetBooleanByName(const aName: RawUTF8; aValue: Boolean);
    function GetDoubleByName(const aName: RawUTF8): Double;
    procedure SetDoubleByName(const aName: RawUTF8; const aValue: Double);
    function GetDocVariantExistingByName(const aName: RawUTF8;
      aNotMatchingKind: TDocVariantKind): PDocVariantData;
    function GetObjectExistingByName(const aName: RawUTF8): PDocVariantData;
    function GetDocVariantOrAddByName(const aName: RawUTF8;
      aKind: TDocVariantKind): PDocVariantData;
    function GetObjectOrAddByName(const aName: RawUTF8): PDocVariantData;
    function GetArrayExistingByName(const aName: RawUTF8): PDocVariantData;
    function GetArrayOrAddByName(const aName: RawUTF8): PDocVariantData;
    function GetAsDocVariantByIndex(aIndex: integer): PDocVariantData;
  public
    /// initialize a TDocVariantData to store some document-based content
    // - can be used with a stack-allocated TDocVariantData variable:
    // !var Doc: TDocVariantData; // stack-allocated variable
    // !begin
    // !  Doc.Init;
    // !  Doc.AddValue('name','John');
    // !  assert(Doc.Value['name']='John');
    // !  assert(variant(Doc).name='John');
    // !end;
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure Init(aOptions: TDocVariantOptions=[]; aKind: TDocVariantKind=dvUndefined);
    /// initialize a TDocVariantData to store per-reference document-based content
    // - same as Doc.Init(JSON_OPTIONS[true]);
    // - can be used with a stack-allocated TDocVariantData variable:
    // !var Doc: TDocVariantData; // stack-allocated variable
    // !begin
    // !  Doc.InitFast;
    // !  Doc.AddValue('name','John');
    // !  assert(Doc.Value['name']='John');
    // !  assert(variant(Doc).name='John');
    // !end;
    // - see also TDocVariant.NewFast() if you want to initialize several
    // TDocVariantData variable instances at once
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitFast; overload;
    /// initialize a TDocVariantData to store per-reference document-based content
    // - this overloaded method allows to specify an estimation of how many
    // properties or items this aKind document would contain
    procedure InitFast(InitialCapacity: integer; aKind: TDocVariantKind); overload;
    /// initialize a TDocVariantData to store document-based object content
    // - object will be initialized with data supplied two by two, as Name,Value
    // pairs, e.g.
    // !var Doc: TDocVariantData; // stack-allocated variable
    // !begin
    // !  Doc.InitObject(['name','John','year',1972]);
    // which is the same as:
    // ! var Doc: TDocVariantData;
    // !begin
    // !  Doc.Init;
    // !  Doc.AddValue('name','John');
    // !  Doc.AddValue('year',1972);
    // - this method is called e.g. by _Obj() and _ObjFast() global functions
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitObject(const NameValuePairs: array of const;
      aOptions: TDocVariantOptions=[]);
    /// initialize a variant instance to store some document-based array content
    // - array will be initialized with data supplied as parameters, e.g.
    // !var Doc: TDocVariantData; // stack-allocated variable
    // !begin
    // !  Doc.InitArray(['one',2,3.0]);
    // !  assert(Doc.Count=3);
    // !end;
    // which is the same as:
    // ! var Doc: TDocVariantData;
    // !     i: integer;
    // !begin
    // !  Doc.Init;
    // !  Doc.AddItem('one');
    // !  Doc.AddItem(2);
    // !  Doc.AddItem(3.0);
    // !  assert(Doc.Count=3);
    // !  for i := 0 to Doc.Count-1 do
    // !    writeln(Doc.Value[i]);
    // !end;
    // - this method is called e.g. by _Arr() and _ArrFast() global functions
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitArray(const Items: array of const;
      aOptions: TDocVariantOptions=[]);
    /// initialize a variant instance to store some document-based array content
    // - array will be initialized with data supplied as variant dynamic array
    // - if Items is [], the variant will be set as null
    // - will be almost immediate, since TVariantDynArray is reference-counted,
    // unless ItemsCopiedByReference is set to FALSE
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitArrayFromVariants(const Items: TVariantDynArray;
      aOptions: TDocVariantOptions=[]; ItemsCopiedByReference: boolean=true);
    /// initialize a variant instance to store some RawUTF8 array content
    procedure InitArrayFrom(const Items: TRawUTF8DynArray; aOptions: TDocVariantOptions); overload;
    /// initialize a variant instance to store some 32-bit integer array content
    procedure InitArrayFrom(const Items: TIntegerDynArray; aOptions: TDocVariantOptions); overload;
    /// initialize a variant instance to store some 64-bit integer array content
    procedure InitArrayFrom(const Items: TInt64DynArray; aOptions: TDocVariantOptions); overload;
    /// initialize a variant instance to store a T*ObjArray content
    // - will call internally ObjectToVariant() to make the conversion
    procedure InitArrayFromObjArray(const ObjArray; aOptions: TDocVariantOptions;
      aWriterOptions: TTextWriterWriteObjectOptions=[woDontStoreDefault]);
    /// initialize a variant instance to store document-based array content
    // - array will be initialized from the supplied variable (which would be
    // e.g. a T*ObjArray or a dynamic array), using RTTI
    // - will use a temporary JSON serialization via SaveJSON()
    procedure InitFromTypeInfo(const aValue; aTypeInfo: pointer;
      aEnumSetsAsText: boolean; aOptions: TDocVariantOptions);
    /// initialize a variant instance to store some document-based object content
    // - object will be initialized with names and values supplied as dynamic arrays
    // - if aNames and aValues are [] or do have matching sizes, the variant
    // will be set as null
    // - will be almost immediate, since Names and Values are reference-counted
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitObjectFromVariants(const aNames: TRawUTF8DynArray;
       const aValues: TVariantDynArray; aOptions: TDocVariantOptions=[]);
    /// initialize a variant instance to store a document-based object with a
    // single property
    // - the supplied path could be 'Main.Second.Third', to create nested
    // objects, e.g. {"Main":{"Second":{"Third":value}}}
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitObjectFromPath(const aPath: RawUTF8; const aValue: variant;
      aOptions: TDocVariantOptions=[]);
    /// initialize a variant instance to store some document-based object content
    // from a supplied JSON array or JSON object content
    // - warning: the incoming JSON buffer will be modified in-place: so you should
    // make a private copy before running this method, e.g. using TSynTempBuffer
    // - this method is called e.g. by _JsonFmt() _JsonFastFmt() global functions
    // with a temporary JSON buffer content created from a set of parameters
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    function InitJSONInPlace(JSON: PUTF8Char;
      aOptions: TDocVariantOptions=[]; aEndOfObject: PUTF8Char=nil): PUTF8Char;
    /// initialize a variant instance to store some document-based object content
    // from a supplied JSON array of JSON object content
    // - a private copy of the incoming JSON buffer will be used, then
    // it will call the other overloaded InitJSONInPlace() method
    // - this method is called e.g. by _Json() and _JsonFast() global functions
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    function InitJSON(const JSON: RawUTF8; aOptions: TDocVariantOptions=[]): boolean;
    /// initialize a variant instance to store some document-based object content
    // from a JSON array of JSON object content, stored in a file
    // - any kind of file encoding will be handled, via AnyTextFileToRawUTF8()
    // - you can optionally remove any comment from the file content
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    function InitJSONFromFile(const JsonFile: TFileName; aOptions: TDocVariantOptions=[];
      RemoveComments: boolean=false): boolean;
    /// ensure a document-based variant instance will have one unique options set
    // - this will create a copy of the supplied TDocVariant instance, forcing
    // all nested events to have the same set of Options
    // - you can use this function to ensure that all internal properties of this
    // variant will be copied e.g. per-reference (if you set JSON_OPTIONS[false])
    // or per-value (if you set JSON_OPTIONS[false]) whatever options the nested
    // objects or arrays were created with
    // - will raise an EDocVariant if the supplied variant is not a TDocVariant
    // - you may rather use _Unique() or _UniqueFast() wrappers if you want to
    // ensure that a TDocVariant instance is unique
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitCopy(const SourceDocVariant: variant; aOptions: TDocVariantOptions);
    /// initialize a variant instance to store some document-based object content
    // from a supplied CSV UTF-8 encoded text
    // - the supplied content may have been generated by ToTextPairs() method
    // - if ItemSep=#10, then any kind of line feed (CRLF or LF) will be handled
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitCSV(CSV: PUTF8Char; aOptions: TDocVariantOptions;
      NameValueSep: AnsiChar='='; ItemSep: AnsiChar=#10; DoTrim: boolean=true); overload;
    /// initialize a variant instance to store some document-based object content
    // from a supplied CSV UTF-8 encoded text
    // - the supplied content may have been generated by ToTextPairs() method
    // - if ItemSep=#10, then any kind of line feed (CRLF or LF) will be handled
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitCSV(const CSV: RawUTF8; aOptions: TDocVariantOptions;
      NameValueSep: AnsiChar='='; ItemSep: AnsiChar=#10; DoTrim: boolean=true); overload;
      {$ifdef HASINLINE}inline;{$endif}

    /// to be called before any Init*() method call, when a previous Init*()
    // has already be performed on the same instance, to avoid memory leaks
    // - for instance:
    // !var Doc: TDocVariantData; // stack-allocated variable
    // !begin
    // !  Doc.InitArray(['one',2,3.0]); // no need of any Doc.Clear here
    // !  assert(Doc.Count=3);
    // !  Doc.Clear; // to release memory before following InitObject()
    // !  Doc.InitObject(['name','John','year',1972]);
    // !end;
    // - implemented as just a wrapper around DocVariantType.Clear()
    procedure Clear;
    /// delete all internal stored values
    // - like Clear + Init() with the same options
    // - will reset Kind to dvUndefined
    procedure Reset;
    /// fill all Values[] with #0, then delete all values
    // - could be used to specifically remove sensitive information from memory
    procedure FillZero;
    /// low-level method to force a number of items
    // - could be used to fast add items to the internal Values[]/Names[] arrays
    // - just set protected VCount field, do not resize the arrays: caller
    // should ensure that Capacity is big enough
    procedure SetCount(aCount: integer); {$ifdef HASINLINE}inline;{$endif}
    /// low-level method called internally to reserve place for new values
    // - returns the index of the newly created item in Values[]/Names[] arrays
    // - you should not have to use it, unless you want to add some items
    // directly within the Values[]/Names[] arrays, using e.g.
    // InitFast(InitialCapacity) to initialize the document
    // - if aName='', append a dvArray item, otherwise append a dvObject field
    // - warning: FPC optimizer is confused by Values[InternalAdd(name)] so
    // you should call InternalAdd() in an explicit previous step
    function InternalAdd(const aName: RawUTF8): integer;

    /// save a document as UTF-8 encoded JSON
    // - will write either a JSON object or array, depending of the internal
    // layout of this instance (i.e. Kind property value)
    // - will write  'null'  if Kind is dvUndefined
    // - implemented as just a wrapper around VariantSaveJSON()
    function ToJSON(const Prefix: RawUTF8=''; const Suffix: RawUTF8='';
      Format: TTextWriterJSONFormat=jsonCompact): RawUTF8;
    /// save an array of objects as UTF-8 encoded non expanded layout JSON
    // - returned content would be a JSON object in mORMot's TSQLTable non
    // expanded format, with reduced JSON size, i.e.
    // $ {"fieldCount":3,"values":["ID","FirstName","LastName",...']}
    // - will write '' if Kind is dvUndefined or dvObject
    // - will raise an exception if the array document is not an array of
    // objects with identical field names
    function ToNonExpandedJSON: RawUTF8;
    /// save a document as an array of UTF-8 encoded JSON
    // - will expect the document to be a dvArray - otherwise, will raise a
    // EDocVariant exception
    // - will use VariantToUTF8() to populate the result array: as a consequence,
    // any nested custom variant types (e.g. TDocVariant) will be stored as JSON
    procedure ToRawUTF8DynArray(out Result: TRawUTF8DynArray); overload;
    /// save a document as an array of UTF-8 encoded JSON
    // - will expect the document to be a dvArray - otherwise, will raise a
    // EDocVariant exception
    // - will use VariantToUTF8() to populate the result array: as a consequence,
    // any nested custom variant types (e.g. TDocVariant) will be stored as JSON
    function ToRawUTF8DynArray: TRawUTF8DynArray; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// save a document as an CSV of UTF-8 encoded JSON
    // - will expect the document to be a dvArray - otherwise, will raise a
    // EDocVariant exception
    // - will use VariantToUTF8() to populate the result array: as a consequence,
    // any nested custom variant types (e.g. TDocVariant) will be stored as JSON
    function ToCSV(const Separator: RawUTF8=','): RawUTF8;
    /// save a document as UTF-8 encoded Name=Value pairs
    // - will follow by default the .INI format, but you can specify your
    // own expected layout
    procedure ToTextPairsVar(out result: RawUTF8; const NameValueSep: RawUTF8='=';
      const ItemSep: RawUTF8=#13#10; Escape: TTextWriterKind=twJSONEscape);
    /// save a document as UTF-8 encoded Name=Value pairs
    // - will follow by default the .INI format, but you can specify your
    // own expected layout
    function ToTextPairs(const NameValueSep: RawUTF8='=';
      const ItemSep: RawUTF8=#13#10; Escape: TTextWriterKind=twJSONEscape): RawUTF8;
      {$ifdef HASINLINE}inline;{$endif}
    /// save an array document as an array of TVarRec, i.e. an array of const
    // - will expect the document to be a dvArray - otherwise, will raise a
    // EDocVariant exception
    // - would allow to write code as such:
    // !  Doc.InitArray(['one',2,3]);
    // !  Doc.ToArrayOfConst(vr);
    // !  s := FormatUTF8('[%,%,%]',vr,[],true);
    // !  // here s='[one,2,3]') since % would be replaced by Args[] parameters
    // !  s := FormatUTF8('[?,?,?]',[],vr,true);
    // !  // here s='["one",2,3]') since ? would be escaped by Params[] parameters
    procedure ToArrayOfConst(out Result: TTVarRecDynArray); overload;
    /// save an array document as an array of TVarRec, i.e. an array of const
    // - will expect the document to be a dvArray - otherwise, will raise a
    // EDocVariant exception
    // - would allow to write code as such:
    // !  Doc.InitArray(['one',2,3]);
    // !  s := FormatUTF8('[%,%,%]',Doc.ToArrayOfConst,[],true);
    // !  // here s='[one,2,3]') since % would be replaced by Args[] parameters
    // !  s := FormatUTF8('[?,?,?]',[],Doc.ToArrayOfConst,true);
    // !  // here s='["one",2,3]') since ? would be escaped by Params[] parameters
    function ToArrayOfConst: TTVarRecDynArray; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// save an object document as an URI-encoded list of parameters
    // - object field names should be plain ASCII-7 RFC compatible identifiers
    // (0..9a..zA..Z_.~), otherwise their values are skipped
    function ToUrlEncode(const UriRoot: RawUTF8): RawUTF8;

    /// find an item index in this document from its name
    // - search will follow dvoNameCaseSensitive option of this document
    // - lookup the value by name for an object document, or accept an integer
    // text as index for an array document
    // - returns -1 if not found
    function GetValueIndex(const aName: RawUTF8): integer; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// find an item index in this document from its name
    // - lookup the value by name for an object document, or accept an integer
    // text as index for an array document
    // - returns -1 if not found
    function GetValueIndex(aName: PUTF8Char; aNameLen: PtrInt; aCaseSensitive: boolean): integer; overload;
    /// find an item in this document, and returns its value
    // - raise an EDocVariant if not found and dvoReturnNullForUnknownProperty
    // is not set in Options (in this case, it will return Null)
    function GetValueOrRaiseException(const aName: RawUTF8): variant;
    /// find an item in this document, and returns its value
    // - return the supplied default if aName is not found, or if the instance
    // is not a TDocVariant
    function GetValueOrDefault(const aName: RawUTF8; const aDefault: variant): variant;
    /// find an item in this document, and returns its value
    // - return null if aName is not found, or if the instance is not a TDocVariant
    function GetValueOrNull(const aName: RawUTF8): variant;
    /// find an item in this document, and returns its value
    // - return a cleared variant if aName is not found, or if the instance is
    // not a TDocVariant
    function GetValueOrEmpty(const aName: RawUTF8): variant;
    /// find an item in this document, and returns its value as enumerate
    // - return false if aName is not found, if the instance is not a TDocVariant,
    // or if the value is not a string corresponding to the supplied enumerate
    // - return true if the name has been found, and aValue stores the value
    // - will call Delete() on the found entry, if aDeleteFoundEntry is true
    function GetValueEnumerate(const aName: RawUTF8; aTypeInfo: pointer;
      out aValue; aDeleteFoundEntry: boolean=false): Boolean;
    /// returns a TDocVariant object containing all properties matching the
    // first characters of the supplied property name
    // - returns null if the document is not a dvObject
    // - will use IdemPChar(), so search would be case-insensitive
    function GetValuesByStartName(const aStartName: RawUTF8;
      TrimLeftStartName: boolean=false): variant;
    /// returns a JSON object containing all properties matching the
    // first characters of the supplied property name
    // - returns null if the document is not a dvObject
    // - will use IdemPChar(), so search would be case-insensitive
    function GetJsonByStartName(const aStartName: RawUTF8): RawUTF8;
    /// find an item in this document, and returns its value as TVarData
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true and set aValue if the name has been found
    // - will use simple loop lookup to identify the name, unless aSortedCompare is
    // set, and would let use a faster O(log(n)) binary search after a SortByName()
    function GetVarData(const aName: RawUTF8; var aValue: TVarData;
      aSortedCompare: TUTF8Compare=nil): boolean; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// find an item in this document, and returns its value as TVarData pointer
    // - return nil if aName is not found, or if the instance is not a TDocVariant
    // - return a pointer to the value if the name has been found
    // - after a SortByName(aSortedCompare), could use faster binary search
    function GetVarData(const aName: RawUTF8;
      aSortedCompare: TUTF8Compare=nil): PVarData; overload;
    /// find an item in this document, and returns its value as boolean
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found, and aValue stores the value
    // - after a SortByName(aSortedCompare), could use faster binary search
    // - consider using B[] property if you want simple read/write typed access
    function GetAsBoolean(const aName: RawUTF8; out aValue: boolean;
      aSortedCompare: TUTF8Compare=nil): Boolean;
    /// find an item in this document, and returns its value as integer
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found, and aValue stores the value
    // - after a SortByName(aSortedCompare), could use faster binary search
    // - consider using I[] property if you want simple read/write typed access
    function GetAsInteger(const aName: RawUTF8; out aValue: integer;
      aSortedCompare: TUTF8Compare=nil): Boolean;
    /// find an item in this document, and returns its value as integer
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found, and aValue stores the value
    // - after a SortByName(aSortedCompare), could use faster binary search
    // - consider using I[] property if you want simple read/write typed access
    function GetAsInt64(const aName: RawUTF8; out aValue: Int64;
      aSortedCompare: TUTF8Compare=nil): Boolean;
    /// find an item in this document, and returns its value as floating point
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found, and aValue stores the value
    // - after a SortByName(aSortedCompare), could use faster binary search
    // - consider using D[] property if you want simple read/write typed access
    function GetAsDouble(const aName: RawUTF8; out aValue: double;
      aSortedCompare: TUTF8Compare=nil): Boolean;
    /// find an item in this document, and returns its value as RawUTF8
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found, and aValue stores the value
    // - after a SortByName(aSortedCompare), could use faster binary search
    // - consider using U[] property if you want simple read/write typed access
    function GetAsRawUTF8(const aName: RawUTF8; out aValue: RawUTF8;
      aSortedCompare: TUTF8Compare=nil): Boolean;
    /// find an item in this document, and returns its value as a TDocVariantData
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found and points to a TDocVariant:
    // then aValue stores a pointer to the value
    // - after a SortByName(aSortedCompare), could use faster binary search
    function GetAsDocVariant(const aName: RawUTF8; out aValue: PDocVariantData;
      aSortedCompare: TUTF8Compare=nil): boolean; overload;
    /// find an item in this document, and returns its value as a TDocVariantData
    // - returns a void TDocVariant if aName is not a document
    // - after a SortByName(aSortedCompare), could use faster binary search
    // - consider using O[] or A[] properties if you want simple read-only
    // access, or O_[] or A_[] properties if you want the ability to add
    // a missing object or array in the document
    function GetAsDocVariantSafe(const aName: RawUTF8;
      aSortedCompare: TUTF8Compare=nil): PDocVariantData;
    /// find an item in this document, and returns pointer to its value
    // - return false if aName is not found
    // - return true if the name has been found: then aValue stores a pointer
    // to the value
    // - after a SortByName(aSortedCompare), could use faster binary search
    function GetAsPVariant(const aName: RawUTF8; out aValue: PVariant;
      aSortedCompare: TUTF8Compare=nil): boolean; overload; {$ifdef HASINLINE}inline;{$endif}
    /// find an item in this document, and returns pointer to its value
    // - lookup the value by aName/aNameLen for an object document, or accept
    // an integer text as index for an array document
    // - return nil if aName is not found, or if the instance is not a TDocVariant
    // - return a pointer to the stored variant, if the name has been found
    function GetAsPVariant(aName: PUTF8Char; aNameLen: PtrInt): PVariant; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// retrieve a value, given its path
    // - path is defined as a dotted name-space, e.g. 'doc.glossary.title'
    // - it will return Unassigned if the path does match the supplied aPath
    function GetValueByPath(const aPath: RawUTF8): variant; overload;
    /// retrieve a value, given its path
    // - path is defined as a dotted name-space, e.g. 'doc.glossary.title'
    // - it will return FALSE if the path does not match the supplied aPath
    // - returns TRUE and set the found value in aValue
    function GetValueByPath(const aPath: RawUTF8; out aValue: variant): boolean; overload;
    /// retrieve a value, given its path
    // - path is defined as a list of names, e.g. ['doc','glossary','title']
    // - it will return Unassigned if the path does not match the data
    // - this method will only handle nested TDocVariant values: use the
    // slightly slower GetValueByPath() overloaded method, if any nested object
    // may be of another type (e.g. a TBSONVariant)
    function GetValueByPath(const aDocVariantPath: array of RawUTF8): variant; overload;
    /// retrieve a reference to a value, given its path
    // - path is defined as a dotted name-space, e.g. 'doc.glossary.title'
    // - if the supplied aPath does not match any object, it will return nil
    // - if aPath is found, returns a pointer to the corresponding value
    function GetPVariantByPath(const aPath: RawUTF8): PVariant;
    /// retrieve a reference to a TDocVariant, given its path
    // - path is defined as a dotted name-space, e.g. 'doc.glossary.title'
    // - if the supplied aPath does not match any object, it will return false
    // - if aPath stores a valid TDocVariant, returns true and a pointer to it
    function GetDocVariantByPath(const aPath: RawUTF8; out aValue: PDocVariantData): boolean;
    /// retrieve a dvObject in the dvArray, from a property value
    // - {aPropName:aPropValue} will be searched within the stored array,
    // and the corresponding item will be copied into Dest, on match
    // - returns FALSE if no match is found, TRUE if found and copied
    // - create a copy of the variant by default, unless DestByRef is TRUE
    // - will call VariantEquals() for value comparison
    function GetItemByProp(const aPropName,aPropValue: RawUTF8;
      aPropValueCaseSensitive: boolean; var Dest: variant; DestByRef: boolean=false): boolean;
    /// retrieve a reference to a dvObject in the dvArray, from a property value
    // - {aPropName:aPropValue} will be searched within the stored array,
    // and the corresponding item will be copied into Dest, on match
    // - returns FALSE if no match is found, TRUE if found and copied by reference
    function GetDocVariantByProp(const aPropName,aPropValue: RawUTF8;
      aPropValueCaseSensitive: boolean; out Dest: PDocVariantData): boolean;
    /// find an item in this document, and returns its value
    // - raise an EDocVariant if not found and dvoReturnNullForUnknownProperty
    // is not set in Options (in this case, it will return Null)
    // - create a copy of the variant by default, unless DestByRef is TRUE
    function RetrieveValueOrRaiseException(aName: PUTF8Char; aNameLen: integer;
      aCaseSensitive: boolean; var Dest: variant; DestByRef: boolean): boolean; overload;
    /// retrieve an item in this document from its index, and returns its value
    // - raise an EDocVariant if the supplied Index is not in the 0..Count-1
    // range and dvoReturnNullForUnknownProperty is set in Options
    // - create a copy of the variant by default, unless DestByRef is TRUE
    procedure RetrieveValueOrRaiseException(Index: integer;
     var Dest: variant; DestByRef: boolean); overload;
    /// retrieve an item in this document from its index, and returns its Name
    // - raise an EDocVariant if the supplied Index is not in the 0..Count-1
    // range and dvoReturnNullForUnknownProperty is set in Options
    procedure RetrieveNameOrRaiseException(Index: integer; var Dest: RawUTF8);
    /// set an item in this document from its index
    // - raise an EDocVariant if the supplied Index is not in 0..Count-1 range
    procedure SetValueOrRaiseException(Index: integer; const NewValue: variant);

    /// add a value in this document
    // - if aName is set, if dvoCheckForDuplicatedNames option is set, any
    // existing duplicated aName will raise an EDocVariant; if instance's
    // kind is dvArray and aName is defined, it will raise an EDocVariant
    // - aName may be '' e.g. if you want to store an array: in this case,
    // dvoCheckForDuplicatedNames option should not be set; if instance's Kind
    // is dvObject, it will raise an EDocVariant exception
    // - if aValueOwned is true, then the supplied aValue will be assigned to
    // the internal values - by default, it will use SetVariantByValue()
    // - you can therefore write e.g.:
    // ! TDocVariant.New(aVariant);
    // ! Assert(TDocVariantData(aVariant).Kind=dvUndefined);
    // ! TDocVariantData(aVariant).AddValue('name','John');
    // ! Assert(TDocVariantData(aVariant).Kind=dvObject);
    // - returns the index of the corresponding newly added value
    function AddValue(const aName: RawUTF8; const aValue: variant;
      aValueOwned: boolean=false): integer; overload;
    /// add a value in this document
    // - overloaded function accepting a UTF-8 encoded buffer for the name
    function AddValue(aName: PUTF8Char; aNameLen: integer; const aValue: variant;
      aValueOwned: boolean=false): integer; overload;
    /// add a value in this document, or update an existing entry
    // - if instance's Kind is dvArray, it will raise an EDocVariant exception
    // - any existing Name would be updated with the new Value, unless
    // OnlyAddMissing is set to TRUE, in which case existing values would remain
    // - returns the index of the corresponding value, which may be just added
    function AddOrUpdateValue(const aName: RawUTF8; const aValue: variant;
      wasAdded: PBoolean=nil; OnlyAddMissing: boolean=false): integer;
    /// add a value in this document, from its text representation
    // - this function expects a UTF-8 text for the value, which would be
    // converted to a variant number, if possible (as varInt/varInt64/varCurrency
    // and/or as varDouble is AllowVarDouble is set)
    // - if Update=TRUE, will set the property, even if it is existing
    function AddValueFromText(const aName,aValue: RawUTF8; Update: boolean=false;
      AllowVarDouble: boolean=false): integer;
    /// add some properties to a TDocVariantData dvObject
    // - data is supplied two by two, as Name,Value pairs
    // - caller should ensure that Kind=dvObject, otherwise it won't do anything
    // - any existing Name would be duplicated
    procedure AddNameValuesToObject(const NameValuePairs: array of const);
    /// merge some properties to a TDocVariantData dvObject
    // - data is supplied two by two, as Name,Value pairs
    // - caller should ensure that Kind=dvObject, otherwise it won't do anything
    // - any existing Name would be updated with the new Value
    procedure AddOrUpdateNameValuesToObject(const NameValuePairs: array of const);
    /// merge some TDocVariantData dvObject properties to a TDocVariantData dvObject
    // - data is supplied two by two, as Name,Value pairs
    // - caller should ensure that both variants have Kind=dvObject, otherwise
    // it won't do anything
    // - any existing Name would be updated with the new Value, unless
    // OnlyAddMissing is set to TRUE, in which case existing values would remain
    procedure AddOrUpdateObject(const NewValues: variant; OnlyAddMissing: boolean=false;
      RecursiveUpdate: boolean=false);
    /// add a value to this document, handled as array
    // - if instance's Kind is dvObject, it will raise an EDocVariant exception
    // - you can therefore write e.g.:
    // ! TDocVariant.New(aVariant);
    // ! Assert(TDocVariantData(aVariant).Kind=dvUndefined);
    // ! TDocVariantData(aVariant).AddItem('one');
    // ! Assert(TDocVariantData(aVariant).Kind=dvArray);
    // - returns the index of the corresponding newly added item
    function AddItem(const aValue: variant): integer;
    /// add a value to this document, handled as array, from its text representation
    // - this function expects a UTF-8 text for the value, which would be
    // converted to a variant number, if possible (as varInt/varInt64/varCurrency
    // unless AllowVarDouble is set)
    // - if instance's Kind is dvObject, it will raise an EDocVariant exception
    // - returns the index of the corresponding newly added item
    function AddItemFromText(const aValue: RawUTF8;
      AllowVarDouble: boolean=false): integer;
    /// add a RawUTF8 value to this document, handled as array
    // - if instance's Kind is dvObject, it will raise an EDocVariant exception
    // - returns the index of the corresponding newly added item
    function AddItemText(const aValue: RawUTF8): integer;
    /// add one or several values to this document, handled as array
    // - if instance's Kind is dvObject, it will raise an EDocVariant exception
    procedure AddItems(const aValue: array of const);
    /// add one or several values from another document
    // - supplied document should be of the same kind than the current one,
    // otherwise nothing is added
    procedure AddFrom(const aDocVariant: Variant);
    /// add or update or on several valeus from another object
    // - current document should be an object
    procedure AddOrUpdateFrom(const aDocVariant: Variant; aOnlyAddMissing: boolean=false);
    /// add one or several properties, specified by path, from another object
    // - path are defined as a dotted name-space, e.g. 'doc.glossary.title'
    // - matching values would be added as root values, with the path as name
    // - instance and supplied aSource should be a dvObject
    procedure AddByPath(const aSource: TDocVariantData; const aPaths: array of RawUTF8);
    /// delete a value/item in this document, from its index
    // - return TRUE on success, FALSE if the supplied index is not correct
    function Delete(Index: integer): boolean; overload;
    /// delete a value/item in this document, from its name
    // - return TRUE on success, FALSE if the supplied name does not exist
    function Delete(const aName: RawUTF8): boolean; overload;
    /// delete a value in this document, by property name match
    // - {aPropName:aPropValue} will be searched within the stored array or
    // object, and the corresponding item will be deleted, on match
    // - returns FALSE if no match is found, TRUE if found and deleted
    // - will call VariantEquals() for value comparison
    function DeleteByProp(const aPropName,aPropValue: RawUTF8;
      aPropValueCaseSensitive: boolean): boolean;
    /// delete one or several value/item in this document, from its value
    // - returns the number of deleted items
    // - returns 0 if the document is not a dvObject, or if no match was found
    // - if the value exists several times, all occurences would be removed
    // - is optimized for DeleteByValue(null) call
    function DeleteByValue(const aValue: Variant; CaseInsensitive: boolean=false): integer;
    /// delete all values matching the first characters of a property name
    // - returns the number of deleted items
    // - returns 0 if the document is not a dvObject, or if no match was found
    // - will use IdemPChar(), so search would be case-insensitive
    function DeleteByStartName(aStartName: PUTF8Char; aStartNameLen: integer): integer;
    /// search a property match in this document, handled as array or object
    // - {aPropName:aPropValue} will be searched within the stored array or
    // object, and the corresponding item index will be returned, on match
    // - returns -1 if no match is found
    // - will call VariantEquals() for value comparison
    function SearchItemByProp(const aPropName,aPropValue: RawUTF8;
      aPropValueCaseSensitive: boolean): integer; overload;
    /// search a property match in this document, handled as array or object
    // - {aPropName:aPropValue} will be searched within the stored array or
    // object, and the corresponding item index will be returned, on match
    // - returns -1 if no match is found
    // - will call VariantEquals() for value comparison
    function SearchItemByProp(const aPropNameFmt: RawUTF8; const aPropNameArgs: array of const;
      const aPropValue: RawUTF8; aPropValueCaseSensitive: boolean): integer; overload;
    /// search a value in this document, handled as array
    // - aValue will be searched within the stored array
    // and the corresponding item index will be returned, on match
    // - returns -1 if no match is found
    // - you could make several searches, using the StartIndex optional parameter
    function SearchItemByValue(const aValue: Variant;
      CaseInsensitive: boolean=false; StartIndex: integer=0): integer;
    /// sort the document object values by name
    // - do nothing if the document is not a dvObject
    // - will follow case-insensitive order (@StrIComp) by default, but you
    // can specify @StrComp as comparer function for case-sensitive ordering
    // - once sorted, you can use GetVarData(..,Compare) or GetAs*(..,Compare)
    // methods for much faster O(log(n)) binary search
    procedure SortByName(Compare: TUTF8Compare=nil);
    /// sort the document object values by value
    // - work for both dvObject and dvArray documents
    // - will sort by UTF-8 text (VariantCompare) if no custom aCompare is supplied
    procedure SortByValue(Compare: TVariantCompare = nil);
    /// sort the document array values by a field of some stored objet values
    // - do nothing if the document is not a dvArray, or if the items are no dvObject
    // - will sort by UTF-8 text (VariantCompare) if no custom aValueCompare is supplied
    procedure SortArrayByField(const aItemPropName: RawUTF8;
      aValueCompare: TVariantCompare=nil; aValueCompareReverse: boolean=false;
      aNameSortedCompare: TUTF8Compare=nil);
    /// reverse the order of the document object or array items
    procedure Reverse;
    /// create a TDocVariant object, from a selection of properties of this
    // document, by property name
    // - if the document is a dvObject, to reduction will be applied to all
    // its properties
    // - if the document is a dvArray, the reduction will be applied to each
    // stored item, if it is a document
    procedure Reduce(const aPropNames: array of RawUTF8; aCaseSensitive: boolean;
      out result: TDocVariantData; aDoNotAddVoidProp: boolean=false); overload;
    /// create a TDocVariant object, from a selection of properties of this
    // document, by property name
    // - always returns a TDocVariantData, even if no property name did match
    // (in this case, it is dvUndefined)
    function Reduce(const aPropNames: array of RawUTF8; aCaseSensitive: boolean;
      aDoNotAddVoidProp: boolean=false): variant; overload;
    /// create a TDocVariant array, from the values of a single properties of
    // this document, specified by name
    // - you can optionally apply an additional filter to each reduced item
    procedure ReduceAsArray(const aPropName: RawUTF8; out result: TDocVariantData;
      OnReduce: TOnReducePerItem=nil); overload;
    /// create a TDocVariant array, from the values of a single properties of
    // this document, specified by name
    // - always returns a TDocVariantData, even if no property name did match
    // (in this case, it is dvUndefined)
    // - you can optionally apply an additional filter to each reduced item
    function ReduceAsArray(const aPropName: RawUTF8; OnReduce: TOnReducePerItem=nil): variant; overload;
    /// create a TDocVariant array, from the values of a single properties of
    // this document, specified by name
    // - this overloaded method accepts an additional filter to each reduced item
    procedure ReduceAsArray(const aPropName: RawUTF8; out result: TDocVariantData;
      OnReduce: TOnReducePerValue); overload;
    /// create a TDocVariant array, from the values of a single properties of
    // this document, specified by name
    // - always returns a TDocVariantData, even if no property name did match
    // (in this case, it is dvUndefined)
    // - this overloaded method accepts an additional filter to each reduced item
    function ReduceAsArray(const aPropName: RawUTF8; OnReduce: TOnReducePerValue): variant; overload;
    /// rename some properties of a TDocVariant object
    // - returns the number of property names modified
    function Rename(const aFromPropName, aToPropName: TRawUTF8DynArray): integer;
    /// map {"obj.prop1"..,"obj.prop2":..} into {"obj":{"prop1":..,"prop2":...}}
    // - the supplied aObjectPropName should match the incoming dotted value
    // of all properties (e.g. 'obj' for "obj.prop1")
    // - if any of the incoming property is not of "obj.prop#" form, the
    // whole process would be ignored
    // - return FALSE if the TDocVariant did not change
    // - return TRUE if the TDocVariant has been flattened
    function FlattenAsNestedObject(const aObjectPropName: RawUTF8): boolean;

    /// how this document will behave
    // - those options are set when creating the instance
    // - dvoArray and dvoObject are not options, but define the document Kind,
    // so those items are ignored when assigned to this property
    property Options: TDocVariantOptions read VOptions write SetOptions;
    /// returns the document internal layout
    // - just after initialization, it will return dvUndefined
    // - most of the time, you will add named values with AddValue() or by
    // setting the variant properties: it will return dvObject
    // - but is you use AddItem(), values will have no associated names: the
    // document will be a dvArray
    // - value computed from the dvoArray and dvoObject presence in Options
    property Kind: TDocVariantKind read GetKind;
    /// return the custom variant type identifier, i.e. DocVariantType.VarType
    property VarType: word read VType;
    /// number of items stored in this document
    // - is 0 if Kind=dvUndefined
    // - is the number of name/value pairs for Kind=dvObject
    // - is the number of items for Kind=dvArray
    property Count: integer read VCount;
    /// the current capacity of this document
    // - allow direct access to VValue[] length
    property Capacity: integer read GetCapacity write SetCapacity;
    /// direct acces to the low-level internal array of values
    // - transtyping a variant and direct access to TDocVariantData is the
    // fastest way of accessing all properties of a given dvObject:
    // ! with TDocVariantData(aVariantObject) do
    // !   for i := 0 to Count-1 do
    // !     writeln(Names[i],'=',Values[i]);
    // - or to access a dvArray items (e.g. a MongoDB collection):
    // ! with TDocVariantData(aVariantArray) do
    // !   for i := 0 to Count-1 do
    // !     writeln(Values[i]);
    property Values: TVariantDynArray read VValue;
    /// direct acces to the low-level internal array of names
    // - is void (nil) if Kind is not dvObject
    // - transtyping a variant and direct access to TDocVariantData is the
    // fastest way of accessing all properties of a given dvObject:
    // ! with TDocVariantData(aVariantObject) do
    // !   for i := 0 to Count-1 do
    // !     writeln(Names[i],'=',Values[i]);
    property Names: TRawUTF8DynArray read VName;
    /// find an item in this document, and returns its value
    // - raise an EDocVariant if aNameOrIndex is neither an integer nor a string
    // - raise an EDocVariant if Kind is dvArray and aNameOrIndex is a string
    // or if Kind is dvObject and aNameOrIndex is an integer
    // - raise an EDocVariant if Kind is dvObject and if aNameOrIndex is a
    // string, which is not found within the object property names and
    // dvoReturnNullForUnknownProperty is set in Options
    // - raise an EDocVariant if Kind is dvArray and if aNameOrIndex is a
    // integer, which is not within 0..Count-1 and dvoReturnNullForUnknownProperty
    // is set in Options
    // - so you can use directly:
    // ! // for an array document:
    // ! aVariant := TDocVariant.NewArray(['one',2,3.0]);
    // ! for i := 0 to TDocVariantData(aVariant).Count-1 do
    // !   aValue := TDocVariantData(aVariant).Value[i];
    // ! // for an object document:
    // ! aVariant := TDocVariant.NewObject(['name','John','year',1972]);
    // ! assert(aVariant.Name=TDocVariantData(aVariant)['name']);
    // ! assert(aVariant.year=TDocVariantData(aVariant)['year']);
    // - due to the internal implementation of variant execution (somewhat
    // slow _DispInvoke() function), it is a bit faster to execute:
    // ! aValue := TDocVariantData(aVariant).Value['name'];
    // instead of
    // ! aValue := aVariant.name;
    // but of course, if want to want to access the content by index (typically
    // for a dvArray), using Values[] - and Names[] - properties is much faster
    // than this variant-indexed pseudo-property:
    // ! with TDocVariantData(aVariant) do
    // !   for i := 0 to Count-1 do
    // !     Writeln(Values[i]);
    // is faster than:
    // ! with TDocVariantData(aVariant) do
    // !   for i := 0 to Count-1 do
    // !     Writeln(Value[i]);
    // which is faster than:
    // ! for i := 0 to aVariant.Count-1 do
    // !   Writeln(aVariant._(i));
    // - this property will return the value as varByRef (just like with
    // variant late binding of any TDocVariant instance), so you can write:
    // !var Doc: TDocVariantData; // stack-allocated variable
    // !begin
    // !  Doc.InitJSON('{arr:[1,2]}');
    // !  assert(Doc.Count=2);
    // !  Doc.Value['arr'].Add(3);  // works since Doc.Value['arr'] is varByRef
    // !  writeln(Doc.ToJSON);      // will write '{"arr":[1,2,3]}'
    // !end;
    // - if you want to access a property as a copy, i.e. to assign it to a
    // variant variable which will stay alive after this TDocVariant instance
    // is release, you should not use Value[] but rather
    // GetValueOrRaiseException or GetValueOrNull/GetValueOrEmpty
    // - see U[] I[] B[] D[] O[] O_[] A[] A_[] _[] properties for direct access
    // of strong typed values
    property Value[const aNameOrIndex: Variant]: Variant read GetValueOrItem
      write SetValueOrItem; default;

    /// direct access to a dvObject UTF-8 stored property value from its name
    // - slightly faster than the variant-based Value[] default property
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - use GetAsRawUTF8() if you want to check the availability of the field
    // - U['prop'] := 'value' would add a new property, or overwrite an existing
    property U[const aName: RawUTF8]: RawUTF8 read GetRawUTF8ByName write SetRawUTF8ByName;
    /// direct string access to a dvObject UTF-8 stored property value from its name
    // - just a wrapper around U[] property, to avoid a compilation warning when
    // using plain string variables (internaly, RawUTF8 will be used for storage)
    // - slightly faster than the variant-based Value[] default property
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - use GetAsRawUTF8() if you want to check the availability of the field
    // - S['prop'] := 'value' would add a new property, or overwrite an existing
    property S[const aName: RawUTF8]: string read GetStringByName write SetStringByName;
    /// direct access to a dvObject Integer stored property value from its name
    // - slightly faster than the variant-based Value[] default property
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - use GetAsInt/GetAsInt64 if you want to check the availability of the field
    // - I['prop'] := 123 would add a new property, or overwrite an existing
    property I[const aName: RawUTF8]: Int64 read GetInt64ByName write SetInt64ByName;
    /// direct access to a dvObject Boolean stored property value from its name
    // - slightly faster than the variant-based Value[] default property
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - use GetAsBoolean if you want to check the availability of the field
    // - B['prop'] := true would add a new property, or overwrite an existing
    property B[const aName: RawUTF8]: Boolean read GetBooleanByName write SetBooleanByName;
    /// direct access to a dvObject floating-point stored property value from its name
    // - slightly faster than the variant-based Value[] default property
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - use GetAsDouble if you want to check the availability of the field
    // - D['prop'] := 1.23 would add a new property, or overwrite an existing
    property D[const aName: RawUTF8]: Double read GetDoubleByName write SetDoubleByName;
    /// direct access to a dvObject existing dvObject property from its name
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - O['prop'] would return a fake void TDocVariant if the property is not
    // existing or not a dvObject, just like GetAsDocVariantSafe()
    // - use O_['prop'] to force adding any missing property
    property O[const aName: RawUTF8]: PDocVariantData read GetObjectExistingByName;
    /// direct access or add a dvObject's dvObject property from its name
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - O_['prop'] would add a new property if there is none existing, or
    // overwrite an existing property which is not a dvObject
    property O_[const aName: RawUTF8]: PDocVariantData read GetObjectOrAddByName;
    /// direct access to a dvObject existing dvArray property from its name
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - A['prop'] would return a fake void TDocVariant if the property is not
    // existing or not a dvArray, just like GetAsDocVariantSafe()
    // - use A_['prop'] to force adding any missing property
    property A[const aName: RawUTF8]: PDocVariantData read GetArrayExistingByName;
    /// direct access or add a dvObject's dvArray property from its name
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - A_['prop'] would add a new property if there is none existing, or
    // overwrite an existing property which is not a dvArray
    property A_[const aName: RawUTF8]: PDocVariantData read GetArrayOrAddByName;
    /// direct access to a dvArray's TDocVariant property from its index
    // - simple values may directly use Values[] dynamic array, but to access
    // a TDocVariantData members, this property is safer
    // - follows dvoReturnNullForUnknownProperty option to raise an exception
    // - _[ndx] would return a fake void TDocVariant if aIndex is out of range,
    // if the property is not existing or not a TDocVariantData (just like
    // GetAsDocVariantSafe)
    property _[aIndex: integer]: PDocVariantData read GetAsDocVariantByIndex;
  end;
  {$A+} { packet object not allowed since Delphi 2009 :( }

var
  /// the internal custom variant type used to register TDocVariant
  DocVariantType: TDocVariant = nil;
  /// copy of DocVariantType.VarType
  // - as used by inlined functions of TDocVariantData
  DocVariantVType: integer = -1;

/// retrieve the text representation of a TDocVairnatKind
function ToText(kind: TDocVariantKind): PShortString; overload;

/// direct access to a TDocVariantData from a given variant instance
// - return a pointer to the TDocVariantData corresponding to the variant
// instance, which may be of kind varByRef (e.g. when retrieved by late binding)
// - raise an EDocVariant exception if the instance is not a TDocVariant
// - the following direct trans-typing may fail, e.g. for varByRef value:
// ! TDocVariantData(aVarDoc.ArrayProp).Add('new item');
// - so you can write the following:
// ! DocVariantData(aVarDoc.ArrayProp).AddItem('new item');
function DocVariantData(const DocVariant: variant): PDocVariantData;

const
  /// constant used e.g. by _Safe() overloaded functions
  // - will be in code section of the exe, so will be read-only by design
  // - would have Kind=dvUndefined and Count=0, so _Safe() would return
  // a valid, but void document
  // - its VType is varNull, so would be viewed as a null variant
  // - dvoReturnNullForUnknownProperty is defined, so that U[]/I[]... methods
  // won't raise any exception about unexpected field name
  DocVariantDataFake: TDocVariantData = (
    VType:1; VOptions:[dvoReturnNullForUnknownProperty]);

/// direct access to a TDocVariantData from a given variant instance
// - return a pointer to the TDocVariantData corresponding to the variant
// instance, which may be of kind varByRef (e.g. when retrieved by late binding)
// - will return a read-only fake TDocVariantData with Kind=dvUndefined if the
// supplied variant is not a TDocVariant instance, so could be safely used
// in a with block (use "with" moderation, of course):
// ! with _Safe(aDocVariant)^ do
// !   for ndx := 0 to Count-1 do // here Count=0 for the "fake" result
// !     writeln(Names[ndx]);
// or excluding the "with" statement, as more readable code:
// ! var dv: PDocVariantData;
// !     ndx: PtrInt;
// ! begin
// !   dv := _Safe(aDocVariant);
// !   for ndx := 0 to dv.Count-1 do // here Count=0 for the "fake" result
// !     writeln(dv.Names[ndx]);
function _Safe(const DocVariant: variant): PDocVariantData; overload;
  {$ifdef FPC}inline;{$endif} // Delphi has problems inlining this :(

/// direct access to a TDocVariantData from a given variant instance
// - return a pointer to the TDocVariantData corresponding to the variant
// instance, which may be of kind varByRef (e.g. when retrieved by late binding)
// - will check the supplied document kind, i.e. either dvObject or dvArray and
// raise a EDocVariant exception if it does not match
function _Safe(const DocVariant: variant; ExpectedKind: TDocVariantKind): PDocVariantData; overload;

/// initialize a variant instance to store some document-based object content
// - object will be initialized with data supplied two by two, as Name,Value
// pairs, e.g.
// ! aVariant := _Obj(['name','John','year',1972]);
// or even with nested objects:
// ! aVariant := _Obj(['name','John','doc',_Obj(['one',1,'two',2.0])]);
// - this global function is an alias to TDocVariant.NewObject()
// - by default, every internal value will be copied, so access of nested
// properties can be slow - if you expect the data to be read-only or not
// propagated into another place, set Options=[dvoValueCopiedByReference]
// or using _ObjFast() will increase the process speed a lot
function _Obj(const NameValuePairs: array of const;
  Options: TDocVariantOptions=[]): variant;

/// add some property values to a document-based object content
// - if Obj is a TDocVariant object, will add the Name/Value pairs
// - if Obj is not a TDocVariant, will create a new fast document,
// initialized with supplied the Name/Value pairs
// - this function will also ensure that ensure Obj is not stored by reference,
// but as a true TDocVariantData
procedure _ObjAddProps(const NameValuePairs: array of const; var Obj: variant); overload;

/// add the property values of a document to a document-based object content
// - if Document is not a TDocVariant object, will do nothing
// - if Obj is a TDocVariant object, will add Document fields to its content
// - if Obj is not a TDocVariant object, Document will be copied to Obj
procedure _ObjAddProps(const Document: variant; var Obj: variant); overload;

/// initialize a variant instance to store some document-based array content
// - array will be initialized with data supplied as parameters, e.g.
// ! aVariant := _Arr(['one',2,3.0]);
// - this global function is an alias to TDocVariant.NewArray()
// - by default, every internal value will be copied, so access of nested
// properties can be slow - if you expect the data to be read-only or not
// propagated into another place, set Options=[dvoValueCopiedByReference]
// or using _ArrFast() will increase the process speed a lot
function _Arr(const Items: array of const;
  Options: TDocVariantOptions=[]): variant;

/// initialize a variant instance to store some document-based content
// from a supplied (extended) JSON content
// - this global function is an alias to TDocVariant.NewJSON(), and
// will return an Unassigned variant if JSON content was not correctly converted
// - object or array will be initialized from the supplied JSON content, e.g.
// ! aVariant := _Json('{"id":10,"doc":{"name":"John","birthyear":1972}}');
// ! // now you can access to the properties via late binding
// ! assert(aVariant.id=10);
// ! assert(aVariant.doc.name='John');
// ! assert(aVariant.doc.birthYear=1972);
// ! // and also some pseudo-properties:
// ! assert(aVariant._count=2);
// ! assert(aVariant.doc._kind=ord(dvObject));
// ! // or with a JSON array:
// ! aVariant := _Json('["one",2,3]');
// ! assert(aVariant._kind=ord(dvArray));
// ! for i := 0 to aVariant._count-1 do
// !   writeln(aVariant._(i));
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names:
// ! aVariant := _Json('{id:10,doc:{name:"John",birthyear:1972}}');
// - if the SynMongoDB unit is used in the application, the MongoDB Shell
// syntax will also be recognized to create TBSONVariant, like
// ! new Date()   ObjectId()   MinKey   MaxKey  /<jRegex>/<jOptions>
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
// - by default, every internal value will be copied, so access of nested
// properties can be slow - if you expect the data to be read-only or not
// propagated into another place, add dvoValueCopiedByReference in Options
// will increase the process speed a lot, or use _JsonFast()
function _Json(const JSON: RawUTF8;
  Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty]): variant; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// initialize a variant instance to store some document-based content
// from a supplied (extended) JSON content, with parameters formating
// - wrapper around the _Json(FormatUTF8(...,JSONFormat=true)) function,
// i.e. every Args[] will be inserted for each % and Params[] for each ?,
// with proper JSON escaping of string values, and writing nested _Obj() /
// _Arr() instances as expected JSON objects / arrays
// - typical use (in the context of SynMongoDB unit) could be:
// ! aVariant := _JSONFmt('{%:{$in:[?,?]}}',['type'],['food','snack']);
// ! aVariant := _JSONFmt('{type:{$in:?}}',[],[_Arr(['food','snack'])]);
// ! // which are the same as:
// ! aVariant := _JSONFmt('{type:{$in:["food","snack"]}}');
// ! // in this context:
// ! u := VariantSaveJSON(aVariant);
// ! assert(u='{"type":{"$in":["food","snack"]}}');
// ! u := VariantSaveMongoJSON(aVariant,modMongoShell);
// ! assert(u='{type:{$in:["food","snack"]}}');
// - by default, every internal value will be copied, so access of nested
// properties can be slow - if you expect the data to be read-only or not
// propagated into another place, add dvoValueCopiedByReference in Options
// will increase the process speed a lot, or use _JsonFast()
function _JsonFmt(const Format: RawUTF8; const Args,Params: array of const;
  Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty]): variant; overload;

/// initialize a variant instance to store some document-based content
// from a supplied (extended) JSON content, with parameters formating
// - this overload function will set directly a local variant variable,
// and would be used by inlined _JsonFmt/_JsonFastFmt functions
procedure _JsonFmt(const Format: RawUTF8; const Args,Params: array of const;
  Options: TDocVariantOptions; out result: variant); overload;

/// initialize a variant instance to store some document-based content
// from a supplied (extended) JSON content
// - this global function is an alias to TDocVariant.NewJSON(), and
// will return TRUE if JSON content was correctly converted into a variant
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names or ObjectID()
// - by default, every internal value will be copied, so access of nested
// properties can be slow - if you expect the data to be read-only or not
// propagated into another place, add dvoValueCopiedByReference in Options
// will increase the process speed a lot, or use _JsonFast()
function _Json(const JSON: RawUTF8; var Value: variant;
  Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty]): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// initialize a variant instance to store some document-based object content
// - this global function is an handy alias to:
// ! Obj(NameValuePairs,JSON_OPTIONS[true]);
// - so all created objects and arrays will be handled by reference, for best
// speed - but you should better write on the resulting variant tree with caution
function _ObjFast(const NameValuePairs: array of const): variant; overload;

/// initialize a variant instance to store any object as a TDocVariant
// - is a wrapper around _JsonFast(ObjectToJson(aObject,aOptions))
function _ObjFast(aObject: TObject;
   aOptions: TTextWriterWriteObjectOptions=[woDontStoreDefault]): variant; overload;

/// initialize a variant instance to store some document-based array content
// - this global function is an handy alias to:
// ! _Array(Items,JSON_OPTIONS[true]);
// - so all created objects and arrays will be handled by reference, for best
// speed - but you should better write on the resulting variant tree with caution
function _ArrFast(const Items: array of const): variant; overload;

/// initialize a variant instance to store some document-based content
// from a supplied (extended) JSON content
// - this global function is an handy alias to:
// ! _Json(JSON,JSON_OPTIONS[true]);
// so it will return an Unassigned variant if JSON content was not correct
// - so all created objects and arrays will be handled by reference, for best
// speed - but you should better write on the resulting variant tree with caution
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names or ObjectID()
function _JsonFast(const JSON: RawUTF8): variant;
  {$ifdef HASINLINE}inline;{$endif}

/// initialize a variant instance to store some extended document-based content
// - this global function is an handy alias to:
// ! _Json(JSON,JSON_OPTIONS_FAST_EXTENDED);
function _JsonFastExt(const JSON: RawUTF8): variant;
  {$ifdef HASINLINE}inline;{$endif}

/// initialize a variant instance to store some document-based content
// from a supplied (extended) JSON content, with parameters formating
// - this global function is an handy alias e.g. to:
// ! aVariant := _JSONFmt('{%:{$in:[?,?]}}',['type'],['food','snack'],JSON_OPTIONS[true]);
// - so all created objects and arrays will be handled by reference, for best
// speed - but you should better write on the resulting variant tree with caution
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names or ObjectID():
function _JsonFastFmt(const Format: RawUTF8; const Args,Params: array of const): variant;

/// ensure a document-based variant instance will have only per-value nested
// objects or array documents
// - is just a wrapper around:
// ! TDocVariantData(DocVariant).InitCopy(DocVariant,JSON_OPTIONS[false])
// - you can use this function to ensure that all internal properties of this
// variant will be copied per-value whatever options the nested objects or
// arrays were created with
// - for huge document with a big depth of nested objects or arrays, a full
// per-value copy may be time and resource consuming, but will be also safe
// - will raise an EDocVariant if the supplied variant is not a TDocVariant or
// a varByRef pointing to a TDocVariant
procedure _Unique(var DocVariant: variant);

/// ensure a document-based variant instance will have only per-value nested
// objects or array documents
// - is just a wrapper around:
// ! TDocVariantData(DocVariant).InitCopy(DocVariant,JSON_OPTIONS[true])
// - you can use this function to ensure that all internal properties of this
// variant will be copied per-reference whatever options the nested objects or
// arrays were created with
// - for huge document with a big depth of nested objects or arrays, it will
// first create a whole copy of the document nodes, but further assignments
// of the resulting value will be per-reference, so will be almost instant
// - will raise an EDocVariant if the supplied variant is not a TDocVariant or
// a varByRef pointing to a TDocVariant
procedure _UniqueFast(var DocVariant: variant);

/// return a full nested copy of a document-based variant instance
// - is just a wrapper around:
// ! TDocVariant.NewUnique(DocVariant,JSON_OPTIONS[false])
// - you can use this function to ensure that all internal properties of this
// variant will be copied per-value whatever options the nested objects or
// arrays were created with: to be used on a value returned as varByRef
// (e.g. by _() pseudo-method)
// - for huge document with a big depth of nested objects or arrays, a full
// per-value copy may be time and resource consuming, but will be also safe -
// consider using _ByRef() instead if a fast copy-by-reference is enough
// - will raise an EDocVariant if the supplied variant is not a TDocVariant or
// a varByRef pointing to a TDocVariant
function _Copy(const DocVariant: variant): variant;
  {$ifdef HASINLINE}inline;{$endif}

/// return a full nested copy of a document-based variant instance
// - is just a wrapper around:
// ! TDocVariant.NewUnique(DocVariant,JSON_OPTIONS[true])
// - you can use this function to ensure that all internal properties of this
// variant will be copied per-value whatever options the nested objects or
// arrays were created with: to be used on a value returned as varByRef
// (e.g. by _() pseudo-method)
// - for huge document with a big depth of nested objects or arrays, a full
// per-value copy may be time and resource consuming, but will be also safe -
// consider using _ByRef() instead if a fast copy-by-reference is enough
// - will raise an EDocVariant if the supplied variant is not a TDocVariant or
// a varByRef pointing to a TDocVariant
function _CopyFast(const DocVariant: variant): variant;
  {$ifdef HASINLINE}inline;{$endif}

/// copy a TDocVariant to another variable, changing the options on the fly
// - note that the content (items or properties) is copied by reference,
// so consider using _Copy() instead if you expect to safely modify its content
// - will return null if the supplied variant is not a TDocVariant
function _ByRef(const DocVariant: variant; Options: TDocVariantOptions): variant; overload;

/// copy a TDocVariant to another variable, changing the options on the fly
// - note that the content (items or properties) is copied by reference,
// so consider using _Copy() instead if you expect to safely modify its content
// - will return null if the supplied variant is not a TDocVariant
procedure _ByRef(const DocVariant: variant; out Dest: variant;
  Options: TDocVariantOptions); overload;

/// convert a TDocVariantData array or a string value into a CSV
// - will call either TDocVariantData.ToCSV, or return the string
// - returns '' if the supplied value is neither a TDocVariant or a string
// - could be used e.g. to store either a JSON CSV string or a JSON array of
// strings in a settings property
function _CSV(const DocVariantOrString: variant): RawUTF8;

/// will convert any TObject into a TDocVariant document instance
// - a slightly faster alternative to Dest := _JsonFast(ObjectToJSON(Value))
// - this would convert the TObject by representation, using only serializable
// published properties: do not use this function to store temporary a class
// instance, but e.g. to store an object values in a NoSQL database
// - if you expect lazy-loading of a TObject, see TObjectVariant.New()
procedure ObjectToVariant(Value: TObject; out Dest: variant); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// will convert any TObject into a TDocVariant document instance
// - a faster alternative to _JsonFast(ObjectToJSON(Value))
// - if you expect lazy-loading of a TObject, see TObjectVariant.New()
function ObjectToVariant(Value: TObject; EnumSetsAsText: boolean=false): variant; overload;

/// will convert any TObject into a TDocVariant document instance
// - a faster alternative to _Json(ObjectToJSON(Value),Options)
// - note that the result variable should already be cleared: no VarClear()
// is done by this function
// - would be used e.g. by VarRecToVariant() function
// - if you expect lazy-loading of a TObject, see TObjectVariant.New()
procedure ObjectToVariant(Value: TObject; var result: variant;
  Options: TTextWriterWriteObjectOptions); overload;

{$endif NOVARIANTS}


{ ******************* process monitoring / statistics ********************** }

type
  /// the kind of value stored in a TSynMonitor / TSynMonitorUsage property
  // - i.e. match TSynMonitorTotalMicroSec, TSynMonitorOneMicroSec,
  // TSynMonitorOneCount, TSynMonitorOneBytes, TSynMonitorBytesPerSec,
  // TSynMonitorTotalBytes, TSynMonitorCount and TSynMonitorCount64 types as
  // used to store statistic information
  // - "cumulative" values would sum each process values, e.g. total elapsed
  // time for SOA execution, task count or total I/O bytes
  // - "immediate" (e.g. svOneBytes or smvBytesPerSec) values would be an evolving
  // single value, e.g. an average value or current disk free size
  // - use SYNMONITORVALUE_CUMULATIVE = [smvMicroSec,smvBytes,smvCount,smvCount64]
  // constant to identify the kind of value
  // - TSynMonitorUsage.Track() would use MonitorPropUsageValue() to guess
  // the tracked properties type from class RTTI
  TSynMonitorType = (
    smvUndefined, smvOneMicroSec, smvOneBytes, smvOneCount, smvBytesPerSec,
    smvMicroSec, smvBytes, smvCount, smvCount64);
  /// value types as stored in TSynMonitor / TSynMonitorUsage
  TSynMonitorTypes = set of TSynMonitorType;

  /// would identify a cumulative time process information in micro seconds, during monitoring
  // - "cumulative" time would add each process timing, e.g. for statistics about
  // SOA computation of a given service
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorTotalMicroSec = type QWord;

  /// would identify an immediate time count information, during monitoring
  // - "immediate" counts won't accumulate, e.g. may store the current number
  // of thread used by a process
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorOneCount = type cardinal;

  /// would identify an immediate time process information in micro seconds, during monitoring
  // - "immediate" time won't accumulate, i.e. may store the duration of the
  // latest execution of a SOA computation
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorOneMicroSec = type QWord;

  /// would identify a process information as cumulative bytes count, during monitoring
  // - "cumulative" size would add some byte for each process, e.g. input/output
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorTotalBytes = type QWord;

  /// would identify an immediate process information as bytes count, during monitoring
  // - "immediate" size won't accumulate, i.e. may be e.g. computer free memory
  // at a given time
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorOneBytes = type QWord;

  /// would identify the process throughput, during monitoring
  // - it indicates e.g. "immediate" bandwith usage
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorBytesPerSec = type QWord;

  /// would identify a cumulative number of processes, during monitoring
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorCount = type cardinal;

  /// would identify a cumulative number of processes, during monitoring
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorCount64 = type QWord;

  /// pointer to a high resolution timer object/record
  PPrecisionTimer = ^TPrecisionTimer;

  /// indirect reference to a pointer to a high resolution timer object/record
  PPPrecisionTimer = ^PPrecisionTimer;

  /// high resolution timer (for accurate speed statistics)
  // - WARNING: under Windows, this record MUST be aligned to 32-bit, otherwise
  // iFreq=0 - so you can use TLocalPrecisionTimer/ILocalPrecisionTimer if you
  // want to alllocate a local timer instance on the stack
  TPrecisionTimer = object
  protected
    fStart,fStop: Int64;
    {$ifndef LINUX} // use QueryPerformanceMicroSeconds() fast API
    fWinFreq: Int64;
    {$endif}
    /// contains the time elapsed in micro seconds between Start and Stop
    fTime: TSynMonitorTotalMicroSec;
    /// contains the time elapsed in micro seconds between Resume and Pause
    fLastTime: TSynMonitorOneMicroSec;
    fPauseCount: TSynMonitorCount;
  public
    /// initialize the timer
    // - will fill all internal state with 0
    // - not necessary e.g. if TPrecisionTimer is defined as a TObject field
    procedure Init; {$ifdef HASINLINE}inline;{$endif}
    /// initialize and start the high resolution timer
    // - similar to Init + Resume
    procedure Start;
    /// stop the timer, returning the total time elapsed as text
    // - with appended time resolution (us,ms,s) - from MicroSecToString()
    // - is just a wrapper around Pause + Time
    // - you can call Resume to continue adding time to this timer
    function Stop: TShort16; {$ifdef HASINLINE}inline;{$endif}
    /// stop the timer, returning the total time elapsed as microseconds
    // - is just a wrapper around Pause + Time
    // - you can call Resume to continue adding time to this timer
    function StopInMicroSec: TSynMonitorTotalMicroSec; {$ifdef HASINLINE}inline;{$endif}
    /// stop the timer, ready to continue its time measurement via Resume
    // - will also compute the global Time value
    // - do nothing if no previous Start/Resume call is pending
    procedure Pause;
    /// resume a paused timer, or start an initialized timer
    // - do nothing if no timer has been initialized or paused just before
    // - if the previous method called was Init, will act like Start
    // - if the previous method called was Pause, it will continue counting
    procedure Resume; {$ifdef HASINLINE}inline;{$endif}
    /// resume a paused timer until the method ends
    // - will internaly create a TInterfaceObject class to let the compiler
    // generate a try..finally block as expected to call Pause at method ending
    // - is therefore very convenient to have consistent Resume/Pause calls
    // - for proper use, expect TPrecisionTimer to be initialized to 0 before
    // execution (e.g. define it as a protected member of a class)
    // - typical use is to declare a fTimeElapsed: TPrecisionTimer protected
    // member, then call fTimeElapsed.ProfileCurrentMethod at the beginning of
    // all process expecting some timing, then log/save fTimeElapsed.Stop content
    // - FPC TIP: result should be assigned to a local variable of IUnknown type
    function ProfileCurrentMethod: IUnknown;
    /// low-level method to force values settings to allow thread safe timing
    // - by default, this timer is not thread safe: you can use this method to
    // set the timing values from manually computed performance counters
    // - the caller should also use a mutex to prevent from race conditions:
    // see e.g. TSynMonitor.FromExternalMicroSeconds implementation
    // - warning: Start, Stop, Pause and Resume methods are then disallowed
    procedure FromExternalMicroSeconds(const MicroSeconds: QWord);
      {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell
    /// low-level method to force values settings to allow thread safe timing
    // - by default, this timer is not thread safe: you can use this method to
    // set the timing values from manually computed performance counters
    // - the caller should also use a mutex to prevent from race conditions:
    // see e.g. TSynMonitor.FromExternalQueryPerformanceCounters implementation
    // - returns the time elapsed, in micro seconds (i.e. LastTime value)
    // - warning: Start, Stop, Pause and Resume methods are then disallowed
    function FromExternalQueryPerformanceCounters(const CounterDiff: QWord): QWord;
      {$ifdef FPCLINUX}inline;{$endif}
    /// compute the per second count
    function PerSec(const Count: QWord): QWord;
    /// compute the time elapsed by count, with appened time resolution (us,ms,s)
    function ByCount(Count: QWord): TShort16;
    /// returns e.g. '16.9 MB in 102.20ms i.e. 165.5 MB/s'
    function SizePerSec(Size: QWord): shortstring;
    /// textual representation of total time elapsed
    // - with appened time resolution (us,ms,s) - from MicroSecToString()
    // - not to be used in normal code (which could rather call the Stop method),
    // but e.g. for custom performance analysis
    function Time: TShort16;
    /// textual representation of last process timing after counter stopped
    // - Time returns a total elapsed time, whereas this method only returns
    // the latest resumed time
    // - with appened time resolution (us,ms,s) - from MicroSecToString()
    // - not to be used in normal code, but e.g. for custom performance analysis
    function LastTime: TShort16;
    /// check if Start/Resume were called at least once
    function Started: boolean;
    /// time elapsed in micro seconds after counter stopped
    // - not to be used in normal code, but e.g. for custom performance analysis
    property TimeInMicroSec: TSynMonitorTotalMicroSec read fTime write fTime;
    /// timing in micro seconds of the last process
    // - not to be used in normal code, but e.g. for custom performance analysis
    property LastTimeInMicroSec: TSynMonitorOneMicroSec read fLastTime write fLastTime;
    /// how many times the Pause method was called, i.e. the number of tasks
    // processeed
    property PauseCount: TSynMonitorCount read fPauseCount;
  end;

  /// interface to a reference counted high resolution timer instance
  // - implemented by TLocalPrecisionTimer
  ILocalPrecisionTimer = interface
    /// start the high resolution timer
    procedure Start;
    /// stop the timer, returning the time elapsed, with appened time resolution (us,ms,s)
    function Stop: TShort16;
    /// stop the timer, ready to continue its time measure
    procedure Pause;
    /// resume a paused timer, or start it if it hasn't be started
    procedure Resume;
    /// compute the per second count
    function PerSec(Count: cardinal): cardinal;
    /// compute the time elapsed by count, with appened time resolution (us,ms,s)
    function ByCount(Count: cardinal): RawUTF8;
  end;

  /// reference counted high resolution timer (for accurate speed statistics)
  // - since TPrecisionTimer shall be 32-bit aligned, you can use this class
  // to initialize a local auto-freeing ILocalPrecisionTimer variable on stack
  // - to be used as such:
  // ! var Timer: ILocalPrecisionTimer;
  // !  (...)
  // !   Timer := TLocalPrecisionTimer.Create;
  // !   Timer.Start;
  // !  (...)
  TLocalPrecisionTimer = class(TInterfacedObject,ILocalPrecisionTimer)
  protected
    fTimer: TPrecisionTimer;
  public
    /// initialize the instance, and start the high resolution timer
    constructor CreateAndStart;
    /// start the high resolution timer
    procedure Start;
    /// stop the timer, returning the time elapsed, with appened time resolution (us,ms,s)
    function Stop: TShort16;
    /// stop the timer, ready to continue its time measure
    procedure Pause;
    /// resume a paused timer, or start the timer
    procedure Resume;
    /// compute the per second count
    function PerSec(Count: cardinal): cardinal;
    /// compute the time elapsed by count, with appened time resolution (us,ms,s)
    function ByCount(Count: cardinal): RawUTF8;
  end;

  /// able to serialize any cumulative timing as raw micro-seconds number or text
  // - "cumulative" time would add each process value, e.g. SOA methods execution
  TSynMonitorTime = class(TSynPersistent)
  protected
    fMicroSeconds: TSynMonitorTotalMicroSec;
    function GetAsText: TShort16;
  public
    /// compute a number per second, of the current value
    function PerSecond(const Count: QWord): QWord;
      {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell
  published
    /// micro seconds time elapsed, as raw number
    property MicroSec: TSynMonitorTotalMicroSec read fMicroSeconds write fMicroSeconds;
    /// micro seconds time elapsed, as '... us-ns-ms-s' text
    property Text: TShort16 read GetAsText;
  end;

  /// able to serialize any immediate timing as raw micro-seconds number or text
  // - "immediate" size won't accumulate, i.e. may be e.g. last process time
  TSynMonitorOneTime = class(TSynPersistent)
  protected
    fMicroSeconds: TSynMonitorOneMicroSec;
    function GetAsText: TShort16;
  public
    /// compute a number per second, of the current value
    function PerSecond(const Count: QWord): QWord;
      {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell
  published
    /// micro seconds time elapsed, as raw number
    property MicroSec: TSynMonitorOneMicroSec read fMicroSeconds write fMicroSeconds;
    /// micro seconds time elapsed, as '... us-ns-ms-s' text
    property Text: TShort16 read GetAsText;
  end;

  TSynMonitorSizeParent = class(TSynPersistent)
  protected
    fTextNoSpace: boolean;
  public
    /// initialize the instance
    constructor Create(aTextNoSpace: boolean); reintroduce;
  end;

  /// able to serialize any cumulative size as bytes number
  // - "cumulative" time would add each process value, e.g. global IO consumption
  TSynMonitorSize = class(TSynMonitorSizeParent)
  protected
    fBytes: TSynMonitorTotalBytes;
    function GetAsText: TShort16;
  published
    /// number of bytes, as raw number
    property Bytes: TSynMonitorTotalBytes read fBytes write fBytes;
    /// number of bytes, as '... B-KB-MB-GB' text
    property Text: TShort16 read GetAsText;
  end;

  /// able to serialize any immediate size as bytes number
  // - "immediate" size won't accumulate, i.e. may be e.g. computer free memory
  // at a given time
  TSynMonitorOneSize = class(TSynMonitorSizeParent)
  protected
    fBytes: TSynMonitorOneBytes;
    function GetAsText: TShort16;
  published
    /// number of bytes, as raw number
    property Bytes: TSynMonitorOneBytes read fBytes write fBytes;
    /// number of bytes, as '... B-KB-MB-GB' text
    property Text: TShort16 read GetAsText;
  end;

  /// able to serialize any bandwith as bytes count per second
  // - is usually associated with TSynMonitorOneSize properties,
  // e.g. to monitor IO activity
  TSynMonitorThroughput = class(TSynMonitorSizeParent)
  protected
    fBytesPerSec: QWord;
    function GetAsText: TShort16;
  published
    /// number of bytes per second, as raw number
    property BytesPerSec: QWord read fBytesPerSec write fBytesPerSec;
    /// number of bytes per second, as '... B-KB-MB-GB/s' text
    property Text: TShort16 read GetAsText;
  end;

  /// a generic value object able to handle any task / process statistic
  // - base class shared e.g. for ORM, SOA or DDD, when a repeatable data
  // process is to be monitored
  // - this class is thread-safe for its methods, but you should call explicitly
  // Lock/UnLock to access its individual properties
  TSynMonitor = class(TSynPersistentLock)
  protected
    fName: RawUTF8;
    fTaskCount: TSynMonitorCount64;
    fTotalTime: TSynMonitorTime;
    fLastTime: TSynMonitorOneTime;
    fMinimalTime: TSynMonitorOneTime;
    fAverageTime: TSynMonitorOneTime;
    fMaximalTime: TSynMonitorOneTime;
    fPerSec: QWord;
    fInternalErrors: TSynMonitorCount;
    fProcessing: boolean;
    fTaskStatus: (taskNotStarted,taskStarted);
    fLastInternalError: variant;
    procedure LockedPerSecProperties; virtual;
    procedure LockedFromProcessTimer; virtual;
    procedure LockedSum(another: TSynMonitor); virtual;
    procedure WriteDetailsTo(W: TTextWriter); virtual;
    procedure Changed; virtual;
  public
    /// low-level high-precision timer instance
    InternalTimer: TPrecisionTimer;
    /// initialize the instance nested class properties
    // - you can specify identifier associated to this monitored resource
    // which would be used for TSynMonitorUsage persistence
    constructor Create(const aName: RawUTF8); reintroduce; overload; virtual;
    /// initialize the instance nested class properties
    constructor Create; overload; override;
    /// finalize the instance
    destructor Destroy; override;
    /// lock the instance for exclusive access
    // - needed only if you access directly the instance properties
    procedure Lock; {$ifdef HASINLINE}inline;{$endif}
    /// release the instance for exclusive access
    // - needed only if you access directly the instance properties
    procedure UnLock; {$ifdef HASINLINE}inline;{$endif}
    /// create Count instances of this actual class in the supplied ObjArr[]
    class procedure InitializeObjArray(var ObjArr; Count: integer); virtual;
    /// should be called when the process starts, to resume the internal timer
    // - thread-safe method
    procedure ProcessStart; virtual;
    /// should be called each time a pending task is processed
    // - will increase the TaskCount property
    // - thread-safe method
    procedure ProcessDoTask; virtual;
    /// should be called when the process starts, and a task is processed
    // - similar to ProcessStart + ProcessDoTask
    // - thread-safe method
    procedure ProcessStartTask; virtual;
    /// should be called when an error occurred
    // - typical use is with ObjectToVariantDebug(E,...) kind of information
    // - thread-safe method
    procedure ProcessError(const info: variant); virtual;
    /// should be called when an error occurred
    // - typical use is with a HTTP status, e.g. as ProcessError(Call.OutStatus)
    // - just a wraper around overloaded ProcessError(), so a thread-safe method
    procedure ProcessErrorNumber(info: integer);
    /// should be called when an error occurred
    // - just a wraper around overloaded ProcessError(), so a thread-safe method
    procedure ProcessErrorFmt(const Fmt: RawUTF8; const Args: array of const);
    /// should be called when an Exception occurred
    // - just a wraper around overloaded ProcessError(), so a thread-safe method
    procedure ProcessErrorRaised(E: Exception);
    /// should be called when the process stops, to pause the internal timer
    // - thread-safe method
    procedure ProcessEnd; virtual;
    /// could be used to manage information average or sums
    // - thread-safe method calling LockedSum protected virtual method
    procedure Sum(another: TSynMonitor);
    /// returns a JSON content with all published properties information
    // - thread-safe method
    function ComputeDetailsJSON: RawUTF8;
    /// appends a JSON content with all published properties information
    // - thread-safe method
    procedure ComputeDetailsTo(W: TTextWriter); virtual;
    {$ifndef NOVARIANTS}
    /// returns a TDocVariant with all published properties information
    // - thread-safe method
    function ComputeDetails: variant;
    {$endif NOVARIANTS}
    /// used to allow thread safe timing
    // - by default, the internal TPrecisionTimer is not thread safe: you can
    // use this method to update the timing from many threads
    // - if you use this method, ProcessStart, ProcessDoTask and ProcessEnd
    // methods are disallowed, and the global fTimer won't be used any more
    // - will return the processing time, converted into micro seconds, ready
    // to be logged if needed
    // - thread-safe method
    function FromExternalQueryPerformanceCounters(const CounterDiff: QWord): QWord;
    /// used to allow thread safe timing
    // - by default, the internal TPrecisionTimer is not thread safe: you can
    // use this method to update the timing from many threads
    // - if you use this method, ProcessStart, ProcessDoTask and ProcessEnd
    // methods are disallowed, and the global fTimer won't be used any more
    // - thread-safe method
    procedure FromExternalMicroSeconds(const MicroSecondsElapsed: QWord);
    /// an identifier associated to this monitored resource
    // - is used e.g. for TSynMonitorUsage persistence/tracking
    property Name: RawUTF8 read fName write fName;
  published
    /// indicates if this thread is currently working on some process
    property Processing: boolean read fProcessing write fProcessing;
    /// how many times the task was performed
    property TaskCount: TSynMonitorCount64 read fTaskCount write fTaskCount;
    /// the whole time spend during all working process
    property TotalTime: TSynMonitorTime read fTotalTime;
    /// the time spend during the last task processing
    property LastTime: TSynMonitorOneTime read fLastTime;
    /// the lowest time spent during any working process
    property MinimalTime: TSynMonitorOneTime read fMinimalTime;
    /// the time spent in average during any working process
    property AverageTime: TSynMonitorOneTime read fAverageTime;
    /// the highest time spent during any working process
    property MaximalTime: TSynMonitorOneTime read fMaximalTime;
    /// average of how many tasks did occur per second
    property PerSec: QWord read fPerSec;
    /// how many errors did occur during the processing
    property Errors: TSynMonitorCount read fInternalErrors;
    /// information about the last error which occured during the processing
    property LastError: variant read fLastInternalError;
  end;
  /// references a TSynMonitor instance
  PSynMonitor = ^TSynMonitor;

  /// handle generic process statistic with a processing data size and bandwitdh
  TSynMonitorWithSize = class(TSynMonitor)
  protected
    fSize: TSynMonitorSize;
    fThroughput: TSynMonitorThroughput;
    procedure LockedPerSecProperties; override;
    procedure LockedSum(another: TSynMonitor); override;
  public
    /// initialize the instance nested class properties
    constructor Create; override;
    /// finalize the instance
    destructor Destroy; override;
    /// increase the internal size counter
    // - thread-safe method
    procedure AddSize(const Bytes: QWord);
  published
    /// how many total data has been hanlded during all working process
    property Size: TSynMonitorSize read fSize;
    /// data processing bandwith, returned as B/KB/MB per second
    property Throughput: TSynMonitorThroughput read fThroughput;
  end;

  /// handle generic process statistic with a incoming and outgoing processing
  // data size and bandwitdh
  TSynMonitorInputOutput = class(TSynMonitor)
  protected
    fInput: TSynMonitorSize;
    fOutput: TSynMonitorSize;
    fInputThroughput: TSynMonitorThroughput;
    fOutputThroughput: TSynMonitorThroughput;
    procedure LockedPerSecProperties; override;
    procedure LockedSum(another: TSynMonitor); override;
  public
    /// initialize the instance nested class properties
    constructor Create; override;
    /// finalize the instance
    destructor Destroy; override;
    /// increase the internal size counters
    // - thread-safe method
    procedure AddSize(const Incoming, Outgoing: QWord);
  published
    /// how many data has been received
    property Input: TSynMonitorSize read fInput;
    /// how many data has been sent back
    property Output: TSynMonitorSize read fOutput;
    /// incoming data processing bandwith, returned as B/KB/MB per second
    property InputThroughput: TSynMonitorThroughput read fInputThroughput;
    /// outgoing data processing bandwith, returned as B/KB/MB per second
    property OutputThroughput: TSynMonitorThroughput read fOutputThroughput;
  end;

  /// could monitor a standard Server
  // - including Input/Output statistics and connected Clients count
  TSynMonitorServer = class(TSynMonitorInputOutput)
  protected
    fCurrentRequestCount: integer;
    fClientsCurrent: TSynMonitorOneCount;
    fClientsMax: TSynMonitorOneCount;
  public
    /// update ClientsCurrent and ClientsMax
    // - thread-safe method
    procedure ClientConnect;
    /// update ClientsCurrent and ClientsMax
    // - thread-safe method
    procedure ClientDisconnect;
    /// update ClientsCurrent to 0
    // - thread-safe method
    procedure ClientDisconnectAll;
    /// retrieve the number of connected clients
    // - thread-safe method
    function GetClientsCurrent: TSynMonitorOneCount;
    /// how many concurrent requests are currently processed
    // - returns the updated number of requests
    // - thread-safe method
    function AddCurrentRequestCount(diff: integer): integer;
  published
    /// current count of connected clients
    property ClientsCurrent: TSynMonitorOneCount read fClientsCurrent;
    /// max count of connected clients
    property ClientsMax: TSynMonitorOneCount read fClientsMax;
    /// how many concurrent requests are currently processed
    // - modified via AddCurrentRequestCount() in TSQLRestServer.URI()
    property CurrentRequestCount: integer read fCurrentRequestCount;
  end;

  /// a list of simple process statistics
  TSynMonitorObjArray = array of TSynMonitor;

  /// a list of data process statistics
  TSynMonitorWithSizeObjArray = array of TSynMonitorWithSize;

  /// a list of incoming/outgoing data process statistics
  TSynMonitorInputOutputObjArray = array of TSynMonitorInputOutput;

  /// class-reference type (metaclass) of a process statistic information
  TSynMonitorClass = class of TSynMonitor;


{ ******************* cross-cutting classes and functions ***************** }

type
  /// an abstract ancestor, for implementing a custom TInterfacedObject like class
  // - by default, will do nothing: no instance would be retrieved by
  // QueryInterface unless the VirtualQueryInterface protected method is
  // overriden, and _AddRef/_Release methods would call VirtualAddRef and
  // VirtualRelease pure abstract methods
  // - using this class will leverage the signature difference between Delphi
  // and FPC, among all supported platforms
  // - the class includes a RefCount integer field
  TSynInterfacedObject = class(TObject,IUnknown)
  protected
    fRefCount: integer;
    // returns E_NOINTERFACE
    function VirtualQueryInterface(const IID: TGUID; out Obj): HResult; virtual;
    // always return 1 for a "non allocated" instance (0 triggers release)
    function VirtualAddRef: Integer; virtual; abstract;
    function VirtualRelease: Integer; virtual; abstract;
    {$ifdef FPC}
    function QueryInterface(
      {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID;
      out Obj): longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _AddRef: longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _Release: longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    {$else}
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    {$endif}
  public
    /// the associated reference count
    property RefCount: integer read fRefCount write fRefCount;
  end;

{$ifdef CPUINTEL}
{$ifndef DELPHI5OROLDER}
  /// a simple class which will set FPU exception flags for a code block
  // - using an IUnknown interface to let the compiler auto-generate a
  // try..finally block statement to reset the FPU exception register
  // - to be used e.g. as such:
  // !begin
  // !  TSynFPUException.ForLibrayCode;
  // !  ... now FPU exceptions will be ignored
  // !  ... so here it is safe to call external libray code
  // !end; // now FPU exception will be reset as with standard Delphi
  // - it will avoid any unexpected invalid floating point operation in Delphi
  // code, whereas it was in fact triggerred in some external library code
  TSynFPUException = class(TSynInterfacedObject)
  protected
    {$ifndef CPU64}
    fExpected8087, fSaved8087: word;
    {$else}
    fExpectedMXCSR, fSavedMXCSR: word;
    {$endif}
    function VirtualAddRef: Integer; override;
    function VirtualRelease: Integer; override;
  public
    /// internal constructor
    // - do not call this constructor directly, but rather use
    // ForLibraryCode/ForDelphiCode class methods
    // - for cpu32 flags are $1372 for Delphi, or $137F for library (mask all exceptions)
    // - for cpu64 flags are $1920 for Delphi, or $1FA0 for library (mask all exceptions)
    {$ifndef CPU64}
    constructor Create(Expected8087Flag: word); reintroduce;
    {$else}
    constructor Create(ExpectedMXCSR: word); reintroduce;
    {$endif}
    /// after this method call, all FPU exceptions will be ignored
    // - until the method finishes (a try..finally block is generated by
    // the compiler), then FPU exceptions will be reset into "Delphi" mode
    // - you have to put this e.g. before calling an external libray
    // - this method is thread-safe and re-entrant (by reference-counting)
    class function ForLibraryCode: IUnknown;
    /// after this method call, all FPU exceptions will be enabled
    // - this is the Delphi normal behavior
    // - until the method finishes (a try..finally block is generated by
    // the compiler), then FPU execptions will be disabled again
    // - you have to put this e.g. before running an Delphi code from
    // a callback executed in an external libray
    // - this method is thread-safe and re-entrant (by reference-counting)
    class function ForDelphiCode: IUnknown;
  end;
{$endif DELPHI5OROLDER}
{$endif CPUINTEL}

  /// interface for TAutoFree to register another TObject instance
  // to an existing IAutoFree local variable
  IAutoFree = interface
    procedure Another(var objVar; obj: TObject);
  end;

  /// simple reference-counted storage for local objects
  // - WARNING: both FPC and Delphi 10.4+ don't keep the IAutoFree instance
  // up to the end-of-method -> you should not use TAutoFree for new projects
  // :( - see https://quality.embarcadero.com/browse/RSP-30050
  // - be aware that it won't implement a full ARC memory model, but may be
  // just used to avoid writing some try ... finally blocks on local variables
  // - use with caution, only on well defined local scope
  TAutoFree = class(TInterfacedObject,IAutoFree)
  protected
    fObject: TObject;
    fObjectList: array of TObject;
  public
    /// initialize the TAutoFree class for one local variable
    // - do not call this constructor, but class function One() instead
    constructor Create(var localVariable; obj: TObject); reintroduce; overload;
    /// initialize the TAutoFree class for several local variables
    // - do not call this constructor, but class function Several() instead
    constructor Create(const varObjPairs: array of pointer); reintroduce; overload;
    /// protect one local TObject variable instance life time
    // - for instance, instead of writing:
    // !var myVar: TMyClass;
    // !begin
    // !  myVar := TMyClass.Create;
    // !  try
    // !    ... use myVar
    // !  finally
    // !    myVar.Free;
    // !  end;
    // !end;
    // - you may write:
    // !var myVar: TMyClass;
    // !begin
    // !  TAutoFree.One(myVar,TMyClass.Create);
    // !  ... use myVar
    // !end; // here myVar will be released
    // - warning: under FPC, you should assign the result of this method to a local
    // IAutoFree variable - see bug http://bugs.freepascal.org/view.php?id=26602
    // - Delphi 10.4 also did change it and release the IAutoFree before the
    // end of the current method, so you should better use a local variable
    class function One(var localVariable; obj: TObject): IAutoFree;
    /// protect several local TObject variable instances life time
    // - specified as localVariable/objectInstance pairs
    // - you may write:
    // !var var1,var2: TMyClass;
    // !begin
    // !  TAutoFree.Several([
    // !    @var1,TMyClass.Create,
    // !    @var2,TMyClass.Create]);
    // !  ... use var1 and var2
    // !end; // here var1 and var2 will be released
    // - warning: under FPC, you should assign the result of this method to a local
    // IAutoFree variable - see bug http://bugs.freepascal.org/view.php?id=26602
    // - Delphi 10.4 also did change it and release the IAutoFree before the
    // end of the current method, so you should better use a local variable
     class function Several(const varObjPairs: array of pointer): IAutoFree;
    /// protect another TObject variable to an existing IAutoFree instance life time
    // - you may write:
    // !var var1,var2: TMyClass;
    // !    auto: IAutoFree;
    // !begin
    // !  auto := TAutoFree.One(var1,TMyClass.Create);,
    // !  .... do something
    // !  auto.Another(var2,TMyClass.Create);
    // !  ... use var1 and var2
    // !end; // here var1 and var2 will be released
    procedure Another(var localVariable; obj: TObject);
    /// will finalize the associated TObject instances
    // - note that releasing the TObject instances won't be protected, so
    // any exception here may induce a memory leak: use only with "safe"
    // simple objects, e.g. mORMot's TSQLRecord
    destructor Destroy; override;
  end;

{$ifdef DELPHI5OROLDER} // IAutoLocker -> internal error C3517 under Delphi 5 :(
  TAutoLocker = class
  protected
    fSafe: TSynLocker;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Enter; virtual;
    procedure Leave; virtual;
    function ProtectMethod: IUnknown;
    /// gives an access to the internal low-level TSynLocker instance used
    function Safe: PSynLocker;
    property Locker: TSynLocker read fSafe;
  end;
  IAutoLocker = TAutoLocker;
{$else DELPHI5OROLDER}
  /// an interface used by TAutoLocker to protect multi-thread execution
  IAutoLocker = interface
    ['{97559643-6474-4AD3-AF72-B9BB84B4955D}']
    /// enter the mutex
    // - any call to Enter should be ended with a call to Leave, and
    // protected by a try..finally block, as such:
    // !begin
    // !  ... // unsafe code
    // !  fSharedAutoLocker.Enter;
    // !  try
    // !    ... // thread-safe code
    // !  finally
    // !    fSharedAutoLocker.Leave;
    // !  end;
    // !end;
    procedure Enter;
    /// leave the mutex
    // - any call to Leave should be preceded with a call to Enter
    procedure Leave;
    /// will enter the mutex until the IUnknown reference is released
    // - using an IUnknown interface to let the compiler auto-generate a
    // try..finally block statement to release the lock for the code block
    // - could be used as such under Delphi:
    // !begin
    // !  ... // unsafe code
    // !  fSharedAutoLocker.ProtectMethod;
    // !  ... // thread-safe code
    // !end; // local hidden IUnknown will release the lock for the method
    // - warning: under FPC, you should assign its result to a local variable -
    // see bug http://bugs.freepascal.org/view.php?id=26602
    // !var LockFPC: IUnknown;
    // !begin
    // !  ... // unsafe code
    // !  LockFPC := fSharedAutoLocker.ProtectMethod;
    // !  ... // thread-safe code
    // !end; // LockFPC will release the lock for the method
    // or
    // !begin
    // !  ... // unsafe code
    // !  with fSharedAutoLocker.ProtectMethod do begin
    // !    ... // thread-safe code
    // !  end; // local hidden IUnknown will release the lock for the method
    // !end;
    function ProtectMethod: IUnknown;
    /// gives an access to the internal low-level TSynLocker instance used
    function Safe: PSynLocker;
  end;

  /// reference-counted block code critical section
  // - you can use one instance of this to protect multi-threaded execution
  // - the main class may initialize a IAutoLocker property in Create, then call
  // IAutoLocker.ProtectMethod in any method to make its execution thread safe
  // - this class inherits from TInterfacedObjectWithCustomCreate so you
  // could define one published property of a mORMot.pas' TInjectableObject
  // as IAutoLocker so that this class may be automatically injected
  // - you may use the inherited TAutoLockerDebug class, as defined in SynLog.pas,
  // to debug unexpected race conditions due to such critical sections
  // - consider inherit from high-level TSynPersistentLock or call low-level
  // fSafe := NewSynLocker / fSafe^.DoneAndFreemem instead
  TAutoLocker = class(TInterfacedObjectWithCustomCreate,IAutoLocker)
  protected
    fSafe: TSynLocker;
  public
    /// initialize the mutex
    constructor Create; override;
    /// finalize the mutex
    destructor Destroy; override;
    /// will enter the mutex until the IUnknown reference is released
    // - as expected by IAutoLocker interface
    // - could be used as such under Delphi:
    // !begin
    // !  ... // unsafe code
    // !  fSharedAutoLocker.ProtectMethod;
    // !  ... // thread-safe code
    // !end; // local hidden IUnknown will release the lock for the method
    // - warning: under FPC, you should assign its result to a local variable -
    // see bug http://bugs.freepascal.org/view.php?id=26602
    // !var LockFPC: IUnknown;
    // !begin
    // !  ... // unsafe code
    // !  LockFPC := fSharedAutoLocker.ProtectMethod;
    // !  ... // thread-safe code
    // !end; // LockFPC will release the lock for the method
    // or
    // !begin
    // !  ... // unsafe code
    // !  with fSharedAutoLocker.ProtectMethod do begin
    // !    ... // thread-safe code
    // !  end; // local hidden IUnknown will release the lock for the method
    // !end;
    function ProtectMethod: IUnknown;
    /// enter the mutex
    // - as expected by IAutoLocker interface
    // - any call to Enter should be ended with a call to Leave, and
    // protected by a try..finally block, as such:
    // !begin
    // !  ... // unsafe code
    // !  fSharedAutoLocker.Enter;
    // !  try
    // !    ... // thread-safe code
    // !  finally
    // !    fSharedAutoLocker.Leave;
    // !  end;
    // !end;
    procedure Enter; virtual;
    /// leave the mutex
    // - as expected by IAutoLocker interface
    procedure Leave; virtual;
    /// access to the locking methods of this instance
    // - as expected by IAutoLocker interface
    function Safe: PSynLocker;
    /// direct access to the locking methods of this instance
    // - faster than IAutoLocker.Safe function
    property Locker: TSynLocker read fSafe;
  end;
{$endif DELPHI5OROLDER}


{$ifndef DELPHI5OROLDER} // internal error C3517 under Delphi 5 :(
{$ifndef NOVARIANTS}
  /// ref-counted interface for thread-safe access to a TDocVariant document
  // - is implemented e.g. by TLockedDocVariant, for IoC/DI resolution
  // - fast and safe storage of any JSON-like object, as property/value pairs,
  // or a JSON-like array, as values
  ILockedDocVariant = interface
    ['{CADC2C20-3F5D-4539-9D23-275E833A86F3}']
    function GetValue(const Name: RawUTF8): Variant;
    procedure SetValue(const Name: RawUTF8; const Value: Variant);
    /// check and return a given property by name
    // - returns TRUE and fill Value with the value associated with the supplied
    // Name, using an internal lock for thread-safety
    // - returns FALSE if the Name was not found, releasing the internal lock:
    // use ExistsOrLock() if you want to add the missing value
    function Exists(const Name: RawUTF8; out Value: Variant): boolean;
    /// check and return a given property by name
    // - returns TRUE and fill Value with the value associated with the supplied
    // Name, using an internal lock for thread-safety
    // - returns FALSE and set the internal lock if Name does not exist:
    // caller should then release the lock via ReplaceAndUnlock()
    function ExistsOrLock(const Name: RawUTF8; out Value: Variant): boolean;
    /// set a value by property name, and set a local copy
    // - could be used as such, for implementing a thread-safe cache:
    // ! if not cache.ExistsOrLock('prop',local) then
    // !   cache.ReplaceAndUnlock('prop',newValue,local);
    // - call of this method should have been precedeed by ExistsOrLock()
    // returning false, i.e. be executed on a locked instance
    procedure ReplaceAndUnlock(const Name: RawUTF8; const Value: Variant; out LocalValue: Variant);
    /// add an existing property value to the given TDocVariant document object
    // - returns TRUE and add the Name/Value pair to Obj if Name is existing,
    // using an internal lock for thread-safety
    // - returns FALSE if Name is not existing in the stored document, and
    // lock the internal storage: caller should eventually release the lock
    // via AddNewPropAndUnlock()
    // - could be used as such, for implementing a thread-safe cache:
    // ! if not cache.AddExistingPropOrLock('Articles',Scope) then
    // !   cache.AddNewPropAndUnlock('Articles',GetArticlesFromDB,Scope);
    // here GetArticlesFromDB would occur inside the main lock
    function AddExistingPropOrLock(const Name: RawUTF8; var Obj: variant): boolean;
    /// add a property value to the given TDocVariant document object and
    // to the internal stored document, then release a previous lock
    // - call of this method should have been precedeed by AddExistingPropOrLock()
    // returning false, i.e. be executed on a locked instance
    procedure AddNewPropAndUnlock(const Name: RawUTF8; const Value: variant; var Obj: variant);
    /// add an existing property value to the given TDocVariant document object
    // - returns TRUE and add the Name/Value pair to Obj if Name is existing
    // - returns FALSE if Name is not existing in the stored document
    // - this method would use a lock during the Name lookup, but would always
    // release the lock, even if returning FALSE (see AddExistingPropOrLock)
    function AddExistingProp(const Name: RawUTF8; var Obj: variant): boolean;
    /// add a property value to the given TDocVariant document object
    // - this method would not expect the resource to be locked when called,
    // as with AddNewPropAndUnlock
    // - will use the internal lock for thread-safety
    // - if the Name is already existing, would update/change the existing value
    // - could be used as such, for implementing a thread-safe cache:
    // ! if not cache.AddExistingProp('Articles',Scope) then
    // !   cache.AddNewProp('Articles',GetArticlesFromDB,Scope);
    // here GetArticlesFromDB would occur outside the main lock
    procedure AddNewProp(const Name: RawUTF8; const Value: variant; var Obj: variant);
    /// append a value to the internal TDocVariant document array
    // - you should not use this method in conjunction with other document-based
    // alternatives, like Exists/AddExistingPropOrLock or AddExistingProp
    procedure AddItem(const Value: variant);
    /// makes a thread-safe copy of the internal TDocVariant document object or array
    function Copy: variant;
    /// delete all stored properties
    procedure Clear;
    /// save the stored values as UTF-8 encoded JSON Object
    function ToJSON(HumanReadable: boolean=false): RawUTF8;
    /// low-level access to the associated thread-safe mutex
    function Lock: TAutoLocker;
    /// the document fields would be safely accessed via this property
    // - this is the main entry point of this storage
    // - will raise an EDocVariant exception if Name does not exist at reading
    // - implementation class would make a thread-safe copy of the variant value
    property Value[const Name: RawUTF8]: Variant read GetValue write SetValue; default;
  end;

  /// allows thread-safe access to a TDocVariant document
  // - this class inherits from TInterfacedObjectWithCustomCreate so you
  // could define one published property of a mORMot.pas' TInjectableObject
  // as ILockedDocVariant so that this class may be automatically injected
  TLockedDocVariant = class(TInterfacedObjectWithCustomCreate,ILockedDocVariant)
  protected
    fValue: TDocVariantData;
    fLock: TAutoLocker;
    function GetValue(const Name: RawUTF8): Variant;
    procedure SetValue(const Name: RawUTF8; const Value: Variant);
  public
    /// initialize the thread-safe document with a fast TDocVariant
    // - i.e. call Create(true) aka Create(JSON_OPTIONS[true])
    // - will be the TInterfacedObjectWithCustomCreate default constructor,
    // called e.g. during IoC/DI resolution
    constructor Create; overload; override;
    /// initialize the thread-safe document storage
    constructor Create(FastStorage: boolean); reintroduce; overload;
    /// initialize the thread-safe document storage with the corresponding options
    constructor Create(options: TDocVariantOptions); reintroduce; overload;
    /// finalize the storage
    destructor Destroy; override;
    /// check and return a given property by name
    function Exists(const Name: RawUTF8; out Value: Variant): boolean;
    /// check and return a given property by name
    // - this version
    function ExistsOrLock(const Name: RawUTF8; out Value: Variant): boolean;
    /// set a value by property name, and set a local copy
    procedure ReplaceAndUnlock(const Name: RawUTF8; const Value: Variant; out LocalValue: Variant);
    /// add an existing property value to the given TDocVariant document object
    // - returns TRUE and add the Name/Value pair to Obj if Name is existing
    // - returns FALSE if Name is not existing in the stored document
    function AddExistingPropOrLock(const Name: RawUTF8; var Obj: variant): boolean;
    /// add a property value to the given TDocVariant document object and
    // to the internal stored document
    procedure AddNewPropAndUnlock(const Name: RawUTF8; const Value: variant; var Obj: variant);
    /// add an existing property value to the given TDocVariant document object
    // - returns TRUE and add the Name/Value pair to Obj if Name is existing
    // - returns FALSE if Name is not existing in the stored document
    // - this method would use a lock during the Name lookup, but would always
    // release the lock, even if returning FALSE (see AddExistingPropOrLock)
    function AddExistingProp(const Name: RawUTF8; var Obj: variant): boolean;
    /// add a property value to the given TDocVariant document object
    // - this method would not expect the resource to be locked when called,
    // as with AddNewPropAndUnlock
    // - will use the internal lock for thread-safety
    // - if the Name is already existing, would update/change the existing value
    procedure AddNewProp(const Name: RawUTF8; const Value: variant; var Obj: variant);
    /// append a value to the internal TDocVariant document array
    procedure AddItem(const Value: variant);
    /// makes a thread-safe copy of the internal TDocVariant document object or array
    function Copy: variant;
    /// delete all stored properties
    procedure Clear;
    /// save the stored value as UTF-8 encoded JSON Object
    // - implemented as just a wrapper around VariantSaveJSON()
    function ToJSON(HumanReadable: boolean=false): RawUTF8;
    /// low-level access to the associated thread-safe mutex
    function Lock: TAutoLocker;
    /// the document fields would be safely accessed via this property
    // - will raise an EDocVariant exception if Name does not exist
    // - result variant is returned as a copy, not as varByRef, since a copy
    // will definitively be more thread safe
    property Value[const Name: RawUTF8]: Variant read GetValue write SetValue; default;
  end;
{$endif}
{$endif}

type
  /// class-reference type (metaclass) of an TSynPersistentLock class
  TSynPersistentLockClass = class of TSynPersistentLock;

  /// abstract dynamic array of TSynPersistentLock instance
  // - note defined as T*ObjArray, since it won't
  TSynPersistentLockDynArray = array of TSynPersistentLock;

/// convert a size to a human readable value power-of-two metric value
// - append EB, PB, TB, GB, MB, KB or B symbol with or without preceding space
// - for EB, PB, TB, GB, MB and KB, add one fractional digit
procedure KB(bytes: Int64; out result: TShort16; nospace: boolean); overload;

/// convert a size to a human readable value
// - append EB, PB, TB, GB, MB, KB or B symbol with preceding space
// - for EB, PB, TB, GB, MB and KB, add one fractional digit
function KB(bytes: Int64): TShort16; overload;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert a size to a human readable value
// - append EB, PB, TB, GB, MB, KB or B symbol without preceding space
// - for EB, PB, TB, GB, MB and KB, add one fractional digit
function KBNoSpace(bytes: Int64): TShort16;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert a size to a human readable value
// - append EB, PB, TB, GB, MB, KB or B symbol with or without preceding space
// - for EB, PB, TB, GB, MB and KB, add one fractional digit
function KB(bytes: Int64; nospace: boolean): TShort16; overload;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert a string size to a human readable value
// - append EB, PB, TB, GB, MB, KB or B symbol
// - for EB, PB, TB, GB, MB and KB, add one fractional digit
function KB(const buffer: RawByteString): TShort16; overload;
  {$ifdef FPC_OR_UNICODE}inline;{$endif}

/// convert a size to a human readable value
// - append EB, PB, TB, GB, MB, KB or B symbol
// - for EB, PB, TB, GB, MB and KB, add one fractional digit
procedure KBU(bytes: Int64; var result: RawUTF8);

/// convert a micro seconds elapsed time into a human readable value
// - append 'us', 'ms', 's', 'm', 'h' and 'd' symbol for the given value range,
// with two fractional digits
function MicroSecToString(Micro: QWord): TShort16; overload;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert a micro seconds elapsed time into a human readable value
// - append 'us', 'ms', 's', 'm', 'h' and 'd' symbol for the given value range,
// with two fractional digits
procedure MicroSecToString(Micro: QWord; out result: TShort16); overload;

/// convert an integer value into its textual representation with thousands marked
// - ThousandSep is the character used to separate thousands in numbers with
// more than three digits to the left of the decimal separator
function IntToThousandString(Value: integer; const ThousandSep: TShort4=','): shortstring;

/// return the Delphi/FPC Compiler Version
// - returns 'Delphi 2007', 'Delphi 2010' or 'Free Pascal 3.3.1' e.g.
function GetDelphiCompilerVersion: RawUTF8;

/// returns TRUE if the supplied mutex has been initialized
// - will check if the supplied mutex is void (i.e. all filled with 0 bytes)
function IsInitializedCriticalSection(const CS: TRTLCriticalSection): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// on need initialization of a mutex, then enter the lock
// - if the supplied mutex has been initialized, do nothing
// - if the supplied mutex is void (i.e. all filled with 0), initialize it
procedure InitializeCriticalSectionIfNeededAndEnter(var CS: TRTLCriticalSection);
  {$ifdef HASINLINE}inline;{$endif}

/// on need finalization of a mutex
// - if the supplied mutex has been initialized, delete it
// - if the supplied mutex is void (i.e. all filled with 0), do nothing
procedure DeleteCriticalSectionIfNeeded(var CS: TRTLCriticalSection);

/// compress a data content using the SynLZ algorithm
// - as expected by THttpSocket.RegisterCompress
// - will return 'synlz' as ACCEPT-ENCODING: header parameter
// - will store a hash of both compressed and uncompressed stream: if the
// data is corrupted during transmission, will instantly return ''
function CompressSynLZ(var DataRawByteString; Compress: boolean): AnsiString;

/// compress a data content using the SynLZ algorithm from one stream into another
// - returns the number of bytes written to Dest
// - you should specify a Magic number to be used to identify the block
function StreamSynLZ(Source: TCustomMemoryStream; Dest: TStream;
  Magic: cardinal): integer; overload;

/// compress a data content using the SynLZ algorithm from one stream into a file
// - returns the number of bytes written to the destination file
// - you should specify a Magic number to be used to identify the block
function StreamSynLZ(Source: TCustomMemoryStream; const DestFile: TFileName;
  Magic: cardinal): integer; overload;

/// uncompress using the SynLZ algorithm from one stream into another
// - returns a newly create memory stream containing the uncompressed data
// - returns nil if source data is invalid
// - you should specify a Magic number to be used to identify the block
// - this function will also recognize the block at the end of the source stream
// (if was appended to an existing data - e.g. a .mab at the end of a .exe)
// - on success, Source will point after all read data (so that you can e.g.
// append several data blocks to the same stream)
function StreamUnSynLZ(Source: TStream; Magic: cardinal): TMemoryStream; overload;

/// compute the real length of a given StreamSynLZ-compressed buffer
// - allows to replace an existing appended content, for instance
function StreamSynLZComputeLen(P: PAnsiChar; Len, aMagic: cardinal): integer;

/// uncompress using the SynLZ algorithm from one file into another
// - returns a newly create memory stream containing the uncompressed data
// - returns nil if source file is invalid (e.g. invalid name or invalid content)
// - you should specify a Magic number to be used to identify the block
// - this function will also recognize the block at the end of the source file
// (if was appended to an existing data - e.g. a .mab at the end of a .exe)
function StreamUnSynLZ(const Source: TFileName; Magic: cardinal): TMemoryStream; overload;

/// compress a file content using the SynLZ algorithm
// - source file is split into 128 MB blocks for fast in-memory compression of
// any file size, then SynLZ compressed and including a Hash32 checksum
// - it is not compatible with StreamSynLZ format, which has no 128 MB chunking
// - you should specify a Magic number to be used to identify the compressed
// file format
function FileSynLZ(const Source, Dest: TFileName; Magic: Cardinal): boolean;

/// uncompress a file previoulsy compressed via FileSynLZ(
// - you should specify a Magic number to be used to identify the compressed
// file format
function FileUnSynLZ(const Source, Dest: TFileName; Magic: Cardinal): boolean;

/// returns TRUE if the supplied file name is a SynLZ compressed file,
// matching the Magic number as supplied to FileSynLZ() function
function FileIsSynLZ(const Name: TFileName; Magic: Cardinal): boolean;

var
  /// acccess to our fast SynLZ compression as a TAlgoCompress class
  // - please use this global variable methods instead of the deprecated
  // SynLZCompress/SynLZDecompress wrapper functions
  AlgoSynLZ: TAlgoCompress;

const
  /// CompressionSizeTrigger parameter SYNLZTRIG[true] will disable then
  // SynLZCompress() compression
  SYNLZTRIG: array[boolean] of integer = (100, maxInt);
  /// used e.g. as when ALGO_SAFE[SafeDecompression] for TAlgoCompress.Decompress
  ALGO_SAFE: array[boolean] of TAlgoCompressLoad = (aclNormal, aclSafeSlow);


/// deprecated function - please call AlgoSynLZ.Compress() method
function SynLZCompress(const Data: RawByteString; CompressionSizeTrigger: integer=100;
  CheckMagicForCompressed: boolean=false): RawByteString; overload;

/// deprecated function - please call AlgoSynLZ.Compress() method
procedure SynLZCompress(P: PAnsiChar; PLen: integer; out Result: RawByteString;
  CompressionSizeTrigger: integer=100; CheckMagicForCompressed: boolean=false); overload;

/// deprecated function - please call AlgoSynLZ.Compress() method
function SynLZCompress(P, Dest: PAnsiChar; PLen, DestLen: integer;
  CompressionSizeTrigger: integer=100; CheckMagicForCompressed: boolean=false): integer; overload;

/// deprecated function - please call AlgoSynLZ.Decompress() method
function SynLZDecompress(const Data: RawByteString): RawByteString; overload;

/// deprecated function - please call AlgoSynLZ.Decompress() method
procedure SynLZDecompress(P: PAnsiChar; PLen: integer; out Result: RawByteString;
  SafeDecompression: boolean=false); overload;

/// deprecated function - please call AlgoSynLZ.DecompressToBytes() method
function SynLZCompressToBytes(const Data: RawByteString;
  CompressionSizeTrigger: integer=100): TByteDynArray; overload;

/// deprecated function - please call AlgoSynLZ.CompressToBytes() method
function SynLZCompressToBytes(P: PAnsiChar; PLen: integer;
  CompressionSizeTrigger: integer=100): TByteDynArray; overload;

/// deprecated function - please call AlgoSynLZ.Decompress() method
function SynLZDecompress(const Data: TByteDynArray): RawByteString; overload;

/// deprecated function - please call AlgoSynLZ.Decompress() method
function SynLZDecompress(const Data: RawByteString; out Len: integer;
  var tmp: RawByteString): pointer; overload;

/// deprecated function - please call AlgoSynLZ.Decompress() method
function SynLZDecompress(P: PAnsiChar; PLen: integer; out Len: integer;
  var tmp: RawByteString): pointer; overload;

/// deprecated function - please call AlgoSynLZ.DecompressHeader() method
function SynLZDecompressHeader(P: PAnsiChar; PLen: integer): integer;

/// deprecated function - please call AlgoSynLZ.DecompressBody() method
function SynLZDecompressBody(P,Body: PAnsiChar; PLen,BodyLen: integer;
  SafeDecompression: boolean=false): boolean;

/// deprecated function - please call AlgoSynLZ.DecompressPartial() method
function SynLZDecompressPartial(P,Partial: PAnsiChar; PLen,PartialLen: integer): integer;



implementation

{$ifdef FPC}
uses
  {$ifdef FPC_X64MM}
  {$ifdef CPUX64}
  SynFPCx64MM,
  {$else}
  {$undef FPC_X64MM}
  {$endif CPUX64}
  {$endif FPC_X64MM}
  {$ifdef LINUX}
  Unix,
  dynlibs,
  {$ifdef BSD}
  sysctl,
  {$else}
  Linux,
  {$endif BSD}
  {$ifdef FPCUSEVERSIONINFO} // to be enabled in Synopse.inc
    fileinfo, // FPC 3.0 and up
    {$ifdef DARWIN}
      machoreader, // MACH-O executables
    {$else}
      elfreader, // ELF executables
    {$endif DARWIN}
  {$endif FPCUSEVERSIONINFO}
  {$ifdef ISFPC271}
    unixcp, // for GetSystemCodePage
  {$endif}
  SynFPCLinux,
  {$endif LINUX}
  SynFPCTypInfo; // small wrapper unit around FPC's TypInfo.pp
{$endif FPC}


{ ************ some fast UTF-8 / Unicode / Ansi conversion routines }

var
  // internal list of TSynAnsiConvert instances
  SynAnsiConvertList: TSynObjectList = nil;

{$ifdef HASINLINE}
{$ifdef USE_VTYPE_STATIC} // circumvent weird bug on BSD + ARM (Alfred)
procedure VarClear(var v: variant); // defined here for proper inlining
const VTYPE_STATIC = $BFE8; // bitmask to avoid remote VarClearProc call
var p: PInteger; // more efficient generated asm with an explicit temp variable
begin
  p := @v;
  if p^ and VTYPE_STATIC=0 then
    p^ := 0 else
    VarClearProc(PVarData(p)^);
end;
{$else}
procedure VarClear(var v: variant); // defined here for proper inlining
begin
  VarClearProc(PVarData(@v)^);
end;
{$endif USE_VTYPE_STATIC}
{$endif HASINLINE}

procedure MoveSmall(Source, Dest: Pointer; Count: PtrUInt);
var c: AnsiChar; // better FPC inlining
begin
  inc(PtrUInt(Source),Count);
  inc(PtrUInt(Dest),Count);
  PtrInt(Count) := -PtrInt(Count);
  repeat
    c := PAnsiChar(Source)[Count];
    PAnsiChar(Dest)[Count] := c;
    inc(Count);
  until Count=0;
end;


{ TSynTempBuffer }

procedure TSynTempBuffer.Init(Source: pointer; SourceLen: PtrInt);
begin
  len := SourceLen;
  if len<=0 then
    buf := nil else begin
    if len<=SizeOf(tmp)-16 then
      buf := @tmp else
      GetMem(buf,len+16); // +16 for trailing #0 and for PInteger() parsing
    if Source<>nil then begin
      MoveFast(Source^,buf^,len);
      PPtrInt(PAnsiChar(buf)+len)^ := 0; // init last 4/8 bytes (makes valgrid happy)
    end;
  end;
end;

function TSynTempBuffer.InitOnStack: pointer;
begin
  buf := @tmp;
  len := SizeOf(tmp);
  result := @tmp;
end;

procedure TSynTempBuffer.Init(const Source: RawByteString);
begin
  Init(pointer(Source),length(Source));
end;

function TSynTempBuffer.Init(Source: PUTF8Char): PUTF8Char;
begin
  Init(Source,StrLen(Source));
  result := buf;
end;

function TSynTempBuffer.Init(SourceLen: PtrInt): pointer;
begin
  len := SourceLen;
  if len<=0 then
    buf := nil else begin
    if len<=SizeOf(tmp)-16 then
      buf := @tmp else
      GetMem(buf,len+16); // +16 for trailing #0 and for PInteger() parsing
  end;
  result := buf;
end;

function TSynTempBuffer.Init: integer;
begin
  buf := @tmp;
  result := SizeOf(tmp)-16;
  len := result;
end;

function TSynTempBuffer.InitRandom(RandomLen: integer; forcegsl: boolean): pointer;
begin
  Init(RandomLen);
  if RandomLen>0 then
    FillRandom(buf,(RandomLen shr 2)+1,forcegsl);
  result := buf;
end;

function TSynTempBuffer.InitIncreasing(Count, Start: PtrInt): PIntegerArray;
begin
  Init((Count-Start)*4);
  FillIncreasing(buf,Start,Count);
  result := buf;
end;

function TSynTempBuffer.InitZero(ZeroLen: PtrInt): pointer;
begin
  Init(ZeroLen-16);
  FillCharFast(buf^,ZeroLen,0);
  result := buf;
end;

procedure TSynTempBuffer.Done;
begin
  if (buf<>@tmp) and (buf<>nil) then
    FreeMem(buf);
end;

procedure TSynTempBuffer.Done(EndBuf: pointer; var Dest: RawUTF8);
begin
  if EndBuf=nil then
    Dest := '' else
    FastSetString(Dest,buf,PAnsiChar(EndBuf)-PAnsiChar(buf));
  if (buf<>@tmp) and (buf<>nil) then
    FreeMem(buf);
end;


{ TSynAnsiConvert }

{$ifdef MSWINDOWS}
const
  DefaultCharVar: AnsiChar = '?';
{$endif}

function TSynAnsiConvert.AnsiBufferToUnicode(Dest: PWideChar;
  Source: PAnsiChar; SourceChars: Cardinal; NoTrailingZero: boolean): PWideChar;
var c: cardinal;
{$ifndef MSWINDOWS}
{$ifdef KYLIX3}
    ic: iconv_t;
    DestBegin: PAnsiChar;
    SourceCharsBegin: integer;
{$endif}
{$endif}
begin
  {$ifdef KYLIX3}
  SourceCharsBegin := SourceChars;
  DestBegin := pointer(Dest);
  {$endif}
  // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
  if SourceChars>=4 then
  repeat
    c := PCardinal(Source)^;
    if c and $80808080<>0 then
      break; // break on first non ASCII quad
    dec(SourceChars,4);
    inc(Source,4);
    PCardinal(Dest)^ := (c shl 8 or (c and $FF)) and $00ff00ff;
    c := c shr 16;
    PCardinal(Dest+2)^ := (c shl 8 or c) and $00ff00ff;
    inc(Dest,4);
  until SourceChars<4;
  if (SourceChars>0) and (ord(Source^)<=127) then
    repeat
      dec(SourceChars);
      PWord(Dest)^ := ord(Source^); // much faster than dest^ := WideChar(c) for FPC
      inc(Source);
      inc(Dest);
    until (SourceChars=0) or (ord(Source^)>=128);
  // rely on the Operating System for all remaining ASCII characters
  if SourceChars=0 then
    result := Dest else begin
    {$ifdef MSWINDOWS}
    result := Dest+MultiByteToWideChar(
      fCodePage,MB_PRECOMPOSED,Source,SourceChars,Dest,SourceChars);
    {$else}
    {$ifdef ISDELPHIXE} // use cross-platform wrapper for MultiByteToWideChar()
    result := Dest+UnicodeFromLocaleChars(
      fCodePage,MB_PRECOMPOSED,Source,SourceChars,Dest,SourceChars);
    {$else}
    {$ifdef FPC}
    // uses our SynFPCLinux ICU API helper
    result := Dest+AnsiToWideICU(fCodePage,Source,Dest,SourceChars);
    {$else}
    {$ifdef KYLIX3}
    result := Dest; // makes compiler happy
    ic := LibC.iconv_open('UTF-16LE',Pointer(fIConvCodeName));
    if PtrInt(ic)>=0 then
    try
      result := IconvBufConvert(ic,Source,SourceChars,1,
        Dest,SourceCharsBegin*2-(PAnsiChar(Dest)-DestBegin),2);
    finally
      LibC.iconv_close(ic);
    end else
    {$else}
    raise ESynException.CreateUTF8('%.AnsiBufferToUnicode() not supported yet for CP=%',
      [self,CodePage]);
    {$endif KYLIX3}
    {$endif FPC}
    {$endif ISDELPHIXE}
    {$endif MSWINDOWS}
  end;
  if not NoTrailingZero then
    result^ := #0;
end;

function TSynAnsiConvert.AnsiBufferToUTF8(Dest: PUTF8Char;
  Source: PAnsiChar; SourceChars: Cardinal; NoTrailingZero: boolean): PUTF8Char;
var tmp: TSynTempBuffer;
    c: cardinal;
    U: PWideChar;
begin
  // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
  if SourceChars>=4 then
    repeat
      c := PCardinal(Source)^;
      if c and $80808080<>0 then
        break; // break on first non ASCII quad
      PCardinal(Dest)^ := c;
      dec(SourceChars,4);
      inc(Source,4);
      inc(Dest,4);
    until SourceChars<4;
  if (SourceChars>0) and (ord(Source^)<=127) then
    repeat
      Dest^ := Source^;
      dec(SourceChars);
      inc(Source);
      inc(Dest);
    until (SourceChars=0) or (ord(Source^)>=128);
  // rely on the Operating System for all remaining ASCII characters
  if SourceChars=0 then
    result := Dest else begin
    U := AnsiBufferToUnicode(tmp.Init(SourceChars*3),Source,SourceChars);
    result := Dest+RawUnicodeToUtf8(Dest,SourceChars*3,tmp.buf,
      (PtrUInt(U)-PtrUInt(tmp.buf))shr 1,[ccfNoTrailingZero]);
    tmp.Done;
  end;
  if not NoTrailingZero then
    result^ := #0;
end;

// UTF-8 is AT MOST 50% bigger than UTF-16 in bytes in range U+0800..U+FFFF
// see http://stackoverflow.com/a/7008095 -> bytes=WideCharCount*3 below

procedure TSynAnsiConvert.InternalAppendUTF8(Source: PAnsiChar; SourceChars: Cardinal;
  DestTextWriter: TObject; Escape: TTextWriterKind);
var W: TTextWriter absolute DestTextWriter;
    tmp: TSynTempBuffer;
begin // rely on explicit conversion
  SourceChars := AnsiBufferToUTF8(tmp.Init(SourceChars*3),Source,SourceChars)-PUTF8Char(tmp.buf);
  W.Add(tmp.buf,SourceChars,Escape);
  tmp.Done;
end;

function TSynAnsiConvert.AnsiToRawUnicode(const AnsiText: RawByteString): RawUnicode;
begin
  result := AnsiToRawUnicode(pointer(AnsiText),length(AnsiText));
end;

function TSynAnsiConvert.AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode;
var U: PWideChar;
    tmp: TSynTempBuffer;
begin
  if SourceChars=0 then
    result := '' else begin
    U := AnsiBufferToUnicode(tmp.Init(SourceChars*2),Source,SourceChars);
    U^ := #0;
    SetString(result,PAnsiChar(tmp.buf),PtrUInt(U)-PtrUInt(tmp.buf)+1);
    tmp.Done;
  end;
end;

function TSynAnsiConvert.AnsiToUnicodeString(Source: PAnsiChar; SourceChars: Cardinal): SynUnicode;
var tmp: TSynTempBuffer;
    U: PWideChar;
begin
  if SourceChars=0 then
    result := '' else begin
    U := AnsiBufferToUnicode(tmp.Init(SourceChars*2),Source,SourceChars);
    SetString(result,PWideChar(tmp.buf),(PtrUInt(U)-PtrUInt(tmp.buf))shr 1);
    tmp.Done;
  end;
end;

function TSynAnsiConvert.AnsiToUnicodeString(const Source: RawByteString): SynUnicode;
var tmp: TSynTempBuffer;
    U: PWideChar;
begin
  if Source='' then
    result := '' else begin
    tmp.Init(length(Source)*2); // max dest size in bytes
    U := AnsiBufferToUnicode(tmp.buf,pointer(Source),length(Source));
    SetString(result,PWideChar(tmp.buf),(PtrUInt(U)-PtrUInt(tmp.buf))shr 1);
    tmp.Done;
  end;
end;

function TSynAnsiConvert.AnsiToUTF8(const AnsiText: RawByteString): RawUTF8;
begin
  result := AnsiBufferToRawUTF8(pointer(AnsiText),length(AnsiText));
end;

function TSynAnsiConvert.AnsiBufferToRawUTF8(Source: PAnsiChar; SourceChars: Cardinal): RawUTF8;
var tmp: TSynTempBuffer;
    endchar: pointer; // try circumvent Delphi 10.4 optimization issue
begin
  if (Source=nil) or (SourceChars=0) then
    result := '' else begin
    endchar := AnsiBufferToUTF8(tmp.Init(SourceChars*3),Source,SourceChars,true);
    tmp.Done(endchar,result);
  end;
end;

constructor TSynAnsiConvert.Create(aCodePage: cardinal);
begin
  fCodePage := aCodePage;
  fAnsiCharShift := 1; // default is safe
  {$ifdef KYLIX3}
  fIConvCodeName := 'CP'+UInt32ToUTF8(aCodePage);
  {$endif}
end;

function IsFixedWidthCodePage(aCodePage: cardinal): boolean;
begin
  result := ((aCodePage>=1250) and (aCodePage<=1258)) or
             (aCodePage=CODEPAGE_LATIN1) or (aCodePage=CP_RAWBYTESTRING);
end;

class function TSynAnsiConvert.Engine(aCodePage: cardinal): TSynAnsiConvert;
var i: PtrInt;
begin
  if SynAnsiConvertList=nil then begin
    GarbageCollectorFreeAndNil(SynAnsiConvertList,TSynObjectList.Create);
    CurrentAnsiConvert := TSynAnsiConvert.Engine(GetACP);
    WinAnsiConvert := TSynAnsiConvert.Engine(CODEPAGE_US) as TSynAnsiFixedWidth;
    UTF8AnsiConvert := TSynAnsiConvert.Engine(CP_UTF8) as TSynAnsiUTF8;
  end;
  if aCodePage<=0 then begin
    result := CurrentAnsiConvert;
    exit;
  end;
  with SynAnsiConvertList do
    for i := 0 to Count-1 do begin
      result := List[i];
      if result.CodePage=aCodePage then
        exit;
    end;
  if aCodePage=CP_UTF8 then
    result := TSynAnsiUTF8.Create(CP_UTF8) else
  if aCodePage=CP_UTF16 then
    result := TSynAnsiUTF16.Create(CP_UTF16) else
  if IsFixedWidthCodePage(aCodePage) then
    result := TSynAnsiFixedWidth.Create(aCodePage) else
    result := TSynAnsiConvert.Create(aCodePage);
  SynAnsiConvertList.Add(result);
end;

function TSynAnsiConvert.UnicodeBufferToAnsi(Dest: PAnsiChar;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
var c: cardinal;
{$ifndef MSWINDOWS}
{$ifdef KYLIX3}
    ic: iconv_t;
    DestBegin: PAnsiChar;
    SourceCharsBegin: integer;
{$endif}
{$endif MSWINDOWS}
begin
  {$ifdef KYLIX3}
  SourceCharsBegin := SourceChars;
  DestBegin := Dest;
  {$endif}
  // first handle trailing 7 bit ASCII chars, by pairs (Sha optimization)
  if SourceChars>=2 then
    repeat
      c := PCardinal(Source)^;
      if c and $ff80ff80<>0 then
        break; // break on first non ASCII pair
      dec(SourceChars,2);
      inc(Source,2);
      c := c shr 8 or c;
      PWord(Dest)^ := c;
      inc(Dest,2);
    until SourceChars<2;
  if (SourceChars>0) and (ord(Source^)<=127) then
    repeat
      Dest^ := AnsiChar(ord(Source^));
      dec(SourceChars);
      inc(Source);
      inc(Dest);
    until (SourceChars=0) or (ord(Source^)>=128);
  // rely on the Operating System for all remaining ASCII characters
  if SourceChars=0 then
    result := Dest else begin
    {$ifdef MSWINDOWS}
    result := Dest+WideCharToMultiByte(
      fCodePage,0,Source,SourceChars,Dest,SourceChars*3,@DefaultCharVar,nil);
    {$else}
    {$ifdef ISDELPHIXE} // use cross-platform wrapper for WideCharToMultiByte()
    result := Dest+System.LocaleCharsFromUnicode(
      fCodePage,0,Source,SourceChars,Dest,SourceChars*3,@DefaultCharVar,nil);
    {$else}
    {$ifdef FPC}
    // uses our SynFPCLinux ICU API helper
    result := Dest+WideToAnsiICU(fCodePage,Source,Dest,SourceChars);
    {$else}
    {$ifdef KYLIX3}
    result := Dest; // makes compiler happy
    ic := LibC.iconv_open(Pointer(fIConvCodeName),'UTF-16LE');
    if PtrInt(ic)>=0 then
    try
      result := IconvBufConvert(ic,Source,SourceChars,2,
        Dest,SourceCharsBegin*3-(PAnsiChar(Dest)-DestBegin),1);
    finally
      LibC.iconv_close(ic);
    end else
    {$else}
    raise ESynException.CreateUTF8('%.UnicodeBufferToAnsi() not supported yet for CP=%',
      [self,CodePage]);    {$endif KYLIX3}
    {$endif FPC}
    {$endif ISDELPHIXE}
    {$endif MSWINDOWS}
  end;
end;

function TSynAnsiConvert.UTF8BufferToAnsi(Dest: PAnsiChar;
  Source: PUTF8Char; SourceChars: Cardinal): PAnsiChar;
var tmp: TSynTempBuffer;
begin
  if (Source=nil) or (SourceChars=0) then
    result := Dest else begin
    tmp.Init((SourceChars+1) shl fAnsiCharShift);
    result := UnicodeBufferToAnsi(Dest,tmp.buf,UTF8ToWideChar(tmp.buf,Source,SourceChars) shr 1);
    tmp.Done;
  end;
end;

function TSynAnsiConvert.UTF8BufferToAnsi(Source: PUTF8Char;
  SourceChars: Cardinal): RawByteString;
begin
  UTF8BufferToAnsi(Source,SourceChars,result);
end;

procedure TSynAnsiConvert.UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal;
  var result: RawByteString);
var tmp: TSynTempBuffer;
begin
  if (Source=nil) or (SourceChars=0) then
    result := '' else begin
    tmp.Init((SourceChars+1) shl fAnsiCharShift);
    FastSetStringCP(result,tmp.buf,
      Utf8BufferToAnsi(tmp.buf,Source,SourceChars)-PAnsiChar(tmp.buf),fCodePage);
    tmp.Done;
  end;
end;

function TSynAnsiConvert.UTF8ToAnsi(const UTF8: RawUTF8): RawByteString;
begin
  UTF8BufferToAnsi(pointer(UTF8),length(UTF8),result);
end;

function TSynAnsiConvert.Utf8ToAnsiBuffer(const S: RawUTF8;
  Dest: PAnsiChar; DestSize: integer): integer;
var tmp: array[0..2047] of AnsiChar; // truncated to 2KB as documented
begin
  if (DestSize<=0) or (Dest=nil) then begin
    result := 0;
    exit;
  end;
  result := length(s);
  if result>0 then begin
    if result>SizeOf(tmp) then
      result := SizeOf(tmp);
    result := UTF8BufferToAnsi(tmp,pointer(s),result)-tmp;
    if result>=DestSize then
      result := DestSize-1;
    MoveFast(tmp,Dest^,result);
  end;
  Dest[result] := #0;
end;

function TSynAnsiConvert.UnicodeBufferToAnsi(Source: PWideChar; SourceChars: Cardinal): RawByteString;
var tmp: TSynTempBuffer;
begin
  if (Source=nil) or (SourceChars=0) then
    result := '' else begin
    tmp.Init((SourceChars+1) shl fAnsiCharShift);
    FastSetStringCP(result,tmp.buf,
      UnicodeBufferToAnsi(tmp.buf,Source,SourceChars)-PAnsiChar(tmp.buf),fCodePage);
    tmp.Done;
  end;
end;

function TSynAnsiConvert.RawUnicodeToAnsi(const Source: RawUnicode): RawByteString;
begin
  result := UnicodeBufferToAnsi(pointer(Source),length(Source) shr 1);
end;

function TSynAnsiConvert.AnsiToAnsi(From: TSynAnsiConvert; const Source: RawByteString): RawByteString;
begin
  if From=self then
    result := Source else
    result := AnsiToAnsi(From,pointer(Source),length(Source));
end;

function TSynAnsiConvert.AnsiToAnsi(From: TSynAnsiConvert; Source: PAnsiChar; SourceChars: cardinal): RawByteString;
var tmpU: array[byte] of WideChar;
    U: PWideChar;
begin
  if From=self then
    FastSetStringCP(result,Source,SourceChars,fCodePage) else
  if (Source=nil) or (SourceChars=0) then
    result := '' else
  if SourceChars<SizeOf(tmpU) shr 1 then
    result := UnicodeBufferToAnsi(tmpU,
      (PtrUInt(From.AnsiBufferToUnicode(tmpU,Source,SourceChars))-PtrUInt(@tmpU))shr 1) else begin
    GetMem(U,SourceChars*2+2);
    result := UnicodeBufferToAnsi(U,From.AnsiBufferToUnicode(U,Source,SourceChars)-U);
    FreeMem(U);
  end;
end;


{ TSynAnsiFixedWidth }

function TSynAnsiFixedWidth.AnsiBufferToUnicode(Dest: PWideChar;
  Source: PAnsiChar; SourceChars: Cardinal; NoTrailingZero: boolean): PWideChar;
var i: Integer;
    tab: PWordArray;
begin
  // PWord*(Dest)[] is much faster than dest^ := WideChar(c) for FPC
  tab := pointer(fAnsiToWide);
  for i := 1 to SourceChars shr 2 do begin
    PWordArray(Dest)[0] := tab[Ord(Source[0])];
    PWordArray(Dest)[1] := tab[Ord(Source[1])];
    PWordArray(Dest)[2] := tab[Ord(Source[2])];
    PWordArray(Dest)[3] := tab[Ord(Source[3])];
    inc(Source,4);
    inc(Dest,4);
  end;
  for i := 1 to SourceChars and 3 do begin
    PWord(Dest)^ := tab[Ord(Source^)];
    inc(Dest);
    inc(Source);
  end;
  if not NoTrailingZero then
    Dest^ := #0;
  result := Dest;
end;

{$ifdef CPUARM} // circumvent FPC issue on ARM
function ToByte(value: cardinal): cardinal; inline;
begin
  result := value and $ff;
end;
{$else}
type ToByte = byte;
{$endif}

function TSynAnsiFixedWidth.AnsiBufferToUTF8(Dest: PUTF8Char;
  Source: PAnsiChar; SourceChars: Cardinal; NoTrailingZero: boolean): PUTF8Char;
var EndSource, EndSourceBy4: PAnsiChar;
    c: Cardinal;
label By4, By1; // ugly but faster
begin
  if (self=nil) or (Dest=nil) then begin
    Result := nil;
    Exit;
  end else
  if (Source<>nil) and (SourceChars>0) then begin
    // handle 7 bit ASCII WideChars, by quads (Sha optimization)
    EndSource := Source+SourceChars;
    EndSourceBy4 := EndSource-4;
    if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then
    repeat
By4:  c := PCardinal(Source)^;
      if c and $80808080<>0 then
        goto By1; // break on first non ASCII quad
      inc(Source,4);
      PCardinal(Dest)^ := c;
      inc(Dest,4);
    until Source>EndSourceBy4;
    // generic loop, handling one WideChar per iteration
    if Source<EndSource then
    repeat
By1:  c := byte(Source^); inc(Source);
      if c<=$7F then begin
        Dest^ := AnsiChar(c); // 0..127 don't need any translation
        Inc(Dest);
        if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then goto By4;
        if Source<endSource then continue else break;
      end
      else begin // no surrogate is expected in TSynAnsiFixedWidth charsets
        c := fAnsiToWide[c]; // convert FixedAnsi char into Unicode char
        if c>$7ff then begin
          Dest[0] := AnsiChar($E0 or (c shr 12));
          Dest[1] := AnsiChar($80 or ((c shr 6) and $3F));
          Dest[2] := AnsiChar($80 or (c and $3F));
          Inc(Dest,3);
          if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then goto By4;
          if Source<EndSource then continue else break;
        end else begin
          Dest[0] := AnsiChar($C0 or (c shr 6));
          Dest[1] := AnsiChar($80 or (c and $3F));
          Inc(Dest,2);
          if (PtrUInt(Source) and 3=0) and (Source<EndSourceBy4) then goto By4;
          if Source<endSource then continue else break;
        end;
      end;
    until false;
  end;
  if not NoTrailingZero then
    Dest^ := #0;
  {$ifdef ISDELPHI104}
  exit(Dest); // circumvent Delphi 10.4 optimizer bug
  {$else}
  Result := Dest;
  {$endif}
end;

procedure TSynAnsiFixedWidth.InternalAppendUTF8(Source: PAnsiChar; SourceChars: Cardinal;
  DestTextWriter: TObject; Escape: TTextWriterKind);
begin
  TTextWriter(DestTextWriter).InternalAddFixedAnsi(
    Source,SourceChars,pointer(fAnsiToWide),Escape);
end;

function TSynAnsiFixedWidth.AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode;
begin
  if SourceChars=0 then
    result := '' else begin
    SetString(result,nil,SourceChars*2+1);
    AnsiBufferToUnicode(pointer(result),Source,SourceChars);
  end;
end;

const
  /// used for fast WinAnsi to Unicode conversion
  // - this table contain all the unicode characters corresponding to
  // the Ansi Code page 1252 (i.e. WinAnsi), which unicode value are > 255
  // - values taken from MultiByteToWideChar(1252,0,@Tmp,256,@WinAnsiTable,256)
  // so these values are available outside the Windows platforms (e.g. Linux/BSD)
  // and even if registry has been tweaked as such:
  // http://www.fas.harvard.edu/~chgis/data/chgis/downloads/v4/howto/cyrillic.html
  WinAnsiUnicodeChars: packed array[128..159] of word =
    (8364, 129, 8218, 402, 8222, 8230, 8224, 8225, 710, 8240, 352, 8249, 338,
     141, 381, 143, 144, 8216, 8217, 8220, 8221, 8226, 8211, 8212, 732, 8482,
     353, 8250, 339, 157, 382, 376);

constructor TSynAnsiFixedWidth.Create(aCodePage: cardinal);
var i: PtrInt;
    A256: array[0..256] of AnsiChar;
    U256: array[0..256] of WideChar; // AnsiBufferToUnicode() write a last #0
begin
  inherited;
  if not IsFixedWidthCodePage(aCodePage) then
    // ESynException.CreateUTF8() uses UTF8ToString() -> use CreateFmt() here
    raise ESynException.CreateFmt('%s.Create - Invalid code page %d',
      [ClassName,fCodePage]);
  // create internal look-up tables
  SetLength(fAnsiToWide,256);
  if (aCodePage=CODEPAGE_US) or (aCodePage=CODEPAGE_LATIN1) or
     (aCodePage=CP_RAWBYTESTRING) then begin
    for i := 0 to 255 do
      fAnsiToWide[i] := i;
    if aCodePage=CODEPAGE_US then // do not trust the Windows API :(
      for i := low(WinAnsiUnicodeChars) to high(WinAnsiUnicodeChars) do
        fAnsiToWide[i] := WinAnsiUnicodeChars[i];
  end else begin // from Operating System returned values
    for i := 0 to 255 do
      A256[i] := AnsiChar(i);
    FillcharFast(U256,SizeOf(U256),0);
    if PtrUInt(inherited AnsiBufferToUnicode(U256,A256,256))-PtrUInt(@U256)>512 then
      // warning: CreateUTF8() uses UTF8ToString() -> use CreateFmt() now
      raise ESynException.CreateFmt('OS error for %s.Create(%d)',[ClassName,aCodePage]);
    MoveFast(U256[0],fAnsiToWide[0],512);
  end;
  SetLength(fWideToAnsi,65536);
  for i := 1 to 126 do
    fWideToAnsi[i] := i;
  FillcharFast(fWideToAnsi[127],65536-127,ord('?')); // '?' for unknown char
  for i := 127 to 255 do
    if (fAnsiToWide[i]<>0) and (fAnsiToWide[i]<>ord('?')) then
      fWideToAnsi[fAnsiToWide[i]] := i;
  // fixed width Ansi will never be bigger than UTF-8
  fAnsiCharShift := 0;
end;

function TSynAnsiFixedWidth.IsValidAnsi(WideText: PWideChar; Length: PtrInt): boolean;
var i: PtrInt;
    wc: PtrUInt;
begin
  result := false;
  if WideText<>nil then
    for i := 0 to Length-1 do begin
      wc := PtrUInt(WideText[i]);
      if wc=0 then
        break else
      if wc<256 then
        if fAnsiToWide[wc]<256 then
          continue else
          exit else
          if fWideToAnsi[wc]=ord('?') then
            exit else
            continue;
    end;
  result := true;
end;

function TSynAnsiFixedWidth.IsValidAnsi(WideText: PWideChar): boolean;
var wc: PtrUInt;
begin
  result := false;
  if WideText<>nil then
    repeat
      wc := PtrUInt(WideText^);
      inc(WideText);
      if wc=0 then
        break else
      if wc<256 then
        if fAnsiToWide[wc]<256 then
          continue else
          exit else
          if fWideToAnsi[wc]=ord('?') then
            exit else
            continue;
    until false;
  result := true;
end;

function TSynAnsiFixedWidth.IsValidAnsiU(UTF8Text: PUTF8Char): boolean;
var c: PtrUInt;
    i, extra: PtrInt;
begin
  result := false;
  if UTF8Text<>nil then
    repeat
      c := byte(UTF8Text^);
      inc(UTF8Text);
      if c=0 then break else
      if c<=127 then
        continue else begin
        extra := UTF8_EXTRABYTES[c];
        if UTF8_EXTRA[extra].minimum>$ffff then
          exit;
        for i := 1 to extra do begin
          if byte(UTF8Text^) and $c0<>$80 then exit; // invalid UTF-8 content
          c := c shl 6+byte(UTF8Text^);
          inc(UTF8Text);
        end;
        dec(c,UTF8_EXTRA[extra].offset);
        if (c>$ffff) or (fWideToAnsi[c]=ord('?')) then
          exit; // invalid char in the WinAnsi code page
      end;
    until false;
  result := true;
end;

function TSynAnsiFixedWidth.IsValidAnsiU8Bit(UTF8Text: PUTF8Char): boolean;
var c: PtrUInt;
    i, extra: PtrInt;
begin
  result := false;
  if UTF8Text<>nil then
    repeat
      c := byte(UTF8Text^);
      inc(UTF8Text);
      if c=0 then break else
      if c<=127 then
        continue else begin
        extra := UTF8_EXTRABYTES[c];
        if UTF8_EXTRA[extra].minimum>$ffff then
          exit;
        for i := 1 to extra do begin
          if byte(UTF8Text^) and $c0<>$80 then exit; // invalid UTF-8 content
          c := c shl 6+byte(UTF8Text^);
          inc(UTF8Text);
        end;
        dec(c,UTF8_EXTRA[extra].offset);
        if (c>255) or (fAnsiToWide[c]>255) then
          exit; // not 8 bit char (like "tm" or such) is marked invalid
      end;
    until false;
  result := true;
end;

function TSynAnsiFixedWidth.UnicodeBufferToAnsi(Dest: PAnsiChar;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
var c: cardinal;
    tab: PAnsiChar;
begin
  // first handle trailing 7 bit ASCII chars, by pairs (Sha optimization)
  if SourceChars>=2 then
  repeat
    c := PCardinal(Source)^;
    if c and $ff80ff80<>0 then
      break; // break on first non ASCII pair
    dec(SourceChars,2);
    inc(Source,2);
    c := c shr 8 or c;
    PWord(Dest)^ := c;
    inc(Dest,2);
  until SourceChars<2;
  // use internal lookup tables for fast process of remaining chars
  tab := pointer(fWideToAnsi);
  for c := 1 to SourceChars shr 2 do begin
    Dest[0] := tab[Ord(Source[0])];
    Dest[1] := tab[Ord(Source[1])];
    Dest[2] := tab[Ord(Source[2])];
    Dest[3] := tab[Ord(Source[3])];
    inc(Source,4);
    inc(Dest,4);
  end;
  for c := 1 to SourceChars and 3 do begin
    Dest^ := tab[Ord(Source^)];
    inc(Dest);
    inc(Source);
  end;
  result := Dest;
end;

function TSynAnsiFixedWidth.UTF8BufferToAnsi(Dest: PAnsiChar;
  Source: PUTF8Char; SourceChars: Cardinal): PAnsiChar;
var c: cardinal;
    endSource, endSourceBy4: PUTF8Char;
    i,extra: integer;
label By1, By4, Quit; // ugly but faster
begin
  // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
  endSource := Source+SourceChars;
  endSourceBy4 := endSource-4;
  if (PtrUInt(Source) and 3=0) and (Source<=endSourceBy4) then
    repeat
By4:  c := PCardinal(Source)^;
      if c and $80808080<>0 then
        goto By1; // break on first non ASCII quad
      PCardinal(Dest)^ := c;
      inc(Source,4);
      inc(Dest,4);
    until Source>endSourceBy4;
  // generic loop, handling one UTF-8 code per iteration
  if Source<endSource then
    repeat
By1:  c := byte(Source^);
      inc(Source);
      if ord(c)<=127 then begin
        Dest^ := AnsiChar(c);
        inc(Dest);
        if (PtrUInt(Source) and 3=0) and (Source<=endSourceBy4) then goto By4;
        if Source<endSource then continue else break;
      end else begin
        extra := UTF8_EXTRABYTES[c];
        if (extra=0) or (Source+extra>endSource) then break;
        for i := 1 to extra do begin
          if byte(Source^) and $c0<>$80 then
            goto Quit; // invalid UTF-8 content
          c := c shl 6+byte(Source^);
          inc(Source);
        end;
        dec(c,UTF8_EXTRA[extra].offset);
        if c>$ffff then
          Dest^ := '?' else // '?' as in unknown fWideToAnsi[] items
          Dest^ := AnsiChar(fWideToAnsi[c]);
        inc(Dest);
        if (PtrUInt(Source) and 3=0) and (Source<=endSourceBy4) then goto By4;
        if Source<endSource then continue else break;
      end;
    until false;
Quit:
  result := Dest;
end;

function TSynAnsiFixedWidth.WideCharToAnsiChar(wc: cardinal): integer;
begin
  if wc<256 then
    if fAnsiToWide[wc]<256 then
      result := wc else
      result := -1 else
      if wc<=65535 then begin
        result := fWideToAnsi[wc];
        if result=ord('?') then
          result := -1;
      end else
      result := -1;
end;


{ TSynAnsiUTF8 }

function TSynAnsiUTF8.AnsiBufferToUnicode(Dest: PWideChar;
  Source: PAnsiChar; SourceChars: Cardinal; NoTrailingZero: boolean): PWideChar;
begin
  result := Dest+
    (UTF8ToWideChar(Dest,PUTF8Char(Source),SourceChars,NoTrailingZero) shr 1);
end;

function TSynAnsiUTF8.AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
  SourceChars: Cardinal; NoTrailingZero: boolean): PUTF8Char;
begin
  MoveFast(Source^,Dest^,SourceChars);
  if not NoTrailingZero then
    Dest[SourceChars] := #0;
  result := Dest+SourceChars;
end;

procedure TSynAnsiUTF8.InternalAppendUTF8(Source: PAnsiChar; SourceChars: Cardinal;
  DestTextWriter: TObject; Escape: TTextWriterKind);
begin
  TTextWriter(DestTextWriter).Add(PUTF8Char(Source),SourceChars,Escape);
end;

function TSynAnsiUTF8.AnsiToRawUnicode(Source: PAnsiChar;
  SourceChars: Cardinal): RawUnicode;
begin
  result := Utf8DecodeToRawUniCode(PUTF8Char(Source),SourceChars);
end;

constructor TSynAnsiUTF8.Create(aCodePage: cardinal);
begin
  if aCodePage<>CP_UTF8 then
    raise ESynException.CreateUTF8('%.Create(%)',[self,aCodePage]);
  inherited Create(aCodePage);
end;

function TSynAnsiUTF8.UnicodeBufferToUTF8(Dest: PAnsiChar; DestChars: Cardinal;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
begin
  result := Dest+RawUnicodeToUTF8(PUTF8Char(Dest),DestChars,Source,SourceChars,
    [ccfNoTrailingZero]);
end;

function TSynAnsiUTF8.UnicodeBufferToAnsi(Dest: PAnsiChar;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
begin
  result := UnicodeBufferToUTF8(Dest,SourceChars,Source,SourceChars);
end;

function TSynAnsiUTF8.UnicodeBufferToAnsi(Source: PWideChar;
  SourceChars: Cardinal): RawByteString;
var tmp: TSynTempBuffer;
begin
  if (Source=nil) or (SourceChars=0) then
    result := '' else begin
    tmp.Init(SourceChars*3);
    FastSetStringCP(result,tmp.buf,UnicodeBufferToUTF8(tmp.buf,
      SourceChars*3,Source,SourceChars)-PAnsiChar(tmp.buf),fCodePage);
    tmp.Done;
  end;
end;

function TSynAnsiUTF8.UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
  SourceChars: Cardinal): PAnsiChar;
begin
  MoveFast(Source^,Dest^,SourceChars);
  result := Dest+SourceChars;
end;

procedure TSynAnsiUTF8.UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal;
  var result: RawByteString);
begin
  FastSetString(RawUTF8(result),Source,SourceChars);
end;

function TSynAnsiUTF8.UTF8ToAnsi(const UTF8: RawUTF8): RawByteString;
begin
  result := UTF8;
  {$ifdef HASCODEPAGE}
  SetCodePage(result,CP_UTF8,false);
  {$endif}
end;

function TSynAnsiUTF8.AnsiToUTF8(const AnsiText: RawByteString): RawUTF8;
begin
  result := AnsiText;
  {$ifdef HASCODEPAGE}
  SetCodePage(RawByteString(result),CP_UTF8,false);
  {$endif}
end;

function TSynAnsiUTF8.AnsiBufferToRawUTF8(Source: PAnsiChar; SourceChars: Cardinal): RawUTF8;
begin
  FastSetString(Result,Source,SourceChars);
end;


{ TSynAnsiUTF16 }

function TSynAnsiUTF16.AnsiBufferToUnicode(Dest: PWideChar;
  Source: PAnsiChar; SourceChars: Cardinal; NoTrailingZero: boolean): PWideChar;
begin
  MoveFast(Source^,Dest^,SourceChars);
  result := Pointer(PtrUInt(Dest)+SourceChars);
  if not NoTrailingZero then
    result^ := #0;
end;

const
  NOTRAILING: array[boolean] of TCharConversionFlags =
    ([],[ccfNoTrailingZero]);

function TSynAnsiUTF16.AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
  SourceChars: Cardinal; NoTrailingZero: boolean): PUTF8Char;
begin
  SourceChars := SourceChars shr 1; // from byte count to WideChar count
  result := Dest+RawUnicodeToUtf8(Dest,SourceChars*3,
    PWideChar(Source),SourceChars,NOTRAILING[NoTrailingZero]);
end;

function TSynAnsiUTF16.AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode;
begin
  SetString(result,Source,SourceChars); // byte count
end;

constructor TSynAnsiUTF16.Create(aCodePage: cardinal);
begin
  if aCodePage<>CP_UTF16 then
    raise ESynException.CreateUTF8('%.Create(%)',[self,aCodePage]);
  inherited Create(aCodePage);
end;

function TSynAnsiUTF16.UnicodeBufferToAnsi(Dest: PAnsiChar;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
begin
  SourceChars := SourceChars shl 1; // from WideChar count to byte count
  MoveFast(Source^,Dest^,SourceChars);
  result := Dest+SourceChars;
end;

function TSynAnsiUTF16.UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
  SourceChars: Cardinal): PAnsiChar;
begin
  result := Dest+UTF8ToWideChar(PWideChar(Dest),Source,SourceChars,true);
end;


function WideCharToUtf8(Dest: PUTF8Char; aWideChar: PtrUInt): integer;
begin
  if aWideChar<=$7F then begin
    Dest^ := AnsiChar(aWideChar);
    result := 1;
  end else
  if aWideChar>$7ff then begin
    Dest[0] := AnsiChar($E0 or (aWideChar shr 12));
    Dest[1] := AnsiChar($80 or ((aWideChar shr 6) and $3F));
    Dest[2] := AnsiChar($80 or (aWideChar and $3F));
    result := 3;
  end else begin
    Dest[0] := AnsiChar($C0 or (aWideChar shr 6));
    Dest[1] := AnsiChar($80 or (aWideChar and $3F));
    result := 2;
  end;
end;

function UTF16CharToUtf8(Dest: PUTF8Char; var Source: PWord): integer;
var c: cardinal;
    j: integer;
begin
  c := Source^;
  inc(Source);
  case c of
  0..$7f: begin
    Dest^ := AnsiChar(c);
    result := 1;
    exit;
  end;
  UTF16_HISURROGATE_MIN..UTF16_HISURROGATE_MAX: begin
    c := ((c-$D7C0)shl 10)+(Source^ xor UTF16_LOSURROGATE_MIN);
    inc(Source);
  end;
  UTF16_LOSURROGATE_MIN..UTF16_LOSURROGATE_MAX: begin
    c := ((cardinal(Source^)-$D7C0)shl 10)+(c xor UTF16_LOSURROGATE_MIN);
    inc(Source);
  end;
  end; // now c is the UTF-32/UCS4 code point
  case c of
  0..$7ff: result := 2;
  $800..$ffff: result := 3;
  $10000..$1FFFFF: result := 4;
  $200000..$3FFFFFF: result := 5;
  else result := 6;
  end;
  for j := result-1 downto 1 do begin
    Dest[j] := AnsiChar((c and $3f)+$80);
    c := c shr 6;
  end;
  Dest^ := AnsiChar(Byte(c) or UTF8_FIRSTBYTE[result]);
end;

function UCS4ToUTF8(ucs4: cardinal; Dest: PUTF8Char): integer;
var j: integer;
begin
  case ucs4 of
  0..$7f: begin
    Dest^ := AnsiChar(ucs4);
    result := 1;
    exit;
  end;
  $80..$7ff: result := 2;
  $800..$ffff: result := 3;
  $10000..$1FFFFF: result := 4;
  $200000..$3FFFFFF: result := 5;
  else result := 6;
  end;
  for j := result-1 downto 1 do begin
    Dest[j] := AnsiChar((ucs4 and $3f)+$80);
    ucs4 := ucs4 shr 6;
  end;
  Dest^ := AnsiChar(Byte(ucs4) or UTF8_FIRSTBYTE[result]);
end;

procedure AnyAnsiToUTF8(const s: RawByteString; var result: RawUTF8);
{$ifdef HASCODEPAGE}var CodePage: Cardinal;{$endif}
begin
  if s='' then
    result := '' else begin
    {$ifdef HASCODEPAGE}
    CodePage := StringCodePage(s);
    if (CodePage=CP_UTF8) or (CodePage=CP_RAWBYTESTRING) then
      result := s else
      result := TSynAnsiConvert.Engine(CodePage).
    {$else}
    result := CurrentAnsiConvert.
    {$endif}
      AnsiBufferToRawUTF8(pointer(s),length(s));
  end;
end;

function AnyAnsiToUTF8(const s: RawByteString): RawUTF8;
begin
  AnyAnsiToUTF8(s,result);
end;

function WinAnsiBufferToUtf8(Dest: PUTF8Char; Source: PAnsiChar; SourceChars: Cardinal): PUTF8Char;
begin
  result := WinAnsiConvert.AnsiBufferToUTF8(Dest,Source,SourceChars);
end;

function ShortStringToUTF8(const source: ShortString): RawUTF8;
begin
  result := WinAnsiConvert.AnsiBufferToRawUTF8(@source[1],ord(source[0]));
end;

procedure WinAnsiToUnicodeBuffer(const S: WinAnsiString; Dest: PWordArray; DestLen: PtrInt);
var L: PtrInt;
begin
  L := length(S);
  if L<>0 then begin
    if L>=DestLen then
      L := DestLen-1; // truncate to avoid buffer overflow
    WinAnsiConvert.AnsiBufferToUnicode(PWideChar(Dest),pointer(S),L); // include last #0
  end else
    Dest^[0] := 0;
end;

function WinAnsiToRawUnicode(const S: WinAnsiString): RawUnicode;
begin
  result := WinAnsiConvert.AnsiToRawUnicode(S);
end;

function WinAnsiToUtf8(const S: WinAnsiString): RawUTF8;
begin
  result := WinAnsiConvert.AnsiBufferToRawUTF8(pointer(S),length(s));
end;

function WinAnsiToUtf8(WinAnsi: PAnsiChar; WinAnsiLen: PtrInt): RawUTF8;
begin
  result := WinAnsiConvert.AnsiBufferToRawUTF8(WinAnsi,WinAnsiLen);
end;

function WideCharToWinAnsiChar(wc: cardinal): AnsiChar;
begin
  wc := WinAnsiConvert.WideCharToAnsiChar(wc);
  if integer(wc)=-1 then
    result := '?' else
    result := AnsiChar(wc);
end;

function WideCharToWinAnsi(wc: cardinal): integer;
begin
  result := WinAnsiConvert.WideCharToAnsiChar(wc);
end;

function IsWinAnsi(WideText: PWideChar; Length: integer): boolean;
begin
  result := WinAnsiConvert.IsValidAnsi(WideText,Length);
end;

function IsAnsiCompatible(PC: PAnsiChar): boolean;
begin
  result := false;
  if PC<>nil then
  while true do
    if PC^=#0 then
      break else
    if PC^<=#127 then
      inc(PC) else // 7 bits chars are always OK, whatever codepage/charset is used
      exit;
  result := true;
end;

function IsAnsiCompatible(PC: PAnsiChar; Len: PtrUInt): boolean;
begin
  if PC<>nil then begin
    result := false;
    Len := PtrUInt(@PC[Len-4]);
    if Len>=PtrUInt(PC) then
      repeat
        if PCardinal(PC)^ and $80808080<>0 then
          exit;
        inc(PC,4);
      until Len<PtrUInt(PC);
    inc(Len,4);
    if Len>PtrUInt(PC) then
      repeat
        if PC^>=#127 then
          exit;
        inc(PC);
      until Len<=PtrUInt(PC);
  end;
  result := true;
end;

function IsAnsiCompatible(const Text: RawByteString): boolean;
begin
  result := IsAnsiCompatible(PAnsiChar(pointer(Text)),length(Text));
end;

function IsAnsiCompatibleW(PW: PWideChar): boolean;
begin
  result := false;
  if PW<>nil then
  while true do
    if ord(PW^)=0 then
      break else
    if ord(PW^)<=127 then
      inc(PW) else // 7 bits chars are always OK, whatever codepage/charset is used
      exit;
  result := true;
end;

function IsAnsiCompatibleW(PW: PWideChar; Len: PtrInt): boolean;
var i: PtrInt;
begin
  result := false;
  if PW<>nil then
    for i := 0 to Len-1 do
      if ord(PW[i])>127 then
        exit;
  result := true;
end;

function IsWinAnsi(WideText: PWideChar): boolean;
begin
  result := WinAnsiConvert.IsValidAnsi(WideText);
end;

function IsWinAnsiU(UTF8Text: PUTF8Char): boolean;
begin
  result := WinAnsiConvert.IsValidAnsiU(UTF8Text);
end;

function IsWinAnsiU8Bit(UTF8Text: PUTF8Char): boolean;
begin
  result := WinAnsiConvert.IsValidAnsiU8Bit(UTF8Text);
end;

function UTF8ToWinPChar(dest: PAnsiChar; source: PUTF8Char; count: integer): integer;
begin
  result := WinAnsiConvert.UTF8BufferToAnsi(dest,source,count)-dest;
end;

function ShortStringToAnsi7String(const source: shortstring): RawByteString;
begin
  FastSetString(RawUTF8(result),@source[1],ord(source[0]));
end;

procedure ShortStringToAnsi7String(const source: shortstring; var result: RawUTF8);
begin
  FastSetString(result,@source[1],ord(source[0]));
end;

procedure UTF8ToShortString(var dest: shortstring; source: PUTF8Char);
var c: cardinal;
    len,extra,i: integer;
begin
  len := 0;
  if source<>nil then
  repeat
    c := byte(source^); inc(source);
    if c=0 then break else
    if c<=127 then begin
      inc(len); dest[len] := AnsiChar(c);
      if len<253 then continue else break;
    end else begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then break; // invalid leading byte
      for i := 1 to extra do begin
        if byte(source^) and $c0<>$80 then begin
          dest[0] := AnsiChar(len);
          exit; // invalid UTF-8 content
        end;
        c := c shl 6+byte(source^);
        inc(Source);
      end;
      dec(c,UTF8_EXTRA[extra].offset);
      // #256.. -> slower but accurate conversion
      inc(len);
      if c>$ffff then
        dest[len] := '?' else
        dest[len] := AnsiChar(WinAnsiConvert.fWideToAnsi[c]);
      if len<253 then continue else break;
    end;
  until false;
  dest[0] := AnsiChar(len);
end;

function Utf8ToWinAnsi(const S: RawUTF8): WinAnsiString;
begin
  result := WinAnsiConvert.UTF8ToAnsi(S);
end;

function Utf8ToWinAnsi(P: PUTF8Char): WinAnsiString;
begin
  result := WinAnsiConvert.UTF8ToAnsi(P);
end;

procedure Utf8ToRawUTF8(P: PUTF8Char; var result: RawUTF8);
begin // fast and Delphi 2009+ ready
  FastSetString(result,P,StrLen(P));
end;

function UTF8ToWideChar(dest: PWideChar; source: PUTF8Char;
  MaxDestChars, sourceBytes: PtrInt; NoTrailingZero: boolean): PtrInt;
// faster than System.Utf8ToUnicode()
var c: cardinal;
    begd: PWideChar;
    endSource: PUTF8Char;
    endDest: PWideChar;
    i,extra: integer;
label Quit, NoSource;
begin
  result := 0;
  if dest=nil then
   exit;
  if source=nil then
    goto NoSource;
  if sourceBytes=0 then begin
    if source^=#0 then
      goto NoSource;
    sourceBytes := StrLen(source);
  end;
  endSource := source+sourceBytes;
  endDest := dest+MaxDestChars;
  begd := dest;
  repeat
    c := byte(source^);
    inc(source);
    if c<=127 then begin
      PWord(dest)^ := c; // much faster than dest^ := WideChar(c) for FPC
      inc(dest);
      if (source<endsource) and (dest<endDest) then
        continue else
        break;
    end;
    extra := UTF8_EXTRABYTES[c];
    if (extra=0) or (Source+extra>endSource) then break;
    for i := 1 to extra do begin
      if byte(Source^) and $c0<>$80 then
        goto Quit; // invalid input content
      c := c shl 6+byte(Source^);
      inc(Source);
    end;
    with UTF8_EXTRA[extra] do begin
      dec(c,offset);
      if c<minimum then
        break; // invalid input content
    end;
    if c<=$ffff then begin
      PWord(dest)^ := c;
      inc(dest);
      if (source<endsource) and (dest<endDest) then
        continue else
        break;
    end;
    dec(c,$10000); // store as UTF-16 surrogates
    PWordArray(dest)[0] := c shr 10  +UTF16_HISURROGATE_MIN;
    PWordArray(dest)[1] := c and $3FF+UTF16_LOSURROGATE_MIN;
    inc(dest,2);
    if (source>=endsource) or (dest>=endDest) then
      break;
  until false;
Quit:
  result := PtrUInt(dest)-PtrUInt(begd); // dest-begd return byte length
NoSource:
  if not NoTrailingZero then
    dest^ := #0; // always append a WideChar(0) to the end of the buffer
end;

function UTF8ToWideChar(dest: PWideChar; source: PUTF8Char; sourceBytes: PtrInt;
  NoTrailingZero: boolean): PtrInt;
// faster than System.UTF8Decode()
var c: cardinal;
    begd: PWideChar;
    endSource, endSourceBy4: PUTF8Char;
    i,extra: PtrInt;
label Quit, NoSource, By1, By4;
begin
  result := 0;
  if dest=nil then
   exit;
  if source=nil then
    goto NoSource;
  if sourceBytes=0 then begin
    if source^=#0 then
      goto NoSource;
    sourceBytes := StrLen(source);
  end;
  begd := dest;
  endSource := Source+SourceBytes;
  endSourceBy4 := endSource-4;
  if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then
    repeat // handle 7 bit ASCII chars, by quad (Sha optimization)
By4:  c := PCardinal(Source)^;
      if c and $80808080<>0 then
        goto By1; // break on first non ASCII quad
      inc(Source,4);
      PCardinal(dest)^ := (c shl 8 or (c and $FF)) and $00ff00ff;
      c := c shr 16;
      PCardinal(dest+2)^ := (c shl 8 or c) and $00ff00ff;
      inc(dest,4);
    until Source>EndSourceBy4;
  if Source<endSource then
    repeat
By1:  c := byte(Source^); inc(Source);
      if c<=127 then begin
        PWord(dest)^ := c; // much faster than dest^ := WideChar(c) for FPC
        inc(dest);
        if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then goto By4;
        if Source<endSource then continue else break;
      end;
      extra := UTF8_EXTRABYTES[c];
      if (extra=0) or (Source+extra>endSource) then break;
      for i := 1 to extra do begin
        if byte(Source^) and $c0<>$80 then
          goto Quit; // invalid input content
        c := c shl 6+byte(Source^);
        inc(Source);
      end;
      with UTF8_EXTRA[extra] do begin
        dec(c,offset);
        if c<minimum then
          break; // invalid input content
      end;
      if c<=$ffff then begin
        PWord(dest)^ := c;
        inc(dest);
        if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then goto By4;
        if Source<endSource then continue else break;
      end;
      dec(c,$10000); // store as UTF-16 surrogates
      PWordArray(dest)[0] := c shr 10  +UTF16_HISURROGATE_MIN;
      PWordArray(dest)[1] := c and $3FF+UTF16_LOSURROGATE_MIN;
      inc(dest,2);
      if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then goto By4;
      if Source>=endSource then break;
    until false;
Quit:
  result := PtrUInt(dest)-PtrUInt(begd); // dest-begd returns bytes length
NoSource:
  if not NoTrailingZero then
    dest^ := #0; // always append a WideChar(0) to the end of the buffer
end;

function IsValidUTF8WithoutControlChars(source: PUTF8Char): Boolean;
var extra, i: integer;
    c: cardinal;
begin
  result := false;
  if source<>nil then
  repeat
    c := byte(source^);
    inc(source);
    if c=0 then break else
    if c<32 then exit else // disallow #1..#31 control char
    if c and $80<>0 then begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then exit else // invalid leading byte
      for i := 1 to extra do
        if byte(source^) and $c0<>$80 then // invalid UTF-8 encoding
          exit else
          inc(source);
    end;
  until false;
  result := true;
end;

function IsValidUTF8WithoutControlChars(const source: RawUTF8): Boolean;
var s, extra, i, len: integer;
    c: cardinal;
begin
  result := false;
  s := 1;
  len := length(source);
  while s<=len do begin
    c := byte(source[s]);
    inc(s);
    if c<32 then exit else // disallow #0..#31 control char
    if c and $80<>0 then begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then exit else // invalid leading byte
      for i := 1 to extra do
        if byte(source[s]) and $c0<>$80 then // reached #0 or invalid UTF-8
          exit else
          inc(s);
    end;
  end;
  result := true;
end;


function Utf8ToUnicodeLength(source: PUTF8Char): PtrUInt;
var c: PtrUInt;
    extra,i: integer;
begin
  result := 0;
  if source<>nil then
  repeat
    c := byte(source^);
    inc(source);
    if c=0 then break else
    if c<=127 then
      inc(result) else begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then exit else // invalid leading byte
      if extra>=UTF8_EXTRA_SURROGATE then
        inc(result,2) else
        inc(result);
      for i := 1 to extra do // inc(source,extra) is faster but not safe
        if byte(source^) and $c0<>$80 then
          exit else
          inc(source); // check valid UTF-8 content
    end;
  until false;
end;

function Utf8TruncateToUnicodeLength(var text: RawUTF8; maxUTF16: integer): boolean;
var c: PtrUInt;
    extra,i: integer;
    source: PUTF8Char;
begin
  source := pointer(text);
  if (source<>nil) and (cardinal(maxUtf16)<cardinal(length(text))) then
    repeat
      if maxUTF16<=0 then begin
        SetLength(text,source-pointer(text)); // truncate
        result := true;
        exit;
      end;
      c := byte(source^);
      inc(source);
      if c=0 then break else
      if c<=127 then
        dec(maxUTF16) else begin
        extra := UTF8_EXTRABYTES[c];
        if extra=0 then break else // invalid leading byte
        if extra>=UTF8_EXTRA_SURROGATE then
          dec(maxUTF16,2) else
          dec(maxUTF16);
        for i := 1 to extra do // inc(source,extra) is faster but not safe
          if byte(source^) and $c0<>$80 then
            break else
            inc(source); // check valid UTF-8 content
      end;
    until false;
  result := false;
end;

function Utf8TruncateToLength(var text: RawUTF8; maxBytes: PtrUInt): boolean;
begin
  if PtrUInt(length(text))<maxBytes then begin
    result := false;
    exit; // nothing to truncate
  end;
  while (maxBytes>0) and (ord(text[maxBytes]) and $c0=$80) do dec(maxBytes);
  if (maxBytes>0) and (ord(text[maxBytes]) and $80<>0) then dec(maxBytes);
  SetLength(text,maxBytes);
  result := true;
end;

function Utf8TruncatedLength(const text: RawUTF8; maxBytes: PtrUInt): PtrInt;
begin
  result := length(text);
  if PtrUInt(result)<maxBytes then
    exit;
  result := maxBytes;
  while (result>0) and (ord(text[result]) and $c0=$80) do dec(result);
  if (result>0) and (ord(text[result]) and $80<>0) then dec(result);
end;

function Utf8TruncatedLength(text: PAnsiChar; textlen,maxBytes: PtrUInt): PtrInt;
begin
  if textlen<maxBytes then begin
    result := textlen;
    exit;
  end;
  result := maxBytes;
  while (result>0) and (ord(text[result]) and $c0=$80) do dec(result);
  if (result>0) and (ord(text[result]) and $80<>0) then dec(result);
end;

function Utf8FirstLineToUnicodeLength(source: PUTF8Char): PtrInt;
var c,extra: PtrUInt;
begin
  result := 0;
  if source<>nil then
  repeat
    c := byte(source^);
    inc(source);
    if c in [0,10,13] then break else // #0, #10 or #13 stop the count
    if c<=127 then
      inc(result) else begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then exit else // invalid leading byte
      if extra>=UTF8_EXTRA_SURROGATE then
        inc(result,2) else
        inc(result);
      inc(source,extra); // a bit less safe, but faster
    end;
  until false;
end;

function Utf8DecodeToRawUnicode(P: PUTF8Char; L: integer): RawUnicode;
var tmp: TSynTempBuffer;
begin
  result := ''; // somewhat faster if result is freed before any SetLength()
  if L=0 then
    L := StrLen(P);
  if L=0 then
    exit;
  // +1 below is for #0 ending -> true WideChar(#0) ending
  tmp.Init(L*3); // maximum posible unicode size (if all <#128)
  SetString(result,PAnsiChar(tmp.buf),UTF8ToWideChar(tmp.buf,P,L)+1);
  tmp.Done;
end;

function Utf8DecodeToRawUnicode(const S: RawUTF8): RawUnicode;
begin
  if S='' then
    result := '' else
    result := Utf8DecodeToRawUnicode(pointer(S),length(S));
end;

function Utf8DecodeToRawUnicodeUI(const S: RawUTF8; DestLen: PInteger): RawUnicode;
var L: integer;
begin
  L := Utf8DecodeToRawUnicodeUI(S,result);
  if DestLen<>nil then
    DestLen^ := L;
end;

function Utf8DecodeToRawUnicodeUI(const S: RawUTF8; var Dest: RawUnicode): integer;
begin
  Dest := ''; // somewhat faster if Dest is freed before any SetLength()
  if S='' then begin
    result := 0;
    exit;
  end;
  result := length(S);
  SetLength(Dest,result*2+2);
  result := UTF8ToWideChar(pointer(Dest),Pointer(S),result);
end;

function RawUnicodeToUtf8(Dest: PUTF8Char; DestLen: PtrInt; Source: PWideChar;
  SourceLen: PtrInt; Flags: TCharConversionFlags): PtrInt;
var c: Cardinal;
    Tail: PWideChar;
    i,j: integer;
label unmatch;
begin
  result := PtrInt(Dest);
  inc(DestLen,PtrInt(Dest));
  if (Source<>nil) and (Dest<>nil) then begin
    // first handle 7 bit ASCII WideChars, by pairs (Sha optimization)
    SourceLen := SourceLen*2+PtrInt(PtrUInt(Source));
    Tail := PWideChar(SourceLen)-2;
    if (PtrInt(PtrUInt(Dest))<DestLen) and (Source<=Tail) then
      repeat
        c := PCardinal(Source)^;
        if c and $ff80ff80<>0 then
          break; // break on first non ASCII pair
        inc(Source,2);
        c := c shr 8 or c;
        PWord(Dest)^ := c;
        inc(Dest,2);
      until (Source>Tail) or (PtrInt(PtrUInt(Dest))>=DestLen);
    // generic loop, handling one UCS4 char per iteration
    if (PtrInt(PtrUInt(Dest))<DestLen) and (PtrInt(PtrUInt(Source))<SourceLen) then
    repeat
      // inlined UTF16CharToUtf8() with bufferoverlow check and $FFFD on unmatch
      c := cardinal(Source^);
      inc(Source);
      case c of
      0..$7f: begin
        Dest^ := AnsiChar(c);
        inc(Dest);
        if (PtrInt(PtrUInt(Dest))<DestLen) and (PtrInt(PtrUInt(Source))<SourceLen) then
          continue else break;
      end;
      UTF16_HISURROGATE_MIN..UTF16_HISURROGATE_MAX:
        if (PtrInt(PtrUInt(Source))>=SourceLen) or
           ((cardinal(Source^)<UTF16_LOSURROGATE_MIN) or (cardinal(Source^)>UTF16_LOSURROGATE_MAX)) then begin
unmatch:  if (PtrInt(PtrUInt(@Dest[3]))>DestLen) or
             not (ccfReplacementCharacterForUnmatchedSurrogate in Flags) then
            break;
          PWord(Dest)^ := $BFEF;
          Dest[2] := AnsiChar($BD);
          inc(Dest,3);
          if (PtrInt(PtrUInt(Dest))<DestLen) and (PtrInt(PtrUInt(Source))<SourceLen) then
            continue else break;
        end else begin
          c := ((c-$D7C0)shl 10)+(cardinal(Source^) xor UTF16_LOSURROGATE_MIN);
          inc(Source);
        end;
      UTF16_LOSURROGATE_MIN..UTF16_LOSURROGATE_MAX:
        if (PtrInt(PtrUInt(Source))>=SourceLen) or
           ((cardinal(Source^)<UTF16_HISURROGATE_MIN) or (cardinal(Source^)>UTF16_HISURROGATE_MAX)) then
          goto unmatch else begin
          c := ((cardinal(Source^)-$D7C0)shl 10)+(c xor UTF16_LOSURROGATE_MIN);
          inc(Source);
        end;
      end; // now c is the UTF-32/UCS4 code point
      case c of
      0..$7ff: i := 2;
      $800..$ffff: i := 3;
      $10000..$1FFFFF: i := 4;
      $200000..$3FFFFFF: i := 5;
      else i := 6;
      end;
      if PtrInt(PtrUInt(Dest))+i>DestLen then
        break;
      for j := i-1 downto 1 do begin
        Dest[j] := AnsiChar((c and $3f)+$80);
        c := c shr 6;
      end;
      Dest^ := AnsiChar(Byte(c) or UTF8_FIRSTBYTE[i]);
      inc(Dest,i);
      if (PtrInt(PtrUInt(Dest))<DestLen) and (PtrInt(PtrUInt(Source))<SourceLen) then
        continue else break;
    until false;
    if not (ccfNoTrailingZero in Flags) then
      Dest^ := #0;
  end;
  result := PtrInt(PtrUInt(Dest))-result;
end;

procedure RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer;
  var result: RawUTF8; Flags: TCharConversionFlags);
var tmp: TSynTempBuffer;
begin
  if (WideChar=nil) or (WideCharCount=0) then
    result := '' else begin
    tmp.Init(WideCharCount*3);
    FastSetString(Result,tmp.buf,RawUnicodeToUtf8(tmp.buf,tmp.len+1,WideChar,WideCharCount,Flags));
    tmp.Done;
  end;
end;

function RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer;
  Flags: TCharConversionFlags): RawUTF8;
begin
  RawUnicodeToUTF8(WideChar,WideCharCount,result, Flags);
end;

function RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer; out UTF8Length: integer): RawUTF8;
var LW: integer;
begin
  result := ''; // somewhat faster if result is freed before any SetLength()
  if WideCharCount=0 then
    exit;
  LW := WideCharCount*3; // maximum resulting length
  SetLength(result,LW);
  UTF8Length := RawUnicodeToUtf8(pointer(result),LW+1,WideChar,WideCharCount,[ccfNoTrailingZero]);
  if UTF8Length<=0 then
    result := '';
end;

/// convert a RawUnicode string into a UTF-8 string
function RawUnicodeToUtf8(const Unicode: RawUnicode): RawUTF8;
begin
  RawUnicodeToUtf8(pointer(Unicode),length(Unicode) shr 1,result);
end;

function SynUnicodeToUtf8(const Unicode: SynUnicode): RawUTF8;
begin
  RawUnicodeToUtf8(pointer(Unicode),length(Unicode),result);
end;

function RawUnicodeToSynUnicode(const Unicode: RawUnicode): SynUnicode;
begin
  SetString(result,PWideChar(pointer(Unicode)),length(Unicode) shr 1);
end;

function RawUnicodeToSynUnicode(WideChar: PWideChar; WideCharCount: integer): SynUnicode;
begin
  SetString(result,WideChar,WideCharCount);
end;

procedure RawUnicodeToWinPChar(dest: PAnsiChar; source: PWideChar; WideCharCount: Integer);
begin
  WinAnsiConvert.UnicodeBufferToAnsi(dest,source,WideCharCount);
end;

function RawUnicodeToWinAnsi(WideChar: PWideChar; WideCharCount: integer): WinAnsiString;
begin
  result := WinAnsiConvert.UnicodeBufferToAnsi(WideChar,WideCharCount);
end;

function RawUnicodeToWinAnsi(const Unicode: RawUnicode): WinAnsiString;
begin
  result := WinAnsiConvert.UnicodeBufferToAnsi(pointer(Unicode),length(Unicode) shr 1);
end;

function WideStringToWinAnsi(const Wide: WideString): WinAnsiString;
begin
  result := WinAnsiConvert.UnicodeBufferToAnsi(pointer(Wide),length(Wide));
end;

procedure UnicodeBufferToWinAnsi(source: PWideChar; out Dest: WinAnsiString);
var L: integer;
begin
  L := StrLenW(source);
  SetLength(Dest,L);
  WinAnsiConvert.UnicodeBufferToAnsi(pointer(Dest),source,L);
end;

function UnicodeBufferToString(source: PWideChar): string;
begin
  result := RawUnicodeToString(source,StrLenW(source));
end;

procedure AnsiCharToUTF8(P: PAnsiChar; L: Integer; var result: RawUTF8; ACP: integer);
begin
  result := TSynAnsiConvert.Engine(ACP).AnsiBufferToRawUTF8(P,L);
end;

function Ansi7ToString(const Text: RawByteString): string;
{$ifdef UNICODE}
var i: PtrInt;
begin
  SetString(result,nil,length(Text));
  for i := 0 to length(Text)-1 do
    PWordArray(result)[i] := PByteArray(Text)[i]; // no conversion for 7 bit Ansi
end;
{$else}
begin
  result := Text; // if we are SURE this text is 7 bit Ansi -> direct assign
end;
{$endif}

function Ansi7ToString(Text: PWinAnsiChar; Len: PtrInt): string;
begin
  {$ifdef UNICODE}
  Ansi7ToString(Text,Len,result);
  {$else}
  SetString(result,PAnsiChar(Text),Len);
  {$endif}
end;

procedure Ansi7ToString(Text: PWinAnsiChar; Len: PtrInt; var result: string);
{$ifdef UNICODE}
var i: PtrInt;
begin
  SetString(result,nil,Len);
  for i := 0 to Len-1 do
    PWordArray(result)[i] := PByteArray(Text)[i]; // no conversion for 7 bit Ansi
end;
{$else}
begin
  SetString(result,PAnsiChar(Text),Len);
end;
{$endif}

function StringToAnsi7(const Text: string): RawByteString;
{$ifdef UNICODE}
var i: PtrInt;
begin
  SetString(result,nil,length(Text));
  for i := 0 to length(Text)-1 do
    PByteArray(result)[i] := PWordArray(Text)[i]; // no conversion for 7 bit Ansi
end;
{$else}
begin
  result := Text; // if we are SURE this text is 7 bit Ansi -> direct assign
end;
{$endif}

function StringToWinAnsi(const Text: string): WinAnsiString;
begin
  {$ifdef UNICODE}
  result := RawUnicodeToWinAnsi(Pointer(Text),length(Text));
  {$else}
  result := WinAnsiConvert.AnsiToAnsi(CurrentAnsiConvert,Text);
  {$endif}
end;

function StringBufferToUtf8(Dest: PUTF8Char; Source: PChar; SourceChars: PtrInt): PUTF8Char;
begin
  {$ifdef UNICODE}
  result := Dest+RawUnicodeToUtf8(Dest,SourceChars*3,PWideChar(Source),SourceChars,[]);
  {$else}
  result := CurrentAnsiConvert.AnsiBufferToUTF8(Dest,Source,SourceChars);
  {$endif}
end;

procedure StringBufferToUtf8(Source: PChar; out result: RawUTF8); overload;
begin
  {$ifdef UNICODE}
  RawUnicodeToUtf8(Source,StrLenW(Source),result);
  {$else}
  result := CurrentAnsiConvert.AnsiBufferToRawUTF8(Source,StrLen(Source));
  {$endif}
end;

function StringToUTF8(const Text: string): RawUTF8;
begin
  {$ifdef UNICODE}
  RawUnicodeToUtf8(pointer(Text),length(Text),result);
  {$else}
  result := CurrentAnsiConvert.AnsiToUTF8(Text);
  {$endif}
end;

procedure StringToUTF8(Text: PChar; TextLen: PtrInt; var result: RawUTF8);
begin
  {$ifdef UNICODE}
  RawUnicodeToUtf8(Text,TextLen,result);
  {$else}
  result := CurrentAnsiConvert.AnsiBufferToRawUTF8(Text, TextLen);
  {$endif}
end;

procedure StringToUTF8(const Text: string; var result: RawUTF8);
begin
  {$ifdef UNICODE}
  RawUnicodeToUtf8(pointer(Text),length(Text),result);
  {$else}
  result := CurrentAnsiConvert.AnsiToUTF8(Text);
  {$endif}
end;

function ToUTF8(const Text: string): RawUTF8;
begin
  {$ifdef UNICODE}
  RawUnicodeToUtf8(pointer(Text),length(Text),result);
  {$else}
  result := CurrentAnsiConvert.AnsiToUTF8(Text);
  {$endif}
end;

function ToUTF8(const Ansi7Text: ShortString): RawUTF8;
begin
  FastSetString(result,@Ansi7Text[1],ord(Ansi7Text[0]));
end;

function ToUTF8({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): RawUTF8;
begin
  FastSetString(result,nil,36);
  GUIDToText(pointer(result),@guid);
end;


{$ifdef HASVARUSTRING} // some UnicodeString dedicated functions
function UnicodeStringToUtf8(const S: UnicodeString): RawUTF8;
begin
  RawUnicodeToUtf8(pointer(S),length(S),result);
end;

function UTF8DecodeToUnicodeString(const S: RawUTF8): UnicodeString;
begin
  UTF8DecodeToUnicodeString(pointer(S),length(S),result);
end;

procedure UTF8DecodeToUnicodeString(P: PUTF8Char; L: integer; var result: UnicodeString);
var tmp: TSynTempBuffer;
begin
  if (P=nil) or (L=0) then
    result := '' else begin
    tmp.Init(L*3); // maximum posible unicode size (if all <#128)
    SetString(result,PWideChar(tmp.buf),UTF8ToWideChar(tmp.buf,P,L) shr 1);
    tmp.Done;
  end;
end;

function UnicodeStringToWinAnsi(const S: UnicodeString): WinAnsiString;
begin
  result := WinAnsiConvert.UnicodeBufferToAnsi(pointer(S),length(S));
end;

function UTF8DecodeToUnicodeString(P: PUTF8Char; L: integer): UnicodeString;
begin
  UTF8DecodeToUnicodeString(P,L,result);
end;

function WinAnsiToUnicodeString(WinAnsi: PAnsiChar; WinAnsiLen: PtrInt): UnicodeString;
begin
  SetString(result,nil,WinAnsiLen);
  WinAnsiConvert.AnsiBufferToUnicode(pointer(result),WinAnsi,WinAnsiLen);
end;

function WinAnsiToUnicodeString(const WinAnsi: WinAnsiString): UnicodeString;
begin
  result := WinAnsiToUnicodeString(pointer(WinAnsi),length(WinAnsi));
end;
{$endif HASVARUSTRING}


function StrInt32(P: PAnsiChar; val: PtrInt): PAnsiChar;
{$ifdef ABSOLUTEPASCALORNOTINTEL}
begin // fallback to pure pascal version for ARM or PIC
  if val<0 then begin
    result := StrUInt32(P,PtrUInt(-val))-1;
    result^ := '-';
  end else
    result := StrUInt32(P,val);
end;
{$else}
{$ifdef CPUX64} {$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx=P, rdx=val (Linux: rdi,rsi) - val is QWord on CPUX64
{$endif FPC}
        {$ifndef win64}
        mov     rcx, rdi
        mov     rdx, rsi
        {$endif win64}
        mov     r10, rdx
        sar     r10, 63         // r10=0 if val>=0 or -1 if val<0
        xor     rdx, r10
        sub     rdx, r10        // rdx=abs(val)
        cmp     rdx, 10
        jb      @3              // direct process of common val<10
        mov     rax, rdx
        lea     r8, [rip + TwoDigitLookup]
@s:     lea     rcx, [rcx - 2]
        cmp     rax, 100
        jb      @2
        lea     r9, [rax * 2]
        shr     rax, 2
        mov     rdx, 2951479051793528259 // use power of two reciprocal to avoid division
        mul     rdx
        shr     rdx, 2
        mov     rax, rdx
        imul    rdx, -200
        lea     rdx, [rdx + r8]
        movzx   rdx, word ptr[rdx + r9]
        mov     [rcx], dx
        cmp     rax, 10
        jae     @s
@1:     or      al, '0'
        mov     byte ptr[rcx - 2], '-'
        mov     [rcx - 1], al
        lea     rax, [rcx + r10 - 1]       // includes '-' if val<0
        ret
@2:     movzx   eax, word ptr[r8 + rax * 2]
        mov     byte ptr[rcx - 1], '-'
        mov     [rcx], ax
        lea     rax, [rcx + r10]           // includes '-' if val<0
        ret
@3:     or      dl, '0'
        mov     byte ptr[rcx - 2], '-'
        mov     [rcx - 1], dl
        lea     rax, [rcx + r10 - 1]       // includes '-' if val<0
end;
{$else} {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=P, edx=val
        mov     ecx, edx
        sar     ecx, 31         // 0 if val>=0 or -1 if val<0
        push    ecx
        xor     edx, ecx
        sub     edx, ecx        // edx=abs(val)
        cmp     edx, 10
        jb      @3  // direct process of common val<10
        push    edi
        mov     edi, eax
        mov     eax, edx
@s:     sub     edi, 2
        cmp     eax, 100
        jb      @2
        mov     ecx, eax
        mov     edx, 1374389535 // use power of two reciprocal to avoid division
        mul     edx
        shr     edx, 5          // now edx=eax div 100
        mov     eax, edx
        imul    edx, -200
        movzx   edx, word ptr[TwoDigitLookup + ecx * 2 + edx]
        mov     [edi], dx
        cmp     eax, 10
        jae     @s
@1:     dec     edi
        or      al, '0'
        mov     byte ptr[edi - 1], '-'
        mov     [edi], al
        mov     eax, edi
        pop     edi
        pop     ecx
        add     eax, ecx // includes '-' if val<0
        ret
@2:     movzx   eax, word ptr[TwoDigitLookup + eax * 2]
        mov     byte ptr[edi - 1], '-'
        mov     [edi], ax
        mov     eax, edi
        pop     edi
        pop     ecx
        add     eax, ecx // includes '-' if val<0
        ret
@3:     dec     eax
        pop     ecx
        or      dl, '0'
        mov     byte ptr[eax - 1], '-'
        mov     [eax], dl
        add     eax, ecx // includes '-' if val<0
end;
{$endif CPUX64}
{$endif ABSOLUTEPASCALORNOTINTEL}

function StrUInt32(P: PAnsiChar; val: PtrUInt): PAnsiChar;
{$ifdef ABSOLUTEPASCALORNOTINTEL} // fallback to pure pascal version for ARM or PIC
var c100: PtrUInt; // val/c100 are QWord on 64-bit CPU
    tab: PWordArray;
begin // this code is faster than Borland's original str() or IntToStr()
  tab := @TwoDigitLookupW;
  repeat
    if val<10 then begin
      dec(P);
      P^ := AnsiChar(val+ord('0'));
      break;
    end else
    if val<100 then begin
      dec(P,2);
      PWord(P)^ := tab[val];
      break;
    end;
    dec(P,2);
    c100 := val div 100;
    dec(val,c100*100);
    PWord(P)^ := tab[val];
    val := c100;
    if c100=0 then
      break;
  until false;
  result := P;
end;
{$else}
{$ifdef CPUX64} {$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx=P, rdx=val (Linux: rdi,rsi) - val is QWord on CPUX64
{$endif FPC}
        {$ifndef win64}
        mov     rcx, rdi
        mov     rdx, rsi
        {$endif win64}
        cmp     rdx, 10
        jb      @3           // direct process of common val<10
        mov     rax, rdx
        lea     r8, [rip + TwoDigitLookup]
@s:     lea     rcx, [rcx - 2]
        cmp     rax, 100
        jb      @2
        lea     r9, [rax * 2]
        shr     rax, 2
        mov     rdx, 2951479051793528259 // use power of two reciprocal to avoid division
        mul     rdx
        shr     rdx, 2
        mov     rax, rdx
        imul    rdx, -200
        add     rdx, r8
        movzx   rdx, word ptr[rdx + r9]
        mov     [rcx], dx
        cmp     rax, 10
        jae     @s
@1:     dec     rcx
        or      al, '0'
        mov     [rcx], al
@0:     mov     rax, rcx
        ret
@2:     movzx   eax, word ptr[r8 + rax * 2]
        mov     [rcx], ax
        mov     rax, rcx
        ret
@3:     lea     rax, [rcx - 1]
        or      dl, '0'
        mov     [rax], dl
end;
{$else} {$ifdef FPC} nostackframe; assembler; {$endif}
asm     // eax=P, edx=val
        cmp     edx, 10
        jb      @3  // direct process of common val=0 (or val<10)
        push    edi
        mov     edi, eax
        mov     eax, edx
        nop
        nop         // @s loop alignment
@s:     sub     edi, 2
        cmp     eax, 100
        jb      @2
        mov     ecx, eax
        mov     edx, 1374389535 // use power of two reciprocal to avoid division
        mul     edx
        shr     edx, 5          // now edx=eax div 100
        mov     eax, edx
        imul    edx, -200
        movzx   edx, word ptr[TwoDigitLookup + ecx * 2 + edx]
        mov     [edi], dx
        cmp     eax, 10
        jae     @s
@1:     dec     edi
        or      al, '0'
        mov     [edi], al
        mov     eax, edi
        pop     edi
        ret
@2:     movzx   eax, word ptr[TwoDigitLookup + eax * 2]
        mov     [edi], ax
        mov     eax, edi
        pop     edi
        ret
@3:     dec     eax
        or      dl, '0'
        mov     [eax], dl
end;
{$endif CPU64}
{$endif ABSOLUTEPASCALORNOTINTEL}

function StrUInt64(P: PAnsiChar; const val: QWord): PAnsiChar;
{$ifdef CPU64}
begin
  result := StrUInt32(P,val); // StrUInt32 converts PtrUInt=QWord on 64-bit CPU
end;
{$else}
var c,c100: QWord;
    tab: {$ifdef CPUX86NOTPIC}TWordArray absolute TwoDigitLookupW{$else}PWordArray{$endif};
begin
  if PInt64Rec(@val)^.Hi=0 then
    P := StrUInt32(P,PCardinal(@val)^) else begin
    {$ifndef CPUX86NOTPIC}tab := @TwoDigitLookupW;{$endif}
    c := val;
    repeat
      {$ifdef PUREPASCAL}
      c100 := c div 100;   // one div by two digits
      dec(c,c100*100);     // fast c := c mod 100
      {$else}
      asm // by-passing the RTL is a good idea here
        push    ebx
        mov     edx, dword ptr[c + 4]
        mov     eax, dword ptr[c]
        mov     ebx, 100
        mov     ecx, eax
        mov     eax, edx
        xor     edx, edx
        div     ebx
        mov     dword ptr[c100 + 4], eax
        xchg    eax, ecx
        div     ebx
        mov     dword ptr[c100], eax
        imul    ebx, ecx
        mov     ecx, 100
        mul     ecx
        add     edx, ebx
        pop     ebx
        sub     dword ptr[c + 4], edx
        sbb     dword ptr[c], eax
      end;
      {$endif}
      dec(P,2);
      PWord(P)^ := tab[c];
      c := c100;
      if PInt64Rec(@c)^.Hi=0 then begin
        if PCardinal(@c)^<>0 then
          P := StrUInt32(P,PCardinal(@c)^);
        break;
      end;
    until false;
  end;
  result := P;
end;
{$endif}

function StrInt64(P: PAnsiChar; const val: Int64): PAnsiChar;
begin
  {$ifdef CPU64}
  result := StrInt32(P,val); // StrInt32 converts PtrInt=Int64 on 64-bit CPU
  {$else}
  if val<0 then begin
    P := StrUInt64(P,-val)-1;
    P^ := '-';
  end else
    P := StrUInt64(P,val);
  result := P;
  {$endif CPU64}
end;

procedure Int32ToUTF8(Value: PtrInt; var result: RawUTF8);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if PtrUInt(Value)<=high(SmallUInt32UTF8) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrInt32(@tmp[23],Value);
    FastSetString(result,P,@tmp[23]-P);
  end;
end;

procedure Int64ToUtf8(Value: Int64; var result: RawUTF8);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  {$ifdef CPU64}
  if PtrUInt(Value)<=high(SmallUInt32UTF8) then
  {$else} // Int64Rec gives compiler internal error C4963
  if (PCardinalArray(@Value)^[0]<=high(SmallUInt32UTF8)) and
     (PCardinalArray(@Value)^[1]=0) then
  {$endif CPU64}
    result := SmallUInt32UTF8[Value] else begin
    P := {$ifdef CPU64}StrInt32{$else}StrInt64{$endif}(@tmp[23],Value);
    FastSetString(result,P,@tmp[23]-P);
  end;
end;

procedure UInt64ToUtf8(Value: QWord; var result: RawUTF8);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  {$ifdef CPU64}
  if Value<=high(SmallUInt32UTF8) then
  {$else} // Int64Rec gives compiler internal error C4963
  if (PCardinalArray(@Value)^[0]<=high(SmallUInt32UTF8)) and
     (PCardinalArray(@Value)^[1]=0) then
  {$endif CPU64}
    result := SmallUInt32UTF8[Value] else begin
    P := {$ifdef CPU64}StrUInt32{$else}StrUInt64{$endif}(@tmp[23],Value);
    FastSetString(result,P,@tmp[23]-P);
  end;
end;

function ClassNameShort(C: TClass): PShortString;
// new TObject.ClassName is UnicodeString (since Delphi 2009) -> inline code
// with vmtClassName = UTF-8 encoded text stored in a shortstring = -44
begin
  result := PPointer(PtrInt(PtrUInt(C))+vmtClassName)^;
end;

function ClassNameShort(Instance: TObject): PShortString;
begin
  result := PPointer(PPtrInt(Instance)^+vmtClassName)^;
end;

function ToText(C: TClass): RawUTF8;
var P: PShortString;
begin
  if C=nil then
    result := '' else begin
    P := PPointer(PtrInt(PtrUInt(C))+vmtClassName)^;
    FastSetString(result,@P^[1],ord(P^[0]));
  end;
end;

procedure ToText(C: TClass; var result: RawUTF8);
var P: PShortString;
begin
  if C=nil then
    result := '' else begin
    P := PPointer(PtrInt(PtrUInt(C))+vmtClassName)^;
    FastSetString(result,@P^[1],ord(P^[0]));
  end;
end;

function GetClassParent(C: TClass): TClass;
begin
  result := PPointer(PtrInt(PtrUInt(C))+vmtParent)^;
  {$ifndef HASDIRECTTYPEINFO} // e.g. for Delphi and newer FPC
  if result<>nil then
    result := PPointer(result)^;
  {$endif HASDIRECTTYPEINFO}
end;

function VarRecAsChar(const V: TVarRec): integer;
begin
  case V.VType of
    vtChar:     result := ord(V.VChar);
    vtWideChar: result := ord(V.VWideChar);
    else        result := 0;
  end;
end;

function VarRecToInt64(const V: TVarRec; out value: Int64): boolean;
begin
  case V.VType of
    vtInteger: value := V.VInteger;
    vtInt64 {$ifdef FPC}, vtQWord{$endif}: value := V.VInt64^;
    vtBoolean: if V.VBoolean then value := 1 else value := 0; // normalize
    {$ifndef NOVARIANTS}
    vtVariant: value := V.VVariant^;
    {$endif}
    else begin
      result := false;
      exit;
    end;
  end;
  result := true;
end;

function VarRecToDouble(const V: TVarRec; out value: double): boolean;
begin
  case V.VType of
    vtInteger: value := V.VInteger;
    vtInt64:   value := V.VInt64^;
    {$ifdef FPC}
    vtQWord:   value := V.VQWord^;
    {$endif}
    vtBoolean: if V.VBoolean then value := 1 else value := 0; // normalize
    vtExtended: value := V.VExtended^;
    vtCurrency: value := V.VCurrency^;
    {$ifndef NOVARIANTS}
    vtVariant: value := V.VVariant^;
    {$endif}
    else begin
      result := false;
      exit;
    end;
  end;
  result := true;
end;

function VarRecToTempUTF8(const V: TVarRec; var Res: TTempUTF8): integer;
{$ifndef NOVARIANTS}
var v64: Int64;
    isString: boolean;
{$endif}
label smlu32;
begin
  Res.TempRawUTF8 := nil; // avoid GPF
  case V.VType of
    vtString: begin
      Res.Text := @V.VString^[1];
      Res.Len := ord(V.VString^[0]);
      result := Res.Len;
      exit;
    end;
    vtAnsiString: begin // expect UTF-8 content
      Res.Text := pointer(V.VAnsiString);
      Res.Len := length(RawUTF8(V.VAnsiString));
      result := Res.Len;
      exit;
    end;
    {$ifdef HASVARUSTRING}
    vtUnicodeString:
      RawUnicodeToUtf8(V.VPWideChar,length(UnicodeString(V.VUnicodeString)),RawUTF8(Res.TempRawUTF8));
    {$endif}
    vtWideString:
      RawUnicodeToUtf8(V.VPWideChar,length(WideString(V.VWideString)),RawUTF8(Res.TempRawUTF8));
    vtPChar: begin // expect UTF-8 content
      Res.Text := V.VPointer;
      Res.Len := StrLen(V.VPointer);
      result := Res.Len;
      exit;
    end;
    vtChar: begin
      Res.Temp[0] := V.VChar; // V may be on transient stack (alf: FPC)
      Res.Text := @Res.Temp;
      Res.Len := 1;
      result := 1;
      exit;
    end;
    vtPWideChar:
      RawUnicodeToUtf8(V.VPWideChar,StrLenW(V.VPWideChar),RawUTF8(Res.TempRawUTF8));
    vtWideChar:
      RawUnicodeToUtf8(@V.VWideChar,1,RawUTF8(Res.TempRawUTF8));
    vtBoolean: begin
      if V.VBoolean then // normalize
        Res.Text := pointer(SmallUInt32UTF8[1]) else
        Res.Text := pointer(SmallUInt32UTF8[0]);
      Res.Len := 1;
      result := 1;
      exit;
    end;
    vtInteger: begin
      result := V.VInteger;
      if cardinal(result)<=high(SmallUInt32UTF8) then begin
smlu32: Res.Text := pointer(SmallUInt32UTF8[result]);
        Res.Len := PStrLen(Res.Text-_STRLEN)^;
      end else begin
        Res.Text := PUTF8Char(StrInt32(@Res.Temp[23],result));
        Res.Len := @Res.Temp[23]-Res.Text;
      end;
      result := Res.Len;
      exit;
    end;
    vtInt64:
      if (PCardinalArray(V.VInt64)^[0]<=high(SmallUInt32UTF8)) and
         (PCardinalArray(V.VInt64)^[1]=0) then begin
        result := V.VInt64^;
        goto smlu32;
      end else begin
        Res.Text := PUTF8Char(StrInt64(@Res.Temp[23],V.VInt64^));
        Res.Len := @Res.Temp[23]-Res.Text;
        result := Res.Len;
        exit;
      end;
    {$ifdef FPC}
    vtQWord:
      if V.VQWord^<=high(SmallUInt32UTF8) then begin
         result := V.VQWord^;
         goto smlu32;
       end else begin
        Res.Text := PUTF8Char(StrUInt64(@Res.Temp[23],V.VQWord^));
        Res.Len := @Res.Temp[23]-Res.Text;
        result := Res.Len;
        exit;
      end;
    {$endif}
    vtCurrency: begin
      Res.Text := @Res.Temp;
      Res.Len := Curr64ToPChar(V.VInt64^,Res.Temp);
      result := Res.Len;
      exit;
    end;
    vtExtended:
      DoubleToStr(V.VExtended^,RawUTF8(Res.TempRawUTF8));
    vtPointer,vtInterface: begin
      Res.Text := @Res.Temp;
      Res.Len := SizeOf(pointer)*2;
      BinToHexDisplayLower(@V.VPointer,@Res.Temp,SizeOf(Pointer));
      result := SizeOf(pointer)*2;
      exit;
    end;
    vtClass: begin
      if V.VClass<>nil then begin
        Res.Text := PPUTF8Char(PtrInt(PtrUInt(V.VClass))+vmtClassName)^+1;
        Res.Len := ord(Res.Text[-1]);
      end else
        Res.Len := 0;
      result := Res.Len;
      exit;
    end;
    vtObject: begin
      if V.VObject<>nil then begin
        Res.Text := PPUTF8Char(PPtrInt(V.VObject)^+vmtClassName)^+1;
        Res.Len := ord(Res.Text[-1]);
      end else
        Res.Len := 0;
      result := Res.Len;
      exit;
    end;
    {$ifndef NOVARIANTS}
    vtVariant:
      if VariantToInt64(V.VVariant^,v64) then
        if (PCardinalArray(@v64)^[0]<=high(SmallUInt32UTF8)) and
           (PCardinalArray(@v64)^[1]=0) then begin
          result := v64;
          goto smlu32;
        end else begin
          Res.Text := PUTF8Char(StrInt64(@Res.Temp[23],v64));
          Res.Len := @Res.Temp[23]-Res.Text;
          result := Res.Len;
          exit;
        end else
        VariantToUTF8(V.VVariant^,RawUTF8(Res.TempRawUTF8),isString);
    {$endif}
    else begin
      Res.Len := 0;
      result := 0;
      exit;
    end;
  end;
  Res.Text := Res.TempRawUTF8;
  Res.Len := length(RawUTF8(Res.TempRawUTF8));
  result := Res.Len;
end;

procedure VarRecToUTF8(const V: TVarRec; var result: RawUTF8; wasString: PBoolean);
var isString: boolean;
begin
  isString := not (V.VType in [
    vtBoolean,vtInteger,vtInt64{$ifdef FPC},vtQWord{$endif},vtCurrency,vtExtended]);
  with V do
  case V.VType of
    vtString:
      FastSetString(result,@VString^[1],ord(VString^[0]));
    vtAnsiString:
      result := RawUTF8(VAnsiString); // expect UTF-8 content
    {$ifdef HASVARUSTRING}
    vtUnicodeString:
      RawUnicodeToUtf8(VUnicodeString,length(UnicodeString(VUnicodeString)),result);
    {$endif}
    vtWideString:
      RawUnicodeToUtf8(VWideString,length(WideString(VWideString)),result);
    vtPChar:
      FastSetString(result,VPChar,StrLen(VPChar));
    vtChar:
      FastSetString(result,PAnsiChar(@VChar),1);
    vtPWideChar:
      RawUnicodeToUtf8(VPWideChar,StrLenW(VPWideChar),result);
    vtWideChar:
      RawUnicodeToUtf8(@VWideChar,1,result);
    vtBoolean:
      if VBoolean then // normalize
        result := SmallUInt32UTF8[1] else
        result := SmallUInt32UTF8[0];
    vtInteger:
      Int32ToUtf8(VInteger,result);
    vtInt64:
      Int64ToUtf8(VInt64^,result);
    {$ifdef FPC}
    vtQWord:
      UInt64ToUtf8(VQWord^,result);
    {$endif}
    vtCurrency:
      Curr64ToStr(VInt64^,result);
    vtExtended:
      DoubleToStr(VExtended^,result);
    vtPointer:
      PointerToHex(VPointer,result);
    vtClass:
      if VClass<>nil then
        ToText(VClass,result) else
        result := '';
    vtObject:
      if VObject<>nil then
        ToText(PClass(VObject)^,result) else
        result := '';
    vtInterface:
      {$ifdef HASINTERFACEASTOBJECT}
      if VInterface<>nil then
        ToText((IInterface(VInterface) as TObject).ClassType,result) else
        result := '';
      {$else}
      PointerToHex(VInterface,result);
      {$endif}
    {$ifndef NOVARIANTS}
    vtVariant:
      VariantToUTF8(VVariant^,result,isString);
    {$endif}
    else begin
      isString := false;
      result := '';
    end;
  end;
  if wasString<>nil then
    wasString^ := isString;
end;

function VarRecToUTF8IsString(const V: TVarRec; var value: RawUTF8): boolean;
begin
  VarRecToUTF8(V,value,@result);
end;

procedure VarRecToInlineValue(const V: TVarRec; var result: RawUTF8);
var wasString: boolean;
    tmp: RawUTF8;
begin
  VarRecToUTF8(V,tmp,@wasString);
  if wasString then
    QuotedStr(tmp,'"',result) else
    result := tmp;
end;

{$ifdef UNICODE}
function StringToRawUnicode(const S: string): RawUnicode;
begin
  SetString(result,PAnsiChar(pointer(S)),length(S)*2+1); // +1 for last wide #0
end;
function StringToSynUnicode(const S: string): SynUnicode;
begin
  result := S;
end;
procedure StringToSynUnicode(const S: string; var result: SynUnicode); overload;
begin
  result := S;
end;
function StringToRawUnicode(P: PChar; L: integer): RawUnicode;
begin
  SetString(result,PAnsiChar(P),L*2+1); // +1 for last wide #0
end;
function RawUnicodeToString(P: PWideChar; L: integer): string;
begin
  SetString(result,P,L);
end;
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string);
begin
  SetString(result,P,L);
end;
function RawUnicodeToString(const U: RawUnicode): string;
begin // uses StrLenW() and not length(U) to handle case when was used as buffer
  SetString(result,PWideChar(pointer(U)),StrLenW(Pointer(U)));
end;
function SynUnicodeToString(const U: SynUnicode): string;
begin
  result := U;
end;
function UTF8DecodeToString(P: PUTF8Char; L: integer): string;
begin
  UTF8DecodeToUnicodeString(P,L,result);
end;
procedure UTF8DecodeToString(P: PUTF8Char; L: integer; var result: string);
begin
  UTF8DecodeToUnicodeString(P,L,result);
end;
function UTF8ToString(const Text: RawUTF8): string;
begin
  UTF8DecodeToUnicodeString(pointer(Text),length(Text),result);
end;
{$else}
function StringToRawUnicode(const S: string): RawUnicode;
begin
  result := CurrentAnsiConvert.AnsiToRawUnicode(S);
end;
function StringToSynUnicode(const S: string): SynUnicode;
begin
  result := CurrentAnsiConvert.AnsiToUnicodeString(pointer(S),length(S));
end;
procedure StringToSynUnicode(const S: string; var result: SynUnicode); overload;
begin
  result := CurrentAnsiConvert.AnsiToUnicodeString(pointer(S),length(S));
end;
function StringToRawUnicode(P: PChar; L: integer): RawUnicode;
begin
  result := CurrentAnsiConvert.AnsiToRawUnicode(P,L);
end;
function RawUnicodeToString(P: PWideChar; L: integer): string;
begin
  result := CurrentAnsiConvert.UnicodeBufferToAnsi(P,L);
end;
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string);
begin
  result := CurrentAnsiConvert.UnicodeBufferToAnsi(P,L);
end;
function RawUnicodeToString(const U: RawUnicode): string;
begin // uses StrLenW() and not length(U) to handle case when was used as buffer
  result := CurrentAnsiConvert.UnicodeBufferToAnsi(Pointer(U),StrLenW(Pointer(U)));
end;
function SynUnicodeToString(const U: SynUnicode): string;
begin
  result := CurrentAnsiConvert.UnicodeBufferToAnsi(Pointer(U),length(U));
end;
function UTF8DecodeToString(P: PUTF8Char; L: integer): string;
begin
  CurrentAnsiConvert.UTF8BufferToAnsi(P,L,RawByteString(result));
end;
procedure UTF8DecodeToString(P: PUTF8Char; L: integer; var result: string);
begin
  CurrentAnsiConvert.UTF8BufferToAnsi(P,L,RawByteString(result));
end;
function UTF8ToString(const Text: RawUTF8): string;
begin
  CurrentAnsiConvert.UTF8BufferToAnsi(pointer(Text),length(Text),RawByteString(result));
end;
{$endif UNICODE}

procedure UTF8ToWideString(const Text: RawUTF8; var result: WideString);
begin
  UTF8ToWideString(pointer(Text),Length(Text),result);
end;

function UTF8ToWideString(const Text: RawUTF8): WideString;
begin
  {$ifdef FPC}
  Finalize(result);
  {$endif FPC}
  UTF8ToWideString(pointer(Text),Length(Text),result);
end;

procedure UTF8ToWideString(Text: PUTF8Char; Len: PtrInt; var result: WideString);
var tmp: TSynTempBuffer;
begin
  if (Text=nil) or (Len=0) then
    result := '' else begin
    tmp.Init(Len*3); // maximum posible unicode size (if all <#128)
    SetString(result,PWideChar(tmp.buf),UTF8ToWideChar(tmp.buf,Text,Len) shr 1);
    tmp.Done;
  end;
end;

function WideStringToUTF8(const aText: WideString): RawUTF8;
begin
  RawUnicodeToUtf8(pointer(aText),length(aText),result);
end;

function UTF8ToSynUnicode(const Text: RawUTF8): SynUnicode;
begin
  UTF8ToSynUnicode(pointer(Text),length(Text),result);
end;

procedure UTF8ToSynUnicode(const Text: RawUTF8; var result: SynUnicode);
begin
  UTF8ToSynUnicode(pointer(Text),length(Text),result);
end;

procedure UTF8ToSynUnicode(Text: PUTF8Char; Len: PtrInt; var result: SynUnicode);
var tmp: TSynTempBuffer;
begin
  if (Text=nil) or (Len=0) then
    result := '' else begin
    tmp.Init(Len*3); // maximum posible unicode size (if all <#128)
    SetString(result,PWideChar(tmp.buf),UTF8ToWideChar(tmp.buf,Text,Len) shr 1);
    tmp.Done;
  end;
end;



{ TRawUTF8InterningSlot }

procedure TRawUTF8InterningSlot.Init;
begin
  Safe.Init;
  {$ifndef NOVARIANTS}
  Safe.LockedInt64[0] := 0;
  {$endif}
  Values.Init(TypeInfo(TRawUTF8DynArray),Value,HashAnsiString,
    SortDynArrayAnsiString,InterningHasher,@Safe.Padding[0].VInteger,false);
end;

procedure TRawUTF8InterningSlot.Done;
begin
  Safe.Done;
end;

function TRawUTF8InterningSlot.Count: integer;
begin
  {$ifdef NOVARIANTS}
  result := Safe.Padding[0].VInteger;
  {$else}
  result := Safe.LockedInt64[0];
  {$endif}
end;

procedure TRawUTF8InterningSlot.Unique(var aResult: RawUTF8;
  const aText: RawUTF8; aTextHash: cardinal);
var i: PtrInt;
    added: boolean;
begin
  EnterCriticalSection(Safe.fSection);
  try
    i := Values.FindHashedForAdding(aText,added,aTextHash);
    if added then begin
      Value[i] := aText;   // copy new value to the pool
      aResult := aText;
     end else
      aResult := Value[i]; // return unified string instance
  finally
    LeaveCriticalSection(Safe.fSection);
  end;
end;

procedure TRawUTF8InterningSlot.UniqueText(var aText: RawUTF8; aTextHash: cardinal);
var i: PtrInt;
    added: boolean;
begin
  EnterCriticalSection(Safe.fSection);
  try
    i := Values.FindHashedForAdding(aText,added,aTextHash);
    if added then
      Value[i] := aText else  // copy new value to the pool
      aText := Value[i];      // return unified string instance
  finally
    LeaveCriticalSection(Safe.fSection);
  end;
end;

procedure TRawUTF8InterningSlot.Clear;
begin
  EnterCriticalSection(Safe.fSection);
  try
    Values.SetCount(0); // Values.Clear
    Values.Hasher.Clear;
  finally
    LeaveCriticalSection(Safe.fSection);
  end;
end;

function TRawUTF8InterningSlot.Clean(aMaxRefCount: integer): integer;
var i: integer;
    s,d: PPtrUInt; // points to RawUTF8 values (bypass COW assignments)
begin
  result := 0;
  EnterCriticalSection(Safe.fSection);
  try
    if Safe.Padding[0].VInteger=0 then
      exit;
    s := pointer(Value);
    d := s;
    for i := 1 to Safe.Padding[0].VInteger do begin
      if PRefCnt(PAnsiChar(s^)-_STRREFCNT)^<=aMaxRefCount then begin
        {$ifdef FPC}
        Finalize(PRawUTF8(s)^);
        {$else}
        PRawUTF8(s)^ := '';
        {$endif FPC}
        inc(result);
      end else begin
        if s<>d then begin
          d^ := s^;
          s^ := 0; // avoid GPF
        end;
        inc(d);
      end;
      inc(s);
    end;
    if result>0 then begin
      Values.SetCount((PtrUInt(d)-PtrUInt(Value))div SizeOf(d^));
      Values.ReHash;
    end;
  finally
    LeaveCriticalSection(Safe.fSection);
  end;
end;


{ TRawUTF8Interning }

constructor TRawUTF8Interning.Create(aHashTables: integer);
var p: integer;
    i: PtrInt;
begin
  for p := 0 to 9 do
    if aHashTables=1 shl p then begin
      SetLength(fPool,aHashTables);
      fPoolLast := aHashTables-1;
      for i := 0 to fPoolLast do
        fPool[i].Init;
      exit;
    end;
  raise ESynException.CreateUTF8('%.Create(%) not allowed: should be a power of 2',
    [self,aHashTables]);
end;

destructor TRawUTF8Interning.Destroy;
var i: PtrInt;
begin
  for i := 0 to fPoolLast do
    fPool[i].Done;
  inherited Destroy;
end;

procedure TRawUTF8Interning.Clear;
var i: PtrInt;
begin
  if self<>nil then
    for i := 0 to fPoolLast do
      fPool[i].Clear;
end;

function TRawUTF8Interning.Clean(aMaxRefCount: integer): integer;
var i: PtrInt;
begin
  result := 0;
  if self<>nil then
    for i := 0 to fPoolLast do
      inc(result,fPool[i].Clean(aMaxRefCount));
end;

function TRawUTF8Interning.Count: integer;
var i: PtrInt;
begin
  result := 0;
  if self<>nil then
    for i := 0 to fPoolLast do
      inc(result,fPool[i].Count);
end;

procedure TRawUTF8Interning.Unique(var aResult: RawUTF8; const aText: RawUTF8);
var hash: cardinal;
begin
  if aText='' then
    aResult := '' else
  if self=nil then
    aResult := aText else begin
    hash := InterningHasher(0,pointer(aText),length(aText)); // = fPool[].Values.HashElement
    fPool[hash and fPoolLast].Unique(aResult,aText,hash);
  end;
end;

procedure TRawUTF8Interning.UniqueText(var aText: RawUTF8);
var hash: cardinal;
begin
  if (self<>nil) and (aText<>'') then begin
    hash := InterningHasher(0,pointer(aText),length(aText)); // = fPool[].Values.HashElement
    fPool[hash and fPoolLast].UniqueText(aText,hash);
  end;
end;

function TRawUTF8Interning.Unique(const aText: RawUTF8): RawUTF8;
var hash: cardinal;
begin
  if aText='' then
    result := '' else
  if self=nil then
    result := aText else begin
    hash := InterningHasher(0,pointer(aText),length(aText)); // = fPool[].Values.HashElement
    fPool[hash and fPoolLast].Unique(result,aText,hash);
  end;
end;

function TRawUTF8Interning.Unique(aText: PUTF8Char; aTextLen: PtrInt): RawUTF8;
begin
  FastSetString(result,aText,aTextLen);
  UniqueText(result);
end;

procedure TRawUTF8Interning.Unique(var aResult: RawUTF8; aText: PUTF8Char;
  aTextLen: PtrInt);
begin
  FastSetString(aResult,aText,aTextLen);
  UniqueText(aResult);
end;

procedure ClearVariantForString(var Value: variant); {$ifdef HASINLINE} inline; {$endif}
var v: TVarData absolute Value;
begin
  if cardinal(v.VType) = varString then
    Finalize(RawByteString(v.VString))
  else
    begin
      VarClear(Value);
      PInteger(@v.VType)^ := varString;
      v.VString := nil; // to avoid GPF when assign a RawByteString
    end;
end;

{$ifndef NOVARIANTS}

procedure TRawUTF8Interning.UniqueVariant(var aResult: variant; const aText: RawUTF8);
begin
  ClearVariantForString(aResult);
  Unique(RawUTF8(TVarData(aResult).VAny),aText);
end;

procedure TRawUTF8Interning.UniqueVariantString(var aResult: variant; const aText: string);
var tmp: RawUTF8;
begin
  StringToUTF8(aText,tmp);
  UniqueVariant(aResult,tmp);
end;

procedure TRawUTF8Interning.UniqueVariant(var aResult: variant;
  aText: PUTF8Char; aTextLen: PtrInt; aAllowVarDouble: boolean);
var tmp: RawUTF8;
begin
  if not GetNumericVariantFromJSON(aText,TVarData(aResult),aAllowVarDouble) then begin
    FastSetString(tmp,aText,aTextLen);
    UniqueVariant(aResult,tmp);
  end;
end;

procedure TRawUTF8Interning.UniqueVariant(var aResult: variant);
var vt: cardinal;
begin
  vt := TVarData(aResult).VType;
  with TVarData(aResult) do
    if vt=varString then
      UniqueText(RawUTF8(VString)) else
    if vt=varVariant or varByRef then
      UniqueVariant(PVariant(VPointer)^) else
    if vt=varString or varByRef then
      UniqueText(PRawUTF8(VPointer)^);
end;

{$endif NOVARIANTS}

const
  // see https://en.wikipedia.org/wiki/Baudot_code
  Baudot2Char: array[0..63] of AnsiChar =
   #0'e'#10'a siu'#13'drjnfcktzlwhypqobg'#254'mxv'#255+
   #0'3'#10'- ''87'#13#0'4'#0',!:(5+)2$6019?@'#254'./;'#255;
var
  Char2Baudot: array[AnsiChar] of byte;

function AsciiToBaudot(const Text: RawUTF8): RawByteString;
begin
  result := AsciiToBaudot(pointer(Text),length(Text));
end;

function AsciiToBaudot(P: PAnsiChar; len: PtrInt): RawByteString;
var i: PtrInt;
    c,d,bits: integer;
    shift: boolean;
    dest: PByte;
    tmp: TSynTempBuffer;
begin
  result := '';
  if (P=nil) or (len=0) then
    exit;
  shift := false;
  dest := tmp.Init((len*10)shr 3);
  d := 0;
  bits := 0;
  for i := 0 to len-1 do begin
    c := Char2Baudot[P[i]];
    if c>32 then begin
      if not shift then begin
        d := (d shl 5) or 27;
        inc(bits,5);
        shift := true;
      end;
      d := (d shl 5) or (c-32);
      inc(bits,5);
    end else
    if c>0 then begin
      if shift and (P[i]>=' ') then begin
        d := (d shl 5) or 31;
        inc(bits,5);
        shift := false;
      end;
      d := (d shl 5) or c;
      inc(bits,5);
    end;
    while bits>=8 do begin
      dec(bits,8);
      dest^ := d shr bits;
      inc(dest);
    end;
  end;
  if bits>0 then begin
    dest^ := d shl (8-bits);
    inc(dest);
  end;
  SetString(result,PAnsiChar(tmp.buf),PAnsiChar(dest)-PAnsiChar(tmp.buf));
  tmp.Done;
end;

function BaudotToAscii(const Baudot: RawByteString): RawUTF8;
begin
  result := BaudotToAscii(pointer(Baudot),length(Baudot));
end;

function BaudotToAscii(Baudot: PByteArray; len: PtrInt): RawUTF8;
var i: PtrInt;
    c,b,bits,shift: integer;
    tmp: TSynTempBuffer;
    dest: PAnsiChar;
begin
  result := '';
  if (Baudot=nil) or (len<=0) then
    exit;
  dest := tmp.Init((len shl 3)div 5);
  try
    shift := 0;
    b := 0;
    bits := 0;
    for i := 0 to len-1 do begin
      b := (b shl 8) or Baudot[i];
      inc(bits,8);
      while bits>=5 do begin
        dec(bits,5);
        c := (b shr bits) and 31;
        case c of
        27: if shift<>0 then
              exit else
              shift := 32;
        31: if shift<>0 then
              shift := 0 else
              exit;
        else begin
          c := ord(Baudot2Char[c+shift]);
          if c=0 then
            if Baudot[i+1]=0 then // allow triming of last 5 bits
              break else
              exit;
          dest^ := AnsiChar(c);
          inc(dest);
        end;
        end;
      end;
    end;
  finally
    tmp.Done(dest,result);
  end;
end;

function IsVoid(const text: RawUTF8): boolean;
var i: PtrInt;
begin
  result := false;
  for i := 1 to length(text) do
    if text[i]>' ' then
      exit;
  result := true;
end;

function TrimControlChars(const text: RawUTF8; const controls: TSynAnsicharSet): RawUTF8;
var len,i,j,n: PtrInt;
    P: PAnsiChar;
begin
  len := length(text);
  for i := 1 to len do
    if text[i] in controls then begin
      n := i-1;
      FastSetString(result,nil,len);
      P := pointer(result);
      if n>0 then
        MoveFast(pointer(text)^,P^,n);
      for j := i+1 to len do
        if not(text[j] in controls) then begin
          P[n] := text[j];
          inc(n);
        end;
      SetLength(result,n); // truncate
      exit;
    end;
  result := text; // no control char found
end;

procedure ExchgPointer(n1,n2: PPointer); {$ifdef HASINLINE}inline;{$endif}
var n: pointer;
begin
  n := n2^;
  n2^ := n1^;
  n1^ := n;
end;

procedure ExchgVariant(v1,v2: PPtrIntArray); {$ifdef CPU64}inline;{$endif}
var c: PtrInt; // 32-bit:16bytes=4ptr 64-bit:24bytes=3ptr
begin
  c := v2[0];
  v2[0] := v1[0];
  v1[0] := c;
  c := v2[1];
  v2[1] := v1[1];
  v1[1] := c;
  c := v2[2];
  v2[2] := v1[2];
  v1[2] := c;
  {$ifdef CPU32}
  c := v2[3];
  v2[3] := v1[3];
  v1[3] := c;
  {$endif}
end;

{$ifdef CPU64}
procedure Exchg16(P1,P2: PPtrIntArray); inline;
var c: PtrInt;
begin
  c := P1[0];
  P1[0] := P2[0];
  P2[0] := c;
  c := P1[1];
  P1[1] := P2[1];
  P2[1] := c;
end;
{$endif}

procedure Exchg(P1,P2: PAnsiChar; count: PtrInt);
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif}
var i, c: PtrInt;
    u: AnsiChar;
begin
  for i := 1 to count shr POINTERSHR do begin
    c := PPtrInt(P1)^;
    PPtrInt(P1)^ := PPtrInt(P2)^;
    PPtrInt(P2)^ := c;
    inc(P1,SizeOf(c));
    inc(P2,SizeOf(c));
  end;
  for i := 0 to (count and POINTERAND)-1 do begin
    u := P1[i];
    P1[i] := P2[i];
    P2[i] := u;
  end;
end;
{$else} {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=P1, edx=P2, ecx=count
        push    ebx
        push    esi
        push    ecx
        shr     ecx, 2
        jz      @2
@4:     mov     ebx, [eax]
        mov     esi, [edx]
        mov     [eax], esi
        mov     [edx], ebx
        add     eax, 4
        add     edx, 4
        dec     ecx
        jnz     @4
@2:     pop     ecx
        and     ecx, 3
        jz      @0
@1:     mov     bl, [eax]
        mov     bh, [edx]
        mov     [eax], bh
        mov     [edx], bl
        inc     eax
        inc     edx
        dec     ecx
        jnz     @1
@0:     pop     esi
        pop     ebx
end;
{$endif}

function GetAllBits(Bits, BitCount: Cardinal): boolean;
begin
  if BitCount in [low(ALLBITS_CARDINAL)..high(ALLBITS_CARDINAL)] then begin
    BitCount := ALLBITS_CARDINAL[BitCount];
    result := (Bits and BitCount)=BitCount;
  end else
    result := false;
end;

// naive code gives the best performance - bts [Bits] has an overhead
function GetBit(const Bits; aIndex: PtrInt): boolean;
begin
  result := PByteArray(@Bits)[aIndex shr 3] and (1 shl (aIndex and 7)) <> 0;
end;

procedure SetBit(var Bits; aIndex: PtrInt);
begin
  TByteArray(Bits)[aIndex shr 3] := TByteArray(Bits)[aIndex shr 3]
    or (1 shl (aIndex and 7));
end;

procedure UnSetBit(var Bits; aIndex: PtrInt);
begin
  PByteArray(@Bits)[aIndex shr 3] := PByteArray(@Bits)[aIndex shr 3]
    and not (1 shl (aIndex and 7));
end;

function GetBitPtr(Bits: pointer; aIndex: PtrInt): boolean;
begin
  result := PByteArray(Bits)[aIndex shr 3] and (1 shl (aIndex and 7)) <> 0;
end;

procedure SetBitPtr(Bits: pointer; aIndex: PtrInt);
begin
  PByteArray(Bits)[aIndex shr 3] := PByteArray(Bits)[aIndex shr 3]
    or (1 shl (aIndex and 7));
end;

procedure UnSetBitPtr(Bits: pointer; aIndex: PtrInt);
begin
  PByteArray(Bits)[aIndex shr 3] := PByteArray(Bits)[aIndex shr 3]
    and not (1 shl (aIndex and 7));
end;

function GetBit64(const Bits: Int64; aIndex: PtrInt): boolean;
begin
  result := aIndex in TBits64(Bits);
end;

procedure SetBit64(var Bits: Int64; aIndex: PtrInt);
begin
  include(PBits64(@Bits)^,aIndex);
end;

procedure UnSetBit64(var Bits: Int64; aIndex: PtrInt);
begin
  exclude(PBits64(@Bits)^,aIndex);
end;

function GetBitsCount(const Bits; Count: PtrInt): PtrInt;
var P: PPtrInt;
    popcnt: function(value: PtrInt): PtrInt; // fast redirection within loop
begin
  P := @Bits;
  result := 0;
  popcnt := @GetBitsCountPtrInt;
  if Count>=POINTERBITS then
    repeat
      dec(Count,POINTERBITS);
      inc(result,popcnt(P^)); // use SSE4.2 if available
      inc(P);
    until Count<POINTERBITS;
  if Count>0 then
    inc(result,popcnt(P^ and ((PtrInt(1) shl Count)-1)));
end;

{  FPC x86_64 Linux:
  1000000 pas in 4.67ms i.e. 213,949,507/s, aver. 0us, 1.5 GB/s
  1000000 asm in 4.14ms i.e. 241,196,333/s, aver. 0us, 1.8 GB/s
  1000000 sse4.2 in 2.36ms i.e. 423,011,844/s, aver. 0us, 3.1 GB/s
  1000000 FPC in 21.32ms i.e. 46,886,721/s, aver. 0us, 357.7 MB/s
   FPC i386 Windows:
  1000000 pas in 3.40ms i.e. 293,944,738/s, aver. 0us, 1 GB/s
  1000000 asm in 3.18ms i.e. 313,971,742/s, aver. 0us, 1.1 GB/s
  1000000 sse4.2 in 2.74ms i.e. 364,166,059/s, aver. 0us, 1.3 GB/s
  1000000 FPC in 8.18ms i.e. 122,204,570/s, aver. 0us, 466.1 MB/s
 notes:
 1. AVX2 faster than popcnt on big buffers - https://arxiv.org/pdf/1611.07612.pdf
 2. our pascal/asm versions below use the efficient Wilkes-Wheeler-Gill algorithm
    whereas FPC RTL's popcnt() is much slower }

{$ifdef CPUX86}
function GetBitsCountSSE42(value: PtrInt): PtrInt; {$ifdef FPC} nostackframe; assembler; {$endif}
asm
        {$ifdef FPC_X86ASM}
        popcnt  eax, eax
        {$else} // oldest Delphi don't support this opcode
        db      $f3,$0f,$B8,$c0
        {$endif}
end;
function GetBitsCountPas(value: PtrInt): PtrInt; {$ifdef FPC} nostackframe; assembler; {$endif}
asm // branchless Wilkes-Wheeler-Gill i386 asm implementation
        mov     edx, eax
        shr     eax, 1
        and     eax, $55555555
        sub     edx, eax
        mov     eax, edx
        shr     edx, 2
        and     eax, $33333333
        and     edx, $33333333
        add     eax, edx
        mov     edx, eax
        shr     eax, 4
        add     eax, edx
        and     eax, $0f0f0f0f
        mov     edx, eax
        shr     edx, 8
        add     eax, edx
        mov     edx, eax
        shr     edx, 16
        add     eax, edx
        and     eax, $3f
end;
{$else}
{$ifdef CPUX64}
function GetBitsCountSSE42(value: PtrInt): PtrInt;
{$ifdef FPC} assembler; nostackframe;
asm
        popcnt  rax, value
{$else} // oldest Delphi don't support this opcode
asm     .noframe
        {$ifdef win64} db $f3,$48,$0f,$B8,$c1
        {$else}        db $f3,$48,$0f,$B8,$c7 {$endif}
{$endif FPC}
end;
function GetBitsCountPas(value: PtrInt): PtrInt;
{$ifdef FPC} assembler; nostackframe; asm {$else} asm .noframe {$endif}
        mov     rax, value
        mov     rdx, value
        shr     rax, 1
        mov     rcx, $5555555555555555
        mov     r8,  $3333333333333333
        mov     r10, $0f0f0f0f0f0f0f0f
        mov     r11, $0101010101010101
        and     rax, rcx
        sub     rdx, rax
        mov     rax, rdx
        shr     rdx, 2
        and     rax, r8
        and     rdx, r8
        add     rax, rdx
        mov     rdx, rax
        shr     rax, 4
        add     rax, rdx
        and     rax, r10
        imul    rax, r11
        shr     rax, 56
end;
{$else}
function GetBitsCountPas(value: PtrInt): PtrInt;
begin // generic branchless Wilkes-Wheeler-Gill pure pascal version
  result := value;
  {$ifdef CPU64}
  result := result-((result shr 1) and $5555555555555555);
  result := (result and $3333333333333333)+((result shr 2) and $3333333333333333);
  result := (result+(result shr 4)) and $0f0f0f0f0f0f0f0f;
  inc(result,result shr 8); // avoid slow multiplication on ARM
  inc(result,result shr 16);
  inc(result,result shr 32);
  result := result and $7f;
  {$else}
  result := result-((result shr 1) and $55555555);
  result := (result and $33333333)+((result shr 2) and $33333333);
  result := (result+(result shr 4)) and $0f0f0f0f;
  inc(result,result shr 8);
  inc(result,result shr 16);
  result := result and $3f;
  {$endif CPU64}
end;
{$endif CPUX64}
{$endif CPUX86}

type
{$ifdef FPC}
  {$packrecords c} // as expected by FPC's RTTI record definitions
  TStrRec = record // see TAnsiRec/TUnicodeRec in astrings/ustrings.inc
  {$ifdef ISFPC27}
    codePage: TSystemCodePage; // =Word
    elemSize: Word;
    {$ifdef CPU64}
    _PaddingToQWord: DWord;
    {$endif}
  {$endif}
    refCnt: TRefCnt; // =SizeInt
    length: SizeInt;
  end;
{$else FPC}
  /// map the Delphi/FPC dynamic array header (stored before each instance)
  TDynArrayRec = packed record
    {$ifdef CPUX64}
    /// padding bytes for 16 byte alignment of the header
    _Padding: LongInt;
    {$endif}
    /// dynamic array reference count (basic garbage memory mechanism)
    refCnt: TRefCnt;
    /// length in element count
    // - size in bytes = length*ElemSize
    length: PtrInt;
  end;
  PDynArrayRec = ^TDynArrayRec;

  /// map the Delphi/FPC string header (stored before each instance)
  TStrRec = packed record
 {$ifdef UNICODE}
    {$ifdef CPU64}
    /// padding bytes for 16 bytes alignment of the header
    _Padding: LongInt;
    {$endif}
    /// the associated code page used for this string
    // - exist only since Delphi/FPC 2009
    // - 0 or 65535 for RawByteString
    // - 1200=CP_UTF16 for UnicodeString
    // - 65001=CP_UTF8 for RawUTF8
    // - the current code page for AnsiString
    codePage: Word;
    /// either 1 (for AnsiString) or 2 (for UnicodeString)
    // - exist only since Delphi/FPC 2009
    elemSize: Word;
  {$endif UNICODE}
    /// COW string reference count (basic garbage memory mechanism)
    refCnt: TRefCnt;
    /// length in characters
    // - size in bytes = length*elemSize
    length: Longint;
  end;
{$endif FPC}
  PStrRec = ^TStrRec;

  PTypeInfo = ^TTypeInfo;
  {$ifdef HASDIRECTTYPEINFO} // for old FPC (<=3.0)
  PTypeInfoStored = PTypeInfo;
  {$else} // e.g. for Delphi and newer FPC
  PTypeInfoStored = ^PTypeInfo; // = TypeInfoPtr macro in FPC typinfo.pp
  {$endif}

  // note: FPC TRecInitData is taken from typinfo.pp via SynFPCTypInfo
  // since this information is evolving/breaking a lot in the current FPC trunk

  /// map the Delphi/FPC record field RTTI
  TFieldInfo =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    TypeInfo: PTypeInfoStored;
    {$ifdef FPC}
    Offset: sizeint;
    {$else}
    Offset: PtrUInt;
    {$endif FPC}
  end;
  PFieldInfo = ^TFieldInfo;
  {$ifdef ISDELPHI2010_OR_FPC_NEWRTTI}
  /// map the Delphi record field enhanced RTTI (available since Delphi 2010)
  TEnhancedFieldInfo =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    TypeInfo: PTypeInfoStored;
    {$ifdef FPC}
    Offset: sizeint; // match TInitManagedField/TManagedField in FPC typinfo.pp
    {$else}
    Offset: PtrUInt;
    {$endif FPC}
    {$ifdef ISDELPHI2010}
    Flags: Byte;
    NameLen: byte; // = Name[0] = length(Name)
    {$ENDIF}
  end;
  PEnhancedFieldInfo = ^TEnhancedFieldInfo;
  {$endif}

  TTypeInfo =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    kind: TTypeKind;
    NameLen: byte;
    case TTypeKind of
    tkUnknown: (
      NameFirst: AnsiChar;
    );
    tkDynArray: (
      {$ifdef FPC}
      elSize: SizeUInt; // and $7FFFFFFF = item/record size
      elType2: PTypeInfoStored;
      varType: LongInt;
      elType: PTypeInfoStored;
      //DynUnitName: ShortStringBase;
      {$else}
      // storage byte count for this field
      elSize: Longint;
      // nil for unmanaged field
      elType: PTypeInfoStored;
      // OleAuto compatible type
      varType: Integer;
      // also unmanaged field
      elType2: PTypeInfoStored;
      {$endif FPC}
    );
    tkArray: (
      {$ifdef FPC}
      // warning: in VER2_6, this is the element size, not full array size
      arraySize: SizeInt;
      // product of lengths of all dimensions
      elCount: SizeInt;
      {$else}
      arraySize: Integer;
      // product of lengths of all dimensions
      elCount: Integer;
      {$endif FPC}
      arrayType: PTypeInfoStored;
      dimCount: Byte;
      dims: array[0..255 {DimCount-1}] of PTypeInfoStored;
    );
    {$ifdef FPC}
    tkRecord, tkObject:(
      {$ifdef FPC_NEWRTTI}
      RecInitInfo: Pointer; // call GetManagedFields() to use FPC's TypInfo.pp
      recSize: longint;
      {$else}
      ManagedCount: longint;
      ManagedFields: array[0..0] of TFieldInfo;
      // note: FPC for 3.0.x and previous generates RTTI for unmanaged fields (as in TEnhancedFieldInfo)
      {$endif FPC_NEWRTTI}
    {$else}
    tkRecord: (
      recSize: cardinal;
      ManagedCount: integer;
      ManagedFields: array[0..0] of TFieldInfo;
    {$ifdef ISDELPHI2010} // enhanced RTTI containing info about all fields
      NumOps: Byte;
      //RecOps: array[0..0] of Pointer;
      AllCount: Integer; // !!!! may need $RTTI EXPLICIT FIELDS([vcPublic])
      AllFields: array[0..0] of TEnhancedFieldInfo;
    {$endif ISDELPHI2010}
    {$endif FPC}
    );
    tkEnumeration: (
      EnumType: TOrdType;
      {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
      EnumDummy: DWORD; // needed on ARM for correct alignment
      {$endif}
      {$ifdef FPC_ENUMHASINNER} inner:
      {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} packed {$endif} record
      {$endif FPC_ENUMHASINNER}
      MinValue: longint;
      MaxValue: longint;
      EnumBaseType: PTypeInfoStored; // BaseTypeRef in FPC TypInfo.pp
      {$ifdef FPC_ENUMHASINNER} end; {$endif FPC_ENUMHASINNER}
      NameList: string[255];
    );
    tkInteger: (
      IntegerType: TOrdType;
    );
    tkInt64: (
      MinInt64Value, MaxInt64Value: Int64;
    );
    tkSet: (
      SetType: TOrdType;
      {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
      SetDummy: DWORD; // needed on ARM for correct alignment
      {$endif}
      {$ifdef FPC}
      {$ifndef VER3_0}
      SetSize: SizeInt;
      {$endif VER3_0}
      {$endif FPC}
      SetBaseType: PTypeInfoStored; // CompTypeRef in FPC TypInfo.pp
    );
    tkFloat: (
      FloatType: TFloatType;
    );
    tkClass: (
      ClassType: TClass;
      ParentInfo: PTypeInfoStored; // ParentInfoRef in FPC TypInfo.pp
      PropCount: SmallInt;
      UnitNameLen: byte;
    );
  end;

  {$ifdef FPC}
    {$push}
    {$PACKRECORDS 1}
  {$endif}
  TPropInfo = packed record
    PropType: PTypeInfoStored;
    GetProc: PtrInt;
    SetProc: PtrInt;
    StoredProc: PtrInt;
    Index: Integer;
    Default: Longint;
    NameIndex: SmallInt;
    {$ifdef FPC}
    PropProcs : Byte;
    {$ifdef FPC_PROVIDE_ATTR_TABLE}
    /// property attributes, introduced since FPC SVN 42356-42411 (2019/07)
    AttributeTable: Pointer;
    {$endif FPC_PROVIDE_ATTR_TABLE}
    {$endif}
    NameLen: byte;
  end;
  PPropInfo = ^TPropInfo;
  {$ifdef FPC}
    {$pop}
  {$endif}

{$ifdef HASDIRECTTYPEINFO}
type
  Deref = PTypeInfo;
{$else}
function Deref(Info: PTypeInfoStored): PTypeInfo; // for Delphi and newer FPC
{$ifdef HASINLINE} inline;
begin
  result := pointer(Info);
  if Info<>nil then
    result := Info^;
end;
{$else}
asm // Delphi is so bad at compiling above code...
        or      eax, eax
        jz      @z
        mov     eax, [eax]
        ret
@z:     db      $f3 // rep ret
end;
{$endif HASINLINE}
{$endif HASDIRECTTYPEINFO}

const
  /// codePage offset = string header size
  // - used to calc the beginning of memory allocation of a string
  STRRECSIZE = SizeOf(TStrRec);

{$ifdef HASCODEPAGE}
function FastNewString(len: PtrInt; cp: cardinal): PAnsiChar; inline;
begin
  if len>0 then begin
    {$ifdef FPC_X64MM}result := _Getmem({$else}GetMem(result,{$endif}len+(STRRECSIZE+4));
    PStrRec(result)^.codePage := cp;
    PStrRec(result)^.elemSize := 1;
    PStrRec(result)^.refCnt := 1;
    PStrRec(result)^.length := len;
    PCardinal(result+len+STRRECSIZE)^ := 0; // ensure ends with four #0
    inc(PStrRec(result));
  end else
    result := nil;
end;
{$endif HASCODEPAGE}

{$ifdef FPC_X64}
procedure fpc_ansistr_decr_ref; external name 'FPC_ANSISTR_DECR_REF';
procedure fpc_ansistr_incr_ref; external name 'FPC_ANSISTR_INCR_REF';
procedure fpc_ansistr_assign; external name 'FPC_ANSISTR_ASSIGN';
procedure fpc_ansistr_setlength; external name 'FPC_ANSISTR_SETLENGTH';
procedure fpc_ansistr_compare; external name 'FPC_ANSISTR_COMPARE';
procedure fpc_ansistr_compare_equal; external name 'FPC_ANSISTR_COMPARE_EQUAL';
procedure fpc_unicodestr_decr_ref; external name 'FPC_UNICODESTR_DECR_REF';
procedure fpc_unicodestr_incr_ref; external name 'FPC_UNICODESTR_INCR_REF';
procedure fpc_unicodestr_assign; external name 'FPC_UNICODESTR_ASSIGN';
procedure fpc_dynarray_incr_ref; external name 'FPC_DYNARRAY_INCR_REF';
procedure fpc_dynarray_decr_ref; external name 'FPC_DYNARRAY_DECR_REF';
procedure fpc_dynarray_clear; external name 'FPC_DYNARRAY_CLEAR';
{$ifdef FPC_X64MM}
procedure fpc_getmem; external name 'FPC_GETMEM';
procedure fpc_freemem; external name 'FPC_FREEMEM';
{$else}
procedure _Getmem; external name 'FPC_GETMEM';
procedure _Freemem; external name 'FPC_FREEMEM';
{$endif FPC_X64MM}

procedure PatchJmp(old, new: PByteArray; size: PtrInt; jmp: PtrUInt=0);
var
  rel: PCardinal;
begin
  PatchCode(old, new, size, nil, {unprotected=}true);
  if jmp = 0 then
    jmp := PtrUInt(@_Freemem);
  repeat // search and fix "jmp rel fpc_freemem/_dynarray_decr_ref_free"
    dec(size);
    if size = 0 then
      exit;
    rel := @old[size + 1];
  until (old[size] = $e9) and
        (rel^ = cardinal(jmp - PtrUInt(@new[size]) - 5));
  rel^ := jmp - PtrUInt(rel) - 4;
end;

procedure _ansistr_decr_ref(var p: Pointer); nostackframe; assembler;
asm
        mov     rax, qword ptr[p]
        xor     edx, edx
        test    rax, rax
        jz      @z
        mov     qword ptr[p], rdx
        mov     p, rax
        cmp     qword ptr[rax - _STRREFCNT], rdx
        jl      @z
lock    dec     qword ptr[rax - _STRREFCNT]
        jbe     @free
@z:     ret
@free:  sub     p, STRRECSIZE
        jmp     _Freemem
end;

procedure _ansistr_incr_ref(p: pointer); nostackframe; assembler;
asm
        test    p, p
        jz      @z
        cmp     qword ptr[p - _STRREFCNT], 0
        jl      @z
lock    inc     qword ptr[p - _STRREFCNT]
@z:
end;

procedure _ansistr_assign(var d: pointer; s: pointer); nostackframe; assembler;
asm
        mov     rax, qword ptr[d]
        cmp     rax, s
        jz      @eq
        test    s, s
        jz      @ns
        cmp     qword ptr[s - _STRREFCNT], 0
        jl      @ns
lock    inc     qword ptr[s - _STRREFCNT]
@ns:    mov     qword ptr[d], s
        test    rax, rax
        jnz     @z
@eq:    ret
@z:     mov     d, rax
        cmp     qword ptr[rax - _STRREFCNT], 0
        jl      @n
 lock   dec     qword ptr[rax - _STRREFCNT]
        ja      @n
@free:  sub     d, STRRECSIZE
        jmp     _Freemem
@n:
end;

{ note: fpc_ansistr_compare/_equal do check the codepage and make a UTF-8
  conversion if necessary, whereas Delphi _LStrCmp/_LStrEqual don't;
  involving codepage is safer, but paranoid, and 1. is (much) slower, and
  2. is not Delphi compatible -> we rather follow the Delphi/Lazy's way }

function _ansistr_compare(s1, s2: pointer): SizeInt; nostackframe; assembler;
asm
        xor     eax, eax
        cmp     s1, s2
        je      @0
        test    s1, s2
        jz      @maybe0
@first: mov     al, byte ptr[s1] // we can check the first char (for quicksort)
        sub     al, byte ptr[s2]
        jne     @ne
        mov     r8, qword ptr[s1 - _STRLEN]
        mov     r11, r8
        sub     r8, qword ptr[s2 - _STRLEN] // r8 = length(s1)-length(s2)
        adc     rax, -1
        and     rax, r8  // rax = -min(length(s1),length(s2))
        sub     rax, r11
        sub     s1, rax
        sub     s2, rax
        align   8
@s:     mov     r10, qword ptr[s1 + rax] // compare by 8 bytes (may include len)
        xor     r10, qword ptr[s2 + rax]
        jnz     @d
        add     rax, 8
        js      @s
@e:     mov     rax, r8 // all equal -> return difflen
@0:     ret
@ne:    movsx   rax, al
        ret
@d:     bsf     r10, r10 // compute s1^-s2^
        shr     r10, 3
        add     rax, r10
        jns     @e
        movzx   edx, byte ptr[s2 + rax]
        movzx   eax, byte ptr[s1 + rax]
        sub     rax, rdx
        ret
@maybe0:test    s2, s2
        jz      @1
        test    s1, s1
        jnz     @first
        dec     rax
        ret
@1:     inc     eax
end;

function _ansistr_compare_equal(s1, s2: pointer): SizeInt; nostackframe; assembler;
asm
        xor     eax, eax
        cmp     s1, s2
        je      @q
        test    s1, s2
        jz      @maybe0
@ok:    mov     rax, qword ptr[s1 - _STRLEN] // len must match
        cmp     rax, qword ptr[s2 - _STRLEN]
        jne     @q
        lea     s1, qword ptr[s1 + rax - 8]
        lea     s2, qword ptr[s2 + rax - 8]
        neg     rax
        mov     r8, qword ptr[s1] // compare last 8 bytes (may include len)
        cmp     r8, qword ptr[s2]
        jne     @q
        align 16
@s:     add     rax, 8 // compare remaining 8 bytes per iteration
        jns     @0
        mov     r8, qword ptr[s1 + rax]
        cmp     r8, qword ptr[s2 + rax]
        je      @s
        mov     eax, 1
        ret
@0:     xor     eax, eax
@q:     ret
@maybe0:test    s2, s2
        jz      @1
        test    s1, s1
        jnz     @ok
@1:     inc     eax // not zero is enough
end;

procedure _dynarray_incr_ref(p: pointer); nostackframe; assembler;
asm
        test    p, p
        jz      @z
        cmp     qword ptr[p - _DAREFCNT], 0
        jle     @z
lock    inc     qword ptr[p - _DAREFCNT]
@z:
end;

procedure _dynarray_decr_ref_free(p: PDynArrayRec; info: pointer); forward;

procedure _dynarray_decr_ref(var p: Pointer; info: pointer); nostackframe; assembler;
asm
        mov     rax, qword ptr[p]
        test    rax, rax
        jz      @z
        mov     qword ptr[p], 0
        mov     p, rax
        sub     p, SizeOf(TDynArrayRec)
        cmp     qword ptr[rax - _DAREFCNT], 0
        jle     @z
lock    dec     qword ptr[p]
        jbe     @free
@z:     ret
@free:  jmp     _dynarray_decr_ref_free
end;

procedure FastAssignNew(var d; s: pointer); nostackframe; assembler;
asm
        mov     rax, qword ptr[d]
        mov     qword ptr[d], s
        test    rax, rax
        jz      @z
        mov     d, rax
        cmp     qword ptr[rax - _STRREFCNT], 0
        jl      @z
lock    dec     qword ptr[rax - _STRREFCNT]
        jbe     @free
@z:     ret
@free:  sub     d, STRRECSIZE
        jmp     _Freemem
end;

{$ifdef FPC_HAS_CPSTRING}

{$ifdef FPC_X64MM}
procedure _ansistr_setlength_new(var s: RawByteString; len: PtrInt; cp: cardinal);
var p, new: PAnsiChar;
    l: PtrInt;
begin
  if cp<=CP_OEMCP then begin // TranslatePlaceholderCP logic
    cp := DefaultSystemCodePage;
    if cp=0 then
      cp := CP_NONE;
  end;
  new := FastNewString(len,cp);
  p := pointer(s);
  if p<>nil then begin
    l := PStrLen(p-_STRLEN)^+1;
    if l>len then
      l := len;
    MoveFast(p^,new^,l);
  end;
  FastAssignNew(s,new);
end;

procedure _ansistr_setlength(var s: RawByteString; len: PtrInt; cp: cardinal);
  nostackframe; assembler;
asm
        mov     rax, qword ptr[s]
        test    len, len
        jle     _ansistr_decr_ref
        test    rax, rax
        jz      _ansistr_setlength_new
        cmp     qword ptr[rax - _STRREFCNT], 1
        jne     _ansistr_setlength_new
        push    len
        push    s
        sub     qword ptr[s], STRRECSIZE
        add     len, STRRECSIZE + 1
        call    _reallocmem // rely on MM in-place detection
        pop     s
        pop     len
        add     qword ptr[s], STRRECSIZE
        mov     qword ptr[rax].TStrRec.length, len
        mov     byte ptr[rax + len + STRRECSIZE], 0
end;
{$endif FPC_X64MM}

// _ansistr_concat_convert* optimized for systemcodepage=CP_UTF8

function ToTempUTF8(var temp: TSynTempBuffer; p: pointer; len, cp: cardinal): pointer;
begin
  if (len=0)  or (cp=CP_UTF8) or (cp>=CP_SQLRAWBLOB) or IsAnsiCompatible(p,len) then begin
    temp.buf := nil;
    temp.len := len;
    result := p;
  end else begin
    temp.Init(len*3);
    p := TSynAnsiConvert.Engine(cp).AnsiBufferToUTF8(temp.buf,p,len);
    temp.len := PAnsiChar(p)-PAnsiChar(temp.buf);
    result := temp.buf;
  end;
end;

procedure _ansistr_concat_convert(var dest: RawByteString; const s1,s2: RawByteString;
  cp,cp1,cp2: cardinal);
var t1, t2, t: TSynTempBuffer; // avoid most memory allocation
    p1, p2, p: PAnsiChar;
    eng: TSynAnsiConvert;
begin
  p1 := ToTempUTF8(t1,pointer(s1),length(s1),cp1);
  p2 := ToTempUTF8(t2,pointer(s2),length(s2),cp2);
  if (cp=CP_UTF8) or (cp>=CP_SQLRAWBLOB) or ((t1.buf=nil) and (t2.buf=nil)) then begin
    p := FastNewString(t1.len+t2.len,cp);
    MoveFast(p1^,p[0],t1.len);
    MoveFast(p2^,p[t1.len],t2.len);
    FastAssignNew(dest,p);
  end else begin
    eng := TSynAnsiConvert.Engine(cp);
    t.Init((t1.len+t2.len) shl eng.fAnsiCharShift);
    p := eng.UTF8BufferToAnsi(eng.UTF8BufferToAnsi(t.buf,p1,t1.len),p2,t2.len);
    FastSetStringCP(dest,t.buf,p-t.buf,cp);
    t.Done;
  end;
  t2.Done;
  t1.Done;
end;

function _lstrlen(const s: RawByteString): TStrLen; inline;
begin
  result := PStrLen(PtrUInt(s)-_STRLEN)^;
end;

function _lstrcp(const s: RawByteString; cp: integer): integer; inline;
begin
  result := cp;
  if s<>'' then begin
    result := PStrRec(PtrUInt(s)-STRRECSIZE)^.codePage;
    if result<=CP_OEMCP then
      result := CP_UTF8;
  end;
end;

procedure _ansistr_concat_utf8(var dest: RawByteString;
  const s1,s2: RawByteString; cp: cardinal);
var cp1, cp2: cardinal;
    new: PAnsiChar;
    l1: PtrInt;
begin
  if cp<=CP_OEMCP then // TranslatePlaceholderCP logic
    cp := CP_UTF8;
  cp1 := _lstrcp(s1,cp);
  cp2 := _lstrcp(s2,cp1);
  if (cp1=cp2) and ((cp>=CP_SQLRAWBLOB) or (cp=cp1)) then
    cp := cp1 else
    if ((cp1<>cp) and (cp1<CP_SQLRAWBLOB)) or
       ((cp2<>cp) and (cp2<CP_SQLRAWBLOB)) then begin
      _ansistr_concat_convert(dest,s1,s2,cp,cp1,cp2);
      exit;
    end;
  if s1='' then
    dest := s2 else
  if s2='' then
    dest := s1 else begin
    l1 := _lstrlen(s1);
    if pointer(s1)=pointer(dest) then begin // dest := dest+s2 -> self-resize dest
      SetLength(dest,l1+_lstrlen(s2));
      PStrRec(PtrUInt(dest)-STRRECSIZE)^.codepage := cp;
      MoveFast(pointer(s2)^,PByteArray(dest)[l1],_lstrlen(s2));
    end else begin
      new := FastNewString(l1+_lstrlen(s2),cp);
      MoveFast(pointer(s1)^,new[0],l1);
      MoveFast(pointer(s2)^,new[l1],_lstrlen(s2));
      FastAssignNew(dest,new);
    end;
  end;
end;

procedure _ansistr_concat_multi_convert(var dest: RawByteString;
  s: PRawByteString; scount, cp: cardinal);
var t: TTextWriter;
    u: RawUTF8;
    tmp: TTextWriterStackBuffer;
begin
  t := TTextWriter.CreateOwnedStream(tmp);
  try
    repeat
      if s^<>'' then
        t.AddAnyAnsiBuffer(pointer(s^),_lstrlen(s^),twNone,_lstrcp(s^,cp));
      inc(s);
      dec(scount);
    until scount=0;
    t.SetText(u);
  finally
    t.Free;
  end;
  if (cp=CP_UTF8) or (cp>=CP_SQLRAWBLOB) then
    dest := u else
    TSynAnsiConvert.Engine(cp).UTF8BufferToAnsi(pointer(u),length(u),dest);
end;

procedure _ansistr_concat_multi_utf8(var dest: RawByteString;
  const s: array of RawByteString; cp: cardinal);
var first,len,i,l: integer; // should NOT be PtrInt/SizeInt to avoid FPC bug with high(s) :(
    cpf,cpi: cardinal;
    p: pointer;
    new: PAnsiChar;
begin
  if cp<=CP_OEMCP then
    cp := CP_UTF8;
  first := 0;
  repeat
    if first>high(s) then begin
      _ansistr_decr_ref(pointer(dest));
      exit;
    end;
    p := pointer(s[first]);
    if p<>nil then
      break;
    inc(first);
  until false;
  len := _lstrlen(RawByteString(p));
  cpf := _lstrcp(RawByteString(p),cp);
  if (cpf<>cp) and (cpf<CP_SQLRAWBLOB) then
    cpf := 0 else
    for i := first+1 to high(s) do begin
      p := pointer(s[i]);
      if p<>nil then begin
        inc(len,_lstrlen(RawByteString(p)));
        cpi := PStrRec(PtrUInt(p)-STRRECSIZE)^.codePage;
        if cpi<=CP_OEMCP then
          cpi := CP_UTF8;
        if (cpi<>cpf) and (cpi<CP_SQLRAWBLOB) then begin
          cpf := 0;
          break;
        end;
      end;
    end;
  if cpf=0 then
    _ansistr_concat_multi_convert(dest,@s[0],length(s),cp) else begin
    p := pointer(s[first]);
    l := _lstrlen(RawByteString(p));
    if p=pointer(dest) then begin // dest := dest+s... -> self-resize
      SetLength(dest,len);
      new := pointer(dest);
      PStrRec(PtrUInt(dest)-STRRECSIZE)^.codepage := cp;
      cp := 0;
    end else begin
      new := FastNewString(len,cp);
      MoveFast(p^,new[0],l);
    end;
    for i := first+1 to high(s) do begin
      p := pointer(s[i]);
      if p<>nil then begin
        MoveFast(p^,new[l],_lstrlen(RawByteString(p)));
        inc(l,_lstrlen(RawByteString(p)));
      end;
    end;
    if cp<>0 then
      FastAssignNew(dest,new);
  end;
end;

procedure _fpc_ansistr_concat(var a: RawUTF8);
begin
  a := a+a; // to generate "call fpc_ansistr_concat" opcode
end;

procedure _fpc_ansistr_concat_multi(var a: RawUTF8);
begin
  a := a+a+a; // to generate "call fpc_ansistr_concat_multi" opcode
end;

procedure RedirectRtl(dummy, dest: PByteArray);
begin
  repeat
    if (dummy[0]=$b9) and (PCardinal(@dummy[1])^=CP_UTF8) then
      case dummy[5] of
      $e8: begin
        // found "mov ecx,65001; call fpc_ansistr_concat" opcodes
        RedirectCode(@dummy[PInteger(@dummy[6])^+10],dest);
        exit;
      end;
      $ba: if (PCardinal(@dummy[6])^=2) and (dummy[10]=$e8) then
      begin
        // found "mov ecx,65001; mov edx,2; call fpc_ansistr_concat_multi"
        RedirectCode(@dummy[PInteger(@dummy[11])^+15],dest);
        exit;
      end;
      end;
    inc(PByte(dummy));
  until PInt64(dummy)^=0;
end;

{$endif FPC_HAS_CPSTRING}

{$else}

procedure FastAssignNew(var d; s: pointer); {$ifdef HASINLINE} inline; {$endif}
var
  sr: PStrRec; // local copy to use register
begin
  sr := Pointer(d);
  Pointer(d) := s;
  if sr = nil then
    exit;
  dec(sr);
  if (sr^.refcnt >= 0) and RefCntDecFree(sr^.refcnt) then
    FreeMem(sr);
end;
{$endif FPC_X64}

{$ifdef HASCODEPAGE}
procedure FastSetStringCP(var s; p: pointer; len, codepage: PtrInt);
var r: pointer;
begin
  r := FastNewString(len,codepage);
  if p<>nil then
    MoveFast(p^,r^,len);
  FastAssignNew(s,r);
end;

procedure FastSetString(var s: RawUTF8; p: pointer; len: PtrInt);
var r: pointer;
begin
  r := FastNewString(len,CP_UTF8);
  if p<>nil then
    MoveFast(p^,r^,len);
  FastAssignNew(s,r);
end;
{$else not HASCODEPAGE}
procedure FastSetStringCP(var s; p: pointer; len, codepage: PtrInt);
begin
  SetString(RawByteString(s),PAnsiChar(p),len);
end;
procedure FastSetString(var s: RawUTF8; p: pointer; len: PtrInt);
begin
  SetString(RawByteString(s),PAnsiChar(p),len);
end;
{$endif HASCODEPAGE}

procedure GetMemAligned(var s: RawByteString; p: pointer; len: PtrInt;
  out aligned: pointer);
begin
  SetString(s,nil,len+16);
  aligned := pointer(s);
  inc(PByte(aligned),PtrUInt(aligned) and 15);
  if p<>nil then
    MoveFast(p^,aligned^,len);
end;

function ToText(k: TTypeKind): PShortString;
begin
  result := GetEnumName(TypeInfo(TTypeKind),ord(k));
end;

function ToText(k: TDynArrayKind): PShortString;
begin
  result := GetEnumName(TypeInfo(TDynArrayKind),ord(k));
end;

function UniqueRawUTF8(var UTF8: RawUTF8): pointer;
begin
  {$ifdef FPC}
  UniqueString(UTF8); // @UTF8[1] won't call UniqueString() under FPC :(
  {$endif}
  result := @UTF8[1];
end;

procedure UniqueRawUTF8ZeroToTilde(var UTF8: RawUTF8; MaxSize: integer);
var i: integer;
begin
  i := length(UTF8);
  if i>MaxSize then
    PByteArray(UTF8)[MaxSize] := 0 else
    MaxSize := i;
  for i := 0 to MaxSize-1 do
    if PByteArray(UTF8)[i]=0 then
      PByteArray(UTF8)[i] := ord('~');
end;

{$ifdef FPC}
function TDynArrayRec.GetLength: sizeint;
begin
  result := high+1;
end;

procedure TDynArrayRec.SetLength(len: sizeint);
begin
  high := len-1;
end;
{$endif FPC}

function DynArrayLength(Value: Pointer): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}
begin
  result := PtrInt(Value);
  if result<>0 then
    result := PDALen(result-_DALEN)^{$ifdef FPC}+1{$endif};
end;

{$ifdef HASALIGNTYPEDATA}
function FPCTypeInfoOverName(P: pointer): pointer; inline;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} {$ifdef CPUARM3264}
const diff=SizeOf(QWord);// always on these two CPU's
{$else} var diff: PtrUInt; {$endif} {$endif}
begin
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
    {$ifndef CPUARM3264}
    diff := PtrUInt(@PTypeInfo(P)^.NameFirst)-PtrUInt(@PTypeInfo(P)^.Kind);
    {$endif}
    result := AlignTypeData(P+2+PByte(P+1)^);
    dec(PByte(result),diff);
  {$else}
    result := AlignTypeData(P+PByte(P+1)^);
  {$endif}
end;
{$endif HASALIGNTYPEDATA}

function GetTypeInfo(aTypeInfo: pointer; aExpectedKind: TTypeKind): PTypeInfo; overload;
{$ifdef HASINLINE} inline;
begin
  result := aTypeInfo;
  if result<>nil then
    if result^.Kind=aExpectedKind then
      {$ifdef HASALIGNTYPEDATA}
      result := FPCTypeInfoOverName(result)
      {$else}
      inc(PByte(result),result^.NameLen)
      {$endif}
    else
      result := nil;
end;
{$else}
asm
        test    eax, eax
        jz      @n
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        cmp     dl, [eax]
        jne     @n
        add     eax, ecx
        ret
@n:     xor     eax, eax
end;
{$endif HASINLINE}

function GetTypeInfo(aTypeInfo: pointer; const aExpectedKind: TTypeKinds): PTypeInfo; overload;
{$ifdef HASINLINE} inline;
begin
  result := aTypeInfo;
  if result<>nil then
    if result^.Kind in aExpectedKind then
      {$ifdef HASALIGNTYPEDATA}
      result := FPCTypeInfoOverName(result)
      {$else}
      inc(PByte(result),result^.NameLen)
      {$endif}
    else
      result := nil;
end;
{$else}
asm // eax=aTypeInfo edx=aExpectedKind
        test    eax, eax
        jz      @n
        movzx   ecx, byte ptr[eax]
        bt      edx, ecx
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        jnb     @n
        add     eax, ecx
        ret
@n:     xor     eax, eax
end;
{$endif HASINLINE}

function GetTypeInfo(aTypeInfo: pointer): PTypeInfo; overload;
{$ifdef HASINLINE} inline;
begin
  {$ifdef HASALIGNTYPEDATA}
  result := FPCTypeInfoOverName(aTypeInfo);
  {$else}
  result := @PAnsiChar(aTypeInfo)[PTypeInfo(aTypeInfo)^.NameLen];
  {$endif}
end;
{$else}
asm
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        add     eax, ecx
end;
{$endif HASINLINE}

function DynArrayTypeInfoToRecordInfo(aDynArrayTypeInfo: pointer;
  aDataSize: PInteger): pointer;
var info: PTypeInfo;
begin
  result := nil;
  info := GetTypeInfo(aDynArrayTypeInfo,tkDynArray);
  if info=nil then
    exit;
  if info^.elType<>nil then
    result := Deref(info^.elType);
  if aDataSize<>nil then
    aDataSize^ := info^.elSize {$ifdef FPC}and $7FFFFFFF{$endif};
end;

procedure TypeInfoToName(aTypeInfo: pointer; var result: RawUTF8;
  const default: RawUTF8);
begin
  if aTypeInfo<>nil then
    FastSetString(result,PAnsiChar(@PTypeInfo(aTypeInfo)^.NameLen)+1,
      PTypeInfo(aTypeInfo)^.NameLen) else
    result := default;
end;

function TypeInfoToShortString(aTypeInfo: pointer): PShortString;
begin
  if aTypeInfo<>nil then
    result := @PTypeInfo(aTypeInfo)^.NameLen else
    result := nil;
end;

procedure TypeInfoToQualifiedName(aTypeInfo: pointer; var result: RawUTF8;
  const default: RawUTF8);
var unitname: RawUTF8;
begin
  if aTypeInfo<>nil then begin
    FastSetString(result,PAnsiChar(@PTypeInfo(aTypeInfo)^.NameLen)+1,
      PTypeInfo(aTypeInfo)^.NameLen);
    if PTypeInfo(aTypeInfo)^.Kind=tkClass then begin
      with GetTypeInfo(aTypeInfo)^ do
        FastSetString(unitname,PAnsiChar(@UnitNameLen)+1,UnitNameLen);
      result := unitname+'.'+result;
    end;
  end else result := default;
end;

function TypeInfoToName(aTypeInfo: pointer): RawUTF8;
begin
  TypeInfoToName(aTypeInfo,Result,'');
end;

function RecordTypeInfoSize(aRecordTypeInfo: pointer): integer;
var info: PTypeInfo;
begin
  info := GetTypeInfo(aRecordTypeInfo,tkRecordKinds);
  if info=nil then
    result := 0 else
    result := info^.recSize;
end;

function GetEnumInfo(aTypeInfo: pointer; out MaxValue: Integer): PShortString;
{$ifdef HASINLINE} inline;
var info: PTypeInfo;
    base: PTypeInfoStored;
begin
  if (aTypeInfo<>nil) and (PTypeKind(aTypeInfo)^=tkEnumeration) then begin
    info := GetTypeInfo(aTypeInfo);
    base := info^.{$ifdef FPC_ENUMHASINNER}inner.{$endif}EnumBaseType;
    {$ifdef FPC} // no redirection if aTypeInfo is already the base type
    if (base<>nil) and (base{$ifndef HASDIRECTTYPEINFO}^{$endif}<>aTypeInfo) then
    {$endif}
      info := GetTypeInfo(base{$ifndef HASDIRECTTYPEINFO}^{$endif});
    MaxValue := info^.{$ifdef FPC_ENUMHASINNER}inner.{$endif}MaxValue;
    result := @info^.NameList;
  end else
    result := nil;
end;
{$else}
asm // eax=aTypeInfo edx=@MaxValue
        test    eax, eax
        jz      @n
        cmp     byte ptr[eax], tkEnumeration
        jnz     @n
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        mov     eax, [eax + ecx + TTypeInfo.EnumBaseType]
        mov     eax, [eax]
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        add     eax, ecx
        mov     ecx, [eax + TTypeInfo.MaxValue]
        mov     [edx], ecx
        lea     eax, [eax + TTypeInfo.NameList]
        ret
@n:     xor     eax, eax
end;
{$endif HASINLINE}

function GetSetBaseEnum(aTypeInfo: pointer): pointer;
begin
  result := GetTypeInfo(aTypeInfo,tkSet);
  if result<>nil then
    result := Deref(PTypeInfo(result)^.SetBaseType);
end;

function GetSetInfo(aTypeInfo: pointer; out MaxValue: Integer;
  out Names: PShortString): boolean; {$ifdef HASINLINE}inline;{$endif}
var info: PTypeInfo;
begin
  info := GetTypeInfo(aTypeInfo,tkSet);
  if info<>nil then begin
    Names := GetEnumInfo(Deref(info^.SetBaseType),MaxValue);
    result := Names<>nil;
  end else
    result := false;
end;

const
  NULL_LOW  = ord('n')+ord('u')shl 8+ord('l')shl 16+ord('l')shl 24;
  FALSE_LOW = ord('f')+ord('a')shl 8+ord('l')shl 16+ord('s')shl 24;
  FALSE_LOW2 = ord('a')+ord('l')shl 8+ord('s')shl 16+ord('e')shl 24;
  TRUE_LOW  = ord('t')+ord('r')shl 8+ord('u')shl 16+ord('e')shl 24;

  NULL_SHORTSTRING: string[1] = '';

procedure GetEnumNames(aTypeInfo: pointer; aDest: PPShortString);
var MaxValue, i: integer;
    res: PShortString;
begin
  res := GetEnumInfo(aTypeInfo,MaxValue);
  if res<>nil then
    for i := 0 to MaxValue do begin
      aDest^ := res;
      inc(PByte(res),PByte(res)^+1); // next
      inc(aDest);
    end;
end;

procedure GetEnumTrimmedNames(aTypeInfo: pointer; aDest: PRawUTF8);
var MaxValue, i: integer;
    res: PShortString;
begin
  res := GetEnumInfo(aTypeInfo,MaxValue);
  if res<>nil then
    for i := 0 to MaxValue do begin
      aDest^ := TrimLeftLowerCaseShort(res);
      inc(PByte(res),PByte(res)^+1); // next
      inc(aDest);
    end;
end;

function GetEnumTrimmedNames(aTypeInfo: pointer): TRawUTF8DynArray;
var MaxValue, i: integer;
    res: PShortString;
begin
  Finalize(result);
  res := GetEnumInfo(aTypeInfo,MaxValue);
  if res=nil then
     exit;
  SetLength(result,MaxValue+1);
  for i := 0 to MaxValue do begin
    result[i] := TrimLeftLowerCaseShort(res);
    inc(PByte(res),PByte(res)^+1); // next
  end;
end;

procedure GetCaptionFromTrimmed(PS: PShortString; var result: string);
var tmp: array[byte] of AnsiChar;
    L: integer;
begin
  L := ord(PS^[0]);
  inc(PByte(PS));
  while (L>0) and (PS^[0] in ['a'..'z']) do begin inc(PByte(PS)); dec(L); end;
  tmp[L] := #0; // as expected by GetCaptionFromPCharLen/UnCamelCase
  if L>0 then
    MoveSmall(PS,@tmp,L);
  GetCaptionFromPCharLen(tmp,result);
end;

procedure GetEnumCaptions(aTypeInfo: pointer; aDest: PString);
var MaxValue, i: integer;
    res: PShortString;
begin
  res := GetEnumInfo(aTypeInfo,MaxValue);
  if res<>nil then
    for i := 0 to MaxValue do begin
      GetCaptionFromTrimmed(res,aDest^);
      inc(PByte(res),PByte(res)^+1); // next
      inc(aDest);
    end;
end;

function GetEnumName(aTypeInfo: pointer; aIndex: integer): PShortString;
{$ifdef HASINLINENOTX86}
var MaxValue: integer;
begin
  result := GetEnumInfo(aTypeInfo,MaxValue);
  if (result<>nil) and (cardinal(aIndex)<=cardinal(MaxValue)) then begin
    if aIndex>0 then
      repeat
        inc(PByte(result),PByte(result)^+1); // next
        dec(aIndex);
        if aIndex=0 then
          break;
        inc(PByte(result),PByte(result)^+1); // loop unrolled twice
        dec(aIndex);
      until aIndex=0;
  end else
    result := @NULL_SHORTSTRING;
end;
{$else}
asm // eax=aTypeInfo edx=aIndex
        test    eax, eax
        jz      @0
        cmp     byte ptr[eax], tkEnumeration
        jnz     @0
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        mov     eax, [eax + ecx + TTypeInfo.EnumBaseType]
        mov     eax, [eax]
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        cmp     edx, [eax + ecx + TTypeInfo.MaxValue]
        ja      @0
        lea     eax, [eax + ecx + TTypeInfo.NameList]
        test    edx, edx
        jz      @z
        push    edx
        shr     edx, 2 // fast by-four scanning
        jz      @1
@4:     dec     edx
        movzx   ecx, byte ptr[eax]
        lea     eax, [eax + ecx + 1]
        movzx   ecx, byte ptr[eax]
        lea     eax, [eax + ecx + 1]
        movzx   ecx, byte ptr[eax]
        lea     eax, [eax + ecx + 1]
        movzx   ecx, byte ptr[eax]
        lea     eax, [eax + ecx + 1]
        jnz     @4
        pop     edx
        and     edx, 3
        jnz     @s
        ret
@1:     pop     edx
@s:     movzx   ecx, byte ptr[eax]
        dec     edx
        lea     eax, [eax + ecx + 1] // next
        jnz     @s
        ret
@z:     rep     ret
@0:     lea     eax, NULL_SHORTSTRING
end;
{$endif HASINLINENOTX86}

{$ifdef PUREPASCAL} // for proper inlining
function IdemPropNameUSameLen(P1,P2: PUTF8Char; P1P2Len: PtrInt): boolean;
label zero;
begin
  P1P2Len := PtrInt(@PAnsiChar(P1)[P1P2Len-SizeOf(cardinal)]);
  if P1P2Len>=PtrInt(PtrUInt(P1)) then
    repeat // case-insensitive compare 4 bytes per loop
      if (PCardinal(P1)^ xor PCardinal(P2)^) and $dfdfdfdf<>0 then
        goto zero;
      inc(P1,SizeOf(cardinal));
      inc(P2,SizeOf(cardinal));
    until P1P2Len<PtrInt(PtrUInt(P1));
  inc(P1P2Len,SizeOf(cardinal));
  dec(PtrUInt(P2),PtrUInt(P1));
  if PtrInt(PtrUInt(P1))<P1P2Len then
    repeat
      if (ord(P1^) xor ord(P2[PtrUInt(P1)])) and $df<>0 then
        goto zero;
      inc(P1);
    until PtrInt(PtrUInt(P1))>=P1P2Len;
  result := true;
  exit;
zero:
  result := false;
end;
{$endif PUREPASCAL}

function IdemPropNameUSmallNotVoid(P1,P2,P1P2Len: PtrInt): boolean;
  {$ifdef HASINLINE}inline;{$endif}
label zero;
begin
  inc(P1P2Len,P1);
  dec(P2,P1);
  repeat
    if (PByte(P1)^ xor ord(PAnsiChar(P1)[P2])) and $df<>0 then
      goto zero;
    inc(P1);
  until P1>=P1P2Len;
  result := true;
  exit;
zero:
  result := false;
end;

function FindShortStringListExact(List: PShortString; MaxValue: integer;
  aValue: PUTF8Char; aValueLen: PtrInt): integer;
var PLen: PtrInt;
begin
  if aValueLen<>0 then
    for result := 0 to MaxValue do begin
      PLen := PByte(List)^;
      if (PLen=aValuelen) and
         IdemPropNameUSmallNotVoid(PtrInt(@List^[1]),PtrInt(aValue),PLen) then
        exit;
      List := pointer(@PAnsiChar(PLen)[PtrUInt(List)+1]); // next
    end;
  result := -1;
end;

function FindShortStringListTrimLowerCase(List: PShortString; MaxValue: integer;
  aValue: PUTF8Char; aValueLen: PtrInt): integer;
var PLen: PtrInt;
begin
  if aValueLen<>0 then
  for result := 0 to MaxValue do begin
    PLen := ord(List^[0]);
    inc(PUTF8Char(List));
    repeat // trim lower case
      if not(PUTF8Char(List)^ in ['a'..'z']) then
        break;
      inc(PUTF8Char(List));
      dec(PLen);
    until PLen=0;
    if (PLen=aValueLen) and IdemPropNameUSmallNotVoid(PtrInt(aValue),PtrInt(List),PLen) then
      exit;
    inc(PUTF8Char(List),PLen); // next
  end;
  result := -1;
end;

{$ifdef HASINLINE}
function CompareMemFixed(P1, P2: Pointer; Length: PtrInt): Boolean;
label zero;
begin // cut-down version of our pure pascal CompareMem() function
  {$ifndef CPUX86} result := false; {$endif}
  Length := PtrInt(@PAnsiChar(P1)[Length-SizeOf(PtrInt)]);
  if Length>=PtrInt(PtrUInt(P1)) then
    repeat // compare one PtrInt per loop
      if PPtrInt(P1)^<>PPtrInt(P2)^ then
        goto zero;
      inc(PPtrInt(P1));
      inc(PPtrInt(P2));
    until Length<PtrInt(PtrUInt(P1));
  inc(Length,SizeOf(PtrInt));
  dec(PtrUInt(P2),PtrUInt(P1));
  if PtrInt(PtrUInt(P1))<Length then
    repeat
      if PByte(P1)^<>PByteArray(P2)[PtrUInt(P1)] then
        goto zero;
      inc(PByte(P1));
    until PtrInt(PtrUInt(P1))>=Length;
  result := true;
  exit;
zero:
  {$ifdef CPUX86} result := false; {$endif}
end;
{$endif HASINLINE}

function FindShortStringListTrimLowerCaseExact(List: PShortString; MaxValue: integer;
  aValue: PUTF8Char; aValueLen: PtrInt): integer;
var PLen: PtrInt;
begin
  if aValueLen<>0 then
  for result := 0 to MaxValue do begin
    PLen := ord(List^[0]);
    inc(PUTF8Char(List));
    repeat
      if not(PUTF8Char(List)^ in ['a'..'z']) then
        break;
      inc(PUTF8Char(List));
      dec(PLen);
    until PLen=0;
    if (PLen=aValueLen) and CompareMemFixed(aValue,List,PLen) then
      exit;
    inc(PUTF8Char(List),PLen);
  end;
  result := -1;
end;

function GetEnumNameValue(aTypeInfo: pointer; aValue: PUTF8Char; aValueLen: PtrInt;
  AlsoTrimLowerCase: boolean): Integer;
var List: PShortString;
    MaxValue: integer;
begin
  List := GetEnumInfo(aTypeInfo,MaxValue);
  if (aValueLen<>0) and (List<>nil) then begin
    result := FindShortStringListExact(List,MaxValue,aValue,aValueLen);
    if (result<0) and AlsoTrimLowerCase then
      result := FindShortStringListTrimLowerCase(List,MaxValue,aValue,aValueLen);
  end else
    result := -1;
end;

function GetEnumNameValueTrimmed(aTypeInfo: pointer; aValue: PUTF8Char; aValueLen: PtrInt): integer;
var List: PShortString;
    MaxValue: integer;
begin
  List := GetEnumInfo(aTypeInfo,MaxValue);
  if (aValueLen<>0) and (List<>nil) then
    result := FindShortStringListTrimLowerCase(List,MaxValue,aValue,aValueLen) else
    result := -1;
end;

function GetEnumNameValueTrimmedExact(aTypeInfo: pointer; aValue: PUTF8Char; aValueLen: PtrInt): integer;
var List: PShortString;
    MaxValue: integer;
begin
  List := GetEnumInfo(aTypeInfo,MaxValue);
  if (aValueLen<>0) and (List<>nil) then
    result := FindShortStringListTrimLowerCaseExact(List,MaxValue,aValue,aValueLen) else
    result := -1;
end;

function GetEnumNameValue(aTypeInfo: pointer; const aValue: RawUTF8;
  AlsoTrimLowerCase: boolean): Integer;
begin
  result := GetEnumNameValue(aTypeInfo, pointer(aValue), length(aValue),
    AlsoTrimLowerCase);
end;

function GetSetName(aTypeInfo: pointer; const value): RawUTF8;
var PS: PShortString;
    i,max: integer;
begin
  result := '';
  if GetSetInfo(aTypeInfo,max,PS) then begin
    for i := 0 to max do begin
      if GetBitPtr(@value,i) then
        result := FormatUTF8('%%,',[result,PS^]);
      inc(PByte(PS),PByte(PS)^+1); // next
    end;
  end;
  if result<>'' then
    SetLength(result,length(result)-1); // trim last comma
end;

procedure AppendShortComma(text: PAnsiChar; len: PtrInt; var result: shortstring;
  trimlowercase: boolean);
begin
  if trimlowercase then
    while text^ in ['a'..'z'] do
      if len=1 then
        exit else begin
        inc(text);
        dec(len);
      end;
  if integer(ord(result[0]))+len>=255 then
    exit;
  if len>0 then
    MoveSmall(text,@result[ord(result[0])+1],len);
  inc(result[0],len+1);
  result[ord(result[0])] := ',';
end;

procedure GetSetNameShort(aTypeInfo: pointer; const value; out result: ShortString;
  trimlowercase: boolean);
var PS: PShortString;
    i,max: integer;
begin
  result := '';
  if GetSetInfo(aTypeInfo,max,PS) then begin
    for i := 0 to max do begin
      if GetBitPtr(@value,i) then
        AppendShortComma(@PS^[1],ord(PS^[0]),result,trimlowercase);
      inc(PByte(PS),PByte(PS)^+1); // next
    end;
  end;
  if result[ord(result[0])]=',' then
    dec(result[0]);
end;

function GetSetNameValue(aTypeInfo: pointer; var P: PUTF8Char;
  out EndOfObject: AnsiChar): cardinal;
var names: PShortString;
    Text: PUTF8Char;
    wasString: boolean;
    MaxValue, TextLen, i: integer;
begin
  result := 0;
  if (P<>nil) and GetSetInfo(aTypeInfo,MaxValue,names) then begin
    while (P^<=' ') and (P^<>#0) do inc(P);
    if P^='[' then begin
      repeat inc(P) until (P^>' ') or (P^=#0);
      if P^=']' then
        inc(P) else begin
        repeat
          Text := GetJSONField(P,P,@wasString,@EndOfObject,@TextLen);
          if (Text=nil) or not wasString then begin
            P := nil; // invalid input (expects a JSON array of strings)
            exit;
          end;
          if Text^='*' then begin
            if MaxValue<32 then
              result := ALLBITS_CARDINAL[MaxValue+1] else
              result := cardinal(-1);
            break;
          end;
          if Text^ in ['a'..'z'] then
            i := FindShortStringListExact(names,MaxValue,Text,TextLen) else
            i := -1;
          if i<0 then
            i := FindShortStringListTrimLowerCase(names,MaxValue,Text,TextLen);
          if i>=0 then
            SetBitPtr(@result,i);
          // unknown enum names (i=-1) would just be ignored
        until EndOfObject=']';
        if P=nil then
          exit; // avoid GPF below if already reached the input end
      end;
      while not (jcEndOfJSONField in JSON_CHARS[P^]) do begin // mimics GetJSONField()
        if P^=#0 then begin
          P := nil;
          exit; // unexpected end
        end;
        inc(P);
      end;
      EndOfObject := P^;
      repeat inc(P) until (P^>' ') or (P^=#0);
    end else
      result := GetCardinal(GetJSONField(P,P,nil,@EndOfObject));
  end;
end;


{ note: those low-level VariantTo*() functions are expected to be there
        even if NOVARIANTS conditional is defined (used e.g. by SynDB.TQuery) }

function SetVariantUnRefSimpleValue(const Source: variant; var Dest: TVarData): boolean;
var typ: cardinal;
begin
  result := false;
  typ := TVarData(Source).VType;
  if typ and varByRef=0 then
    exit;
  typ := typ and not varByRef;
  case typ of
  varVariant:
    if integer(PVarData(TVarData(Source).VPointer)^.VType) in
        [varEmpty..varDate,varBoolean,varShortInt..varWord64] then begin
      Dest := PVarData(TVarData(Source).VPointer)^;
      result := true;
    end;
  varEmpty..varDate,varBoolean,varShortInt..varWord64: begin
    Dest.VType := typ;
    Dest.VInt64 :=  PInt64(TVarData(Source).VAny)^;
    result := true;
  end;
  end;
end;

function VariantToInteger(const V: Variant; var Value: integer): boolean;
var tmp: TVarData;
    vt: cardinal;
begin
  result := false;
  vt := TVarData(V).VType;
  case vt of
  varNull,
  varEmpty:    Value := 0;
  varBoolean:  if TVarData(V).VBoolean then Value := 1 else Value := 0; // normalize
  varSmallint: Value := TVarData(V).VSmallInt;
  {$ifndef DELPHI5OROLDER}
  varShortInt: Value := TVarData(V).VShortInt;
  varWord:     Value := TVarData(V).VWord;
  varLongWord:
    if TVarData(V).VLongWord<=cardinal(High(integer)) then
      Value := TVarData(V).VLongWord else
      exit;
  {$endif}
  varByte:     Value := TVarData(V).VByte;
  varInteger:  Value := TVarData(V).VInteger;
  varWord64:
    if (TVarData(V).VInt64>=0) and (TVarData(V).VInt64<=High(integer)) then
      Value := TVarData(V).VInt64 else
      exit;
  varInt64:
    if (TVarData(V).VInt64>=Low(integer)) and (TVarData(V).VInt64<=High(integer)) then
      Value := TVarData(V).VInt64 else
      exit;
  else
    if SetVariantUnRefSimpleValue(V,tmp) then begin
      result := VariantToInteger(variant(tmp),Value);
      exit;
    end else
      exit;
  end;
  result := true;
end;

function VariantToDouble(const V: Variant; var Value: double): boolean;
var tmp: TVarData;
    vt: cardinal;
begin
  vt := TVarData(V).VType;
  if vt=varVariant or varByRef then
    result := VariantToDouble(PVariant(TVarData(V).VPointer)^,Value) else begin
    result := true;
    if VariantToInt64(V,tmp.VInt64) then // also handle varEmpty,varNull
      Value := tmp.VInt64 else
    case vt of
    varDouble,varDate:
      Value := TVarData(V).VDouble;
    varSingle:
      Value := TVarData(V).VSingle;
    varCurrency:
      Value := TVarData(V).VCurrency;
    else begin
      if SetVariantUnRefSimpleValue(V,tmp) then
        result := VariantToDouble(variant(tmp),Value) else
        result := false;
    end;
    end;
  end;
end;

function VariantToDoubleDef(const V: Variant; const default: double=0): double;
begin
  if not VariantToDouble(V,result) then
    result := default;
end;

function VariantToCurrency(const V: Variant; var Value: currency): boolean;
var tmp: TVarData;
    vt: cardinal;
begin
  vt := TVarData(V).VType;
  if vt=varVariant or varByRef then
    result := VariantToCurrency(PVariant(TVarData(V).VPointer)^,Value) else begin
    result := true;
    if VariantToInt64(V,tmp.VInt64) then
      Value := tmp.VInt64 else
    case vt of
    varDouble,varDate:
      Value := TVarData(V).VDouble;
    varSingle:
      Value := TVarData(V).VSingle;
    varCurrency:
      Value := TVarData(V).VCurrency;
    else
      if SetVariantUnRefSimpleValue(V,tmp) then
        result := VariantToCurrency(variant(tmp),Value) else
        result := false;
    end;
  end;
end;

function VariantToBoolean(const V: Variant; var Value: Boolean): boolean;
var tmp: TVarData;
    vt: cardinal;
begin
  vt := TVarData(V).VType;
  case vt of
  varEmpty, varNull: begin
    result := false;
    exit;
  end;
  varBoolean:
    Value := TVarData(V).VBoolean;
  varInteger: // coming e.g. from GetJsonField()
    Value := TVarData(V).VInteger=1;
  varString:
    Value := IdemPropNameU(RawUTF8(TVarData(V).VAny),BOOL_UTF8[true]);
  {$ifndef DELPHI5OROLDER} // WideCompareText() not defined on this old RTL
  varOleStr:
    Value := WideCompareText(WideString(TVarData(V).VAny),'true')=0;
  {$endif DELPHI5OROLDER}
  {$ifdef HASVARUSTRING}
  varUString: Value := {$ifdef FPC}UnicodeCompareText{$else}CompareText{$endif}(
    UnicodeString(TVarData(V).VAny),'true')=0;
  {$endif HASVARUSTRING}
  else
    if SetVariantUnRefSimpleValue(V,tmp) then
      if tmp.VType=varBoolean then
        Value := tmp.VBoolean else begin
        result := false;
        exit;
      end else begin
        result := false;
        exit;
      end;
  end;
  result := true;
end;

function VariantToInt64(const V: Variant; var Value: Int64): boolean;
var tmp: TVarData;
    vt: cardinal;
begin
  vt := TVarData(V).VType;
  case vt of
  varNull,
  varEmpty:    Value := 0;
  varBoolean:  if TVarData(V).VBoolean then Value := 1 else Value := 0; // normalize
  varSmallint: Value := TVarData(V).VSmallInt;
  {$ifndef DELPHI5OROLDER}
  varShortInt: Value := TVarData(V).VShortInt;
  varWord:     Value := TVarData(V).VWord;
  varLongWord: Value := TVarData(V).VLongWord;
  {$endif}
  varByte:     Value := TVarData(V).VByte;
  varInteger:  Value := TVarData(V).VInteger;
  varWord64:   if TVarData(V).VInt64>=0 then
                 Value := TVarData(V).VInt64 else begin
                 result := false;
                 exit;
               end;
  varInt64:    Value := TVarData(V).VInt64;
  else
    if SetVariantUnRefSimpleValue(V,tmp) then begin
      result := VariantToInt64(variant(tmp),Value);
      exit;
    end else begin
      result := false;
      exit;
    end;
  end;
  result := true;
end;

function VariantToInt64Def(const V: Variant; DefaultValue: Int64): Int64;
begin
  if not VariantToInt64(V,result) then
    result := DefaultValue;
end;

function VariantToIntegerDef(const V: Variant; DefaultValue: integer): integer;
begin
  if not VariantToInteger(V,result) then
    result := DefaultValue;
end;

{$ifndef NOVARIANTS}

function BinToHexDisplayLowerVariant(Bin: pointer; BinBytes: integer): variant;
begin
  RawUTF8ToVariant(BinToHexDisplayLower(Bin,BinBytes),result);
end;

function VariantHexDisplayToBin(const Hex: variant; Bin: PByte; BinBytes: integer): boolean;
var tmp: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(hex,tmp,wasString);
  result := wasstring and HexDisplayToBin(pointer(tmp),Bin,BinBytes);
end;

function VariantToDateTime(const V: Variant; var Value: TDateTime): boolean;
var tmp: RawUTF8;
    vd: TVarData;
    vt: cardinal;
begin
  vt := TVarData(V).VType;
  if vt=varVariant or varByRef then
    result := VariantToDateTime(PVariant(TVarData(V).VPointer)^,Value) else begin
    result := true;
    case vt of
    varDouble,varDate:
      Value := TVarData(V).VDouble;
    varSingle:
      Value := TVarData(V).VSingle;
    varCurrency:
      Value := TVarData(V).VCurrency;
    else
      if SetVariantUnRefSimpleValue(V,vd) then
        result := VariantToDateTime(variant(vd),Value) else begin
        VariantToUTF8(V,tmp);
        Iso8601ToDateTimePUTF8CharVar(pointer(tmp),length(tmp),Value);
        result := Value<>0;
      end;
    end;
  end;
end;

procedure VariantToInlineValue(const V: Variant; var result: RawUTF8);
var tmp: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(V,tmp,wasString);
  if wasString then
    QuotedStr(tmp,'"',result) else
    result := tmp;
end;

function VariantToVariantUTF8(const V: Variant): variant;
var tmp: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(V,tmp,wasString);
  if wasString then
    result := V else
    RawUTF8ToVariant(tmp,result);
end;

procedure VariantToUTF8(const V: Variant; var result: RawUTF8;
  var wasString: boolean);
var tmp: TVarData;
    vt: cardinal;
begin
  wasString := false;
  vt := TVarData(V).VType;
  with TVarData(V) do
  case vt of
  varEmpty,
  varNull:
    result := NULL_STR_VAR;
  varSmallint:
    Int32ToUTF8(VSmallInt,result);
  {$ifndef DELPHI5OROLDER}
  varShortInt:
    Int32ToUTF8(VShortInt,result);
  varWord:
    UInt32ToUTF8(VWord,result);
  varLongWord:
    UInt32ToUTF8(VLongWord,result);
  {$endif}
  varByte:
    result := SmallUInt32UTF8[VByte];
  varBoolean:
    if VBoolean then
      result := SmallUInt32UTF8[1] else
      result := SmallUInt32UTF8[0];
  varInteger:
    Int32ToUTF8(VInteger,result);
  varInt64:
    Int64ToUTF8(VInt64,result);
  varWord64:
    UInt64ToUTF8(VInt64,result);
  varSingle:
    ExtendedToStr(VSingle,SINGLE_PRECISION,result);
  varDouble:
    DoubleToStr(VDouble,result);
  varCurrency:
    Curr64ToStr(VInt64,result);
  varDate: begin
    wasString := true;
    DateTimeToIso8601TextVar(VDate,'T',result);
  end;
  varString: begin
    wasString := true;
    {$ifdef HASCODEPAGE}
    AnyAnsiToUTF8(RawByteString(VString),result);
    {$else}
    result := RawUTF8(VString);
    {$endif}
  end;
  {$ifdef HASVARUSTRING}
  varUString: begin
    wasString := true;
    RawUnicodeToUtf8(VAny,length(UnicodeString(VAny)),result);
  end;
  {$endif}
  varOleStr: begin
    wasString := true;
    RawUnicodeToUtf8(VAny,length(WideString(VAny)),result);
  end;
  else
  if SetVariantUnRefSimpleValue(V,tmp) then
    VariantToUTF8(Variant(tmp),result,wasString) else
  if vt=varVariant or varByRef then // complex varByRef
    VariantToUTF8(PVariant(VPointer)^,result,wasString) else
  if vt=varByRef or varString then begin
    wasString := true;
    {$ifdef HASCODEPAGE}
    AnyAnsiToUTF8(PRawByteString(VString)^,result);
    {$else}
    result := PRawUTF8(VString)^;
    {$endif}
  end else
  if vt=varByRef or varOleStr then begin
    wasString := true;
    RawUnicodeToUtf8(pointer(PWideString(VAny)^),length(PWideString(VAny)^),result);
  end else
  {$ifdef HASVARUSTRING}
  if vt=varByRef or varUString then begin
    wasString := true;
    RawUnicodeToUtf8(pointer(PUnicodeString(VAny)^),length(PUnicodeString(VAny)^),result);
  end else
  {$endif}
    VariantSaveJSON(V,twJSONEscape,result); // will handle also custom types
  end;
end;

function VariantToUTF8(const V: Variant): RawUTF8;
var wasString: boolean;
begin
  VariantToUTF8(V,result,wasString);
end;

function ToUTF8(const V: Variant): RawUTF8;
var wasString: boolean;
begin
  VariantToUTF8(V,result,wasString);
end;

function VariantToUTF8(const V: Variant; var Text: RawUTF8): boolean;
begin
  VariantToUTF8(V,Text,result);
end;

function VariantEquals(const V: Variant; const Str: RawUTF8;
   CaseSensitive: boolean): boolean;
  function Complex: boolean;
  var wasString: boolean;
      tmp: RawUTF8;
  begin
    VariantToUTF8(V,tmp,wasString);
    if CaseSensitive then
      result := (tmp=Str) else
      result := IdemPropNameU(tmp,Str);
  end;
var v1,v2: Int64;
    vt: cardinal;
begin
  vt := TVarData(V).VType;
  with TVarData(V) do
    case vt of
    varEmpty,varNull:
      result := Str='';
    varBoolean:
      result := VBoolean=(Str<>'');
    varString:
      if CaseSensitive then
        result := RawUTF8(VString)=Str else
        result := IdemPropNameU(RawUTF8(VString),Str);
    else if VariantToInt64(V,v1) then begin
      SetInt64(pointer(Str),v2);
      result := v1=v2;
     end else
      result := Complex;
  end;
end;

function VariantToString(const V: Variant): string;
var wasString: boolean;
    tmp: RawUTF8;
    vt: cardinal;
begin
  vt := TVarData(V).VType;
  with TVarData(V) do
    case vt of
    varEmpty,varNull:
      result := ''; // default VariantToUTF8(null)='null'
    {$ifdef UNICODE} // not HASVARUSTRING: here we handle string=UnicodeString
    varUString:
      result := UnicodeString(VAny);
    else
    if vt=varByRef or varUString then
      result := PUnicodeString(VAny)^
    {$endif}
    else begin
      VariantToUTF8(V,tmp,wasString);
      if tmp='' then
        result := '' else
        UTF8DecodeToString(pointer(tmp),length(tmp),result);
    end;
    end;
end;

procedure RawVariantDynArrayClear(V: PVarData; n: integer);
var vt,docv: integer;
    handler: TCustomVariantType;
begin
  handler := nil;
  docv := DocVariantVType;
  repeat
    vt := V^.VType;
    case vt of
    varEmpty..varDate,varError,varBoolean,varShortInt..varWord64: ;
    varString: {$ifdef FPC}Finalize(RawUTF8(V^.VAny)){$else}RawUTF8(V^.VAny) := ''{$endif};
    varOleStr: WideString(V^.VAny) := '';
    {$ifdef HASVARUSTRING}
    varUString: UnicodeString(V^.VAny) := '';
    {$endif}
    else
    if vt=docv then
      DocVariantType.Clear(V^) else
    if vt=varVariant or varByRef then
      VarClear(PVariant(V^.VPointer)^) else
    if handler=nil then
      if (vt and varByRef=0) and FindCustomVariantType(vt,handler) then
        handler.Clear(V^) else
        VarClear(variant(V^)) else
      if vt=handler.VarType then
        handler.Clear(V^) else
        VarClear(variant(V^));
    end;
    inc(V);
    dec(n);
  until n=0;
end;

procedure VariantDynArrayClear(var Value: TVariantDynArray);
begin
  FastDynArrayClear(@Value,TypeInfo(variant));
end;

{$endif NOVARIANTS}

{$ifdef UNICODE}
// this Pos() is seldom used, it was decided to only define it under
// Delphi 2009+ (which expect such a RawUTF8 specific overloaded version)

function Pos(const substr, str: RawUTF8): Integer; overload;
begin
  Result := PosEx(substr,str,1);
end;

function IntToString(Value: integer): string;
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt32(@tmp[23],Value);
  Ansi7ToString(PWinAnsiChar(P),@tmp[23]-P,result);
end;

function IntToString(Value: cardinal): string;
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrUInt32(@tmp[23],Value);
  Ansi7ToString(PWinAnsiChar(P),@tmp[23]-P,result);
end;

function IntToString(Value: Int64): string;
var tmp: array[0..31] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt64(@tmp[31],Value);
  Ansi7ToString(PWinAnsiChar(P),@tmp[31]-P,result);
end;

function DoubleToString(Value: Double): string;
var tmp: ShortString;
begin
  if Value=0 then
    result := '0' else
    Ansi7ToString(PWinAnsiChar(@tmp[1]),DoubleToShort(tmp,Value),result);
end;

function Curr64ToString(Value: Int64): string;
var tmp: array[0..31] of AnsiChar;
begin
  Ansi7ToString(tmp,Curr64ToPChar(Value,tmp),result);
end;

{$else UNICODE}

{$ifdef PUREPASCAL}
function IntToString(Value: integer): string;
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if cardinal(Value)<=high(SmallUInt32UTF8) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrInt32(@tmp[23],Value);
    SetString(result,P,@tmp[23]-P);
  end;
end;
{$else}
function IntToString(Value: integer): string; {$ifdef FPC} nostackframe; assembler; {$endif}
asm
  jmp Int32ToUTF8
end;
{$endif PUREPASCAL}

function IntToString(Value: cardinal): string;
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if Value<=high(SmallUInt32UTF8) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrUInt32(@tmp[23],Value);
    SetString(result,P,@tmp[23]-P);
  end;
end;

function IntToString(Value: Int64): string;
var tmp: array[0..31] of AnsiChar;
    P: PAnsiChar;
begin
  if (Value>=0) and (Value<=high(SmallUInt32UTF8)) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrInt64(@tmp[31],Value);
    SetString(result,P,@tmp[31]-P);
  end;
end;

function DoubleToString(Value: Double): string;
var tmp: ShortString;
begin
  if Value=0 then
    result := '0' else
    SetString(result,PAnsiChar(@tmp[1]),DoubleToShort(tmp,Value));
end;

function Curr64ToString(Value: Int64): string;
begin
  result := Curr64ToStr(Value);
end;

{$endif UNICODE}

procedure bswap64array(a,b: PQWordArray; n: PtrInt);
{$ifdef CPUX86} {$ifdef FPC}nostackframe; assembler;{$endif}
asm
    push  ebx
    push  esi
@1: mov   ebx, dword ptr[eax]
    mov   esi, dword ptr[eax + 4]
    bswap ebx
    bswap esi
    mov   dword ptr[edx + 4], ebx
    mov   dword ptr[edx], esi
    add   eax, 8
    add   edx, 8
    dec   ecx
    jnz   @1
    pop   esi
    pop   ebx
end;
{$else}
{$ifdef CPUX64}
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe  {$endif FPC}
@1: mov   rax, qword ptr[a]
    bswap rax
    mov   qword ptr[b], rax
    add   a, 8
    add   b, 8
    dec   n
    jnz @1
end;
{$else}
var i: PtrInt;
begin
  for i := 0 to n-1 do
    b^[i] := {$ifdef FPC}SwapEndian{$else}bswap64{$endif}(a^[i]);
end;
{$endif CPUX64}
{$endif CPUX86}

{$ifdef CPUX64}
function bswap32(a: cardinal): cardinal;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
  mov eax, a
  bswap eax
end;

function bswap64(const a: QWord): QWord; {$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx=a (Linux: rdi)
{$endif FPC}
  mov rax, a
  bswap rax
end;
{$else}
{$ifdef CPUX86}
function bswap32(a: cardinal): cardinal; {$ifdef FPC} nostackframe; assembler; {$endif}
asm
  bswap eax
end;

function bswap64({$ifdef FPC_X86}constref{$else}const{$endif} a: QWord): QWord;
{$ifdef FPC} nostackframe; assembler; {$endif} asm
  {$ifdef FPC_X86}
  mov edx, dword ptr[eax]
  mov eax, dword ptr[eax + 4]
  {$else}
  mov edx, a.TQWordRec.L
  mov eax, a.TQWordRec.H
  {$endif FPC_X86}
  bswap edx
  bswap eax
end;
{$else}
{$ifdef FPC}
function bswap32(a: cardinal): cardinal;
begin
  result := SwapEndian(a); // use fast platform-specific function
end;

function bswap64(const a: QWord): QWord;
begin
  result := SwapEndian(a); // use fast platform-specific function
end;
{$else}
function bswap32(a: cardinal): cardinal;
begin
  result := ((a and $ff)shl 24)or((a and $ff00)shl 8)or
            ((a and $ff0000)shr 8)or((a and $ff000000)shr 24);
end;

function bswap64(const a: QWord): QWord;
begin
  TQWordRec(result).L := bswap32(TQWordRec(a).H);
  TQWordRec(result).H := bswap32(TQWordRec(a).L);
end;
{$endif FPC}
{$endif CPUX86}
{$endif CPUX64}

{$ifndef PUREPASCAL} { these functions are implemented in asm }
{$ifndef LVCL}       { don't define these functions twice }
{$ifndef FPC}        { some asm functions use some low-level system.pas calls }

{$define DEFINED_INT32TOUTF8}

function Int32ToUTF8(Value : PtrInt): RawUtf8; // 3x faster than SysUtils.IntToStr
// from IntToStr32_JOH_IA32_6_a, adapted for Delphi 2009+
asm // eax=Value, edx=@result
        push    ebx
        push    edi
        push    esi
        mov     ebx, eax                // value
        sar     ebx, 31                 // 0 for +ve value or -1 for -ve value
        xor     eax, ebx
        sub     eax, ebx                // abs(value)
        mov     esi, 10                 // max dig in result
        mov     edi, edx                // @result
        cmp     eax, 10
        sbb     esi, 0
        cmp     eax, 100
        sbb     esi, 0
        cmp     eax, 1000
        sbb     esi, 0
        cmp     eax, 10000
        sbb     esi, 0
        cmp     eax, 100000
        sbb     esi, 0
        cmp     eax, 1000000
        sbb     esi, 0
        cmp     eax, 10000000
        sbb     esi, 0
        cmp     eax, 100000000
        sbb     esi, 0
        cmp     eax, 1000000000
        sbb     esi, ebx                // esi=dig (including sign character)
        mov     ecx, [edx]              // result
        test    ecx, ecx
        je      @newstr                 // create new string for result
        cmp     dword ptr[ecx - 8], 1
        jne     @chgstr                 // reference count <> 1
        cmp     esi, [ecx - 4]
        je      @lenok                  // existing length = required length
        sub     ecx, STRRECSIZE         // allocation address
        push    eax                     // abs(value)
        push    ecx
        mov     eax, esp
        lea     edx, [esi + STRRECSIZE + 1] // new allocation size
        call    System.@ReallocMem      // reallocate result string
        pop     ecx
        pop     eax                     // abs(value)
        add     ecx, STRRECSIZE         // result
        mov     [ecx - 4], esi          // set new length
        mov     byte ptr[ecx + esi], 0  // add null terminator
        mov     [edi], ecx              // set result address
        jmp     @lenok
@chgstr:mov     edx, dword ptr[ecx - 8] // reference count
        add     edx, 1
        jz      @newstr                 // refcount = -1 (string constant)
lock    dec     dword ptr[ecx - 8]      // decrement existing reference count
@newstr:push    eax                     // abs(value)
        mov     eax, esi                // length
        {$ifdef UNICODE}
        mov     edx, CP_UTF8            // utf-8 code page for delphi 2009+
        {$endif}
        call    System.@NewAnsiString
        mov     [edi], eax              // set result address
        mov     ecx, eax                // result
        pop     eax                     // abs(value)
@lenok: mov     byte ptr[ecx], '-'      // store '-' character (may be overwritten)
        add     esi, ebx                // dig (excluding sign character)
        sub     ecx, ebx                // destination of 1st dig
        sub     esi, 2                  // dig (excluding sign character) - 2
        jle     @findig                 // 1 or 2 dig value
        cmp     esi, 8                  // 10 dig value?
        jne     @setres              // not a 10 dig value
        sub     eax, 2000000000         // dig 10 must be either '1' or '2'
        mov     dl, '2'
        jnc     @set10               // dig 10 = '2'
        mov     dl, '1'                 // dig 10 = '1'
        add     eax, 1000000000
@set10: mov     [ecx], dl               // save dig 10
        mov     esi, 7                  // 9 dig remaining
        add     ecx, 1                  // destination of 2nd dig
@setres:mov     edi, $28f5c29           // ((2^32)+100-1)/100
@loop:  mov     ebx, eax                // dividend
        mul     edi                     // edx = dividend div 100
        mov     eax, edx                // set next dividend
        imul    edx, -200             // -2 * (100 * dividend div  100)
        movzx   edx, word ptr[TwoDigitLookup + ebx * 2 + edx] // dividend mod 100 in ascii
        mov     [ecx + esi], dx
        sub     esi, 2
        jg      @loop                   // loop until 1 or 2 dig remaining
@findig:pop     esi
        pop     edi
        pop     ebx
        jnz     @last
        movzx   eax, word ptr[TwoDigitLookup + eax * 2]
        mov     [ecx], ax               // save final 2 dig
        ret
@last:  or      al, '0'                 // ascii adjustment
        mov     [ecx], al               // save final dig
end;

function Int64ToUTF8(Value: Int64): RawUtf8;
asm     // from IntToStr64_JOH_IA32_6_b, adapted for Delphi 2009+
        push    ebx
        mov     ecx, [ebp + 8]          // low integer of val
        mov     edx, [ebp + 12]         // high integer of val
        xor     ebp, ebp                // clear sign flag (ebp already pushed)
        mov     ebx, ecx                // low integer of val
        test    edx, edx
        jnl     @absval
        mov     ebp, 1                  // ebp = 1 for -ve val or 0 for +ve val
        neg     ecx
        adc     edx, 0
        neg     edx
@absval:jnz     @large                  // edx:ecx = abs(val)
        test    ecx, ecx
        js      @large
        mov     edx, eax                // @result
        mov     eax, ebx                // low integer of val
        call    Int32ToUtf8             // call fastest integer inttostr function
        pop     ebx
@exit:  pop     ebp                     // restore stack and exit
        ret     8
@large: push    edi
        push    esi
        mov     edi, eax
        xor     ebx, ebx
        xor     eax, eax
@t15:   cmp     edx, $00005af3          // test for 15 or more dig
        jne     @chk15                  // 100000000000000 div $100000000
        cmp     ecx, $107a4000          // 100000000000000 mod $100000000
@chk15: jb      @t13
@t17:   cmp     edx, $002386f2          // test for 17 or more dig
        jne     @chk17                  // 10000000000000000 div $100000000
        cmp     ecx, $6fc10000          // 10000000000000000 mod $100000000
@chk17: jb      @t1516
@t19:   cmp     edx, $0de0b6b3          // test for 19 dig
        jne     @chk19                  // 1000000000000000000 div $100000000
        cmp     ecx, $a7640000          // 1000000000000000000 mod $100000000
@chk19: jb      @t1718
        mov     al, 19
        jmp     @setl2
@t1718: mov     bl, 18                  // 17 or 18 dig
        cmp     edx, $01634578          // 100000000000000000 div $100000000
        jne     @setlen
        cmp     ecx, $5d8a0000          // 100000000000000000 mod $100000000
        jmp     @setlen
@t1516: mov     bl, 16                  // 15 or 16 dig
        cmp     edx, $00038d7e          // 1000000000000000 div $100000000
        jne     @setlen
        cmp     ecx, $a4c68000          // 1000000000000000 mod $100000000
        jmp     @setlen
@t13:   cmp     edx, $000000e8          // test for 13 or more dig
        jne     @chk13                  // 1000000000000 div $100000000
        cmp     ecx, $d4a51000          // 1000000000000 mod $100000000
@chk13: jb      @t11
@t1314: mov     bl, 14                  // 13 or 14 dig
        cmp     edx, $00000918          // 10000000000000 div $100000000
        jne     @setlen
        cmp     ecx, $4e72a000          // 10000000000000 mod $100000000
        jmp     @setlen
@t11:   cmp     edx, $02                // 10, 11 or 12 dig
        jne     @chk11                  // 10000000000 div $100000000
        cmp     ecx, $540be400          // 10000000000 mod $100000000
@chk11: mov     bl, 11
        jb      @setlen                 // 10 dig
@t1112: mov     bl, 12                  // 11 or 12 dig
        cmp     edx, $17                // 100000000000 div $100000000
        jne     @setlen
        cmp     ecx, $4876e800          // 100000000000 mod $100000000
@setlen:sbb     eax, 0                  // adjust for odd/evem digit count
        add     eax, ebx
@setl2: push    ecx                     // abs(val) in edx:ecx, dig in eax
        push    edx                     // save abs(val)
        lea     edx, [eax + ebp]        // digit needed (including sign character)
        mov     ecx, [edi]              // @result
        mov     esi, edx                // digit needed (including sign character)
        test    ecx, ecx
        je      @newstr                 // create new ansistring for result
        cmp     dword ptr[ecx - 8], 1
        jne     @chgstr                 // reference count <> 1
        cmp     esi, [ecx - 4]
        je      @lenok                  // existing length = required length
        sub     ecx, STRRECSIZE         // allocation address
        push    eax                     // abs(val)
        push    ecx
        mov     eax, esp
        lea     edx, [esi + STRRECSIZE + 1] // new allocation size
        call    System.@ReallocMem      // reallocate result ansistring
        pop     ecx
        pop     eax                     // abs(val)
        add     ecx, STRRECSIZE         // @result
        mov     [ecx - 4], esi          // set new length
        mov     byte ptr[ecx + esi], 0  // add null terminator
        mov     [edi], ecx              // set result address
        jmp     @lenok
@chgstr:mov     edx, dword ptr[ecx - 8] // reference count
        add     edx, 1
        jz      @newstr                 // refcount = -1 (ansistring constant)
lock    dec     dword ptr[ecx - 8]      // decrement existing reference count
@newstr:push    eax                     // abs(val)
        mov     eax, esi                // length
        {$ifdef UNICODE}
        mov     edx, CP_UTF8            // utf-8 code page for delphi 2009+
        {$endif}
        call    System.@NewAnsiString
        mov     [edi], eax              // set result address
        mov     ecx, eax                // @result
        pop     eax                     // abs(val)
@lenok: mov     edi, [edi]              // @result
        sub     esi, ebp                // digit needed (excluding sign character)
        mov     byte ptr[edi], '-'      // store '-' character (may be overwritten)
        add     edi, ebp                // destination of 1st digit
        pop     edx                     // restore abs(val)
        pop     eax
        cmp     esi, 17
        jl      @less17                 // dig < 17
        je      @set17                  // dig = 17
        cmp     esi, 18
        je      @set18                  // dig = 18
        mov     cl, '0' - 1
        mov     ebx, $a7640000          // 1000000000000000000 mod $100000000
        mov     ebp, $0de0b6b3          // 1000000000000000000 div $100000000
@dig19: add     ecx, 1
        sub     eax, ebx
        sbb     edx, ebp
        jnc     @dig19
        add     eax, ebx
        adc     edx, ebp
        mov     [edi], cl
        add     edi, 1
@set18: mov     cl, '0' - 1
        mov     ebx, $5d8a0000          // 100000000000000000 mod $100000000
        mov     ebp, $01634578          // 100000000000000000 div $100000000
@dig18: add     ecx, 1
        sub     eax, ebx
        sbb     edx, ebp
        jnc     @dig18
        add     eax, ebx
        adc     edx, ebp
        mov     [edi], cl
        add     edi, 1
@set17: mov     cl, '0' - 1
        mov     ebx, $6fc10000          // 10000000000000000 mod $100000000
        mov     ebp, $002386f2          // 10000000000000000 div $100000000
@dig17: add     ecx, 1
        sub     eax, ebx
        sbb     edx, ebp
        jnc     @dig17
        add     eax, ebx
        adc     edx, ebp
        mov     [edi], cl
        add     edi, 1                  // update destination
        mov     esi, 16                 // set 16 dig left
@less17:mov     ecx, 100000000          // process next 8 dig
        div     ecx                     // edx:eax = abs(val) = dividend
        mov     ebp, eax                // dividend div 100000000
        mov     ebx, edx
        mov     eax, edx                // dividend mod 100000000
        mov     edx, $51eb851f
        mul     edx
        shr     edx, 5                  // dividend div 100
        mov     eax, edx                // set next dividend
        lea     edx, [edx * 4 + edx]
        lea     edx, [edx * 4 + edx]
        shl     edx, 2                  // dividend div 100 * 100
        sub     ebx, edx                // remainder (0..99)
        movzx   ebx, word ptr[TwoDigitLookup + ebx * 2]
        shl     ebx, 16
        mov     edx, $51eb851f
        mov     ecx, eax                // dividend
        mul     edx
        shr     edx, 5                  // dividend div 100
        mov     eax, edx
        lea     edx, [edx * 4 + edx]
        lea     edx, [edx * 4 + edx]
        shl     edx, 2                  // dividend div 100 * 100
        sub     ecx, edx                // remainder (0..99)
        or      bx, word ptr[TwoDigitLookup + ecx * 2]
        mov     [edi + esi - 4], ebx        // store 4 dig
        mov     ebx, eax
        mov     edx, $51eb851f
        mul     edx
        shr     edx, 5                  // edx = dividend div 100
        lea     eax, [edx * 4 + edx]
        lea     eax, [eax * 4 + eax]
        shl     eax, 2                  // eax = dividend div 100 * 100
        sub     ebx, eax                // remainder (0..99)
        movzx   ebx, word ptr[TwoDigitLookup + ebx * 2]
        movzx   ecx, word ptr[TwoDigitLookup + edx * 2]
        shl     ebx, 16
        or      ebx, ecx
        mov     [edi + esi - 8], ebx    // store 4 dig
        mov     eax, ebp                // remainder
        sub     esi, 10                 // dig left - 2
        jz      @last2
@small: mov     edx, $28f5c29           // ((2^32)+100-1)/100
        mov     ebx, eax                // dividend
        mul     edx
        mov     eax, edx                // set next dividend
        imul    edx, -200
        movzx   edx, word ptr[TwoDigitLookup + ebx * 2 + edx] // dividend mod 100 in ascii
        mov     [edi + esi], dx
        sub     esi, 2
        jg      @small                  // repeat until less than 2 dig remaining
        jz      @last2
        or      al, '0'                 // ascii adjustment
        mov     [edi], al               // save final digit
        jmp     @done
@last2: movzx   eax, word ptr[TwoDigitLookup + eax * 2]
        mov     [edi], ax               // save final 2 dig
@done:  pop     esi
        pop     edi
        pop     ebx
end;

function Trim(const S: RawUTF8): RawUTF8;
asm  // fast implementation by John O'Harrow, modified for Delphi 2009+
        test    eax, eax                 // S = nil?
        xchg    eax, edx
        jz      System.@LStrClr          // Yes, Return Empty String
        mov     ecx, [edx - 4]           // Length(S)
        cmp     byte ptr[edx], ' '       // S[1] <= ' '?
        jbe     @left                    // Yes, Trim Leading Spaces
        cmp     byte ptr[edx + ecx - 1], ' '  // S[Length(S)] <= ' '?
        jbe     @right                   // Yes, Trim Trailing Spaces
        jmp     System.@LStrLAsg         // No, Result := S (which occurs most time)
@left:  dec     ecx                      // Strip Leading Whitespace
        jle     System.@LStrClr          // All Whitespace
        inc     edx
        cmp     byte ptr[edx], ' '
        jbe     @left
@done:  cmp     byte ptr[edx + ecx - 1], ' '
{$ifdef UNICODE}
        jbe     @right
        push    CP_UTF8 // UTF-8 code page for Delphi 2009+
        call    System.@LStrFromPCharLen // we need a call, not a jmp here
        rep     ret
{$else} ja      System.@LStrFromPCharLen
{$endif}
@right: dec     ecx                      // Strip Trailing Whitespace
        jmp     @done
end;

{$endif FPC}  { above asm function had some low-level system.pas calls }

{$endif LVCL}
{$endif PUREPASCAL}

function CompareMemSmall(P1, P2: Pointer; Length: PtrUInt): Boolean;
label zero;
var c: AnsiChar; // explicit temp variable for better FPC code generation
begin
  {$ifndef CPUX86} result := false; {$endif}
  inc(PtrUInt(P1),PtrUInt(Length));
  inc(PtrUInt(P2),PtrUInt(Length));
  Length := -Length;
  if Length<>0 then
    repeat
      c := PAnsiChar(P1)[Length];
      if c<>PAnsiChar(P2)[Length] then
        goto zero;
      inc(Length);
    until Length=0;
  result := true;
  {$ifdef CPUX86} exit; {$endif}
zero:
  {$ifdef CPUX86} result := false; {$endif}
end;

{$ifdef HASINLINE}
procedure FillZero(var dest; count: PtrInt);
begin
  FillCharFast(dest,count,0);
end;
{$else}
procedure FillZero(var dest; count: PtrInt);
asm
  xor ecx, ecx
  jmp dword ptr [FillCharFast]
end;
{$endif}

function IsEqual(const A,B; count: PtrInt): boolean;
var perbyte: boolean; // ensure no optimization takes place
begin
  result := true;
  while count>0 do begin
    dec(count);
    perbyte := PByteArray(@A)[count]=PByteArray(@B)[count];
    result := result and perbyte;
  end;
end;

function PosCharAny(Str: PUTF8Char; Characters: PAnsiChar): PUTF8Char;
var s: PAnsiChar;
    c: AnsiChar;
begin
  if (Str<>nil) and (Characters<>nil) and (Characters^<>#0) then
    repeat
      c := Str^;
      if c=#0 then
        break;
      s := Characters;
      repeat
        if s^=c then begin
          result := Str;
          exit;
        end;
        inc(s);
      until s^=#0;
      inc(Str);
    until false;
  result := nil;
end;

function StringReplaceChars(const Source: RawUTF8; OldChar, NewChar: AnsiChar): RawUTF8;
var i,j,n: PtrInt;
begin
  if (OldChar<>NewChar) and (Source<>'') then begin
    n := length(Source);
    for i := 0 to n-1 do
      if PAnsiChar(pointer(Source))[i]=OldChar then begin
        FastSetString(result,PAnsiChar(pointer(Source)),n);
        for j := i to n-1 do
          if PAnsiChar(pointer(result))[j]=OldChar then
            PAnsiChar(pointer(result))[j] := NewChar;
        exit;
      end;
  end;
  result := Source;
end;

function IdemPChar2(table: PNormTable; p: PUTF8Char; up: PAnsiChar): boolean;
  {$ifdef HASINLINE}inline;{$endif}
var u: AnsiChar;
begin // here p and up are expected to be <> nil
  result := false;
  dec(PtrUInt(p),PtrUInt(up));
  repeat
    u := up^;
    if u=#0 then
      break;
    if table^[up[PtrUInt(p)]]<>u then
      exit;
    inc(up);
  until false;
  result := true;
end;

function PosI(uppersubstr: PUTF8Char; const str: RawUTF8): PtrInt;
var u: AnsiChar;
    table: {$ifdef CPUX86NOTPIC}TNormTable absolute NormToUpperAnsi7{$else}PNormTable{$endif};
begin
  if uppersubstr<>nil then begin
    {$ifndef CPUX86NOTPIC}table := @NormToUpperAnsi7;{$endif}
    u := uppersubstr^;
    for result := 1 to Length(str) do
      if table[str[result]]=u then
        if {$ifdef CPUX86NOTPIC}IdemPChar({$else}IdemPChar2(table,{$endif}
           @PUTF8Char(pointer(str))[result],PAnsiChar(uppersubstr)+1) then
          exit;
  end;
  result := 0;
end;

function StrPosI(uppersubstr,str: PUTF8Char): PUTF8Char;
var u: AnsiChar;
    table: {$ifdef CPUX86NOTPIC}TNormTable absolute NormToUpperAnsi7{$else}PNormTable{$endif};
begin
  if (uppersubstr<>nil) and (str<>nil) then begin
    {$ifndef CPUX86NOTPIC}table := @NormToUpperAnsi7;{$endif}
    u := uppersubstr^;
    inc(uppersubstr);
    result := str;
    while result^<>#0 do begin
      if table[result^]=u then
        if {$ifdef CPUX86NOTPIC}IdemPChar({$else}IdemPChar2(table,{$endif}
           result+1,PAnsiChar(uppersubstr)) then
          exit;
      inc(result);
    end;
  end;
  result := nil;
end;

function PosIU(substr: PUTF8Char; const str: RawUTF8): Integer;
var p: PUTF8Char;
begin
  if (substr<>nil) and (str<>'') then begin
    p := pointer(str);
    repeat
      if GetNextUTF8Upper(p)=ord(substr^) then
        if IdemPCharU(p,substr+1) then begin
          result := p-pointer(str);
          exit;
        end;
    until p^=#0;
  end;
  result := 0;
end;

// same as PosExPas() but using char/PChar for (unicode)string process
function PosExStringPas(pSub, p: PChar; Offset: PtrUInt): PtrInt;
var len, lenSub: PtrInt;
    ch: char;
    pStart, pStop: PChar;
label Loop2, Loop6, TestT, Test0, Test1, Test2, Test3, Test4,
      AfterTestT, AfterTest0, Ret, Exit;
begin
  result := 0;
  if (p=nil) or (pSub=nil) or (PtrInt(Offset)<=0) then
    goto Exit;
  len := PStrLen(PtrUInt(p)-_STRLEN)^;
  lenSub := PStrLen(PtrUInt(pSub)-_STRLEN)^-1;
  if (len<lenSub+PtrInt(Offset)) or (lenSub<0) then
    goto Exit;
  pStop := p+len;
  inc(p,lenSub);
  inc(pSub,lenSub);
  pStart := p;
  inc(p,Offset+3);
  ch := pSub[0];
  lenSub := -lenSub;
  if p<pStop then goto Loop6;
  dec(p,4);
  goto Loop2;
Loop6: // check 6 chars per loop iteration
  if ch=p[-4] then goto Test4;
  if ch=p[-3] then goto Test3;
  if ch=p[-2] then goto Test2;
  if ch=p[-1] then goto Test1;
Loop2:
  if ch=p[0] then goto Test0;
AfterTest0:
  if ch=p[1] then goto TestT;
AfterTestT:
  inc(p,6);
  if p<pStop then goto Loop6;
  dec(p,4);
  if p>=pStop then goto Exit;
  goto Loop2;
Test4: dec(p,2);
Test2: dec(p,2);
  goto Test0;
Test3: dec(p,2);
Test1: dec(p,2);
TestT: len := lenSub;
  if lenSub<>0 then
    repeat
      if (psub[len]<>p[len+1]) or (psub[len+1]<>p[len+2]) then
        goto AfterTestT;
      inc(len,2);
    until len>=0;
  inc(p,2);
  if p<=pStop then goto Ret;
  goto Exit;
Test0: len := lenSub;
  if lenSub<>0 then
    repeat
      if (psub[len]<>p[len]) or (psub[len+1]<>p[len+1]) then
        goto AfterTest0;
      inc(len,2);
    until len>=0;
  inc(p);
Ret:
  result := p-pStart;
Exit:
end;

procedure AppendCharToRawUTF8(var Text: RawUTF8; Ch: AnsiChar);
var L: PtrInt;
begin
  L := length(Text);
  SetLength(Text,L+1); // reallocate
  PByteArray(Text)[L] := ord(Ch);
end;

procedure AppendBufferToRawUTF8(var Text: RawUTF8; Buffer: pointer; BufferLen: PtrInt);
var L: PtrInt;
begin
  if BufferLen<=0 then
    exit;
  L := length(Text);
  SetLength(Text,L+BufferLen);
  MoveFast(Buffer^,pointer(PtrInt(Text)+L)^,BufferLen);
end;

procedure AppendBuffersToRawUTF8(var Text: RawUTF8; const Buffers: array of PUTF8Char);
var i,len,TextLen: PtrInt;
    lens: array[0..63] of integer;
    P: PUTF8Char;
begin
  if high(Buffers)>high(lens) then
    raise ESynException.Create('Too many params in AppendBuffersToRawUTF8()');
  len := 0;
  for i := 0 to high(Buffers) do begin
    lens[i] := StrLen(Buffers[i]);
    inc(len,lens[i]);
  end;
  TextLen := Length(Text);
  SetLength(Text,TextLen+len);
  P := pointer(Text);
  inc(P,TextLen);
  for i := 0 to high(Buffers) do
    if Buffers[i]<>nil then begin
      MoveFast(Buffers[i]^,P^,lens[i]);
      inc(P,lens[i]);
    end;
end;

function AppendRawUTF8ToBuffer(Buffer: PUTF8Char; const Text: RawUTF8): PUTF8Char;
var L: PtrInt;
begin
  L := length(Text);
  if L<>0 then begin
    MoveFast(Pointer(Text)^,Buffer^,L);
    inc(Buffer,L);
  end;
  result := Buffer;
end;

function AppendUInt32ToBuffer(Buffer: PUTF8Char; Value: PtrUInt): PUTF8Char;
var L: PtrInt;
    P: PAnsiChar;
    tmp: array[0..23] of AnsiChar;
begin
  if Value<=high(SmallUInt32UTF8) then begin
    P := pointer(SmallUInt32UTF8[Value]);
    L := PStrLen(P-_STRLEN)^;
  end else begin
    P := StrUInt32(@tmp[23],Value);
    L := @tmp[23]-P;
  end;
  result := Buffer;
  repeat
    result^ := P^;
    inc(result);
    inc(P);
    dec(L);
  until L=0;
end;

function Append999ToBuffer(Buffer: PUTF8Char; Value: PtrUInt): PUTF8Char;
var L: PtrInt;
    P: PAnsiChar;
    c: cardinal;
begin
  P := pointer(SmallUInt32UTF8[Value]);
  L := PStrLen(P-_STRLEN)^;
  c := PCardinal(P)^;
  Buffer[0] := AnsiChar(c); // PCardinal() write = FastMM4 FullDebugMode errors
  inc(Buffer);
  if L>1 then begin
    Buffer^ := AnsiChar(c shr 8);
    inc(Buffer);
    if L>2 then begin
      Buffer^ := AnsiChar(c shr 16);
      inc(Buffer);
    end;
  end;
  result := pointer(Buffer);
end;

function QuotedStr(const S: RawUTF8; Quote: AnsiChar): RawUTF8;
begin
  QuotedStr(S,Quote,result);
end;

procedure QuotedStr(const S: RawUTF8; Quote: AnsiChar; var result: RawUTF8);
var i,L,quote1,nquote: PtrInt;
    P,R: PUTF8Char;
    tmp: pointer; // will hold a RawUTF8 with no try..finally exception block
    c: AnsiChar;
begin
  tmp := nil;
  L := length(S);
  P := pointer(S);
  if (P<>nil) and (P=pointer(result)) then begin
    RawUTF8(tmp) := S; // make private ref-counted copy for QuotedStr(U,'"',U)
    P := pointer(tmp);
  end;
  nquote := 0;
  {$ifdef FPC} // will use fast FPC SSE version
  quote1 := IndexByte(P^,L,byte(Quote));
  if quote1>=0 then
    for i := quote1 to L-1 do
      if P[i]=Quote then
        inc(nquote);
  {$else}
  quote1 := 0;
  for i := 0 to L-1 do
    if P[i]=Quote then begin
      if nquote=0 then
        quote1 := i;
      inc(nquote);
    end;
  {$endif}
  FastSetString(result,nil,L+nquote+2);
  R := pointer(result);
  R^ := Quote;
  inc(R);
  if nquote=0 then begin
    MoveFast(P^,R^,L);
    R[L] := Quote;
  end else begin
    MoveFast(P^,R^,quote1);
    inc(R,quote1);
    inc(quote1,PtrInt(P)); // trick for reusing a register on FPC
    repeat
      c := PAnsiChar(quote1)^;
      if c=#0 then
        break;
      inc(quote1);
      R^ := c;
      inc(R);
      if c<>Quote then
        continue;
      R^ := c;
      inc(R);
    until false;
    R^ := Quote;
  end;
  if tmp<>nil then
    {$ifdef FPC}Finalize(RawUTF8(tmp)){$else}RawUTF8(tmp) := ''{$endif};
end;

function GotoEndOfQuotedString(P: PUTF8Char): PUTF8Char;
var quote: AnsiChar;
begin // P^=" or P^=' at function call
  quote := P^;
  inc(P);
  repeat
    if P^=#0 then
      break else
    if P^<>quote then
      inc(P) else
      if P[1]=quote then // allow double quotes inside string
        inc(P,2) else
        break; // end quote
  until false;
  result := P;
end; // P^='"' at function return

procedure QuotedStrJSON(P: PUTF8Char; PLen: PtrInt; var result: RawUTF8;
  const aPrefix, aSuffix: RawUTF8);
var temp: TTextWriterStackBuffer;
    Lp,Ls: PtrInt;
    D: PUTF8Char;
begin
  if (P=nil) or (PLen<=0) then
    result := '""' else
  if (pointer(result)=pointer(P)) or NeedsJsonEscape(P,PLen) then
    with TTextWriter.CreateOwnedStream(temp) do
    try
      AddString(aPrefix);
      Add('"');
      AddJSONEscape(P,PLen);
      Add('"');
      AddString(aSuffix);
      SetText(result);
      exit;
    finally
      Free;
    end else begin
    Lp := length(aPrefix);
    Ls := length(aSuffix);
    FastSetString(result,nil,PLen+Lp+Ls+2);
    D := pointer(result); // we checked dest result <> source P above
    if Lp>0 then begin
      MoveFast(pointer(aPrefix)^,D^,Lp);
      inc(D,Lp);
    end;
    D^ := '"';
    MoveFast(P^,D[1],PLen);
    inc(D,PLen);
    D[1] := '"';
    if Ls>0 then
      MoveFast(pointer(aSuffix)^,D[2],Ls);
  end;
end;

procedure QuotedStrJSON(const aText: RawUTF8; var result: RawUTF8;
  const aPrefix, aSuffix: RawUTF8);
begin
  QuotedStrJSON(pointer(aText),Length(aText),result,aPrefix,aSuffix);
end;

function QuotedStrJSON(const aText: RawUTF8): RawUTF8;
begin
  QuotedStrJSON(pointer(aText),Length(aText),result,'','');
end;

function GotoEndOfJSONString(P: PUTF8Char): PUTF8Char;
var c: AnsiChar;
begin // P^='"' at function call
  inc(P);
  repeat
    c := P^;
    if c=#0 then
      break else
    if c<>'\' then
      if c<>'"' then // ignore \"
        inc(P) else
        break else    // found ending "
      if P[1]=#0 then // avoid potential buffer overflow issue for \#0
        break else
        inc(P,2);     // ignore \?
  until false;
  result := P;
end; // P^='"' at function return

function GotoNextNotSpace(P: PUTF8Char): PUTF8Char;
begin
  {$ifdef FPC}
  while (P^<=' ') and (P^<>#0) do inc(P);
  {$else}
  if P^ in [#1..' '] then
    repeat
      inc(P)
    until not(P^ in [#1..' ']);
  {$endif}
  result := P;
end;

function GotoNextNotSpaceSameLine(P: PUTF8Char): PUTF8Char;
begin
  while P^ in [#9,' '] do inc(P);
  result := P;
end;

function GotoNextSpace(P: PUTF8Char): PUTF8Char;
begin
  if P^>' ' then
    repeat
      inc(P)
    until P^<=' ';
  result := P;
end;

function NextNotSpaceCharIs(var P: PUTF8Char; ch: AnsiChar): boolean;
begin
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^=ch then begin
    inc(P);
    result := true;
  end else
    result := false;
end;

function UnQuoteSQLStringVar(P: PUTF8Char; out Value: RawUTF8): PUTF8Char;
var quote: AnsiChar;
    PBeg, PS: PUTF8Char;
    internalquote: PtrInt;
begin
  if P=nil then begin
    result := nil;
    exit;
  end;
  quote := P^; // " or '
  inc(P);
  // compute unquoted string length
  PBeg := P;
  internalquote := 0;
  repeat
    if P^=#0 then
      break;
    if P^<>quote then
      inc(P) else
      if P[1]=quote then begin
        inc(P,2); // allow double quotes inside string
        inc(internalquote);
      end else
        break; // end quote
  until false;
  if P^=#0 then begin
    result := nil; // end of string before end quote -> incorrect
    exit;
  end;
  // create unquoted string
  if internalquote=0 then
    // no quote within
    FastSetString(Value,PBeg,P-PBeg) else begin
    // unescape internal quotes
    SetLength(Value,P-PBeg-internalquote);
    P := PBeg;
    PS := Pointer(Value);
    repeat
      if P^=quote then
        if P[1]=quote then
          inc(P) else // allow double quotes inside string
          break; // end quote
      PS^ := P^;
      inc(PByte(PS));
      inc(P);
    until false;
  end;
  result := P+1;
end;

function UnQuoteSQLString(const Value: RawUTF8): RawUTF8;
begin
  UnQuoteSQLStringVar(pointer(Value),result);
end;

function UnQuotedSQLSymbolName(const ExternalDBSymbol: RawUTF8): RawUTF8;
begin
  if (ExternalDBSymbol<>'') and
     (ExternalDBSymbol[1] in ['[','"','''','(']) then // e.g. for ZDBC's GetFields()
    result := copy(ExternalDBSymbol,2,length(ExternalDBSymbol)-2) else
    result := ExternalDBSymbol;
end;

function isSelect(P: PUTF8Char; SelectClause: PRawUTF8): boolean;
var from: PUTF8Char;
begin
  if P<>nil then begin
    P := SQLBegin(P);
    case IdemPCharArray(P, ['SELECT','EXPLAIN ','VACUUM','PRAGMA','WITH','EXECUTE']) of
    0: if P[6]<=' ' then begin
         if SelectClause<>nil then begin
           inc(P,7);
           from := StrPosI(' FROM ',P);
           if from=nil then
             SelectClause^ := '' else
             FastSetString(SelectClause^,P,from-P);
         end;
         result := true;
       end else
         result := false;
    1:   result := true;
    2,3: result := P[6] in [#0..' ',';'];
    4:   result := (P[4]<=' ') and not (StrPosI('INSERT',P+5)<>nil) or
           (StrPosI('UPDATE',P+5)<>nil) or (StrPosI('DELETE',P+5)<>nil);
    5: begin // FireBird specific
        P := GotoNextNotSpace(P+7);
        result := IdemPChar(P,'BLOCK') and IdemPChar(GotoNextNotSpace(P+5),'RETURNS');
      end
    else result := false;
    end;
  end else
    result := true; // assume '' statement is SELECT command
end;

function SQLBegin(P: PUTF8Char): PUTF8Char;
begin
  if P<>nil then
  repeat
    if P^<=' ' then // ignore blanks
      repeat
        if P^=#0 then
          break else
          inc(P)
      until P^>' ';
    if PWord(P)^=ord('-')+ord('-')shl 8 then // SQL comments
      repeat
        inc(P)
      until P^ in [#0,#10]
    else
    if PWord(P)^=ord('/')+ord('*')shl 8 then begin // C comments
      inc(P);
      repeat
        inc(P);
        if PWord(P)^=ord('*')+ord('/')shl 8 then begin
          inc(P,2);
          break;
        end;
      until P^=#0;
    end
    else break;
 until false;
 result := P;
end;

procedure SQLAddWhereAnd(var where: RawUTF8; const condition: RawUTF8);
begin
  if where='' then
    where := condition else
    where := where+' and '+condition;
end;

procedure Base64MagicDecode(var ParamValue: RawUTF8);
var
  tmp: RawUTF8;
begin // '\uFFF0base64encodedbinary' decode into binary (input shall have been checked)
  tmp := ParamValue;
  if not Base64ToBinSafe(PAnsiChar(pointer(tmp))+3,length(tmp)-3,RawByteString(ParamValue)) then
    ParamValue := '';
end;

function Base64MagicCheckAndDecode(Value: PUTF8Char; var Blob: RawByteString): boolean;
var ValueLen: integer;
begin // '\uFFF0base64encodedbinary' checked and decode into binary
  if (Value=nil) or (Value[0]=#0) or (Value[1]=#0) or (Value[2]=#0) or
     (PCardinal(Value)^ and $ffffff<>JSON_BASE64_MAGIC) then
    result := false else begin
    ValueLen := StrLen(Value)-3;
    if ValueLen>0 then
      result := Base64ToBinSafe(PAnsiChar(Value)+3,ValueLen,Blob) else
      result := false;
  end;
end;

function Base64MagicCheckAndDecode(Value: PUTF8Char; var Blob: TSynTempBuffer): boolean;
var ValueLen: integer;
begin // '\uFFF0base64encodedbinary' checked and decode into binary
  if (Value=nil) or (Value[0]=#0) or (Value[1]=#0) or (Value[2]=#0) or
     (PCardinal(Value)^ and $ffffff<>JSON_BASE64_MAGIC) then
    result := false else begin
    ValueLen := StrLen(Value)-3;
    if ValueLen>0 then
      result := Base64ToBin(PAnsiChar(Value)+3,ValueLen,Blob) else
      result := false;
  end;
end;

function Base64MagicCheckAndDecode(Value: PUTF8Char; ValueLen: integer;
  var Blob: RawByteString): boolean;
begin // '\uFFF0base64encodedbinary' checked and decode into binary
  if (ValueLen<4) or (PCardinal(Value)^ and $ffffff<>JSON_BASE64_MAGIC) then
    result := false else
    result := Base64ToBinSafe(PAnsiChar(Value)+3,ValueLen-3,Blob);
end;

{$ifndef DEFINED_INT32TOUTF8}

function Int32ToUtf8(Value: PtrInt): RawUTF8; // faster than SysUtils.IntToStr
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if PtrUInt(Value)<=high(SmallUInt32UTF8) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrInt32(@tmp[23],Value);
    FastSetString(result,P,@tmp[23]-P);
  end;
end;

function Int64ToUtf8(Value: Int64): RawUTF8; // faster than SysUtils.IntToStr
begin
  Int64ToUtf8(Value,result);
end;

function Trim(const S: RawUTF8): RawUTF8;
var I,L: PtrInt;
begin
  L := Length(S);
  I := 1;
  while (I<=L) and (S[I]<=' ') do inc(I);
  if I>L then // void string
    result := '' else
  if (I=1) and (S[L]>' ') then // nothing to trim
    result := S else begin
    while S[L]<=' ' do dec(L); // allocated trimmed
    result := Copy(S,I,L-I+1);
  end;
end;

{$endif DEFINED_INT32TOUTF8}

{$ifndef CPU64} // already implemented by ToUTF8(Value: PtrInt) below
function ToUTF8(Value: Int64): RawUTF8;
begin
  Int64ToUTF8(Value,result);
end;
{$endif CPU64}

function ToUTF8(Value: PtrInt): RawUTF8;
begin
  Int32ToUTF8(Value,result);
end;

procedure UInt32ToUtf8(Value: PtrUInt; var result: RawUTF8);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if Value<=high(SmallUInt32UTF8) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrUInt32(@tmp[23],Value);
    FastSetString(result,P,@tmp[23]-P);
  end;
end;

function UInt32ToUtf8(Value: PtrUInt): RawUTF8;
begin
  UInt32ToUTF8(Value,result);
end;

{$ifndef EXTENDEDTOSHORT_USESTR}
var // standard FormatSettings: force US decimal display (with '.' for floats)
  SettingsUS: TFormatSettings;
{$endif EXTENDEDTOSHORT_USESTR}

function FloatStringNoExp(S: PAnsiChar; Precision: PtrInt): PtrInt;
var i, prec: PtrInt;
    c: AnsiChar;
begin
  result := ord(S[0]);
  prec := result; // if no decimal
  if S[1]='-' then
   dec(prec);
  for i := 2 to result do begin // test if scientific format -> return as this
    c := S[i];
    if c='E' then // should not appear
      exit else
    if c='.' then
      if i>=precision then begin // return huge decimal number as is
        result := i-1;
        exit;
      end else
      dec(prec);
  end;
  if (prec>=Precision) and (prec<>result) then begin
    dec(result,prec-Precision);
    if S[result+1]>'5' then begin // manual rounding
      prec := result;
      repeat
        c := S[prec];
        if c<>'.' then
          if c='9' then begin
            S[prec] := '0';
            if ((prec=2) and (S[1]='-')) or (prec=1) then begin
              i := result;
              inc(S,prec);
              repeat // inlined Move(S[prec],S[prec+1],result);
                S[i] := S[i-1];
                dec(i);
              until i=0;
              S^ := '1';
              dec(S,prec);
              break;
            end;
          end else
          if (c>='0') and (c<='8') then begin
            inc(S[prec]);
            break;
          end else
          break;
        dec(prec);
      until prec=0;
    end; // note: this fixes http://stackoverflow.com/questions/2335162
  end;
  if S[result]='0' then
    repeat
      dec(result); // trunc any trimming 0
      c := S[result];
      if c<>'.' then
        if c<>'0' then
          break else
          continue else begin
          dec(result);
          if (result=2) and (S[1]='-') and (S[2]='0') then begin
            result := 1;
            S[1] := '0'; // '-0.000' -> '0'
          end;
          break; // if decimal are all '0' -> return only integer part
        end;
    until false;
end;

function ExtendedToShortNoExp(var S: ShortString; Value: TSynExtended;
  Precision: integer): integer;
begin
  {$ifdef DOUBLETOSHORT_USEGRISU}
  if Precision=DOUBLE_PRECISION then
    DoubleToAscii(0,Precision,Value,@S) else
  {$endif DOUBLETOSHORT_USEGRISU}
    str(Value:0:Precision,S); // not str(Value:0,S) -> '  0.0E+0000'
  result := FloatStringNoExp(@S,Precision);
  S[0] := AnsiChar(result);
end;

const // range when to switch into scientific notation - minimal 6 digits
  SINGLE_HI: TSynExtended = 1E3; // for proper Delphi 5 compilation
  SINGLE_LO: TSynExtended = 1E-3;
  DOUBLE_HI: TSynExtended = 1E9;
  DOUBLE_LO: TSynExtended = 1E-9;
  EXT_HI: TSynExtended = 1E12;
  EXT_LO: TSynExtended = 1E-12;

function ExtendedToShort(var S: ShortString; Value: TSynExtended;
  Precision: integer): integer;
{$ifdef EXTENDEDTOSHORT_USESTR}
var scientificneeded: boolean;
    valueabs: TSynExtended;
begin
  {$ifdef DOUBLETOSHORT_USEGRISU}
  if Precision=DOUBLE_PRECISION then begin
    result := DoubleToShort(S,Value);
    exit;
  end;
  {$endif DOUBLETOSHORT_USEGRISU}
  if Value=0 then begin
    PWord(@s)^ := 1 + ord('0') shl 8;
    result := 1;
    exit;
  end;
  scientificneeded := false;
  valueabs := abs(Value);
  if Precision<=SINGLE_PRECISION then begin
    if (valueabs>SINGLE_HI) or (valueabs<SINGLE_LO) then
      scientificneeded := true;
  end else
  {$ifdef TSYNEXTENDED80}
  if Precision>DOUBLE_PRECISION then begin
    if (valueabs>EXT_HI) or (valueabs<EXT_LO) then
      scientificneeded := true;
  end else
  {$endif TSYNEXTENDED80}
    if (valueabs>DOUBLE_HI) or (valueabs<DOUBLE_LO) then
      scientificneeded := true;
  if scientificneeded then begin
    str(Value,S);
    if S[1]=' ' then begin
      dec(s[0]);
      MoveSmall(@S[2],@S[1],ord(s[0]));
    end;
    result := ord(S[0]);
  end else begin
    str(Value:0:Precision,S); // not str(Value:0,S) -> '  0.0E+0000'
    result := FloatStringNoExp(@S,Precision);
    S[0] := AnsiChar(result);
  end;
end;
{$else}
{$ifdef UNICODE}
var i: PtrInt;
{$endif}
begin
  // use ffGeneral: see https://synopse.info/forum/viewtopic.php?pid=442#p442
  result := FloatToText(PChar(@S[1]), Value, fvExtended, ffGeneral,
    Precision, 0, SettingsUS);
  {$ifdef UNICODE} // FloatToText(PWideChar) is faster than FloatToText(PAnsiChar)
  for i := 1 to result do
    PByteArray(@S)[i] := PWordArray(PtrInt(@S)-1)[i];
  {$endif}
  S[0] := AnsiChar(result);
end;
{$endif EXTENDEDTOSHORT_USESTR}

function FloatToShortNan(const s: shortstring): TFloatNan;
begin
  case PInteger(@s)^ and $ffdfdfdf of
    3+ord('N')shl 8+ord('A')shl 16+ord('N')shl 24:
      result := fnNan;
    3+ord('I')shl 8+ord('N')shl 16+ord('F')shl 24,
    4+ord('+')shl 8+ord('I')shl 16+ord('N')shl 24:
      result := fnInf;
    4+ord('-')shl 8+ord('I')shl 16+ord('N')shl 24:
      result := fnNegInf;
    else
      result := fnNumber;
  end;
end;

function FloatToStrNan(const s: RawUTF8): TFloatNan;
begin
  case length(s) of
  3: case PInteger(s)^ and $dfdfdf of
     ord('N')+ord('A')shl 8+ord('N')shl 16: result := fnNan;
     ord('I')+ord('N')shl 8+ord('F')shl 16: result := fnInf;
     else result := fnNumber;
     end;
  4: case PInteger(s)^ and $dfdfdfdf of
     ord('+')+ord('I')shl 8+ord('N')shl 16+ord('F')shl 24: result := fnInf;
     ord('-')+ord('I')shl 8+ord('N')shl 16+ord('F')shl 24: result := fnNegInf;
     else result := fnNumber;
     end;
  else result := fnNumber;
  end;
end;

function ExtendedToStr(Value: TSynExtended; Precision: integer): RawUTF8;
begin
  ExtendedToStr(Value,Precision,result);
end;

procedure ExtendedToStr(Value: TSynExtended; Precision: integer;
  var result: RawUTF8);
var tmp: ShortString;
begin
  if Value=0 then
    result := SmallUInt32UTF8[0] else
    FastSetString(result,@tmp[1],ExtendedToShort(tmp,Value,Precision));
end;

function FloatToJSONNan(const s: ShortString): PShortString;
begin
  case PInteger(@s)^ and $ffdfdfdf of
    3+ord('N')shl 8+ord('A')shl 16+ord('N')shl 24:
      result := @JSON_NAN[fnNan];
    3+ord('I')shl 8+ord('N')shl 16+ord('F')shl 24,
    4+ord('+')shl 8+ord('I')shl 16+ord('N')shl 24:
      result := @JSON_NAN[fnInf];
    4+ord('-')shl 8+ord('I')shl 16+ord('N')shl 24:
      result := @JSON_NAN[fnNegInf];
    else
      result := @s;
  end;
end;

function ExtendedToJSON(var tmp: ShortString; Value: TSynExtended;
  Precision: integer; NoExp: boolean): PShortString;
begin
  if Value=0 then
    result := @JSON_NAN[fnNumber] else begin
    if noexp then
      ExtendedToShortNoExp(tmp,Value,precision) else
      ExtendedToShort(tmp,Value,precision);
    result := FloatToJSONNan(tmp);
  end;
end;

procedure Div100(Y: cardinal; var res: TDiv100Rec);
{$ifdef FPC}
var Y100: cardinal;
begin
  Y100 := Y div 100; // FPC will use fast reciprocal
  res.D := Y100;
  res.M := Y-Y100*100; // avoid div twice
end;
{$else}
{$ifdef CPUX64}
asm
        .noframe
        mov     r8, res
        mov     edx, Y
        mov     dword ptr [r8].TDiv100Rec.M,edx
        mov     eax, 1374389535
        mul     edx
        shr     edx, 5
        mov     dword ptr [r8].TDiv100Rec.D, edx
        imul    eax, edx, 100
        sub     dword ptr [r8].TDiv100Rec.M, eax
end;
{$else}
asm
      mov     dword ptr [edx].TDiv100Rec.M, eax
      mov     ecx, edx
      mov     edx, eax
      mov     eax, 1374389535
      mul     edx
      shr     edx, 5
      mov     dword ptr [ecx].TDiv100Rec.D, edx
      imul    eax, edx, 100
      sub     dword ptr [ecx].TDiv100Rec.M, eax
end;
{$endif CPUX64}
{$endif FPC}

{$ifdef DOUBLETOSHORT_USEGRISU}

// includes Fabian Loitsch's Grisu algorithm especially compiled for double
{$I SynDoubleToText.inc} // implements DoubleToAscii()

function DoubleToShort(var S: ShortString; const Value: double): integer;
var valueabs: double;
begin
  valueabs := abs(Value);
  if (valueabs>DOUBLE_HI) or (valueabs<DOUBLE_LO) then begin
    DoubleToAscii(C_NO_MIN_WIDTH,-1,Value,@S); // = str(Value,S) for scientific notation
    result := ord(S[0]);
  end else
    result := DoubleToShortNoExp(S,Value);
end;

function DoubleToShortNoExp(var S: ShortString; const Value: double): integer;
begin
  DoubleToAscii(0,DOUBLE_PRECISION,Value,@S); // = str(Value:0:DOUBLE_PRECISION,S)
  result := FloatStringNoExp(@S,DOUBLE_PRECISION);
  S[0] := AnsiChar(result);
end;

{$else} // use regular Extended version

function DoubleToShort(var S: ShortString; const Value: double): integer;
begin
  result := ExtendedToShort(S,Value,DOUBLE_PRECISION);
end;

function DoubleToShortNoExp(var S: ShortString; const Value: double): integer;
begin
  result := ExtendedToShortNoExp(S,Value,DOUBLE_PRECISION);
end;

{$endif DOUBLETOSHORT_USEGRISU}

function DoubleToJSON(var tmp: ShortString; Value: double; NoExp: boolean): PShortString;
begin
  if Value=0 then
    result := @JSON_NAN[fnNumber] else begin
    if noexp then
      DoubleToShortNoExp(tmp,Value) else
      DoubleToShort(tmp,Value);
    result := FloatToJSONNan(tmp);
  end;
end;

function DoubleToStr(Value: Double): RawUTF8;
begin
  DoubleToStr(Value,result);
end;

procedure DoubleToStr(Value: Double; var result: RawUTF8);
var tmp: ShortString;
begin
  if Value=0 then
    result := SmallUInt32UTF8[0] else
    FastSetString(result,@tmp[1],DoubleToShort(tmp,Value));
end;

function TrimU(const S: RawUTF8): RawUTF8;
begin
  result := Trim(s);
end;

function FormatUTF8(const Format: RawUTF8; const Args: array of const): RawUTF8;
begin
  FormatUTF8(Format,Args,result);
end;

type
  // only supported token is %, with any const arguments
  TFormatUTF8 = object
    b: PTempUTF8;
    L,argN: integer;
    blocks: array[0..63] of TTempUTF8; // to avoid most heap allocations
    procedure Parse(const Format: RawUTF8; const Args: array of const);
    procedure Write(Dest: PUTF8Char);
    function WriteMax(Dest: PUTF8Char; Max: PtrUInt): PUTF8Char;
  end;

procedure TFormatUTF8.Parse(const Format: RawUTF8; const Args: array of const);
var F,FDeb: PUTF8Char;
begin
  if length(Args)*2>=high(blocks) then
    raise ESynException.Create('FormatUTF8: too many args (max=32)!');
  L := 0;
  argN := 0;
  b := @blocks;
  F := pointer(Format);
  repeat
    if F^=#0 then
      break;
    if F^<>'%' then begin
      FDeb := F;
      repeat
        inc(F);
      until (F^='%') or (F^=#0);
      b^.Text := FDeb;
      b^.Len := F-FDeb;
      b^.TempRawUTF8 := nil;
      inc(L,b^.Len);
      inc(b);
      if F^=#0 then
        break;
    end;
    inc(F); // jump '%'
    if argN<=high(Args) then begin
      inc(L,VarRecToTempUTF8(Args[argN],b^));
      if b.Len>0 then
        inc(b);
      inc(argN);
      if F^=#0 then
        break;
    end else // no more available Args -> add all remaining text
      if F^=#0 then
        break else begin
        b^.Len := length(Format)-(F-pointer(Format));
        b^.Text := F;
        b^.TempRawUTF8 := nil;
        inc(L,b^.Len);
        inc(b);
        break;
      end;
  until false;
end;

procedure TFormatUTF8.Write(Dest: PUTF8Char);
var d: PTempUTF8;
begin
  d := @blocks;
  repeat
    {$ifdef HASINLINE}MoveSmall(d^.Text,Dest{$else}MoveFast(d^.Text^,Dest^{$endif},d^.Len);
    inc(Dest,d^.Len);
    if d^.TempRawUTF8<>nil then
      {$ifdef FPC}Finalize(RawUTF8(d^.TempRawUTF8)){$else}RawUTF8(d^.TempRawUTF8) := ''{$endif};
    inc(d);
  until d=b;
end;

function TFormatUTF8.WriteMax(Dest: PUTF8Char; Max: PtrUInt): PUTF8Char;
var d: PTempUTF8;
begin
  if Max>0 then begin
    inc(Max,PtrUInt(Dest));
    d := @blocks;
    if Dest<>nil then
    repeat
      if PtrUInt(Dest)+PtrUInt(d^.Len)>Max then begin // avoid buffer overflow
        {$ifdef HASINLINE}MoveSmall(d^.Text,Dest{$else}MoveFast(d^.Text^,Dest^{$endif},Max-PtrUInt(Dest));
        repeat
          if d^.TempRawUTF8<>nil then
            {$ifdef FPC}Finalize(RawUTF8(d^.TempRawUTF8)){$else}RawUTF8(d^.TempRawUTF8) := ''{$endif};
          inc(d);
        until d=b; // avoid memory leak
        result := PUTF8Char(Max);
        exit;
      end;
      {$ifdef HASINLINE}MoveSmall(d^.Text,Dest{$else}MoveFast(d^.Text^,Dest^{$endif},d^.Len);
      inc(Dest,d^.Len);
      if d^.TempRawUTF8<>nil then
        {$ifdef FPC}Finalize(RawUTF8(d^.TempRawUTF8)){$else}RawUTF8(d^.TempRawUTF8) := ''{$endif};
      inc(d);
    until d=b;
  end;
  result := Dest;
end;

procedure FormatUTF8(const Format: RawUTF8; const Args: array of const;
  out result: RawUTF8);
var process: TFormatUTF8;
begin
  if (Format='') or (high(Args)<0) then // no formatting needed
    result := Format else
  if PWord(Format)^=ord('%') then // optimize raw conversion
    VarRecToUTF8(Args[0],result) else begin
    process.Parse(Format,Args);
    if process.L<>0 then begin
      FastSetString(result,nil,process.L);
      process.Write(pointer(result));
    end;
  end;
end;

procedure FormatShort(const Format: RawUTF8; const Args: array of const;
  var result: shortstring);
var process: TFormatUTF8;
begin
  if (Format='') or (high(Args)<0) then // no formatting needed
    SetString(result,PAnsiChar(pointer(Format)),length(Format)) else begin
    process.Parse(Format,Args);
    result[0] := AnsiChar(process.WriteMax(@result[1],255)-@result[1]);
  end;
end;

function FormatBuffer(const Format: RawUTF8; const Args: array of const;
  Dest: pointer; DestLen: PtrInt): PtrInt;
var process: TFormatUTF8;
begin
  if (Dest=nil) or (DestLen<=0) then begin
    result := 0;
    exit; // avoid buffer overflow
  end;
  process.Parse(Format,Args);
  result := PtrInt(process.WriteMax(Dest,DestLen))-PtrInt(Dest);
end;

function FormatToShort(const Format: RawUTF8; const Args: array of const): shortstring;
var process: TFormatUTF8;
begin // Delphi 5 has troubles compiling overloaded FormatShort()
  process.Parse(Format,Args);
  result[0] := AnsiChar(process.WriteMax(@result[1],255)-@result[1]);
end;

procedure FormatShort16(const Format: RawUTF8; const Args: array of const;
  var result: TShort16);
var process: TFormatUTF8;
begin
  if (Format='') or (high(Args)<0) then // no formatting needed
    SetString(result,PAnsiChar(pointer(Format)),length(Format)) else begin
    process.Parse(Format,Args);
    result[0] := AnsiChar(process.WriteMax(@result[1],16)-@result[1]);
  end;
end;

procedure FormatString(const Format: RawUTF8; const Args: array of const;
  out result: string);
var process: TFormatUTF8;
    temp: TSynTempBuffer; // will avoid most memory allocations
begin
  if (Format='') or (high(Args)<0) then begin // no formatting needed
    UTF8DecodeToString(pointer(Format),length(Format),result);
    exit;
  end;
  process.Parse(Format,Args);
  temp.Init(process.L);
  process.Write(temp.buf);
  UTF8DecodeToString(temp.buf,process.L,result);
  temp.Done;
end;

function FormatString(const Format: RawUTF8; const Args: array of const): string;
begin
  FormatString(Format,Args,result);
end;

function FormatUTF8(const Format: RawUTF8; const Args, Params: array of const; JSONFormat: boolean): RawUTF8;
var i, tmpN, L, A, P, len: PtrInt;
    isParam: AnsiChar;
    tmp: TRawUTF8DynArray;
    inlin: set of 0..255;
    F,FDeb: PUTF8Char;
    wasString: Boolean;
const NOTTOQUOTE: array[boolean] of set of 0..31 = (
        [vtBoolean,vtInteger,vtInt64{$ifdef FPC},vtQWord{$endif},vtCurrency,vtExtended],
        [vtBoolean,vtInteger,vtInt64{$ifdef FPC},vtQWord{$endif},vtCurrency,vtExtended,vtVariant]);
label Txt;
begin
  if Format='' then begin
    result := '';
    exit;
  end;
  if (high(Args)<0) and (high(Params)<0) then begin
    // no formatting to process, but may be a const -> make unique
    FastSetString(result,pointer(Format),length(Format));
    exit; // e.g. _JsonFmt() will parse it in-place
  end;
  if high(Params)<0 then begin
    FormatUTF8(Format,Args,result); // slightly faster overloaded function
    exit;
  end;
  if Format='%' then begin
    VarRecToUTF8(Args[0],result); // optimize raw conversion
    exit;
  end;
  result := '';
  tmpN := 0;
  FillCharFast(inlin,SizeOf(inlin),0);
  L := 0;
  A := 0;
  P := 0;
  F := pointer(Format);
  while F^<>#0 do begin
    if F^<>'%' then begin
      FDeb := F;
      while not (F^ in [#0,'%','?']) do inc(F);
Txt:  len := F-FDeb;
      if len>0 then begin
        inc(L,len);
        if tmpN=length(tmp) then
          SetLength(tmp,tmpN+8);
        FastSetString(tmp[tmpN],FDeb,len); // add inbetween text
        inc(tmpN);
      end;
    end;
    if F^=#0 then
      break;
    isParam := F^;
    inc(F); // jump '%' or '?'
    if (isParam='%') and (A<=high(Args)) then begin // handle % substitution
      if tmpN=length(tmp) then
        SetLength(tmp,tmpN+8);
      VarRecToUTF8(Args[A],tmp[tmpN]);
      inc(A);
      if tmp[tmpN]<>'' then begin
        inc(L,length(tmp[tmpN]));
        inc(tmpN);
      end;
    end else
    if (isParam='?') and (P<=high(Params)) then begin // handle ? substitution
      if tmpN=length(tmp) then
        SetLength(tmp,tmpN+8);
      {$ifndef NOVARIANTS}
      if JSONFormat and (Params[P].VType=vtVariant) then
        VariantSaveJSON(Params[P].VVariant^,twJSONEscape,tmp[tmpN]) else
      {$endif}
      begin
        VarRecToUTF8(Params[P],tmp[tmpN]);
        wasString := not (Params[P].VType in NOTTOQUOTE[JSONFormat]);
        if wasString then
          if JSONFormat then
            QuotedStrJSON(tmp[tmpN],tmp[tmpN]) else
            tmp[tmpN] := QuotedStr(tmp[tmpN],'''');
        if not JSONFormat then begin
          inc(L,4); // space for :():
          include(inlin,tmpN);
        end;
      end;
      inc(P);
      inc(L,length(tmp[tmpN]));
      inc(tmpN);
    end else
    if F^<>#0 then begin // no more available Args -> add all remaining text
      FDeb := F;
      repeat inc(F) until (F^=#0);
      goto Txt;
    end;
  end;
  if L=0 then
    exit;
  if not JSONFormat and (tmpN>SizeOf(inlin)shl 3) then
    raise ESynException.CreateUTF8(
      'Too many parameters for FormatUTF8(): %>%',[tmpN,SizeOf(inlin)shl 3]);
  FastSetString(result,nil,L);
  F := pointer(result);
  for i := 0 to tmpN-1 do
  if tmp[i]<>'' then begin
    if byte(i) in inlin then begin
      PWord(F)^ := ord(':')+ord('(')shl 8;
      inc(F,2);
    end;
    L := PStrLen(PtrUInt(tmp[i])-_STRLEN)^;
    MoveFast(pointer(tmp[i])^,F^,L);
    inc(F,L);
    if byte(i) in inlin then begin
      PWord(F)^ := ord(')')+ord(':')shl 8;
      inc(F,2);
    end;
  end;
end;

function ScanUTF8(P: PUTF8Char; PLen: PtrInt; const fmt: RawUTF8;
  const values: array of pointer; ident: PRawUTF8DynArray): integer;
var
  v,w: PtrInt;
  F,FEnd,PEnd: PUTF8Char;
  tab: PTextCharSet;
label next;
begin
  result := 0;
  if (fmt='') or (P=nil) or (PLen<=0) or (high(values)<0) then
    exit;
  if ident<>nil then
    SetLength(ident^,length(values));
  F := pointer(fmt);
  FEnd := F+length(fmt);
  PEnd := P+PLen;
  for v := 0 to high(values) do
  repeat
    if (P^<=' ') and (P^<>#0) then // ignore any whitespace char in text
      repeat
        inc(P);
        if P=PEnd then
          exit;
      until (P^>' ') or (P^=#0);
    while (F^<=' ') and (F^<>#0) do begin // ignore any whitespace char in fmt
      inc(F);
      if F=FEnd then
        exit;
    end;
    if F^='%' then begin // format specifier
      inc(F);
      if F=FEnd then
        exit;
      case F^ of
      'd': PInteger(values[v])^ := GetNextItemInteger(P,#0);
      'D': PInt64(values[v])^ := GetNextItemInt64(P,#0);
      'u': PCardinal(values[v])^ := GetNextItemCardinal(P,#0);
      'U': PQword(values[v])^ := GetNextItemQword(P,#0);
      'f': unaligned(PDouble(values[v])^) := GetNextItemDouble(P,#0);
      'F': GetNextItemCurrency(P,PCurrency(values[v])^,#0);
      'x': if not GetNextItemHexDisplayToBin(P,values[v],4,#0) then
             exit;
      'X': if not GetNextItemHexDisplayToBin(P,values[v],8,#0) then
             exit;
      's','S': begin
        w := 0;
        while (P[w]>' ') and (P+w<=PEnd) do inc(w);
        if F^='s' then
          SetString(PShortString(values[v])^,PAnsiChar(P),w) else
          FastSetString(PRawUTF8(values[v])^,P,w);
        inc(P,w);
        while (P^<=' ') and (P^<>#0) and (P<=PEnd) do inc(P);
      end;
      'L': begin
        w := 0;
        tab := @TEXT_CHARS;
        while (tcNot01013 in tab[P[w]]) and (P+w<=PEnd) do inc(w);
        FastSetString(PRawUTF8(values[v])^,P,w);
        inc(P,w);
      end;
      '%': goto next;
      else raise ESynException.CreateUTF8('ScanUTF8: unknown ''%'' specifier [%]',[F^,fmt]);
      end;
      inc(result);
      tab := @TEXT_CHARS;
      if (tcIdentifier in tab[F[1]]) or (ident<>nil) then begin
        w := 0;
        repeat inc(w) until not(tcIdentifier in tab[F[w]]) or (F+w=FEnd);
        if ident<>nil then
          FastSetString(ident^[v],F,w);
        inc(F,w);
      end else
        inc(F);
      if (F>=FEnd) or (P>=PEnd) then
        exit;
      break;
    end else begin
next: while (P^<>F^) and (P<=PEnd) do inc(P);
      inc(F);
      inc(P);
      if (F>=FEnd) or (P>=PEnd) then
        exit;
    end;
  until false;
end;

function ScanUTF8(const text, fmt: RawUTF8; const values: array of pointer;
  ident: PRawUTF8DynArray): integer;
begin
  result := ScanUTF8(pointer(text),length(text),fmt,values,ident);
end;

function RawByteStringArrayConcat(const Values: array of RawByteString): RawByteString;
var i, L: PtrInt;
    P: PAnsiChar;
begin
  L := 0;
  for i := 0 to high(Values) do
    inc(L,length(Values[i]));
  SetString(Result,nil,L);
  P := pointer(Result);
  for i := 0 to high(Values) do begin
    L := length(Values[i]);
    MoveFast(pointer(Values[i])^,P^,L);
    inc(P,L);
  end;
end;

procedure RawByteStringToBytes(const buf: RawByteString; out bytes: TBytes);
var L: Integer;
begin
  L := Length(buf);
  if L<>0 then begin
    SetLength(bytes,L);
    MoveFast(pointer(buf)^,pointer(bytes)^,L);
  end;
end;

procedure BytesToRawByteString(const bytes: TBytes; out buf: RawByteString);
begin
  SetString(buf,PAnsiChar(pointer(bytes)),Length(bytes));
end;

procedure ResourceToRawByteString(const ResName: string; ResType: PChar;
  out buf: RawByteString; Instance: THandle);
var HResInfo: THandle;
    HGlobal: THandle;
begin
  if Instance=0 then
    Instance := HInstance;
  HResInfo := FindResource(Instance,PChar(ResName),ResType);
  if HResInfo=0 then
    exit;
  HGlobal := LoadResource(Instance,HResInfo);
  if HGlobal<>0 then begin
    SetString(buf,PAnsiChar(LockResource(HGlobal)),SizeofResource(Instance,HResInfo));
    UnlockResource(HGlobal); // only needed outside of Windows
    FreeResource(HGlobal);
  end;
end;

procedure ResourceSynLZToRawByteString(const ResName: string;
  out buf: RawByteString; Instance: THandle);
var HResInfo: THandle;
    HGlobal: THandle;
begin
  if Instance=0 then
    Instance := HInstance;
  HResInfo := FindResource(Instance,PChar(ResName),PChar(10));
  if HResInfo=0 then
    exit;
  HGlobal := LoadResource(Instance,HResInfo);
  if HGlobal<>0 then // direct decompression from memory mapped .exe content
    try
      AlgoSynLZ.Decompress(LockResource(HGlobal),SizeofResource(Instance,HResInfo),buf);
    finally
      UnlockResource(HGlobal); // only needed outside of Windows
      FreeResource(HGlobal);
    end;
end;

function StrLenW(S: PWideChar): PtrInt;
begin
  result := 0;
  if S<>nil then
  while true do
    if S[result+0]<>#0 then
    if S[result+1]<>#0 then
    if S[result+2]<>#0 then
    if S[result+3]<>#0 then
      inc(result,4) else begin
      inc(result,3);
      exit;
    end else begin
      inc(result,2);
      exit;
    end else begin
      inc(result);
      exit;
    end else
      exit;
end;

function StrCompW(Str1, Str2: PWideChar): PtrInt;
begin
  if Str1<>Str2 then
  if Str1<>nil then
  if Str2<>nil then begin
    if Str1^=Str2^ then
    repeat
      if (Str1^=#0) or (Str2^=#0) then break;
      inc(Str1);
      inc(Str2);
    until Str1^<>Str2^;
    result := PWord(Str1)^-PWord(Str2)^;
    exit;
  end else
  result := 1 else  // Str2=''
  result := -1 else // Str1=''
  result := 0;      // Str1=Str2
end;

{$ifdef PUREPASCAL}

function IdemPChar(p: PUTF8Char; up: PAnsiChar): boolean;
// if the beginning of p^ is same as up^ (ignore case - up^ must be already Upper)
var table: PNormTable;
    u: AnsiChar;
begin
  result := false;
  if p=nil then
    exit;
  if up<>nil then begin
    dec(PtrUInt(p),PtrUInt(up));
    table := @NormToUpperAnsi7;
    repeat
      u := up^;
      if u=#0 then
        break;
      if u<>table^[up[PtrUInt(p)]] then
        exit;
      inc(up);
    until false;
  end;
  result := true;
end;

function IntegerScanIndex(P: PCardinalArray; Count: PtrInt; Value: cardinal): PtrInt;
begin
  result := 0;
  dec(Count,4);
  if P<>nil then begin
    repeat
      if result>Count then
        break;
      if P^[result]<>Value then
      if P^[result+1]<>Value then
      if P^[result+2]<>Value then
      if P^[result+3]<>Value then begin
        inc(result,4);
        continue;
      end else
        inc(result,3) else
        inc(result,2) else
        inc(result);
      exit;
    until false;
    inc(Count,4);
    repeat
      if result>=Count then
        break;
      if P^[result]=Value then
        exit else
        inc(result);
    until false;
  end;
  result := -1;
end;

function IntegerScan(P: PCardinalArray; Count: PtrInt; Value: cardinal): PCardinal;
begin
  result := nil;
  if P=nil then
    exit;
  Count := PtrInt(@P[Count-4]);
  repeat
    if PtrUInt(P)>PtrUInt(Count) then
      break;
    if P^[0]<>Value then
    if P^[1]<>Value then
    if P^[2]<>Value then
    if P^[3]<>Value then begin
      P := @P[4];
      continue;
    end else
      result := @P[3] else
      result := @P[2] else
      result := @P[1] else
      result := pointer(P);
    exit;
  until false;
  inc(Count,4*SizeOf(Value));
  result := pointer(P);
  repeat
    if PtrUInt(result)>=PtrUInt(Count) then
      break;
    if result^=Value then
      exit else
      inc(result);
  until false;
  result := nil;
end;

function IntegerScanExists(P: PCardinalArray; Count: PtrInt; Value: cardinal): boolean;
begin
  if P<>nil then begin
    result := true;
    Count := PtrInt(@P[Count-4]);
    repeat
      if PtrUInt(P)>PtrUInt(Count) then
        break;
      if (P^[0]=Value) or (P^[1]=Value) or (P^[2]=Value) or (P^[3]=Value) then
        exit;
      P := @P[4];
    until false;
    inc(Count,4*SizeOf(Value));
    repeat
      if PtrUInt(P)>=PtrUInt(Count) then
        break;
      if P^[0]=Value then
        exit else
        P := @P[1];
    until false;
  end;
  result := false;
end;

function PosChar(Str: PUTF8Char; Chr: AnsiChar): PUTF8Char;
var c: cardinal;
begin // FPC is efficient at compiling this code
  result := nil;
  if Str<>nil then begin
    repeat
      c := PCardinal(str)^;
      if ToByte(c)=0 then
        exit else
      if ToByte(c)=byte(Chr) then
        break;
      c := c shr 8;
      inc(Str);
      if ToByte(c)=0 then
        exit else
      if ToByte(c)=byte(Chr) then
        break;
      c := c shr 8;
      inc(Str);
      if ToByte(c)=0 then
        exit else
      if ToByte(c)=byte(Chr) then
        break;
      c := c shr 8;
      inc(Str);
      if ToByte(c)=0 then
        exit else
      if ToByte(c)=byte(Chr) then
        break;
      inc(Str);
    until false;
    result := Str;
  end;
end;

function CompareMem(P1, P2: Pointer; Length: PtrInt): Boolean;
label zero;
begin // this code compiles well under FPC and Delphi on both 32-bit and 64-bit
  Length := PtrInt(@PAnsiChar(P1)[Length-SizeOf(PtrInt)*2]); // = 2*PtrInt end
  if Length>=PtrInt(PtrUInt(P1)) then begin
    if PPtrInt(PtrUInt(P1))^<>PPtrInt(P2)^ then // compare first PtrInt bytes
      goto zero;
    inc(PPtrInt(P1));
    inc(PPtrInt(P2));
    dec(PtrInt(P2),PtrInt(PtrUInt(P1)));
    PtrInt(PtrUInt(P1)) := PtrInt(PtrUInt(P1)) and -SizeOf(PtrInt); // align
    inc(PtrInt(P2),PtrInt(PtrUInt(P1)));
    if Length>=PtrInt(PtrUInt(P1)) then
      repeat // compare 4 aligned PtrInt per loop
        if (PPtrInt(PtrUInt(P1))^<>PPtrInt(P2)^) or (PPtrIntArray(P1)[1]<>PPtrIntArray(P2)[1]) then
          goto zero;
        inc(PByte(P1),SizeOf(PtrInt)*2);
        inc(PByte(P2),SizeOf(PtrInt)*2);
        if Length<PtrInt(PtrUInt(P1)) then
          break;
        if (PPtrInt(PtrUInt(P1))^<>PPtrInt(P2)^) or (PPtrIntArray(P1)[1]<>PPtrIntArray(P2)[1]) then
          goto zero;
        inc(PByte(P1),SizeOf(PtrInt)*2);
        inc(PByte(P2),SizeOf(PtrInt)*2);
      until Length<PtrInt(PtrUInt(P1));
  end;
  dec(Length,PtrInt(PtrUInt(P1))-SizeOf(PtrInt)*2); // back to real length
  if Length>=SizeOf(PtrInt) then begin
    if PPtrInt(PtrUInt(P1))^<>PPtrInt(P2)^ then
      goto zero;
    inc(PPtrInt(P1));
    inc(PPtrInt(P2));
    dec(Length,SizeOf(PtrInt));
  end;
  {$ifdef CPU64}
  if Length>=4 then begin
    if PCardinal(P1)^<>PCardinal(P2)^ then
      goto zero;
    inc(PCardinal(P1));
    inc(PCardinal(P2));
    dec(Length,4);
  end;
  {$endif}
  if Length>=2 then begin
    if PWord(P1)^<>PWord(P2)^ then
      goto zero;
    inc(PWord(P1));
    inc(PWord(P2));
    dec(Length,2);
  end;
  if Length>=1 then
    if PByte(P1)^<>PByte(P2)^ then
      goto zero;
  result := true;
  exit;
zero:
  result := false;
end;

{$ifdef HASINLINE} // to use directly the SubStr/S arguments registers
function PosEx(const SubStr, S: RawUTF8; Offset: PtrUInt): PtrInt;
begin
  result := PosExPas(pointer(SubStr),pointer(S),Offset);
end;
{$endif HASINLINE}

// from Aleksandr Sharahov's PosEx_Sha_Pas_2() - refactored for cross-platform
function PosExPas(pSub, p: PUTF8Char; Offset: PtrUInt): PtrInt;
var len, lenSub: PtrInt;
    ch: AnsiChar;
    pStart, pStop: PUTF8Char;
label Loop2, Loop6, TestT, Test0, Test1, Test2, Test3, Test4,
      AfterTestT, AfterTest0, Ret, Exit;
begin
  result := 0;
  if (p=nil) or (pSub=nil) or (PtrInt(Offset)<=0) then
    goto Exit;
  len := PStrLen(p-_STRLEN)^;
  lenSub := PStrLen(pSub-_STRLEN)^-1;
  if (len<lenSub+PtrInt(Offset)) or (lenSub<0) then
    goto Exit;
  pStop := p+len;
  inc(p,lenSub);
  inc(pSub,lenSub);
  pStart := p;
  inc(p,Offset+3);
  ch := pSub[0];
  lenSub := -lenSub;
  if p<pStop then goto Loop6;
  dec(p,4);
  goto Loop2;
Loop6: // check 6 chars per loop iteration
  if ch=p[-4] then goto Test4;
  if ch=p[-3] then goto Test3;
  if ch=p[-2] then goto Test2;
  if ch=p[-1] then goto Test1;
Loop2:
  if ch=p[0] then goto Test0;
AfterTest0:
  if ch=p[1] then goto TestT;
AfterTestT:
  inc(p,6);
  if p<pStop then goto Loop6;
  dec(p,4);
  if p>=pStop then goto Exit;
  goto Loop2;
Test4: dec(p,2);
Test2: dec(p,2);
  goto Test0;
Test3: dec(p,2);
Test1: dec(p,2);
TestT: len := lenSub;
  if lenSub<>0 then
    repeat
      if (psub[len]<>p[len+1]) or (psub[len+1]<>p[len+2]) then
        goto AfterTestT;
      inc(len,2);
    until len>=0;
  inc(p,2);
  if p<=pStop then goto Ret;
  goto Exit;
Test0: len := lenSub;
  if lenSub<>0 then
    repeat
      if (psub[len]<>p[len]) or (psub[len+1]<>p[len+1]) then
        goto AfterTest0;
      inc(len,2);
    until len>=0;
  inc(p);
Ret:
  result := p-pStart;
Exit:
end;

function IdemPropNameU(const P1,P2: RawUTF8): boolean;
var L: PtrInt;
begin
  L := length(P1);
  if length(P2)=L then
    result := IdemPropNameUSameLen(pointer(P1),pointer(P2),L) else
    result := false;
end;

function StrIComp(Str1, Str2: pointer): PtrInt;
var C1,C2: byte; // integer/PtrInt are actually slower on FPC
    lookupper: PByteArray; // better x86-64 / PIC asm generation
begin
  result := PtrInt(PtrUInt(Str2))-PtrInt(PtrUInt(Str1));
  if result<>0 then
    if Str1<>nil then
      if Str2<>nil then begin
        lookupper := @NormToUpperAnsi7Byte;
        repeat
          C1 := lookupper[PByteArray(Str1)[0]];
          C2 := lookupper[PByteArray(Str1)[result]];
          inc(PByte(Str1));
        until (C1=0) or (C1<>C2);
        result := C1-C2;
      end else
      result := 1 else  // Str2=''
    result := -1;     // Str1=''
end;

function StrLenPas(S: pointer): PtrInt;
label
  _0, _1, _2, _3; // ugly but faster
begin
  result := PtrUInt(S);
  if S<>nil then begin
    while true do
      if PAnsiChar(result)[0]=#0 then
        goto _0
      else if PAnsiChar(result)[1]=#0 then
        goto _1
      else if PAnsiChar(result)[2]=#0 then
        goto _2
      else if PAnsiChar(result)[3]=#0 then
        goto _3
      else
        inc(result, 4);
_3: inc(result);
_2: inc(result);
_1: inc(result);
_0: dec(result,PtrUInt(S)); // return length
  end;
end;

function StrCompFast(Str1, Str2: pointer): PtrInt;
var c: byte;
begin
  if Str1<>Str2 then
  if Str1<>nil then
  if Str2<>nil then begin
    c := PByte(Str1)^;
    if c=PByte(Str2)^ then
      repeat
        if c=0 then break;
        inc(PByte(Str1));
        inc(PByte(Str2));
        c := PByte(Str1)^;
      until c<>PByte(Str2)^;
    result := c-PByte(Str2)^;
    exit;
  end else
  result := 1 else  // Str2=''
  result := -1 else // Str1=''
  result := 0;      // Str1=Str2
end;

procedure YearToPChar(Y: PtrUInt; P: PUTF8Char);
var d100: PtrUInt;
    tab: PWordArray;
begin
  tab := @TwoDigitLookupW;
  d100 := Y div 100;
  PWordArray(P)[0] := tab[d100];
  PWordArray(P)[1] := tab[Y-(d100*100)];
end;

procedure YearToPChar2(tab: PWordArray; Y: PtrUInt; P: PUTF8Char); {$ifdef HASINLINE}inline;{$endif}
var d100: PtrUInt;
begin
  d100 := Y div 100;
  PWordArray(P)[0] := tab[d100];
  PWordArray(P)[1] := tab[Y-(d100*100)];
end;

function Iso8601ToTimeLog(const S: RawByteString): TTimeLog;
begin
  result := Iso8601ToTimeLogPUTF8Char(pointer(S),length(S));
end;

function UpperCopy(dest: PAnsiChar; const source: RawUTF8): PAnsiChar;
var s: PAnsiChar;
    c: byte;
    lookupper: PByteArray; // better x86-64 / PIC asm generation
begin
  s := pointer(source);
  if s<>nil then begin
    lookupper := @NormToUpperAnsi7Byte;
    repeat
      c := lookupper[ord(s^)];
      if c=0 then
        break;
      dest^ := AnsiChar(c);
      inc(s);
      inc(dest);
    until false;
  end;
  result := dest;
end;

function UpperCopyShort(dest: PAnsiChar; const source: shortstring): PAnsiChar;
var s: PByteArray;
    i: PtrInt;
    lookupper: PByteArray; // better x86-64 / PIC asm generation
begin
  s := @source;
  lookupper := @NormToUpperAnsi7Byte;
  for i := 1 to s[0] do begin
    dest^ := AnsiChar(lookupper[s[i]]);
    inc(dest);
  end;
  result := dest;
end;

function IdemPCharAndGetNextLine(var source: PUTF8Char; searchUp: PAnsiChar): boolean;
begin
  if source=nil then
    result := false else begin
    result := IdemPChar(source,searchUp);
    source := GotoNextLine(source);
  end;
end;

function fnv32(crc: cardinal; buf: PAnsiChar; len: PtrInt): cardinal;
var i: PtrInt;
begin
  if buf<>nil then
    for i := 0 to len-1 do
      crc := (crc xor ord(buf[i]))*16777619;
  result := crc;
end;

function kr32(crc: cardinal; buf: PAnsiChar; len: PtrInt): cardinal;
var i: PtrInt;
begin
  if buf<>nil then
    for i := 0 to len-1 do begin
      crc := crc*31;
      inc(crc,ord(buf[i]));
    end;
  result := crc;
end;

procedure crcblockNoSSE42(crc128, data128: PBlock128);
var c: cardinal;
    tab: PCrc32tab;
begin
  tab := @crc32ctab;
  c := crc128^[0] xor data128^[0];
  crc128^[0] := tab[3,ToByte(c)] xor tab[2,ToByte(c shr 8)]
            xor tab[1,ToByte(c shr 16)] xor tab[0,ToByte(c shr 24)];
  c := crc128^[1] xor data128^[1];
  crc128^[1] := tab[3,ToByte(c)] xor tab[2,ToByte(c shr 8)]
            xor tab[1,ToByte(c shr 16)] xor tab[0,ToByte(c shr 24)];
  c := crc128^[2] xor data128^[2];
  crc128^[2] := tab[3,ToByte(c)] xor tab[2,ToByte(c shr 8)]
            xor tab[1,ToByte(c shr 16)] xor tab[0,ToByte(c shr 24)];
  c := crc128^[3] xor data128^[3];
  crc128^[3] := tab[3,ToByte(c)] xor tab[2,ToByte(c shr 8)]
            xor tab[1,ToByte(c shr 16)] xor tab[0,ToByte(c shr 24)];
end;

function crc32cfast(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$ifdef ABSOLUTEPASCALORNOTINTEL}
var tab: PCrc32tab;
begin // on ARM, we use slicing-by-4 to avoid polluting smaller L1 cache
  tab := @crc32ctab;
  result := not crc;
  if (buf<>nil) and (len>0) then begin
    repeat
      if PtrUInt(buf) and 3=0 then // align to 4 bytes boundary
        break;
      result := tab[0,ToByte(result xor ord(buf^))] xor (result shr 8);
      dec(len);
      inc(buf);
    until len=0;
    if len>=4 then
      repeat
        result := result xor PCardinal(buf)^;
        inc(buf,4);
        dec(len,4);
        result := tab[3,ToByte(result)] xor
                  tab[2,ToByte(result shr 8)] xor
                  tab[1,ToByte(result shr 16)] xor
                  tab[0,ToByte(result shr 24)];
      until len<4;
    while len>0 do begin
      result := tab[0,ToByte(result xor ord(buf^))] xor (result shr 8);
      dec(len);
      inc(buf);
    end;
  end;
  result := not result;
end;
{$else}
{$ifdef FPC} nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
        {$ifndef win64}
        mov     r8d, len
        {$endif}
        mov     eax, crc
        xor     ecx, ecx
        test    buf, buf // buf=rdx/rsi len=r8
        jz      @z
        neg     r8
        jz      @z
        not     eax
        lea     r9, [rip + crc32ctab]
        cmp     r8, -8
        jb      @head
@sml:   mov     cl, byte ptr[buf]
        inc     buf
        xor     cl, al
        shr     eax, 8
        xor     eax, dword ptr[rcx * 4 + r9]
        inc     r8
        jnz     @sml
@0:     not     eax
@z:     ret
@head:  test    buf, 7
        jz      @align
        mov     cl, byte ptr[buf]
        inc     buf
        xor     cl, al
        shr     eax, 8
        xor     eax, dword ptr[rcx * 4 + r9]
        inc     r8
        jnz     @head
        not     eax
        ret
@align: sub     buf, r8
        add     r8, 8
        jg      @done
        xor     r11, r11
@by8:   mov     r10d, eax
        mov     rcx, qword ptr[buf + r8 - 8]
        xor     r10d, ecx
        shr     rcx, 32
        mov     r11b, cl
        shr     ecx, 8
        mov     eax, dword ptr[r11 * 4 + r9 + 1024 * 3]
        mov     r11b, cl
        shr     ecx, 8
        xor     eax, dword ptr[r11 * 4 + r9 + 1024 * 2]
        mov     r11b, cl
        shr     ecx, 8
        xor     eax, dword ptr[r11 * 4 + r9 + 1024 * 1]
        mov     r11b, cl
        xor     eax, dword ptr[r11 * 4 + r9 + 1024 * 0]
        mov     ecx, r10d
        mov     r11b, cl
        shr     ecx, 8
        xor     eax, dword ptr[r11 * 4 + r9 + 1024 * 7]
        mov     r11b, cl
        shr     ecx, 8
        xor     eax, dword ptr[r11 * 4 + r9 + 1024 * 6]
        mov     r11b, cl
        shr     ecx, 8
        xor     eax, dword ptr[r11 * 4 + r9 + 1024 * 5]
        mov     r11b, cl
        xor     eax, dword ptr[r11 * 4 + r9 + 1024 * 4]
        add     r8, 8
        jle     @by8
@done:  sub     r8, 8
        jge     @e
@tail:  mov     cl, byte ptr[buf + r8]
        xor     cl, al
        shr     eax, 8
        xor     eax, dword ptr[rcx * 4 + r9]
        inc     r8
        jnz     @tail
@e:     not     eax
end;
{$endif ABSOLUTEPASCALORNOTINTEL}

function ToVarInt32(Value: PtrInt; Dest: PByte): PByte;
begin // 0=0,1=1,2=-1,3=2,4=-2...
  if Value<0 then
    // -1->2, -2->4..
    Value := (-Value) shl 1 else
  if Value>0 then
    // 1->1, 2->3..
    Value := (Value shl 1)-1;
    // 0->0
  result := ToVarUInt32(Value,Dest);
end;

function ToVarUInt32(Value: cardinal; Dest: PByte): PByte;
label _1,_2,_3; // ugly but fast
begin
  if Value>$7f then begin
    if Value<$80 shl 7  then goto _1 else
      if Value<$80 shl 14 then goto _2 else
        if Value<$80 shl 21 then goto _3;
    Dest^ := (Value and $7F) or $80;
    Value := Value shr 7;
    inc(Dest);
_3: Dest^ := (Value and $7F) or $80;
    Value := Value shr 7;
    inc(Dest);
_2: Dest^ := (Value and $7F) or $80;
    Value := Value shr 7;
    inc(Dest);
_1: Dest^ := (Value and $7F) or $80;
    Value := Value shr 7;
    inc(Dest);
  end;
  Dest^ := Value;
  inc(Dest);
  result := Dest;
end;

{$ifdef CPUX64}  // very efficient branchless asm - rcx/rdi=A rdx/rsi=B
function SortDynArrayInteger(const A,B): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
        mov     r8d, dword ptr[A]
        mov     edx, dword ptr[B]
        xor     eax, eax
        xor     ecx, ecx
        cmp     r8d, edx
        setl    cl
        setg    al
        sub     eax, ecx
end;
function SortDynArrayCardinal(const A,B): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
        mov     ecx, dword ptr[A]
        mov     edx, dword ptr[B]
        xor     eax, eax
        cmp     ecx, edx
        seta    al
        sbb     eax, 0
end;
function SortDynArrayInt64(const A,B): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
        mov     r8, qword ptr[A]
        mov     rdx, qword ptr[B]
        xor     eax, eax
        xor     ecx, ecx
        cmp     r8, rdx
        setl    cl
        setg    al
        sub     eax, ecx
end;
function SortDynArrayQWord(const A,B): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
        mov     rcx, qword ptr[A]
        mov     rdx, qword ptr[B]
        xor     eax, eax
        cmp     rcx, rdx
        seta    al
        sbb     eax, 0
end;
function SortDynArrayPointer(const A,B): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
        mov     rcx, qword ptr[A]
        mov     rdx, qword ptr[B]
        xor     eax, eax
        cmp     rcx, rdx
        seta    al
        sbb     eax, 0
end;
function SortDynArrayDouble(const A,B): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
        movsd   xmm0, qword ptr[A]
        movsd   xmm1, qword ptr[B]
        xor     eax, eax
        xor     edx, edx
        comisd  xmm0, xmm1
        seta    al
        setb    dl
        sub     eax, edx
end;
function SortDynArraySingle(const A,B): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
        movss   xmm0, dword ptr[A]
        movss   xmm1, dword ptr[B]
        xor     eax, eax
        xor     edx, edx
        comiss  xmm0, xmm1
        seta    al
        setb    dl
        sub     eax, edx
end;
function SortDynArrayAnsiString(const A,B): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
        mov     rcx, qword ptr[A]
        mov     rdx, qword ptr[B]
        cmp     rcx, rdx // A=B (happens with string refcounting)
        je      @0
        test    rcx, rdx // A^ or B^ may be nil i.e. ''
        jz      @n1
@s:     mov     al, byte ptr[rcx] // by char comparison
        cmp     al, byte ptr[rdx]
        jne     @ne
        inc     rcx
        inc     rdx
        test    al, al
        jnz     @s
@0:     xor     eax, eax
        ret
@n1:    test    rcx, rcx
        jz      @less    // A='' -> -1
        test    rdx, rdx
        jnz     @s       // B='' -> 1
@1:     mov     eax, 1
        ret
@ne:    jnc     @1
@less:  mov     eax, -1
end; // note: SSE4.2 read up to 16 bytes after buffer, this version won't
{$else}
function SortDynArrayInteger(const A,B): integer;
begin
  result := ord(integer(A)>integer(B))-ord(integer(A)<integer(B));
end;
function SortDynArrayCardinal(const A,B): integer;
begin
  result := ord(cardinal(A)>cardinal(B))-ord(cardinal(A)<cardinal(B));
end;

function SortDynArrayInt64(const A,B): integer;
begin
  result := ord(Int64(A)>Int64(B))-ord(Int64(A)<Int64(B));
end;
function SortDynArrayQWord(const A,B): integer;
begin
  result := ord(QWord(A)>QWord(B))-ord(QWord(A)<QWord(B));
end;
function SortDynArrayPointer(const A,B): integer;
begin
  result := ord(PtrUInt(A)>PtrUInt(B))-ord(PtrUInt(A)<PtrUInt(B));
end;
function SortDynArrayDouble(const A,B): integer;
begin
  result := ord(double(A)>double(B))-ord(double(A)<double(B));
end;
function SortDynArraySingle(const A,B): integer;
begin
  result := ord(single(A)>single(B))-ord(single(A)<single(B));
end;
function SortDynArrayAnsiString(const A,B): integer;
begin
  result := StrCompFast(pointer(A),pointer(B));
end;
{$endif CPUX64}

function CompareQWord(A, B: QWord): integer;
begin
  result := ord(A>B)-ord(A<B);
end;

function SortDynArrayAnsiStringI(const A,B): integer;
begin
  result := StrIComp(PUTF8Char(A),PUTF8Char(B));
end;

function SortDynArrayRawByteString(const A,B): integer;
var p1,p2: PByteArray;
    l1,l2,i,l: PtrInt; // FPC will use very efficiently the CPU registers
begin // we can't use StrComp() since a RawByteString may contain #0
  p1 := pointer(A);
  p2 := pointer(B);
  if p1<>p2 then
    if p1<>nil then
      if p2<>nil then begin
        l1 := PStrLen(PtrUInt(p1)-_STRLEN)^;
        l2 := PStrLen(PtrUInt(p2)-_STRLEN)^;
        l := l1;
        if l2<l1 then
          l := l2;
        i := 0;
        repeat
          result := p1[i];
          dec(result,p2[i]);
          if result<>0 then
            exit;
          inc(i);
        until i>=l;
        result := l1-l2;
      end else
      result := 1 else  // p2=''
    result := -1 else // p1=''
  result := 0;      // p1=p2
end;

function SortDynArrayPUTF8Char(const A,B): integer;
begin
  result := StrCompFast(pointer(A),pointer(B));
end;

{$else PUREPASCAL}

function IdemPChar(p: PUTF8Char; up: PAnsiChar): boolean;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm
        test    eax, eax
        jz      @e            // P=nil -> false
        test    edx, edx
        push    ebx
        jz      @t            // up=nil -> true
        xor     ebx, ebx
@1:     mov     ecx, [edx]    // optimized for DWORD aligned read up^
        test    cl, cl
        mov     bl, [eax]
        jz      @t            // up^[0]=#0 -> OK
        cmp     cl, byte ptr[ebx + NormToUpperAnsi7] // NormToUpperAnsi7[p^[0]]
        jne     @f
        mov     bl, [eax + 1]
        test    ch, ch
        jz      @t            // up^[1]=#0 -> OK
        cmp     ch, byte ptr[ebx + NormToUpperAnsi7] // NormToUpperAnsi7[p^[1]]
        jne     @f
        shr     ecx, 16       // cl=up^[2] ch=up^[3]
        mov     bl, [eax + 2]
        test    cl, cl
        jz      @t            // up^[2]=#0 -> OK
        cmp     cl, byte ptr[ebx + NormToUpperAnsi7] // NormToUpperAnsi7[p^[2]]
        jne     @f
        mov     bl, [eax + 3]
        add     eax, 4
        add     edx, 4
        test    ch, ch
        jz      @t            // up^[3]=#0 -> OK
        cmp     ch, byte ptr[ebx + NormToUpperAnsi7] // NormToUpperAnsi7[p^[3]]
        je      @1
@f:     pop     ebx // NormToUpperAnsi7[p^]<>up^ -> FALSE
@e:     xor     eax, eax
        ret
@t:     pop     ebx // up^=#0 -> TRUE
        mov     al, 1
end;

function IntegerScanIndex(P: PCardinalArray; Count: PtrInt; Value: cardinal): PtrInt;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm
        push    eax
        call    IntegerScan
        pop     edx
        test    eax, eax
        jnz     @e
        dec     eax // returns -1
        ret
@e:     sub     eax, edx
        shr     eax, 2
end;

function IntegerScan(P: PCardinalArray; Count: PtrInt; Value: cardinal): PCardinal;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=P, edx=Count, Value=ecx
        test    eax, eax
        jz      @ok0 // avoid GPF
        cmp     edx, 8
        jb      @s2
        nop
        nop
        nop // @s1 loop align
@s1:    sub     edx, 8
        cmp     [eax], ecx
        je      @ok0
        cmp     [eax + 4], ecx
        je      @ok4
        cmp     [eax + 8], ecx
        je      @ok8
        cmp     [eax + 12], ecx
        je      @ok12
        cmp     [eax + 16], ecx
        je      @ok16
        cmp     [eax + 20], ecx
        je      @ok20
        cmp     [eax + 24], ecx
        je      @ok24
        cmp     [eax + 28], ecx
        je      @ok28
        add     eax, 32
        cmp     edx, 8
        jae     @s1
@s2:    test    edx, edx
        jz      @z
        cmp     [eax], ecx
        je      @ok0
        dec     edx
        jz      @z
        cmp     [eax + 4], ecx
        je      @ok4
        dec     edx
        jz      @z
        cmp     [eax + 8], ecx
        je      @ok8
        dec     edx
        jz      @z
        cmp     [eax + 12], ecx
        je      @ok12
        dec     edx
        jz      @z
        cmp     [eax + 16], ecx
        je      @ok16
        dec     edx
        jz      @z
        cmp     [eax + 20], ecx
        je      @ok20
        dec     edx
        jz      @z
        cmp     [eax + 24], ecx
        je      @ok24
@z:     xor     eax, eax // return nil if not found
        ret
@ok0:   rep     ret
@ok28:  add     eax, 28
        ret
@ok24:  add     eax, 24
        ret
@ok20:  add     eax, 20
        ret
@ok16:  add     eax, 16
        ret
@ok12:  add     eax, 12
        ret
@ok8:   add     eax, 8
        ret
@ok4:   add     eax, 4
end;

function IntegerScanExists(P: PCardinalArray; Count: PtrInt; Value: cardinal): boolean;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=P, edx=Count, Value=ecx
        test    eax, eax
        jz      @z // avoid GPF
        cmp     edx, 8
        jae     @s1
        jmp     dword ptr[edx * 4 + @Table]
@Table: dd      @z, @1, @2, @3, @4, @5, @6, @7
@s1:    // fast search by 8 integers (pipelined instructions)
        sub     edx, 8
        cmp     [eax], ecx
        je      @ok
        cmp     [eax + 4], ecx
        je      @ok
        cmp     [eax + 8], ecx
        je      @ok
        cmp     [eax + 12], ecx
        je      @ok
        cmp     [eax + 16], ecx
        je      @ok
        cmp     [eax + 20], ecx
        je      @ok
        cmp     [eax + 24], ecx
        je      @ok
        cmp     [eax + 28], ecx
        je      @ok
        add     eax, 32
        cmp     edx, 8
        jae     @s1
        jmp     dword ptr[edx * 4 + @Table]
@7:     cmp     [eax + 24], ecx
        je      @ok
@6:     cmp     [eax + 20], ecx
        je      @ok
@5:     cmp     [eax + 16], ecx
        je      @ok
@4:     cmp     [eax + 12], ecx
        je      @ok
@3:     cmp     [eax + 8], ecx
        je      @ok
@2:     cmp     [eax + 4], ecx
        je      @ok
@1:     cmp     [eax], ecx
        je      @ok
@z:     xor     eax, eax
        ret
@ok:    mov     al, 1
end;

function PosChar(Str: PUTF8Char; Chr: AnsiChar): PUTF8Char;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // faster version by AB - eax=Str dl=Chr
        test    eax, eax
        jz      @z
@1:     mov     ecx, dword ptr [eax]
        cmp     cl, dl
        je      @z
        inc     eax
        test    cl, cl
        jz      @e
        cmp     ch, dl
        je      @z
        inc     eax
        test    ch, ch
        jz      @e
        shr     ecx, 16
        cmp     cl, dl
        je      @z
        inc     eax
        test    cl, cl
        jz      @e
        cmp     ch, dl
        je      @z
        inc     eax
        test    ch, ch
        jnz     @1
@e:     xor     eax, eax
        ret
@z:     db      $f3 // rep ret
end;

function CompareMem(P1, P2: Pointer; Length: PtrInt): Boolean;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm     // eax=P1 edx=P2 ecx=Length
        cmp     eax, edx
        je      @0                 // P1=P2
        sub     ecx, 8
        jl      @small
        push    ebx
        mov     ebx, [eax]         // Compare First 4 Bytes
        cmp     ebx, [edx]
        jne     @setbig
        lea     ebx, [eax + ecx]   // Compare Last 8 Bytes
        add     edx, ecx
        mov     eax, [ebx]
        cmp     eax, [edx]
        jne     @setbig
        mov     eax, [ebx + 4]
        cmp     eax, [edx + 4]
        jne     @setbig
        sub     ecx, 4
        jle     @true              // All Bytes already Compared
        neg     ecx                // ecx=-(Length-12)
        add     ecx, ebx           // DWORD Align Reads
        and     ecx, -4
        sub     ecx, ebx
@loop:  mov     eax, [ebx + ecx]   // Compare 8 Bytes per Loop
        cmp     eax, [edx + ecx]
        jne     @setbig
        mov     eax, [ebx + ecx + 4]
        cmp     eax, [edx + ecx + 4]
        jne     @setbig
        add     ecx, 8
        jl      @loop
@true:  pop     ebx
@0:     mov     al, 1
        ret
@setbig:pop     ebx
        setz    al
        ret
@small: add     ecx, 8             // ecx=0..7
        jle     @0                 // Length <= 0
        neg     ecx                // ecx=-1..-7
        lea     ecx, [@1 + ecx * 8 + 8]   // each @#: block below = 8 bytes
        jmp     ecx
@7:     mov     cl, [eax + 6]
        cmp     cl, [edx + 6]
        jne     @setsml
@6:     mov     ch, [eax + 5]
        cmp     ch, [edx + 5]
        jne     @setsml
@5:     mov     cl, [eax + 4]
        cmp     cl, [edx + 4]
        jne     @setsml
@4:     mov     ch, [eax + 3]
        cmp     ch, [edx + 3]
        jne     @setsml
@3:     mov     cl, [eax + 2]
        cmp     cl, [edx + 2]
        jne     @setsml
@2:     mov     ch, [eax + 1]
        cmp     ch, [edx + 1]
        jne     @setsml
@1:     mov     al, [eax]
        cmp     al, [edx]
@setsml:setz    al
end;

function PosEx(const SubStr, S: RawUTF8; Offset: PtrUInt): integer;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm     // eax=SubStr, edx=S, ecx=Offset
        push    ebx
        push    esi
        push    edx
        test    eax, eax
        jz      @notfnd            // exit if SubStr=''
        test    edx, edx
        jz      @notfnd            // exit if S=''
        mov     esi, ecx
        mov     ecx, [edx - 4]     // length(S)
        mov     ebx, [eax - 4]     // length(SubStr)
        add     ecx, edx
        sub     ecx, ebx              // ecx = max start pos for full match
        lea     edx, [edx + esi - 1]  // edx = start position
        cmp     edx, ecx
        jg      @notfnd            // startpos > max start pos
        cmp     ebx, 1
        jle     @onec              // optimized loop for length(SubStr)<=1
        push    edi
        push    ebp
        lea     edi, [ebx - 2]     // edi = length(SubStr)-2
        mov     esi, eax           // esi = SubStr
        movzx   ebx, byte ptr[eax] // bl = search character
        nop; nop
@l:     cmp     bl, [edx]          // compare 2 characters per @l
        je      @c1fnd
@notc1: cmp     bl, [edx + 1]
        je      @c2fnd
@notc2: add     edx, 2
        cmp     edx, ecx            // next start position <= max start position
        jle     @l
        pop     ebp
        pop     edi
@notfnd:xor     eax, eax            // returns 0 if not fnd
        pop     edx
        pop     esi
        pop     ebx
        ret
@c1fnd: mov     ebp, edi            // ebp = length(SubStr)-2
@c1l:   movzx   eax, word ptr[esi + ebp]
        cmp     ax, [edx + ebp]     // compare 2 chars per @c1l (may include #0)
        jne     @notc1
        sub     ebp, 2
        jnc     @c1l
        pop     ebp
        pop     edi
        jmp     @setres
@c2fnd: mov     ebp, edi            // ebp = length(SubStr)-2
@c2l:   movzx   eax, word ptr[esi + ebp]
        cmp     ax, [edx + ebp + 1] // compare 2 chars per @c2l (may include #0)
        jne     @notc2
        sub     ebp, 2
        jnc     @c2l
        pop     ebp
        pop     edi
        jmp     @chkres
@onec:  jl      @notfnd             // needed for zero-length non-nil strings
        movzx   eax, byte ptr[eax]  // search character
@charl: cmp     al, [edx]
        je      @setres
        cmp     al, [edx + 1]
        je      @chkres
        add     edx, 2
        cmp     edx, ecx
        jle     @charl
        jmp     @notfnd
@chkres:cmp     edx, ecx           // check within ansistring
        jge     @notfnd
        add     edx, 1
@setres:pop     ecx                // ecx = S
        pop     esi
        pop     ebx
        neg     ecx
        lea     eax, [edx + ecx + 1]
end;

function IdemPropNameU(const P1,P2: RawUTF8): boolean;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=p1, edx=p2
        cmp     eax, edx
        je      @out1
        test    eax, edx
        jz      @maybenil
@notnil:mov     ecx, [eax - 4] // compare lengths
        cmp     ecx, [edx - 4]
        jne     @out1
        push    ebx
        lea     edx, [edx + ecx - 4]  // may include the length for shortest strings
        lea     ebx, [eax + ecx - 4]
        neg     ecx
        mov     eax, [ebx]     // compare last 4 chars
        xor     eax, [edx]
        and     eax, $dfdfdfdf // case insensitive
        jne     @out2
@by4:   add     ecx, 4
        jns     @match
        mov     eax, [ebx + ecx]
        xor     eax, [edx + ecx]
        and     eax, $dfdfdfdf // case insensitive
        je      @by4
@out2:  pop     ebx
@out1:  setz    al
        ret
@match: mov     al, 1
        pop     ebx
        ret
@maybenil: // here we know that eax<>edx
        test    eax, eax
        jz      @nil0     // eax=nil and eax<>edx -> edx<>nil -> false
        test    edx, edx
        jnz     @notnil
        mov     al, dl    // eax<>nil and edx=nil -> false
@nil0:
end;

function IdemPropNameUSameLen(P1,P2: PUTF8Char; P1P2Len: PtrInt): boolean;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=p1, edx=p2, ecx=P1P2Len
        cmp     eax, edx
        je      @out2
        cmp     ecx, 4
        jbe     @sml
        push    ebx
        lea     edx, [edx + ecx - 4]
        lea     ebx, [eax + ecx - 4]
        neg     ecx
        mov     eax, [ebx]     // compare last 4 chars
        xor     eax, [edx]
        and     eax, $dfdfdfdf // case insensitive
        jne     @out1
@by4:   add     ecx, 4
        jns     @match
        mov     eax, [ebx + ecx]
        xor     eax, [edx + ecx]
        and     eax, $dfdfdfdf // case insensitive
        je      @by4
@out1:  pop     ebx
@out2:  setz    al
        ret
        nop
        nop
@match: pop     ebx
        mov     al, 1
        ret
@mask:  dd      0, $df, $dfdf, $dfdfdf, $dfdfdfdf // compare 1..4 chars
@sml:   test    ecx, ecx
        jz      @smlo      // p1p2len=0
        mov     eax, [eax]
        xor     eax, [edx]
        and     eax, dword ptr[@mask + ecx * 4]
@smlo:  setz    al
end;

function StrIComp(Str1, Str2: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // faster version by AB, from Agner Fog's original
        mov     ecx, eax
        test    eax, edx
        jz      @n
@ok:    sub     edx, eax
        jz      @0
@10:    mov     al, [ecx]
        cmp     al, [ecx + edx]
        jne     @20
        inc     ecx
        test    al, al
        jnz     @10                    // continue with next byte
        // terminating zero found. Strings are equal
@0:     xor     eax, eax
        ret
@20:    // bytes are different. check case
        xor     al, 20H                // toggle case
        cmp     al, [ecx + edx]
        jne     @30
        // possibly differing only by case. Check if a-z
        or      al, 20H                // upper case
        sub     al, 'a'
        cmp     al, 'z' - 'a'
        ja      @30                    // not a-z
        // a-z and differing only by case
        inc     ecx
        jmp     @10                    // continue with next byte
@30:    // bytes are different,even after changing case
        movzx   eax, byte[ecx]        // get original value again
        sub     eax, 'A'
        cmp     eax, 'Z' - 'A'
        ja      @40
        add     eax, 20H
@40:    movzx   edx, byte[ecx + edx]
        sub     edx, 'A'
        cmp     edx, 'Z' - 'A'
        ja      @50
        add     edx, 20H
@50:    sub     eax, edx                 // subtract to get result
        ret
@n:     cmp     eax, edx
        je      @0
        test    eax, eax  // Str1='' ?
        jz      @max
        test    edx, edx  // Str2='' ?
        jnz     @ok
        mov     eax, 1
        ret
@max:   dec     eax
end;

function StrLenPas(S: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // slower than x86/SSE* StrLen(), but won't read any byte beyond the string
        mov     edx, eax
        test    eax, eax
        jz      @0
        xor     eax, eax
@s:     cmp     byte ptr[eax + edx + 0], 0
        je      @0
        cmp     byte ptr[eax + edx + 1], 0
        je      @1
        cmp     byte ptr[eax + edx + 2], 0
        je      @2
        cmp     byte ptr[eax + edx + 3], 0
        je      @3
        add     eax, 4
        jmp     @s
@1:     inc     eax
        ret
@0:     rep     ret
@2:     add     eax, 2
        ret
@3:     add     eax, 3
end;

function StrCompFast(Str1, Str2: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // no branch taken in case of not equal first char
        cmp     eax, edx
        je      @zero  // same string or both nil
        test    eax, edx
        jz      @maynil
@1:     mov     cl, [eax]
        mov     ch, [edx]
        inc     eax
        inc     edx
        test    cl, cl
        jz      @exit
        cmp     cl, ch
        je      @1
@exit:  movzx   eax, cl
        movzx   edx, ch
        sub     eax, edx
        ret
@maynil:test    eax, eax  // Str1='' ?
        jz      @max
        test    edx, edx  // Str2='' ?
        jnz     @1
        mov     eax, 1
        ret
@max:   dec     eax
        ret
@zero:  xor     eax, eax
end;

const
  EQUAL_EACH = 8;   // see https://msdn.microsoft.com/en-us/library/bb531463
  NEGATIVE_POLARITY = 16;

function StrCompSSE42(Str1, Str2: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // warning: may read up to 15 bytes beyond the string itself
      test      eax, edx
      jz        @n
@ok:  sub       eax, edx
      {$ifdef HASAESNI}
      movups    xmm0, dqword [edx]
      pcmpistri xmm0, dqword [edx + eax], EQUAL_EACH + NEGATIVE_POLARITY // result in ecx
      {$else}
      db $F3,$0F,$6F,$02
      db $66,$0F,$3A,$63,$04,$10,EQUAL_EACH+NEGATIVE_POLARITY
      {$endif}
      ja        @1
      jc        @2
      xor       eax, eax
      ret
@1:   add       edx, 16
      {$ifdef HASAESNI}
      movups    xmm0, dqword [edx]
      pcmpistri xmm0, dqword [edx + eax], EQUAL_EACH + NEGATIVE_POLARITY // result in ecx
      {$else}
      db $F3,$0F,$6F,$02
      db $66,$0F,$3A,$63,$04,$10,EQUAL_EACH+NEGATIVE_POLARITY
      {$endif}
      ja        @1
      jc        @2
@0:   xor       eax, eax // Str1=Str2
      ret
@n:   cmp       eax, edx
      je        @0
      test      eax, eax  // Str1='' ?
      jz        @max
      test      edx, edx  // Str2='' ?
      jnz       @ok
      mov       eax, 1
      ret
@max: dec       eax
      ret
@2:   add       eax, edx
      movzx     eax, byte ptr [eax+ecx]
      movzx     edx, byte ptr [edx+ecx]
      sub       eax, edx
end;

function SortDynArrayAnsiStringSSE42(const A,B): integer;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // warning: may read up to 15 bytes beyond the string itself
      mov       eax, [eax]
      mov       edx, [edx]
      test      eax, edx
      jz        @n
@ok:  sub       eax, edx
      jz        @0
      {$ifdef HASAESNI}
      movups    xmm0, dqword [edx] // result in ecx
      pcmpistri xmm0, dqword [edx+eax], EQUAL_EACH + NEGATIVE_POLARITY
      {$else}
      db $F3,$0F,$6F,$02
      db $66,$0F,$3A,$63,$04,$10,EQUAL_EACH+NEGATIVE_POLARITY
      {$endif}
      ja        @1
      jc        @2
      xor       eax, eax
      ret
@1:   add       edx, 16
      {$ifdef HASAESNI}
      movups    xmm0, dqword [edx] // result in ecx
      pcmpistri xmm0, dqword [edx+eax], EQUAL_EACH + NEGATIVE_POLARITY
      {$else}
      db $F3,$0F,$6F,$02
      db $66,$0F,$3A,$63,$04,$10,EQUAL_EACH+NEGATIVE_POLARITY
      {$endif}
      ja        @1
      jc        @2
@0:   xor       eax, eax // Str1=Str2
      ret
@n:   cmp       eax, edx
      je        @0
      test      eax, eax  // Str1='' ?
      jz        @max
      test      edx, edx  // Str2='' ?
      jnz       @ok
      mov       eax, -1
      ret
@max: inc       eax
      ret
@2:   add       eax, edx
      movzx     eax, byte ptr [eax+ecx]
      movzx     edx, byte ptr [edx+ecx]
      sub       eax, edx
end;

function StrLenSSE42(S: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // warning: may read up to 15 bytes beyond the string itself
        mov     edx, eax             // copy pointer
        test    eax, eax
        jz      @null                // returns 0 if S=nil
        xor     eax, eax
        {$ifdef HASAESNI}
        pxor    xmm0, xmm0
        pcmpistri xmm0, dqword[edx], EQUAL_EACH  // comparison result in ecx
        {$else}
        db      $66, $0F, $EF, $C0
        db      $66, $0F, $3A, $63, $02, EQUAL_EACH
        {$endif}
        jnz     @loop
        mov     eax, ecx
        ret
        nop   // for @loop alignment
@loop:  add     eax, 16
        {$ifdef HASAESNI}
        pcmpistri xmm0, dqword[edx + eax], EQUAL_EACH  // comparison result in ecx
        {$else}
        db      $66, $0F, $3A, $63, $04, $10, EQUAL_EACH
        {$endif}
        jnz     @loop
@ok:    add     eax, ecx
        ret
@null:  db      $f3 // rep ret
end;

procedure YearToPChar(Y: PtrUInt; P: PUTF8Char);
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=Y, edx=P
        push    edx
        mov     ecx, eax
        mov     edx, 1374389535 // use power of two reciprocal to avoid division
        mul     edx
        shr     edx, 5          // now edx=Y div 100
        movzx   eax, word ptr[TwoDigitLookup + edx * 2]
        imul    edx, -200
        movzx   edx, word ptr[TwoDigitLookup + ecx * 2 + edx]
        pop     ecx
        shl     edx, 16
        or      eax, edx
        mov     [ecx], eax
end;

function Iso8601ToTimeLog(const S: RawByteString): TTimeLog;
{$ifdef FPC} nostackframe; assembler; {$endif} asm
    xor ecx,ecx  // ContainsNoTime=nil
    test eax,eax   // if s='' -> p=nil -> will return 0, whatever L value is
    jz Iso8601ToTimeLogPUTF8Char
    mov edx,[eax-4] // edx=L
@1: jmp Iso8601ToTimeLogPUTF8Char
end;

function UpperCopy(dest: PAnsiChar; const source: RawUTF8): PAnsiChar;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=dest source=edx
        test    edx, edx
        jz      @z
        push    esi
        mov     esi, offset NormToUpperAnsi7
        xor     ecx, ecx
@1:     mov     cl, [edx]
        inc     edx
        test    cl, cl
        mov     cl, [esi + ecx]
        jz      @2
        mov     [eax], cl
        inc     eax
        jmp     @1
@2:     pop     esi
@z:
end;

function UpperCopyShort(dest: PAnsiChar; const source: shortstring): PAnsiChar;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=dest source=edx
        push    esi
        push    ebx
        movzx   ebx, byte ptr[edx] // ebx = length(source)
        xor     ecx, ecx
        test    ebx, ebx
        mov     esi, offset NormToUpperAnsi7
        jz      @2 // source=''
        inc     edx
@1:     mov     cl, [edx]
        inc     edx
        dec     ebx
        mov     cl, [esi + ecx]
        mov     [eax], cl
        lea     eax, [eax + 1]
        jnz     @1
@2:     pop     ebx
        pop     esi
@z:
end;

function IdemPCharAndGetNextLine(var source: PUTF8Char; searchUp: PAnsiChar): boolean;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=source edx=searchUp
        push    eax        // save source var
        mov     eax, [eax] // eax=source
        test    eax, eax
        jz      @z
        push    eax
        call    IdemPChar
        pop     ecx        // ecx=source
        push    eax        // save result
@1:     mov     dl, [ecx]  // while not (source^ in [#0,#10,#13]) do inc(source)
        inc     ecx
        cmp     dl, 13
        ja      @1
        je      @e
        or      dl, dl
        jz      @0
        cmp     dl, 10
        jne     @1
        jmp     @4
@e:     cmp     byte ptr[ecx], 10 // jump #13#10
        jne     @4
@3:     inc     ecx
@4:     pop     eax        // restore result
        pop     edx        // restore source var
        mov     [edx], ecx // update source var
        ret
@0:     xor     ecx, ecx   // set source=nil
        jmp     @4
@z:     pop     edx        // ignore source var, result := false
end;

procedure crcblockNoSSE42(crc128, data128: PBlock128);
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // Delphi is not efficient about compiling above pascal code
        push    ebp
        push    edi
        push    esi
        mov     ebp, eax  // ebp=crc128 edi=data128
        mov     edi, edx
        mov     edx, dword ptr[eax]
        mov     ecx, dword ptr[eax + 4]
        xor     edx, dword ptr[edi]
        xor     ecx, dword ptr[edi + 4]
        movzx   esi, dl
        mov     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
        movzx   esi, dh
        shr     edx, 16
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
        movzx   esi, dl
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
        movzx   esi, dh
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
        mov     edx, dword ptr[ebp + 8]
        xor     edx, dword ptr[edi + 8]
        mov     dword ptr[ebp], eax
        movzx   esi, cl
        mov     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
        movzx   esi, ch
        shr     ecx, 16
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
        movzx   esi, cl
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
        movzx   esi, ch
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
        mov     dword ptr[ebp + 4], eax
        mov     ecx, dword ptr[ebp + 12]
        xor     ecx, dword ptr[edi + 12]
        movzx   esi, dl
        mov     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
        movzx   esi, dh
        shr     edx, 16
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
        movzx   esi, dl
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
        movzx   esi, dh
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
        mov     dword ptr[ebp + 8], eax
        movzx   esi, cl
        mov     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
        movzx   esi, ch
        shr     ecx, 16
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
        movzx   esi, cl
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
        movzx   esi, ch
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
        mov     dword ptr[ebp + 12], eax
        pop     esi
        pop     edi
        pop     ebp
end;

function crc32cfast(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm  // adapted from Aleksandr Sharahov code and Maxim Masiutin remarks
        test    edx, edx
        jz      @z
        neg     ecx
        jz      @z
        not     eax
        push    ebx
        push    ebp
        lea     ebp, [crc32ctab]
@head:  test    dl, 3
        jz      @align
        movzx   ebx, byte ptr[edx]
        inc     edx
        xor     bl, al
        shr     eax, 8
        xor     eax, dword ptr[ebx * 4 + ebp]
        inc     ecx
        jnz     @head
        pop     ebp
        pop     ebx
        not     eax
@z:     ret
@align: sub     edx, ecx
        add     ecx, 8
        jg      @done
        push    esi
        push    edi
        mov     edi, edx
@by8:   mov     edx, eax
        mov     ebx, [edi + ecx - 4]
        xor     edx, [edi + ecx - 8]
        movzx   esi, bl
        mov     eax, dword ptr[esi * 4 + ebp + 1024 * 3]
        movzx   esi, bh
        xor     eax, dword ptr[esi * 4 + ebp + 1024 * 2]
        shr     ebx, 16
        movzx   esi, bl
        xor     eax, dword ptr[esi * 4 + ebp + 1024 * 1]
        movzx   esi, bh
        xor     eax, dword ptr[esi * 4 + ebp + 1024 * 0]
        movzx   esi, dl
        xor     eax, dword ptr[esi * 4 + ebp + 1024 * 7]
        movzx   esi, dh
        xor     eax, dword ptr[esi * 4 + ebp + 1024 * 6]
        shr     edx, 16
        movzx   esi, dl
        xor     eax, dword ptr[esi * 4 + ebp + 1024 * 5]
        movzx   esi, dh
        xor     eax, dword ptr[esi * 4 + ebp + 1024 * 4]
        add     ecx, 8
        jle     @by8
        mov     edx, edi
        pop     edi
        pop     esi
@done:  sub     ecx, 8
        jl      @tail
        pop     ebp
        pop     ebx
        not     eax
        ret
@tail:  movzx   ebx, byte[edx + ecx]
        xor     bl, al
        shr     eax, 8
        xor     eax, dword ptr[ebx * 4 + ebp]
        inc     ecx
        jnz     @tail
@e:     pop     ebp
        pop     ebx
        not     eax
end;

{$ifndef DELPHI5OROLDER}
const
  CMP_RANGES = $44; // see https://msdn.microsoft.com/en-us/library/bb531425

function UpperCopy255BufSSE42(dest: PAnsiChar; source: PUTF8Char; sourceLen: PtrInt): PAnsiChar;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=dest edx=source ecx=sourceLen
       test    ecx,ecx
       jz      @z
       movups  xmm1, dqword ptr [@az]
       movups  xmm3, dqword ptr [@bits]
       cmp     ecx, 16
       ja      @big
       // optimize the common case of sourceLen<=16
       movups  xmm2, [edx]
       {$ifdef HASAESNI}
       pcmpistrm xmm1, xmm2, CMP_RANGES // find in range a-z, return mask in xmm0
       {$else}
       db $66, $0F, $3A, $62, $CA, CMP_RANGES
       {$endif}
       pand    xmm0, xmm3
       pxor    xmm2, xmm0
       movups  [eax], xmm2
       add     eax, ecx
@z:    ret
@big:  push    eax
       cmp     ecx, 240
       jb      @ok
       mov     ecx, 239
@ok:   add     [esp], ecx // save to return end position with the exact size
       shr     ecx, 4
       sub     edx, eax
       inc     ecx
@s:    movups  xmm2, [edx+eax]
       {$ifdef HASAESNI}
       pcmpistrm xmm1, xmm2, CMP_RANGES
       {$else}
       db $66, $0F, $3A, $62, $CA, CMP_RANGES
       {$endif}
       pand    xmm0, xmm3
       pxor    xmm2, xmm0
       movups  [eax], xmm2
       add     eax, 16
       dec     ecx
       jnz     @s
       pop     eax
       ret
@az:   db 'azazazazazazazaz'         // define range for upper case conversion
@bits: db '                '         // $20 = bit to change when changing case
end;
{$endif DELPHI5OROLDER}

function fnv32(crc: cardinal; buf: PAnsiChar; len: PtrInt): cardinal;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=crc, edx=buf, ecx=len
        push    ebx
        test    edx, edx
        jz      @0
        neg     ecx
        jz      @0
        sub     edx, ecx
@1:     movzx   ebx, byte ptr[edx + ecx]
        xor     eax, ebx
        imul    eax, eax, 16777619
        inc     ecx
        jnz     @1
@0:     pop     ebx
end; // we tried an unrolled version, but it was slower on our Core i7!

function kr32(crc: cardinal; buf: PAnsiChar; len: PtrInt): cardinal;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=crc, edx=buf, ecx=len
        test    ecx, ecx
        push    edi
        push    esi
        push    ebx
        push    ebp
        jz      @z
        cmp     ecx, 4
        jb      @s
@8:     mov     ebx, [edx] // unrolled version reading per dword
        add     edx, 4
        mov     esi, eax
        movzx   edi, bl
        movzx   ebp, bh
        shr     ebx, 16
        shl     eax, 5
        sub     eax, esi
        add     eax, edi
        mov     esi, eax
        shl     eax, 5
        sub     eax, esi
        lea     esi, [eax + ebp]
        add     eax, ebp
        movzx   edi, bl
        movzx   ebx, bh
        shl     eax, 5
        sub     eax, esi
        lea     ebp, [eax + edi]
        add     eax, edi
        shl     eax, 5
        sub     eax, ebp
        add     eax, ebx
        cmp     ecx, 8
        lea     ecx, [ecx - 4]
        jae     @8
        test    ecx, ecx
        jz      @z
@s:     mov     esi, eax
@1:     shl     eax, 5
        movzx   ebx, byte ptr[edx]
        inc     edx
        sub     eax, esi
        lea     esi, [eax + ebx]
        add     eax, ebx
        dec     ecx
        jnz     @1
@z:     pop     ebp
        pop     ebx
        pop     esi
        pop     edi
end;

function ToVarInt32(Value: PtrInt; Dest: PByte): PByte;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm
        test    eax, eax
        jnl     @pos
        neg     eax
        add     eax, eax
        jmp     ToVarUInt32
@pos:   jz      @zer
        lea     eax, [eax * 2 - 1]
        jmp     ToVarUInt32
@zer:   mov     [edx], al
        lea     eax, [edx + 1]
end;

function ToVarUInt32(Value: PtrUInt; Dest: PByte): PByte;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm
        cmp     eax, $7f
        jbe     @0
        cmp     eax, $00004000
        jb      @1
        cmp     eax, $00200000
        jb      @2
        cmp     eax, $10000000
        jb      @3
        mov     ecx, eax
        shr     eax, 7
        and     cl, $7f
        or      cl, $80
        mov     [edx], cl
        inc     edx
@3:     mov     ecx, eax
        shr     eax, 7
        and     cl, $7f
        or      cl, $80
        mov     [edx], cl
        inc     edx
@2:     mov     ecx, eax
        shr     eax, 7
        and     cl, $7f
        or      cl, $80
        mov     [edx], cl
        inc     edx
@1:     mov     ecx, eax
        shr     eax, 7
        and     cl, $7f
        or      cl, $80
        mov     [edx], cl
        inc     edx
@0:     mov     [edx], al
        lea     eax, [edx + 1]
end;

function CompareQWord(A, B: QWord): integer;
begin
  {$ifdef FPC_OR_UNICODE} // recent compilers are able to generate correct code
  result := ord(A>B)-ord(A<B);
  {$else}
  result := SortDynArrayQWord(A,B); // use correct x86 asm version below
  {$endif}
end;

function SortDynArrayInteger(const A,B): integer;
{$ifdef FPC} nostackframe; assembler; {$endif} asm
        mov     ecx, [eax]
        mov     edx, [edx]
        xor     eax, eax
        cmp     ecx, edx
        setl    cl
        setg    al
        movzx   ecx, cl
        sub     eax, ecx
end;
function SortDynArrayCardinal(const A,B): integer;
{$ifdef FPC} nostackframe; assembler; {$endif} asm
        mov     ecx, [eax]
        mov     edx, [edx]
        xor     eax, eax
        cmp     ecx, edx
        seta    al
        sbb     eax,0
end;
function SortDynArrayPointer(const A,B): integer;
{$ifdef FPC} nostackframe; assembler; {$endif} asm
        mov     ecx, [eax]
        mov     edx, [edx]
        xor     eax, eax
        cmp     ecx, edx
        seta    al
        sbb     eax,0
end;
function SortDynArrayInt64(const A,B): integer;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // Delphi x86 compiler is not efficient at compiling Int64 comparisons
        mov     ecx, [eax]
        mov     eax, [eax + 4]
        cmp     eax, [edx + 4]
        jnz     @nz
        cmp     ecx, [edx]
        jz      @0
        jnb     @p
@n:     mov     eax, -1
        ret
@0:     xor     eax, eax
        ret
@nz:    jl      @n
@p:     mov     eax, 1
end;
function SortDynArrayQWord(const A,B): integer;
{$ifdef FPC} nostackframe; assembler; {$endif} asm
        mov     ecx, [eax]
        mov     eax, [eax + 4]
        cmp     eax, [edx + 4]
        jnz     @nz
        cmp     ecx, [edx]
        jz      @0
@nz:    jnb     @p
        mov     eax, -1
        ret
@0:     xor     eax, eax
        ret
@p:     mov     eax, 1
end;
function SortDynArrayRawByteString(const A,B): integer;
{$ifdef FPC} nostackframe; assembler; {$endif} asm
        jmp     SortDynArrayAnsiString
end;
function SortDynArrayAnsiString(const A,B): integer;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // x86 version optimized for AnsiString/RawUTF8/RawByteString types
        mov     eax, [eax]
        mov     edx, [edx]
        cmp     eax, edx
        je      @0
        test    eax, edx
        jz      @n1
@n2:    movzx   ecx, byte ptr[eax] // first char comparison (quicksort speedup)
        sub     cl, [edx]
        jne     @no
        push    ebx
        mov     ebx, [eax - 4]
        sub     ebx, [edx - 4]   // ebx = length(A)-length(B)
        push    ebx
        adc     ecx, -1
        and     ecx, ebx
        sub     ecx, [eax - 4]
        sub     eax, ecx
        sub     edx, ecx
@s:     mov     ebx, [eax + ecx]  // compare by dword
        xor     ebx, [edx + ecx]
        jnz     @d
        add     ecx, 4
        js      @s
@l:     pop     eax            // all chars equal -> returns length(a)-length(b)
        pop     ebx
        ret
@d:     bsf     ebx, ebx       // char differs -> returns pbyte(a)^-pbyte(b)^
        shr     ebx, 3
        add     ecx, ebx
        jns     @l
        movzx   eax, byte ptr[eax + ecx]
        movzx   edx, byte ptr[edx + ecx]
        pop     ebx
        pop     ebx
        sub     eax, edx
        ret
@n1:    test    eax, eax       // a or b may be ''
        jz      @n0
        test    edx, edx
        jnz     @n2
        cmp     [eax - 4], edx
        je      @0
@no:    jnc     @1
        mov     eax, -1
        ret
@n0:    cmp     eax, [edx - 4]
        je      @0
        jnc     @1
        mov     eax, -1
        ret
@0:     xor     eax, eax
        ret
@1:     mov     eax, 1
end;
function SortDynArrayAnsiStringI(const A,B): integer;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // avoid a call on the stack on x86 platform
        mov     eax, [eax]
        mov     edx, [edx]
        jmp     StrIComp
end;
function SortDynArrayPUTF8Char(const A,B): integer;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // avoid a call on the stack on x86 platform
        mov     eax, [eax]
        mov     edx, [edx]
        jmp     dword ptr[StrComp]
end;
function SortDynArrayDouble(const A,B): integer;
{$ifdef FPC} nostackframe; assembler; {$endif} asm
        fld     qword ptr[eax]
        fcomp   qword ptr[edx]
        fstsw   ax
        sahf
        jz      @0
@nz:    jnb     @p
        mov     eax, -1
        ret
@0:     xor     eax, eax
        ret
@p:     mov     eax, 1
end;
function SortDynArraySingle(const A,B): integer;
{$ifdef FPC} nostackframe; assembler; {$endif} asm
        fld     dword ptr[eax]
        fcomp   dword ptr[edx]
        fstsw   ax
        sahf
        jz      @0
@nz:    jnb     @p
        mov     eax, -1
        ret
@0:     xor     eax, eax
        ret
@p:     mov     eax, 1
end;
{$endif PUREPASCAL}

function PosExChar(Chr: AnsiChar; const Str: RawUTF8): PtrInt;
begin
  if Str<>'' then
  {$ifdef FPC} // will use fast FPC SSE version
    result := IndexByte(pointer(Str)^,PStrLen(PtrUInt(Str)-_STRLEN)^,byte(chr))+1 else
  {$else}
    for result := 1 to PInteger(PtrInt(Str)-sizeof(Integer))^ do
      if Str[result]=Chr then
        exit;
  {$endif FPC}
    result := 0;
end;

function SplitRight(const Str: RawUTF8; SepChar: AnsiChar; LeftStr: PRawUTF8): RawUTF8;
var i: PtrInt;
begin
  for i := length(Str) downto 1 do
    if Str[i]=SepChar then begin
      result := copy(Str,i+1,maxInt);
      if LeftStr<>nil then
        LeftStr^ := copy(Str,1,i-1);
      exit;
    end;
  result := Str;
  if LeftStr<>nil then
    LeftStr^ := '';
end;

function SplitRights(const Str, SepChar: RawUTF8): RawUTF8;
var i, j, sep: PtrInt;
    c: AnsiChar;
begin
  sep := length(SepChar);
  if sep > 0 then
    if sep = 1 then
      result := SplitRight(Str,SepChar[1]) else begin
    for i := length(Str) downto 1 do begin
      c := Str[i];
      for j := 1 to sep do
        if c=SepChar[j] then begin
          result := copy(Str,i+1,maxInt);
          exit;
        end;
    end;
  end;
  result := Str;
end;

function Split(const Str, SepStr: RawUTF8; StartPos: integer): RawUTF8;
var i: integer;
begin
{$ifdef FPC} // to use fast FPC SSE version
  if (StartPos=1) and (length(SepStr)=1) then
    i := PosExChar(SepStr[1],Str) else
{$endif FPC}
    i := PosEx(SepStr,Str,StartPos);
  if i>0 then
    result := Copy(Str,StartPos,i-StartPos) else
    if StartPos=1 then
      result := Str else
      result := Copy(Str,StartPos,maxInt);
end;

procedure Split(const Str, SepStr: RawUTF8; var LeftStr, RightStr: RawUTF8; ToUpperCase: boolean);
var i: integer;
    tmp: RawUTF8; // may be called as Split(Str,SepStr,Str,RightStr)
begin
  {$ifdef FPC} // to use fast FPC SSE version
  if length(SepStr)=1 then
    i := PosExChar(SepStr[1],Str) else
  {$endif FPC}
    i := PosEx(SepStr,Str);
  if i=0 then begin
    LeftStr := Str;
    RightStr := '';
  end else begin
    tmp := copy(Str,1,i-1);
    RightStr := copy(Str,i+length(SepStr),maxInt);
    LeftStr := tmp;
  end;
  if ToUpperCase then begin
    UpperCaseSelf(LeftStr);
    UpperCaseSelf(RightStr);
  end;
end;

function Split(const Str, SepStr: RawUTF8; var LeftStr: RawUTF8; ToUpperCase: boolean): RawUTF8;
begin
  Split(Str,SepStr,LeftStr,result,ToUpperCase);
end;

function Split(const Str: RawUTF8; const SepStr: array of RawUTF8;
  const DestPtr: array of PRawUTF8): PtrInt;
var s,i,j: PtrInt;
begin
  j := 1;
  result := 0;
  s := 0;
  if high(SepStr)>=0 then
    while result<=high(DestPtr) do begin
      i := PosEx(SepStr[s],Str,j);
      if i=0 then begin
        if DestPtr[result]<>nil then
          DestPtr[result]^ := copy(Str,j,MaxInt);
        inc(result);
        break;
      end;
      if DestPtr[result]<>nil then
        DestPtr[result]^ := copy(Str,j,i-j);
      inc(result);
      if s<high(SepStr) then
        inc(s);
      j := i+1;
    end;
  for i := result to high(DestPtr) do
    if DestPtr[i]<>nil then
      DestPtr[i]^ := '';
end;

function StringReplaceAllProcess(const S, OldPattern, NewPattern: RawUTF8;
  found: integer): RawUTF8;
var oldlen,newlen,i,last,posCount,sharedlen: integer;
    pos: TIntegerDynArray;
    src,dst: PAnsiChar;
begin
  oldlen := length(OldPattern);
  newlen := length(NewPattern);
  SetLength(pos,64);
  pos[0] := found;
  posCount := 1;
  repeat
    found := PosEx(OldPattern,S,found+oldlen);
    if found=0 then
      break;
    AddInteger(pos,posCount,found);
  until false;
  FastSetString(result,nil,Length(S)+(newlen-oldlen)*posCount);
  last := 1;
  src := pointer(s);
  dst := pointer(result);
  for i := 0 to posCount-1 do begin
    sharedlen := pos[i]-last;
    MoveFast(src^,dst^,sharedlen);
    inc(src,sharedlen+oldlen);
    inc(dst,sharedlen);
    if newlen>0 then begin
      MoveSmall(pointer(NewPattern),dst,newlen);
      inc(dst,newlen);
    end;
    last := pos[i]+oldlen;
  end;
  MoveFast(src^,dst^,length(S)-last+1);
end;

function StringReplaceAll(const S, OldPattern, NewPattern: RawUTF8): RawUTF8;
var found: integer;
begin
  if (S='') or (OldPattern='') or (OldPattern=NewPattern) then
    result := S else begin
    found := PosEx(OldPattern,S,1); // our PosEx() is faster than Pos()
    if found=0 then
      result := S else
      result := StringReplaceAllProcess(S,OldPattern,NewPattern,found);
  end;
end;

function StringReplaceAll(const S: RawUTF8; const OldNewPatternPairs: array of RawUTF8): RawUTF8;
var n,i: integer;
begin
  result := S;
  n := high(OldNewPatternPairs);
  if (n>0) and (n and 1=1) then
    for i := 0 to n shr 1 do
      result := StringReplaceAll(result,OldNewPatternPairs[i*2],OldNewPatternPairs[i*2+1]);
end;

function StringReplaceTabs(const Source,TabText: RawUTF8): RawUTF8;

  procedure Process(S,D,T: PAnsiChar; TLen: integer);
  begin
    repeat
      if S^=#0 then
        break else
      if S^<>#9 then begin
        D^ := S^;
        inc(D);
        inc(S);
      end else begin
        if TLen>0 then begin
          MoveSmall(T,D,TLen);
          inc(D,TLen);
        end;
        inc(S);
      end;
    until false;
  end;

var L,i,n,ttl: PtrInt;
begin
  ttl := length(TabText);
  L := Length(Source);
  n := 0;
  if ttl<>0 then
    for i := 1 to L do
      if Source[i]=#9 then
        inc(n);
  if n=0 then begin
    result := Source;
    exit;
  end;
  FastSetString(result,nil,L+n*pred(ttl));
  Process(pointer(Source),pointer(result),pointer(TabText),ttl);
end;

function strspnpas(s,accept: pointer): integer;
var p: PCardinal;
    c: AnsiChar;
    d: cardinal;
begin // returns size of initial segment of s which are in accept
  result := 0;
  repeat
    c := PAnsiChar(s)[result];
    if c=#0 then
      break;
    p := accept;
    repeat // stop as soon as we find any character not from accept
      d := p^;
      inc(p);
      if AnsiChar(d)=c then
        break else
      if AnsiChar(d)=#0 then
        exit;
      d := d shr 8;
      if AnsiChar(d)=c then
        break else
      if AnsiChar(d)=#0 then
        exit;
      d := d shr 8;
      if AnsiChar(d)=c then
        break else
      if AnsiChar(d)=#0 then
        exit;
      d := d shr 8;
      if AnsiChar(d)=c then
        break else
      if AnsiChar(d)=#0 then
        exit;
    until false;
    inc(result);
  until false;
end;

function strcspnpas(s,reject: pointer): integer;
var p: PCardinal;
    c: AnsiChar;
    d: cardinal;
begin // returns size of initial segment of s which are not in reject
  result := 0;
  repeat
    c := PAnsiChar(s)[result];
    if c=#0 then
      break;
    p := reject;
    repeat // stop as soon as we find any character from reject
      d := p^;
      inc(p);
      if AnsiChar(d)=c then
        exit else
      if AnsiChar(d)=#0 then
        break;
      d := d shr 8;
      if AnsiChar(d)=c then
        exit else
      if AnsiChar(d)=#0 then
        break;
      d := d shr 8;
      if AnsiChar(d)=c then
        exit else
      if AnsiChar(d)=#0 then
        break;
      d := d shr 8;
      if AnsiChar(d)=c then
        exit else
      if AnsiChar(d)=#0 then
        break;
    until false;
    inc(result);
  until false;
end;

{$ifndef ABSOLUTEPASCAL}
{$ifdef CPUINTEL}
{$ifdef CPUX64} // inspired by Agner Fog's strspn64.asm
function strcspnsse42(s,reject: pointer): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx=s, rdx=reject (Linux: rdi,rsi)
{$endif FPC}
{$ifdef win64}
        push    rdi
        push    rsi
        mov     rdi, rcx
        mov     rsi, rdx
{$endif}mov     r8,  rsi
        xor     ecx, ecx
@1:     movups  xmm2, [rdi]
        movups  xmm1, [rsi]
        {$ifdef HASAESNI}
        pcmpistrm xmm1, xmm2, $30 //  find in set, invert valid bits, return bit mask in xmm0
        {$else}
        db $66,$0F,$3A,$62,$CA,$30
        {$endif}
        movd    eax, xmm0
        jns     @5
@2:     cmp     eax, 65535
        jne     @3
        add     rdi, 16 // first 16 chars matched, continue with next 16 chars
        add     rcx, 16
        jmp     @1
@3:     not     eax
        bsf     eax, eax
        add     rax, rcx
{$ifdef win64}
        pop     rsi
        pop     rdi
{$endif}ret
@4:     and     eax, edx // accumulate matches
@5:     add     rsi, 16  // the set is more than 16 bytes
        movups  xmm1, [rsi]
        {$ifdef HASAESNI}
        pcmpistrm xmm1, xmm2, $30
        {$else}
        db $66,$0F,$3A,$62,$CA,$30
        {$endif}
        movd    edx, xmm0
        jns     @4
        mov     rsi, r8    // restore set pointer
        and     eax, edx   // accumulate matches
        cmp     eax, 65535
        jne     @3
        add     rdi, 16
        add     rcx, 16
        jmp     @1
end;
function strspnsse42(s,accept: pointer): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx=s, rdx=accept (Linux: rdi,rsi)
{$endif FPC}
{$ifdef win64}
        push    rdi
        push    rsi
        mov     rdi, rcx
        mov     rsi, rdx
{$endif}mov     r8,  rsi
        xor     ecx, ecx
@1:     movups  xmm2, [rdi]
        movups  xmm1, [rsi]
        {$ifdef HASAESNI}
        pcmpistrm xmm1, xmm2, $00 //  find in set, return bit mask in xmm0
        {$else}
        db $66,$0F,$3A,$62,$CA,$00
        {$endif}
        movd    eax, xmm0
        jns     @5
@2:     cmp     eax, 65535
        jne     @3
        add     rdi, 16 // first 16 chars matched, continue with next 16 chars
        add     rcx, 16
        jmp     @1
@3:     not     eax
        bsf     eax, eax
        add     rax, rcx
{$ifdef win64}
        pop     rsi
        pop     rdi
{$endif}ret
@4:     or      eax, edx // accumulate matches
@5:     add     rsi, 16  // the set is more than 16 bytes
        movups  xmm1, [rsi]
        {$ifdef HASAESNI}
        pcmpistrm xmm1, xmm2, $00
        {$else}
        db $66,$0F,$3A,$62,$CA,$00
        {$endif}
        movd    edx, xmm0
        jns     @4
        mov     rsi, r8    // restore set pointer
        or      eax, edx   // accumulate matches
        cmp     eax, 65535
        jne     @3
        add     rdi, 16 // first 16 chars matched, continue with next 16 chars
        add     rcx, 16
        jmp     @1
end;
{$endif CPUX64}
{$ifdef CPUX86}
function strcspnsse42(s,reject: pointer): integer; {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=s, edx=reject
        push    edi
        push    esi
        push    ebx
        mov     edi, eax
        mov     esi, edx
        mov     ebx,  esi
        xor     ecx, ecx
@1:     {$ifdef HASAESNI}
        movups  xmm2, dqword [edi]
        movups  xmm1, dqword [esi]
        pcmpistrm xmm1, xmm2, $30 //  find in set, invert valid bits, return bit mask in xmm0
        movd    eax, xmm0
        {$else}
        db $F3,$0F,$6F,$17
        db $F3,$0F,$6F,$0E
        db $66,$0F,$3A,$62,$CA,$30
        db $66,$0F,$7E,$C0
        {$endif}
        jns     @5
@2:     cmp     eax, 65535
        jne     @3
        add     edi, 16 // first 16 chars matched, continue with next 16 chars
        add     ecx, 16
        jmp     @1
@3:     not     eax
        bsf     eax, eax
        add     eax, ecx
        pop     ebx
        pop     esi
        pop     edi
        ret
@4:     and     eax, edx  // accumulate matches
@5:     add     esi, 16   // the set is more than 16 bytes
        {$ifdef HASAESNI}
        movups  xmm1, [esi]
        pcmpistrm xmm1, xmm2, $30
        movd    edx, xmm0
        {$else}
        db $F3,$0F,$6F,$0E
        db $66,$0F,$3A,$62,$CA,$30
        db $66,$0F,$7E,$C2
        {$endif}
        jns     @4
        mov     esi, ebx   // restore set pointer
        and     eax, edx   // accumulate matches
        cmp     eax, 65535
        jne     @3
        add     edi, 16 // first 16 chars matched, continue with next 16 chars
        add     ecx, 16
        jmp     @1
end;
function strspnsse42(s,accept: pointer): integer; {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=s, edx=accept
        push    edi
        push    esi
        push    ebx
        mov     edi, eax
        mov     esi, edx
        mov     ebx,  esi
        xor     ecx, ecx
@1:     {$ifdef HASAESNI}
        movups  xmm2, dqword [edi]
        movups  xmm1, dqword [esi]
        pcmpistrm xmm1, xmm2, $00 //  find in set, return bit mask in xmm0
        movd    eax, xmm0
        {$else}
        db $F3,$0F,$6F,$17
        db $F3,$0F,$6F,$0E
        db $66,$0F,$3A,$62,$CA,$00
        db $66,$0F,$7E,$C0
        {$endif}
        jns     @5
@2:     cmp     eax, 65535
        jne     @3
        add     edi, 16 // first 16 chars matched, continue with next 16 chars
        add     ecx, 16
        jmp     @1
@3:     not     eax
        bsf     eax, eax
        add     eax, ecx
        pop     ebx
        pop     esi
        pop     edi
        ret
@4:     or      eax, edx // accumulate matches
@5:     add     esi, 16  // the set is more than 16 bytes
        {$ifdef HASAESNI}
        movups  xmm1, [esi]
        pcmpistrm xmm1, xmm2, $00
        movd    edx, xmm0
        {$else}
        db $F3,$0F,$6F,$0E
        db $66,$0F,$3A,$62,$CA,$00
        db $66,$0F,$7E,$C2
        {$endif}
        jns     @4
        mov     esi, ebx   // restore set pointer
        or      eax, edx   // accumulate matches
        cmp     eax, 65535
        jne     @3
        add     edi, 16 // first 16 chars matched, continue with next 16 chars
        add     ecx, 16
        jmp     @1
end;
{$ifndef DELPHI5OROLDER}
function StrLenSSE2(S: pointer): PtrInt; {$ifdef FPC} nostackframe; assembler; {$endif}
asm // from GPL strlen32.asm by Agner Fog - www.agner.org/optimize
        mov     ecx, eax            // copy pointer
        test    eax, eax
        jz      @null               // returns 0 if S=nil
        push    eax                 // save start address
        pxor    xmm0, xmm0          // set to zero
        and     ecx, 15             // lower 4 bits indicate misalignment
        and     eax, -16            // align pointer by 16
        // will never read outside a memory page boundary, so won't trigger GPF
        movaps  xmm1, [eax]         // read from nearest preceding boundary
        pcmpeqb xmm1, xmm0          // compare 16 bytes with zero
        pmovmskb edx, xmm1          // get one bit for each byte result
        shr     edx, cl             // shift out false bits
        shl     edx, cl             // shift back again
        bsf     edx, edx            // find first 1-bit
        jnz     @A200               // found
        // Main loop, search 16 bytes at a time
@A100:  add     eax, 10H            // increment pointer by 16
        movaps  xmm1, [eax]         // read 16 bytes aligned
        pcmpeqb xmm1, xmm0          // compare 16 bytes with zero
        pmovmskb edx, xmm1          // get one bit for each byte result
        bsf     edx, edx            // find first 1-bit
        // (moving the bsf out of the loop and using test here would be faster
        // for long strings on old processors, but we are assuming that most
        // strings are short, and newer processors have higher priority)
        jz      @A100               // loop if not found
@A200:  // Zero-byte found. Compute string length
        pop     ecx                 // restore start address
        sub     eax, ecx            // subtract start address
        add     eax, edx            // add byte index
@null:
end;
{$endif DELPHI5OROLDER}
{$endif CPUX86}
{$endif CPUINTEL}
{$endif ABSOLUTEPASCAL}

function IdemPropName(const P1,P2: shortstring): boolean;
begin
  if P1[0]=P2[0] then
    result := IdemPropNameUSameLen(@P1[1],@P2[1],ord(P2[0])) else
    result := false;
end;

function IdemPropName(const P1: shortstring; P2: PUTF8Char; P2Len: PtrInt): boolean;
begin
  if ord(P1[0])=P2Len then
    result := IdemPropNameUSameLen(@P1[1],P2,P2Len) else
    result := false;
end;

function IdemPropName(P1,P2: PUTF8Char; P1Len,P2Len: PtrInt): boolean;
begin
  if P1Len=P2Len then
    result := IdemPropNameUSameLen(P1,P2,P2Len) else
    result := false;
end;

function IdemPropNameU(const P1: RawUTF8; P2: PUTF8Char; P2Len: PtrInt): boolean;
begin
  if length(P1)=P2Len then
    result := IdemPropNameUSameLen(pointer(P1),P2,P2Len) else
    result := false;
end;

function ToText(os: TOperatingSystem): PShortString;
begin
  result := GetEnumName(TypeInfo(TOperatingSystem),ord(os));
end;

function ToText(const osv: TOperatingSystemVersion): ShortString;
begin
  if osv.os=osWindows then
     FormatShort('Windows %', [WINDOWS_NAME[osv.win]], result) else
     TrimLeftLowerCaseToShort(ToText(osv.os),result);
end;

function ToTextOS(osint32: integer): RawUTF8;
var osv: TOperatingSystemVersion absolute osint32;
    ost: ShortString;
begin
  ost := ToText(osv);
  if (osv.os>=osLinux) and (osv.utsrelease[2]<>0) then
    result := FormatUTF8('% %.%.%',[ost,osv.utsrelease[2],osv.utsrelease[1],osv.utsrelease[0]]) else
    result := ShortStringToUTF8(ost);
end;

{$ifdef MSWINDOWS}
procedure FileTimeToInt64(const FT: TFileTime; out I64: Int64);
begin
  {$ifdef CPU64}
  PInt64Rec(@I64)^.Lo := FT.dwLowDateTime;
  PInt64Rec(@I64)^.Hi := FT.dwHighDateTime;
  {$else}
  I64 := PInt64(@FT)^;
  {$endif}
end;

const
  // lpMinimumApplicationAddress retrieved from Windows is very low $10000
  // - i.e. maximum number of ID per table would be 65536 in TSQLRecord.GetID
  // - so we'll force an higher and almost "safe" value as 1,048,576
  // (real value from runnning Windows is greater than $400000)
  MIN_PTR_VALUE = $100000;

  // see http://msdn.microsoft.com/en-us/library/ms724833(v=vs.85).aspx
  VER_NT_WORKSTATION = 1;
  VER_NT_DOMAIN_CONTROLLER = 2;
  VER_NT_SERVER = 3;
  SM_SERVERR2 = 89;
  PROCESSOR_ARCHITECTURE_AMD64 = 9;

{$ifndef UNICODE}
function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall;
  external kernel32 name 'GetVersionExA';
{$endif}

threadvar // mandatory: GetTickCount seems per-thread on XP :(
  LastTickXP: TQWordRec;

function GetTickCount64ForXP: Int64; stdcall;
var t32: cardinal;
    p: PQWordRec;
begin // warning: GetSystemTimeAsFileTime() is fast, but not monotonic!
  t32 := Windows.GetTickCount;
  p := @LastTickXP;
  if t32<p^.L then
    inc(p^.H); // wrap-up overflow after 49 days
  p^.L := t32;
  result := p^.V;
end; // warning: FPC's GetTickCount64 doesn't handle 49 days wrap :(

{$ifdef FPC} // oddly not defined in fpc\rtl\win
function SwitchToThread: BOOL; stdcall; external kernel32 name 'SwitchToThread';
{$endif}

procedure SleepHiRes(ms: cardinal);
begin
  if (ms<>0) or not SwitchToThread then
    Windows.Sleep(ms);
end;

{ TWinRegistry }

function TWinRegistry.ReadOpen(root: HKEY; const keyname: RawUTF8;
  closefirst: boolean): boolean;
var tmp: TSynTempBuffer;
begin
  if closefirst then
    Close;
  tmp.Init(length(keyname)*2);
  UTF8ToWideChar(tmp.buf,pointer(keyname));
  key := 0;
  result := RegOpenKeyExW(root,tmp.buf,0,KEY_READ,key)=0;
  tmp.Done;
end;

procedure TWinRegistry.Close;
begin
  if key<>0 then
    RegCloseKey(key);
end;

function TWinRegistry.ReadString(const entry: SynUnicode; andtrim: boolean): RawUTF8;
var rtype, rsize: DWORD;
    tmp: TSynTempBuffer;
begin
  result := '';
  if RegQueryValueExW(key,pointer(entry),nil,@rtype,nil,@rsize)<>0 then
    exit;
  tmp.Init(rsize);
  if RegQueryValueExW(key,pointer(entry),nil,nil,tmp.buf,@rsize)=0 then begin
    case rtype of
      REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ:
        RawUnicodeToUtf8(tmp.buf,StrLenW(tmp.buf),result);
    end;
    if andtrim then
      result := Trim(result);
  end;
  tmp.Done;
end;

function TWinRegistry.ReadData(const entry: SynUnicode): RawByteString;
var rtype, rsize: DWORD;
begin
  result := '';
  if RegQueryValueExW(key,pointer(entry),nil,@rtype,nil,@rsize)<>0 then
    exit;
  SetLength(result,rsize);
  if RegQueryValueExW(key,pointer(entry),nil,nil,pointer(result),@rsize)<>0 then
    result := '';
end;

function TWinRegistry.ReadDword(const entry: SynUnicode): cardinal;
var rsize: DWORD;
begin
  rsize := 4;
  if RegQueryValueExW(key,pointer(entry),nil,nil,@result,@rsize)<>0 then
    result := 0;
end;

function TWinRegistry.ReadQword(const entry: SynUnicode): QWord;
var rsize: DWORD;
begin
  rsize := 8;
  if RegQueryValueExW(key,pointer(entry),nil,nil,@result,@rsize)<>0 then
    result := 0;
end;

function TWinRegistry.ReadEnumEntries: TRawUTF8DynArray;
var count,maxlen,i,len: DWORD;
    tmp: TSynTempBuffer;
begin
  result := nil;
  if (RegQueryInfoKeyW(key,nil,nil,nil,@count,@maxlen,nil,nil,nil,nil,nil,nil)<>0) or
     (count=0) then
    exit;
  SetLength(result,count);
  inc(maxlen);
  tmp.Init(maxlen*3);
  for i := 0 to count-1 do begin
    len := maxlen;
    if RegEnumKeyExW(key,i,tmp.buf,len,nil,nil,nil,nil)=0 then
      RawUnicodeToUtf8(tmp.buf,len,result[i]);
  end;
  tmp.Done;
end;


procedure RetrieveSystemInfo;
var
  IsWow64Process: function(Handle: THandle; var Res: BOOL): BOOL; stdcall;
  GetNativeSystemInfo: procedure(var SystemInfo: TSystemInfo); stdcall;
  wine_get_version: function: PAnsiChar; stdcall;
  Res: BOOL;
  h: THandle;
  P: pointer;
  Vers: TWindowsVersion;
  cpu, manuf, prod, prodver: RawUTF8;
  reg: TWinRegistry;
begin
  h := GetModuleHandle(kernel32);
  GetTickCount64 := GetProcAddress(h,'GetTickCount64');
  if not Assigned(GetTickCount64) then // WinXP+
    GetTickCount64 := @GetTickCount64ForXP;
  GetSystemTimePreciseAsFileTime := GetProcAddress(h,'GetSystemTimePreciseAsFileTime');
  if not Assigned(GetSystemTimePreciseAsFileTime) then // Win8+
    GetSystemTimePreciseAsFileTime := @GetSystemTimeAsFileTime;
  IsWow64Process := GetProcAddress(h,'IsWow64Process');
  Res := false;
  IsWow64 := Assigned(IsWow64Process) and
    IsWow64Process(GetCurrentProcess,Res) and Res;
  FillcharFast(SystemInfo,SizeOf(SystemInfo),0);
  if IsWow64 then // see http://msdn.microsoft.com/en-us/library/ms724381(v=VS.85).aspx
    GetNativeSystemInfo := GetProcAddress(h,'GetNativeSystemInfo') else
    @GetNativeSystemInfo := nil;
  if Assigned(GetNativeSystemInfo) then
    GetNativeSystemInfo(SystemInfo) else
    Windows.GetSystemInfo(SystemInfo);
  GetMem(P,10); // ensure that using MIN_PTR_VALUE won't break anything
  if (PtrUInt(P)>MIN_PTR_VALUE) and
     (PtrUInt(SystemInfo.lpMinimumApplicationAddress)<=MIN_PTR_VALUE) then
     PtrUInt(SystemInfo.lpMinimumApplicationAddress) := MIN_PTR_VALUE;
  Freemem(P);
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  GetVersionEx(OSVersionInfo);
  Vers := wUnknown;
  with OSVersionInfo do
  // see https://msdn.microsoft.com/en-us/library/windows/desktop/ms724833
  case dwMajorVersion of
    5: case dwMinorVersion of
       0: Vers := w2000;
       1: Vers := wXP;
       2: if (wProductType=VER_NT_WORKSTATION) and
             (SystemInfo.wProcessorArchitecture=PROCESSOR_ARCHITECTURE_AMD64) then
            Vers := wXP_64 else
          if GetSystemMetrics(SM_SERVERR2)=0 then
            Vers := wServer2003 else
            Vers := wServer2003_R2;
      end;
    6: case dwMinorVersion of
       0: Vers := wVista;
       1: Vers := wSeven;
       2: Vers := wEight;
       3: Vers := wEightOne;
       4: Vers := wTen;
       end;
    10: Vers := wTen;
  end;
  if Vers>=wVista then begin
    if OSVersionInfo.wProductType<>VER_NT_WORKSTATION then begin // Server edition
      inc(Vers,2); // e.g. wEight -> wServer2012
      if (Vers=wServer2016) and (OSVersionInfo.dwBuildNumber>=17763) then
        Vers := wServer2019_64; // https://stackoverflow.com/q/53393150
    end else if (Vers=wTen) and (OSVersionInfo.dwBuildNumber>=22000) then
      Vers := wEleven; // waiting for an official mean of Windows 11 identification
    if (SystemInfo.wProcessorArchitecture=PROCESSOR_ARCHITECTURE_AMD64) and
       (Vers<wServer2019_64) then
      inc(Vers);   // e.g. wEight -> wEight64
  end;
  OSVersion := Vers;
  with OSVersionInfo do
    if wServicePackMajor=0 then
      FormatUTF8('Windows % (%.%.%)',[WINDOWS_NAME[Vers],
        dwMajorVersion,dwMinorVersion,dwBuildNumber],OSVersionText) else
      FormatUTF8('Windows % SP% (%.%.%)',[WINDOWS_NAME[Vers],wServicePackMajor,
        dwMajorVersion,dwMinorVersion,dwBuildNumber],OSVersionText);
  OSVersionInt32 := (integer(Vers) shl 8)+ord(osWindows);
  if reg.ReadOpen(HKEY_LOCAL_MACHINE,'Hardware\Description\System\CentralProcessor\0') then begin
    cpu := reg.ReadString('ProcessorNameString');
    if cpu='' then
      cpu := reg.ReadString('Identifier');
  end;
  if reg.ReadOpen(HKEY_LOCAL_MACHINE,'Hardware\Description\System\BIOS',true) then begin
    manuf := reg.ReadString('SystemManufacturer');
    if manuf<>'' then
      manuf := manuf+' ';
    prod := reg.ReadString('SystemProductName');
    prodver := reg.ReadString('SystemVersion');
    if prodver='' then
      prodver := reg.ReadString('BIOSVersion');
  end;
  if (prod='') or (prodver='') then begin
    if reg.ReadOpen(HKEY_LOCAL_MACHINE,'Hardware\Description\System',true) then begin
      if prod='' then
        prod := reg.ReadString('SystemBiosVersion');
      if prodver='' then
        prodver := reg.ReadString('VideoBiosVersion');
    end;
  end;
  reg.Close;
  if prodver<>'' then
    FormatUTF8('%% %',[manuf,prod,prodver],BiosInfoText) else
    FormatUTF8('%%',[manuf,prod],BiosInfoText);
  if cpu='' then
    cpu := StringToUTF8(GetEnvironmentVariable('PROCESSOR_IDENTIFIER'));
  cpu := Trim(cpu);
  FormatUTF8('% x % ('+CPU_ARCH_TEXT+')',[SystemInfo.dwNumberOfProcessors,cpu],CpuInfoText);
  h := LoadLibrary('ntdll.dll');
  if h>0 then begin
    wine_get_version := GetProcAddress(h,'wine_get_version');
    if Assigned(wine_get_version) then
      OSVersionInfoEx := trim('Wine '+trim(wine_get_version));
    FreeLibrary(h);
  end;
  if OSVersionInfoEx<>'' then
    OSVersionText := FormatUTF8('% - %', [OSVersionText,OSVersionInfoEx]);
end;

{$else}

{$ifndef BSD}
procedure SetLinuxDistrib(const release: RawUTF8);
var
  distrib: TOperatingSystem;
  dist: RawUTF8;
begin
  for distrib := osArch to high(distrib) do begin
    dist := UpperCase(TrimLeftLowerCaseShort(ToText(distrib)));
    if PosI(pointer(dist),release)>0 then begin
      OS_KIND := distrib;
      break;
    end;
  end;
end;
{$endif BSD}

procedure RetrieveSystemInfo;
var modname, beg: PUTF8Char;
    {$ifdef BSD}
    temp: shortstring;
    {$else}
    cpuinfo: PUTF8Char;
    proccpuinfo,prod,prodver,release,dist: RawUTF8;
    SR: TSearchRec;
    {$endif BSD}
begin
  modname := nil;
  {$ifdef BSD}
  fpuname(SystemInfo.uts);
  SystemInfo.dwNumberOfProcessors := fpsysctlhwint(HW_NCPU);
  Utf8ToRawUTF8(fpsysctlhwstr(HW_MACHINE,temp),BiosInfoText);
  modname := fpsysctlhwstr(HW_MODEL,temp);
  with SystemInfo.uts do
    FormatUTF8('%-% %',[sysname,release,version],OSVersionText);
  {$else}
  {$ifdef KYLIX3}
  uname(SystemInfo.uts);
  {$else}
  fpuname(SystemInfo.uts);
  {$endif KYLIX3}
  prod := Trim(StringFromFile('/sys/class/dmi/id/product_name',true));
  if prod<>'' then begin
    prodver := Trim(StringFromFile('/sys/class/dmi/id/product_version',true));
    if prodver<>'' then
      FormatUTF8('% %',[prod,prodver],BiosInfoText) else
      BiosInfoText := prod;
  end;
  SystemInfo.dwNumberOfProcessors := 0;
  proccpuinfo := StringFromFile('/proc/cpuinfo',true);
  cpuinfo := pointer(proccpuinfo);
  while cpuinfo<>nil do begin
    beg := cpuinfo;
    cpuinfo := GotoNextLine(cpuinfo);
    if IdemPChar(beg,'PROCESSOR') then
      if beg^='P' then
        modname := beg else // Processor : ARMv7
        inc(SystemInfo.dwNumberOfProcessors) else // processor : 0
    if IdemPChar(beg,'MODEL NAME') then
      modname := beg;
  end;
  modname := PosChar(modname,':');
  if modname<>nil then
    modname := GotoNextNotSpace(modname+1);
  FindNameValue(StringFromFile('/etc/os-release'),'PRETTY_NAME=',release);
  if (release<>'') and (release[1]='"') then
    release := copy(release,2,length(release)-2);
  release := trim(release);
  if release=''  then
    if FindNameValue(StringFromFile('/etc/lsb-release'),'DISTRIB_DESCRIPTION=',release) and
       (release<>'') and (release[1]='"') then
      release := copy(release,2,length(release)-2);
  if (release='') and (FindFirst('/etc/*-release',faAnyFile,SR)=0) then begin
    release := StringToUTF8(SR.Name); // 'redhat-release' 'SuSE-release'
    if IdemPChar(pointer(release),'LSB-') and (FindNext(SR)=0) then
       release := StringToUTF8(SR.Name);
    release := split(release,'-');
    dist := split(trim(StringFromFile('/etc/'+SR.Name)),#10);
    if (dist<>'') and (PosExChar('=',dist)=0) and (PosExChar(' ',dist)>0) then
      SetLinuxDistrib(dist) // e.g. 'Red Hat Enterprise Linux Server release 6.7 (Santiago)'
    else
      dist := '';
    FindClose(SR);
  end;
  if (release<>'') and (OS_KIND=osLinux) then begin
    SetLinuxDistrib(release);
    if (OS_KIND=osLinux) and (dist<>'') then begin
      SetLinuxDistrib(dist);
      release := dist;
    end;
    if (OS_KIND=osLinux) and ((PosEx('RH',release)>0) or (PosEx('Red Hat',release)>0)) then
      OS_KIND := osRedHat;
  end;
  SystemInfo.release := release;
  {$endif BSD}
  OSVersionInt32 := {$ifdef FPC}integer(KernelRevision shl 8)+{$endif}ord(OS_KIND);
  with SystemInfo.uts do
    FormatUTF8('% %',[sysname,release],OSVersionText);
  if SystemInfo.release<>'' then
    OSVersionText := FormatUTF8('% - %',[SystemInfo.release,OSVersionText]);
  {$ifdef Android}
  OSVersionText := 'Android ('+OSVersionText+')';
  {$endif}
  if (SystemInfo.dwNumberOfProcessors>0) and (modname<>nil) then begin
    beg := modname;
    while not (ord(modname^) in [0,10,13]) do begin
      if modname^<' ' then
        modname^ := ' ';
      inc(modname);
    end;
    modname^ := #0;
    FormatUTF8('% x % ('+CPU_ARCH_TEXT+')',[SystemInfo.dwNumberOfProcessors,beg],CpuInfoText);
  end;
  if CpuInfoText='' then
     CpuInfoText := CPU_ARCH_TEXT;
end;

{$ifdef KYLIX3}
function FileOpen(const FileName: string; Mode: LongWord): Integer;
const
  SHAREMODE: array[0..fmShareDenyNone shr 4] of Byte = (
    0,        // No share mode specified
    F_WRLCK,  // fmShareExclusive
    F_RDLCK,  // fmShareDenyWrite
    0);       // fmShareDenyNone
var FileHandle, Tvar: Integer;
    LockVar: TFlock;
    smode: Byte;
begin
  result := -1;
  if FileExists(FileName) and
     ((Mode and 3)<=fmOpenReadWrite) and ((Mode and $F0)<=fmShareDenyNone) then begin
    FileHandle := open64(pointer(FileName),(Mode and 3),FileAccessRights);
    if FileHandle=-1 then
      exit;
    smode := Mode and $F0 shr 4;
    if SHAREMODE[smode]<>0 then begin
      with LockVar do begin
        l_whence := SEEK_SET;
        l_start := 0;
        l_len := 0;
        l_type := SHAREMODE[smode];
      end;
      Tvar := fcntl(FileHandle,F_SETLK,LockVar);
      if Tvar=-1 then begin
        __close(FileHandle);
        exit;
      end;
    end;
    result := FileHandle;
  end;
end;

function GetTickCount64: Int64;
begin
  result := SynKylix.GetTickCount64;
end;
{$endif KYLIX3}

{$ifdef FPC}
function GetTickCount64: Int64;
begin
  result := SynFPCLinux.GetTickCount64;
end;
{$endif FPC}

{$endif MSWINDOWS}

function FileOpenSequentialRead(const FileName: string): Integer;
begin
  {$ifdef MSWINDOWS}
  if OSVersion>=wVista then // don't use the flag on XP
    result := CreateFile(pointer(FileName),GENERIC_READ,
      FILE_SHARE_READ or FILE_SHARE_WRITE,nil, // same as fmShareDenyNone
      OPEN_EXISTING,FILE_FLAG_SEQUENTIAL_SCAN,0) else
    result := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  {$else}
    // SysUtils.FileOpen = fpOpen + fpFlock - assuming FileName is UTF-8
    result := fpOpen(pointer(FileName), O_RDONLY);
  {$endif MSWINDOWS}
end;

type
{$ifdef DELPHI5ORFPC} // TFileStream doesn't have per-handle constructor like Delphi
  TFileStreamFromHandle = class(THandleStream)
  public
    destructor Destroy; override;
  end;

destructor TFileStreamFromHandle.Destroy;
begin
  FileClose(Handle); // otherwise file is still opened
end;
{$else}
  TFileStreamFromHandle = TFileStream;
{$endif DELPHI5ORFPC}

function FileStreamSequentialRead(const FileName: string): THandleStream;
begin
  result := TFileStreamFromHandle.Create(FileOpenSequentialRead(FileName));
end;

function Elapsed(var PreviousTix: Int64; Interval: Integer): Boolean;
var now: Int64;
begin
  if Interval<=0 then
    result := false else begin
    now := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64;
    if now-PreviousTix>Interval then begin
      PreviousTix := now;
      result := true;
    end else
      result := false;
  end;
end;

function RefCntDecFree(var refcnt: TRefCnt): boolean;
{$ifdef CPUINTEL} {$ifdef FPC}nostackframe; assembler; {$endif}
asm {$ifdef CPU64DELPHI} .noframe {$endif}
        {$ifdef FPC_64}
        lock dec qword ptr[refcnt]  // TRefCnt=SizeInt=PtrInt=Int64 for FPC_64
        {$else}
        lock dec dword ptr[refcnt]  // TRefCnt=longint on Delphi and FPC_32
        {$endif}
        setbe   al
end; // we don't check for ismultithread global since lock is cheap on new CPUs
{$else}
begin // fallback to RTL asm e.g. for ARM
  {$ifdef FPC_64}
  result := InterLockedDecrement64(refcnt)<=0;
  {$else}
  result := InterLockedDecrement(refcnt)<=0;
  {$endif FPC_64}
end;
{$endif CPUINTEL}

{$ifndef FPC} // FPC has its built-in InterlockedIncrement/InterlockedDecrement
{$ifdef PUREPASCAL}
function InterlockedIncrement(var I: Integer): Integer;
begin
  {$ifdef MSWINDOWS} // AtomicIncrement() may not be available e.g. on Delphi XE2
  result := Windows.InterlockedIncrement(I);
  {$else}
  result := AtomicIncrement(I);
  {$endif}
end;

function InterlockedDecrement(var I: Integer): Integer;
begin
  {$ifdef MSWINDOWS} // AtomicDecrement() may not be available e.g. on Delphi XE2
  result := Windows.InterlockedDecrement(I);
  {$else}
  result := AtomicDecrement(I);
  {$endif}
end;
{$else}
function InterlockedIncrement(var I: Integer): Integer;
asm
        mov     edx, 1
        xchg    eax, edx
   lock xadd    [edx], eax
        inc     eax
end;
function InterlockedDecrement(var I: Integer): Integer;
asm
        mov     edx, -1
        xchg    eax, edx
   lock xadd    [edx], eax
        dec     eax
end;
{$endif}
{$endif FPC}

function GetHighUTF8UCS4(var U: PUTF8Char): PtrUInt;
var extra,i: PtrInt;
    c: PtrUInt;
begin
  result := 0;
  c := byte(U^); // here U^>=#80
  inc(U);
  extra := UTF8_EXTRABYTES[c];
  if extra=0 then exit else // invalid leading byte
  for i := 1 to extra do begin
    if byte(U^) and $c0<>$80 then
      exit; // invalid input content
    c := c shl 6+byte(U^);
    inc(U);
  end;
  with UTF8_EXTRA[extra] do begin
    dec(c,offset);
    if c<minimum then
      exit; // invalid input content
  end;
  result := c;
end;

function GetHighUTF8UCS4Inlined(var U: PUTF8Char): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}
var extra,i: PtrInt;
    c: PtrUInt;
begin
  result := 0;
  c := byte(U^); // here U^>=#80
  inc(U);
  extra := UTF8_EXTRABYTES[c];
  if extra=0 then exit else // invalid leading byte
  for i := 1 to extra do begin
    if byte(U^) and $c0<>$80 then
      exit; // invalid input content
    c := c shl 6+byte(U^);
    inc(U);
  end;
  with UTF8_EXTRA[extra] do begin
    dec(c,offset);
    if c<minimum then
      exit; // invalid input content
  end;
  result := c;
end;

function GetNextUTF8Upper(var U: PUTF8Char): PtrUInt;
begin
  result := ord(U^);
  if result=0 then
    exit;
  if result<=127 then begin
    inc(U);
    {$ifdef USENORMTOUPPER}
    result := NormToUpperByte[result];
    {$else}
    result := NormToUpperAnsi7Byte[result];
    {$endif}
    exit;
  end;
  result := GetHighUTF8UCS4(U);
  if (result<=255) and (WinAnsiConvert.AnsiToWide[result]<=255) then
    {$ifdef USENORMTOUPPER}
    result := NormToUpperByte[result];
    {$else}
    result := NormToUpperAnsi7Byte[result];
    {$endif}
end;

function FindNextUTF8WordBegin(U: PUTF8Char): PUTF8Char;
var c: cardinal;
    V: PUTF8Char;
begin
  result := nil;
  repeat
    c := GetNextUTF8Upper(U);
    if c=0 then
      exit;
  until (c>=127) or not(tcWord in TEXT_BYTES[c]);
  repeat
    V := U;
    c := GetNextUTF8Upper(U);
    if c=0 then
      exit;
  until (c<127) and (tcWord in TEXT_BYTES[c]);
  result := V;
end;

{$ifdef USENORMTOUPPER}

function AnsiICompW(u1, u2: PWideChar): PtrInt; {$ifdef HASINLINE}inline;{$endif}
var C1,C2: PtrInt;
    table: {$ifdef CPUX86NOTPIC}TNormTableByte absolute NormToUpperAnsi7Byte{$else}PNormTableByte{$endif};
begin
  if u1<>u2 then
    if u1<>nil then
      if u2<>nil then begin
        {$ifndef CPUX86NOTPIC}table := @NormToUpperAnsi7Byte;{$endif}
        repeat
          C1 := PtrInt(u1^);
          C2 := PtrInt(u2^);
          result := C1-C2;
          if result<>0 then begin
            if (C1>255) or (C2>255) then exit;
            result := table[C1]-table[C2];
            if result<>0 then exit;
          end;
          if (C1=0) or (C2=0) then break;
          inc(u1);
          inc(u2);
        until false;
    end else
        result := 1 else  // u2=''
      result := -1 else // u1=''
    result := 0;      // u1=u2
end;


{$ifdef PUREPASCAL}
function AnsiIComp(Str1, Str2: pointer): PtrInt;
var C1,C2: byte; // integer/PtrInt are actually slower on FPC
    lookupper: PByteArray; // better x86-64 / PIC asm generation
begin
  result := PtrInt(PtrUInt(Str2))-PtrInt(PtrUInt(Str1));
  if result<>0 then
    if Str1<>nil then
      if Str2<>nil then begin
        lookupper := @NormToUpperByte;
        repeat
          C1 := lookupper[PByteArray(Str1)[0]];
          C2 := lookupper[PByteArray(Str1)[result]];
          inc(PByte(Str1));
        until (C1=0) or (C1<>C2);
        result := C1-C2;
      end else
      result := 1 else  // Str2=''
    result := -1;     // Str1=''
end;
{$else}
function AnsiIComp(Str1, Str2: pointer): PtrInt; {$ifdef FPC} nostackframe; assembler; {$endif}
asm // fast 8 bits WinAnsi comparison using the NormToUpper[] array
        cmp     eax, edx
        je      @2
        test    eax, edx // is either of the strings perhaps nil?
        jz      @3
@0:     push    ebx // compare the first character (faster quicksort)
        movzx   ebx, byte ptr[eax] // ebx=S1[1]
        movzx   ecx, byte ptr[edx] // ecx=S2[1]
        test    ebx, ebx
        jz      @z
        cmp     ebx, ecx
        je      @s
        mov     bl, byte ptr[NormToUpper + ebx]
        mov     cl, byte ptr[NormToUpper + ecx]
        cmp     ebx, ecx
        je      @s
        mov     eax, ebx
        pop     ebx
        sub     eax, ecx // return S1[1]-S2[1]
        ret
@2b:    pop     ebx
@2:     xor     eax, eax
        ret
@3:     test    eax, eax // S1=''
        jz      @4
        test    edx, edx // S2='' ?
        jnz     @0
        mov     eax, 1 // return 1 (S1>S2)
        ret
@s:     inc     eax
        inc     edx
        mov     bl, [eax] // ebx=S1[i]
        mov     cl, [edx] // ecx=S2[i]
        test    ebx, ebx
        je      @z        // end of S1
        cmp     ebx, ecx
        je      @s
        mov     bl, byte ptr[NormToUpper + ebx]
        mov     cl, byte ptr[NormToUpper + ecx]
        cmp     ebx, ecx
        je      @s
        mov     eax, ebx
        pop     ebx
        sub     eax, ecx // return S1[i]-S2[i]
        ret
@z:     cmp     ebx, ecx // S1=S2?
        jz      @2b
        pop     ebx
@4:     mov     eax, -1 // return -1 (S1<S2)
end;
{$endif PUREPASCAL}

function ConvertCaseUTF8(P: PUTF8Char; const Table: TNormTableByte): PtrInt;
var D,S: PUTF8Char;
    c: PtrUInt;
    extra,i: PtrInt;
begin
  result := 0;
  if P=nil then
    exit;
  D := P;
  repeat
    c := byte(P[0]);
    inc(P);
    if c=0 then
      break;
    if c<=127 then begin
      D[result] := AnsiChar(Table[c]);
      inc(result);
    end else begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then exit else // invalid leading byte
      for i := 0 to extra-1 do
        if byte(P[i]) and $c0<>$80 then
          exit else // invalid input content
          c := c shl 6+byte(P[i]);
      with UTF8_EXTRA[extra] do begin
        dec(c,offset);
        if c<minimum then
          exit; // invalid input content
      end;
      if (c<=255) and (Table[c]<=127) then begin
        D[result] := AnsiChar(Table[c]);
        inc(result);
        inc(P,extra);
        continue;
      end;
      S := P-1;
      inc(P,extra);
      inc(extra);
      MoveSmall(S,D+result,extra);
      inc(result,extra);
    end;
  until false;
end;

function UpperCaseU(const S: RawUTF8): RawUTF8;
var LS,LD: integer;
begin
  LS := length(S);
  FastSetString(result,pointer(S),LS);
  LD := ConvertCaseUTF8(pointer(result),NormToUpperByte);
  if LS<>LD then
    SetLength(result,LD);
end;

function LowerCaseU(const S: RawUTF8): RawUTF8;
var LS,LD: integer;
begin
  LS := length(S);
  FastSetString(result,pointer(S),LS);
  LD := ConvertCaseUTF8(pointer(result),NormToLowerByte);
  if LS<>LD then
    SetLength(result,LD);
end;

function UTF8IComp(u1, u2: PUTF8Char): PtrInt;
var c2: PtrInt;
    table: {$ifdef CPUX86NOTPIC}TNormTableByte absolute NormToUpperByte{$else}PNormTableByte{$endif};
begin // fast UTF-8 comparison using the NormToUpper[] array for all 8 bits values
  {$ifndef CPUX86NOTPIC}table := @NormToUpperByte;{$endif}
  if u1<>u2 then
  if u1<>nil then
  if u2<>nil then
  repeat
    result := ord(u1^);
    c2 := ord(u2^);
    if result<=127 then
      if result<>0 then begin
        inc(u1);
        result := table[result];
        if c2<=127 then begin
          if c2=0 then exit; // u1>u2 -> return u1^
          inc(u2);
          dec(result,table[c2]);
          if result<>0 then exit;
          continue;
        end;
      end else begin // u1^=#0 -> end of u1 reached
        if c2<>0 then    // end of u2 reached -> u1=u2 -> return 0
          result := -1;    // u1<u2
        exit;
      end else begin
        result := GetHighUTF8UCS4Inlined(u1);
        if result and $ffffff00=0 then
          result := table[result]; // 8 bits to upper, 32-bit as is
      end;
    if c2<=127 then begin
      if c2=0 then exit; // u1>u2 -> return u1^
      inc(u2);
      dec(result,table[c2]);
      if result<>0 then exit;
      continue;
    end else begin
      c2 := GetHighUTF8UCS4Inlined(u2);
      if c2<=255 then
        dec(result,table[c2]) else // 8 bits to upper
        dec(result,c2); // 32-bit widechar returns diff
      if result<>0 then exit;
    end;
  until false else
  result := 1 else  // u2=''
  result := -1 else // u1=''
  result := 0;      // u1=u2
end;

function UTF8ILComp(u1, u2: PUTF8Char; L1,L2: cardinal): PtrInt;
var c2: PtrInt;
    extra,i: integer;
    table: {$ifdef CPUX86NOTPIC}TNormTableByte absolute NormToUpperByte{$else}PNormTableByte{$endif};
label neg,pos;
begin // fast UTF-8 comparison using the NormToUpper[] array for all 8 bits values
  {$ifndef CPUX86NOTPIC}table := @NormToUpperByte;{$endif}
  if u1<>u2 then
  if (u1<>nil) and (L1<>0) then
  if (u2<>nil) and (L2<>0) then
  repeat
    result := ord(u1^);
    c2 := ord(u2^);
    inc(u1);
    dec(L1);
    if result<=127 then begin
      result := table[result];
      if c2<=127 then begin
        dec(result,table[c2]);
        dec(L2);
        inc(u2);
        if result<>0 then
           exit else
        if L1<>0 then
          if L2<>0 then
            continue else // L1>0 and L2>0 -> next char
            goto pos else // L1>0 and L2=0 -> u1>u2
          if L2<>0 then
            goto neg else // L1=0 and L2>0 -> u1<u2
            exit;         // L1=0 and L2=0 -> u1=u2
      end;
    end else begin
      extra := UTF8_EXTRABYTES[result];
      if extra=0 then goto neg; // invalid leading byte
      dec(L1,extra);
      if Integer(L1)<0 then goto neg;
      for i := 0 to extra-1 do
        result := result shl 6+PByteArray(u1)[i];
      dec(result,UTF8_EXTRA[extra].offset);
      inc(u1,extra);
      if result and $ffffff00=0 then
        result := table[result]; // 8 bits to upper, 32-bit as is
    end;
    // here result=NormToUpper[u1^]
    inc(u2);
    dec(L2);
    if c2<=127 then begin
      dec(result,table[c2]);
      if result<>0 then exit;
    end else begin
      extra := UTF8_EXTRABYTES[c2];
      if extra=0 then goto pos;
      dec(L2,extra);
      if integer(L2)<0 then goto pos;
      for i := 0 to extra-1 do
        c2 := c2 shl 6+PByteArray(u2)[i];
      dec(c2,UTF8_EXTRA[extra].offset);
      inc(u2,extra);
      if c2 and $ffffff00=0 then
        dec(result,table[c2]) else // 8 bits to upper
        dec(result,c2); // returns 32-bit diff
      if result<>0 then exit;
    end;
    // here we have result=NormToUpper[u2^]-NormToUpper[u1^]=0
    if L1=0 then // test if we reached end of u1 or end of u2
      if L2=0 then exit     // u1=u2
         else goto neg else // u1<u2
    if L2=0 then goto pos;  // u1>u2
  until false else
pos: result := 1 else  // u2='' or u1>u2
neg: result := -1 else // u1='' or u1<u2
     result := 0;      // u1=u2
end;

function SameTextU(const S1, S2: RawUTF8): Boolean;
// checking UTF-8 lengths is not accurate: surrogates may be confusing
begin
  result := UTF8IComp(pointer(S1),pointer(S2))=0;
end;

{$else} // no NormToUpper[]

function AnsiIComp(Str1, Str2: PWinAnsiChar): integer;
{$ifdef PUREPASCAL}
begin
  result := StrIComp(Str1,Str2); // fast enough, especially since inlined
end;
{$else}
asm
  jmp StrIComp // LVCL without NormToUpper[]: use default SysUtils implementation
end;
{$endif}
{$endif}

function FindAnsi(A, UpperValue: PAnsiChar): boolean;
var ValueStart: PAnsiChar;
{$ifndef USENORMTOUPPER}
    ch: AnsiChar;
{$endif}
begin
  result := false;
  if (A=nil) or (UpperValue=nil) then exit;
  ValueStart := UpperValue;
  repeat
    // test beginning of word
    repeat
      if A^=#0 then exit else
{$ifdef USENORMTOUPPER}
      if tcWord in TEXT_CHARS[NormToUpper[A^]] then break else inc(A);  {$else}
      if tcWord in TEXT_CHARS[A^] then break else inc(A);
{$endif}
    until false;
    // check if this word is the UpperValue
    UpperValue := ValueStart;
    repeat
{$ifdef USENORMTOUPPER}
      if NormToUpper[A^]<>UpperValue^ then break;  {$else}
      if NormToUpperAnsi7[A^]<>UpperValue^ then break;
{$endif}
      inc(UpperValue);
      if UpperValue^=#0 then begin
        result := true; // UpperValue found!
        exit;
      end;
      inc(A);
      if A^=#0 then exit;
    until false;
    // find beginning of next word
    repeat
      if A^=#0 then exit else
{$ifdef USENORMTOUPPER}
        if not (tcWord in TEXT_CHARS[NormToUpper[A^]]) then break else inc(A);
{$else} if not (tcWord in TEXT_CHARS[A^]) then break else inc(A); {$endif}
    until false;
  until false;
end;

function FindUnicode(PW, Upper: PWideChar; UpperLen: PtrInt): boolean;
var Start: PWideChar;
    w: PtrUInt;
begin
  result := false;
  if (PW=nil) or (Upper=nil) then exit;
  repeat
    // go to beginning of next word
    repeat
      w := ord(PW^);
      if w=0 then exit else
      if (w>126) or (tcWord in TEXT_BYTES[w]) then
        Break;
      inc(PW);
    until false;
    Start := PW;
    // search end of word matching UpperLen characters
    repeat
      inc(PW);
      w := ord(PW^);
    until (PW-Start>=UpperLen) or
      (w=0) or ((w<126) and (not(tcWord in TEXT_BYTES[w])));
    if PW-Start>=UpperLen then
      if CompareStringW(LOCALE_USER_DEFAULT,NORM_IGNORECASE,Start,UpperLen,Upper,UpperLen)=2 then begin
        result := true; // match found
        exit;
      end;
    // not found: go to end of current word
    repeat
      w := ord(PW^);
      if w=0 then exit else
      if ((w<126) and (not(tcWord in TEXT_BYTES[w]))) then Break;
      inc(PW);
    until false;
  until false;
end;

function FindUTF8(U: PUTF8Char; UpperValue: PAnsiChar): boolean;
var ValueStart: PAnsiChar;
{$ifdef USENORMTOUPPER}
    c: PtrUInt;
    FirstChar: AnsiChar;
label Next;
{$else}
    ch: AnsiChar;
{$endif}
begin
  result := false;
  if (U=nil) or (UpperValue=nil) then exit;
{$ifdef USENORMTOUPPER}
  // handles 8-bits WinAnsi chars inside UTF-8 encoded data
  FirstChar := UpperValue^;
  ValueStart := UpperValue+1;
  repeat
    // test beginning of word
    repeat
      c := byte(U^);
      inc(U);
      if c=0 then exit else
      if c<=127 then begin
        if tcWord in TEXT_BYTES[c] then
          if PAnsiChar(@NormToUpper)[c]<>FirstChar then
            goto Next else
            break;
      end else
      if c and $20=0 then begin // fast direct process $0..$7ff
        c := c shl 6+byte(U^)-$3080;
        inc(U);
        if c<=255 then begin
          c := NormToUpperByte[c];
          if tcWord in TEXT_BYTES[c] then
            if AnsiChar(c)<>FirstChar then
              goto Next else
              break;
        end;
      end else
        if UTF8_EXTRABYTES[c]=0 then
          exit else // invalid leading byte
          inc(U,UTF8_EXTRABYTES[c]); // just ignore surrogates for soundex
    until false;
    // here we had the first char match -> check if this word match UpperValue
    UpperValue := ValueStart;
    repeat
      if UpperValue^=#0 then begin
        result := true; // UpperValue found!
        exit;
      end;
      c := byte(U^); inc(U); // next chars
      if c=0 then exit else
      if c<=127 then begin
        if PAnsiChar(@NormToUpper)[c]<>UpperValue^ then break;
      end else
      if c and $20=0 then begin
        c := c shl 6+byte(U^)-$3080;
        inc(U);
        if (c>255) or (PAnsiChar(@NormToUpper)[c]<>UpperValue^) then break;
      end else begin
        if UTF8_EXTRABYTES[c]=0 then
          exit else // invalid leading byte
          inc(U,UTF8_EXTRABYTES[c]);
        break;
      end;
      inc(UpperValue);
    until false;
Next: // find beginning of next word
    U := FindNextUTF8WordBegin(U);
  until U=nil;
{$else}
  // this tiny version only handles 7-bits ansi chars and ignore all UTF-8 chars
  ValueStart := UpperValue;
  repeat
    // find beginning of word
    repeat
      if byte(U^)=0 then exit else
      if byte(U^)<=127 then
        if byte(U^) in IsWord then
          break else
          inc(U) else
      if byte(U^) and $20=0 then
        inc(U,2) else
        inc(U,3);
    until false;
    // check if this word is the UpperValue
    UpperValue := ValueStart;
    repeat
      ch := NormToUpperAnsi7[U^];
      if ch<>UpperValue^ then break;
      inc(UpperValue);
      if UpperValue^=#0 then begin
        result := true; // UpperValue found!
        exit;
      end;
      inc(U);
      if byte(U^)=0 then exit else
      if byte(U^) and $80<>0 then break; // 7 bits char check only
    until false;
    // find beginning of next word
    U := FindNextUTF8WordBegin(U);
  until U=nil;
{$endif}
end;

function HexDisplayToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: integer): boolean;
var b,c: byte;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute ConvertHexToBin{$else}PNormTableByte{$endif};
begin
  result := false; // return false if any invalid char
  if (Hex=nil) or (Bin=nil) then
    exit;
  {$ifndef CPUX86NOTPIC}tab := @ConvertHexToBin;{$endif} // faster on PIC and x86_64
  if BinBytes>0 then begin
    inc(Bin,BinBytes-1);
    repeat
      b := tab[Ord(Hex[0])];
      c := tab[Ord(Hex[1])];
      if (b>15) or (c>15) then
        exit;
      b := b shl 4; // better FPC generation code in small explicit steps
      b := b or c;
      Bin^ := b;
      dec(Bin);
      inc(Hex,2);
      dec(BinBytes);
    until BinBytes=0;
  end;
  result := true; // correct content in Hex
end;

function HexDisplayToCardinal(Hex: PAnsiChar; out aValue: cardinal): boolean;
begin
  result := HexDisplayToBin(Hex,@aValue,SizeOf(aValue));
  if not result then
   aValue := 0;
end;

function HexDisplayToInt64(Hex: PAnsiChar; out aValue: Int64): boolean;
begin
  result := HexDisplayToBin(Hex,@aValue,SizeOf(aValue));
  if not result then
   aValue := 0;
end;

function HexDisplayToInt64(const Hex: RawByteString): Int64;
begin
  if not HexDisplayToBin(pointer(Hex),@result,SizeOf(result)) then
    result := 0;
end;

function HexToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: Integer): boolean;
var b,c: byte;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute ConvertHexToBin{$else}PNormTableByte{$endif};
begin
  result := false; // return false if any invalid char
  if Hex=nil then
    exit;
  {$ifndef CPUX86NOTPIC}tab := @ConvertHexToBin;{$endif} // faster on PIC and x86_64
  if BinBytes>0 then
    if Bin<>nil then
      repeat
        b := tab[Ord(Hex[0])];
        c := tab[Ord(Hex[1])];
        if (b>15) or (c>15) then
          exit;
        inc(Hex,2);
        b := b shl 4;
        b := b or c;
        Bin^ := b;
        inc(Bin);
        dec(BinBytes);
      until BinBytes=0 else
      repeat // Bin=nil -> validate Hex^ input
        if (tab[Ord(Hex[0])]>15) or (tab[Ord(Hex[1])]>15) then
          exit;
        inc(Hex,2);
        dec(BinBytes);
      until BinBytes=0;
  result := true; // conversion OK
end;

procedure HexToBinFast(Hex: PAnsiChar; Bin: PByte; BinBytes: Integer);
var tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute ConvertHexToBin{$else}PNormTableByte{$endif};
    c: byte;
begin
  {$ifndef CPUX86NOTPIC}tab := @ConvertHexToBin;{$endif} // faster on PIC and x86_64
  if BinBytes>0 then
    repeat
      c := tab[ord(Hex[0])];
      c := c shl 4;
      c := tab[ord(Hex[1])] or c;
      Bin^ := c;
      inc(Hex,2);
      inc(Bin);
      dec(BinBytes);
    until BinBytes=0;
end;

function OctToBin(Oct: PAnsiChar; Bin: PByte): PtrInt;
var c, v: byte;
label _nxt;
begin
  result := PtrInt(Bin);
  if Oct <> nil then
    repeat
      c := ord(Oct^);
      inc(Oct);
      if c <> ord('\') then begin
        if c = 0 then
          break;
_nxt:   Bin^ := c;
        inc(Bin);
        continue;
      end;
      c := ord(Oct^);
      inc(Oct);
      if c = ord('\') then
        goto _nxt;
      dec(c, ord('0'));
      if c > 3 then
        break; // stop at malformated input (includes #0)
      c := c shl 6;
      v := c;
      c := ord(Oct[0]);
      dec(c, ord('0'));
      if c > 7 then
        break;
      c := c shl 3;
      v := v or c;
      c := ord(Oct[1]);
      dec(c, ord('0'));
      if c > 7 then
        break;
      c := c or v;
      Bin^ := c;
      inc(Bin);
      inc(Oct, 2);
    until false;
  result := PtrInt(Bin)-result;
end;

function OctToBin(const Oct: RawUTF8): RawByteString;
var tmp: TSynTempBuffer;
    L: integer;
begin
  tmp.Init(length(Oct));
  try
    L := OctToBin(pointer(Oct), tmp.buf);
    SetString(result, PAnsiChar(tmp.buf), L);
  finally
    tmp.Done;
  end;
end;

function IsHex(const Hex: RawByteString; BinBytes: integer): boolean;
begin
  result := (length(Hex)=BinBytes*2) and SynCommons.HexToBin(pointer(Hex),nil,BinBytes);
end;

function HexToCharValid(Hex: PAnsiChar): boolean;
begin
  result := (ConvertHexToBin[Ord(Hex[0])]<=15) and
            (ConvertHexToBin[Ord(Hex[1])]<=15);
end;

function HexToChar(Hex: PAnsiChar; Bin: PUTF8Char): boolean;
var B,C: PtrUInt;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute ConvertHexToBin{$else}PNormTableByte{$endif};
begin
  if Hex<>nil then begin
    {$ifndef CPUX86NOTPIC}tab := @ConvertHexToBin;{$endif} // faster on PIC and x86_64
    B := tab[Ord(Hex[0])];
    C := tab[Ord(Hex[1])];
    if (B<=15) and (C<=15) then begin
      if Bin<>nil then
        Bin^ := AnsiChar(B shl 4+C);
      result := true;
      exit;
    end;
  end;
  result := false; // return false if any invalid char
end;

function HexToWideChar(Hex: PAnsiChar): cardinal;
var B: PtrUInt;
begin
  result := ConvertHexToBin[Ord(Hex[0])];
  if result<=15 then begin
    B := ConvertHexToBin[Ord(Hex[1])];
    if B<=15 then begin
      result := result shl 4+B;
      B := ConvertHexToBin[Ord(Hex[2])];
      if B<=15 then begin
        result := result shl 4+B;
        B := ConvertHexToBin[Ord(Hex[3])];
        if B<=15 then begin
          result := result shl 4+B;
          exit;
        end;
      end;
    end;
  end;
  result := 0;
end;

{ --------- Base64 encoding/decoding }

type
  TBase64Enc = array[0..63] of AnsiChar;
  PBase64Enc = ^TBase64Enc;
  TBase64Dec = array[AnsiChar] of shortint;
  PBase64Dec = ^TBase64Dec;
const
  b64enc: TBase64Enc =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  b64URIenc: TBase64Enc =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_';
var
  /// a conversion table from Base64 text into binary data
  // - used by Base64ToBin/IsBase64 functions
  // - contains -1 for invalid char, -2 for '=', 0..63 for b64enc[] chars
  ConvertBase64ToBin, ConvertBase64URIToBin: TBase64Dec;

function Base64AnyDecode(const decode: TBase64Dec; sp,rp: PAnsiChar; len: PtrInt): boolean;
var c, ch: PtrInt;
begin
  result := false;
  while len>=4 do begin
    c := decode[sp[0]];
    if c<0 then
      exit;
    c := c shl 6;
    ch := decode[sp[1]];
    if ch<0 then
      exit;
    c := (c or ch) shl 6;
    ch := decode[sp[2]];
    if ch<0 then
      exit;
    c := (c or ch) shl 6;
    ch := decode[sp[3]];
    if ch<0 then
      exit;
    c := c or ch;
    rp[2] := AnsiChar(c);
    c := c shr 8;
    rp[1] := AnsiChar(c);
    c := c shr 8;
    rp[0] := AnsiChar(c);
    dec(len,4);
    inc(rp,3);
    inc(sp,4);
  end;
  if len>=2 then begin
    c := decode[sp[0]];
    if c<0 then
      exit;
    c := c shl 6;
    ch := decode[sp[1]];
    if ch<0 then
      exit;
    if len=2 then
      rp[0] := AnsiChar((c or ch) shr 4) else begin
      c := (c or ch) shl 6;
      ch := decode[sp[2]];
      if ch<0 then
        exit;
      c := (c or ch) shr 2;
      rp[1] := AnsiChar(c);
      rp[0] := AnsiChar(c shr 8);
    end;
  end;
  result := true;
end;

function Base64Decode(sp,rp: PAnsiChar; len: PtrInt): boolean; {$ifdef FPC}inline;{$endif}
var tab: PBase64Dec; // use local register
begin
  tab := @ConvertBase64ToBin;
  len := len shl 2; // len was the number of 4 chars chunks in sp
  if (len>0) and (tab[sp[len-2]]>=0) then
    if tab[sp[len-1]]>=0 then else
      dec(len) else
      dec(len,2); // Base64AnyDecode() algorithm ignores the trailing '='
  result := Base64AnyDecode(tab^,sp,rp,len);
end;

{$ifdef PUREPASCAL}
function Base64EncodeMain(rp, sp: PAnsiChar; len: cardinal): integer;
var c: cardinal;
    enc: PBase64Enc; // use local register
begin
  enc := @b64enc;
  len := len div 3;
  result := len;
  if len<>0 then
    repeat
      c := (ord(sp[0]) shl 16) or (ord(sp[1]) shl 8) or ord(sp[2]);
      rp[0] := enc[(c shr 18) and $3f];
      rp[1] := enc[(c shr 12) and $3f];
      rp[2] := enc[(c shr 6) and $3f];
      rp[3] := enc[c and $3f];
      inc(rp,4);
      inc(sp,3);
      dec(len);
    until len=0;
end;
{$else PUREPASCAL}
function Base64EncodeMain(rp, sp: PAnsiChar; len: cardinal): integer;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=rp edx=sp ecx=len - pipeline optimized version by AB
        push    ebx
        push    esi
        push    edi
        push    ebp
        mov     ebx, edx
        mov     esi, eax
        mov     eax, ecx
        mov     edx, 1431655766 // faster eax=len div 3 using reciprocal
        sar     ecx, 31
        imul    edx
        mov     eax, edx
        sub     eax, ecx
        mov     edi, offset b64enc
        mov     ebp, eax
        push    eax
        jz      @z
        // edi=b64enc[] ebx=sp esi=rp ebp=len div 3
        xor     eax, eax
@1:    // read 3 bytes from sp
        movzx   edx, byte ptr[ebx]
        shl     edx, 16
        mov     al, [ebx + 2]
        mov     ah, [ebx + 1]
        add     ebx, 3
        or      eax, edx
        // encode as Base64
        mov     ecx, eax
        mov     edx, eax
        shr     ecx, 6
        and     edx, $3f
        and     ecx, $3f
        mov     dh, [edi + edx]
        mov     dl, [edi + ecx]
        mov     ecx, eax
        shr     eax, 12
        shr     ecx, 18
        shl     edx, 16
        and     ecx, $3f
        and     eax, $3f
        mov     cl, [edi + ecx]
        mov     ch, [edi + eax]
        or      ecx, edx
        // write the 4 encoded bytes into rp
        mov     [esi], ecx
        add     esi, 4
        dec     ebp
        jnz     @1
@z:     pop     eax // result := len div 3
        pop     ebp
        pop     edi
        pop     esi
        pop     ebx
end;
{$endif PUREPASCAL}

procedure Base64EncodeTrailing(rp, sp: PAnsiChar; len: cardinal);
  {$ifdef HASINLINE}inline;{$endif}
var c: cardinal;
    enc: PBase64Enc; // use local register
begin
  enc := @b64enc;
  case len of
    1: begin
      c := ord(sp[0]) shl 4;
      rp[0] := enc[(c shr 6) and $3f];
      rp[1] := enc[c and $3f];
      PWord(rp+2)^ := ord('=')+ord('=') shl 8;
    end;
    2: begin
      c := (ord(sp[0]) shl 10) or (ord(sp[1]) shl 2);
      rp[0] := enc[(c shr 12) and $3f];
      rp[1] := enc[(c shr 6) and $3f];
      rp[2] := enc[c and $3f];
      rp[3] := '=';
    end;
  end;
end;

procedure Base64Encode(rp, sp: PAnsiChar; len: cardinal);
var main: cardinal;
begin
  main := Base64EncodeMain(rp,sp,len);
  Base64EncodeTrailing(rp+main*4,sp+main*3,len-main*3);
end;

function BinToBase64Length(len: PtrUInt): PtrUInt;
begin
  result := ((len+2)div 3)*4;
end;

function BinToBase64(const s: RawByteString): RawUTF8;
var len: integer;
begin
  result := '';
  len := length(s);
  if len=0 then
    exit;
  FastSetString(result,nil,BinToBase64Length(len));
  Base64Encode(pointer(result),pointer(s),len);
end;

function BinToBase64Short(Bin: PAnsiChar; BinBytes: integer): shortstring;
var destlen: integer;
begin
  result := '';
  if BinBytes=0 then
    exit;
  destlen := BinToBase64Length(BinBytes);
  if destlen>255 then
    exit; // avoid buffer overflow
  result[0] := AnsiChar(destlen);
  Base64Encode(@result[1],Bin,BinBytes);
end;

function BinToBase64Short(const s: RawByteString): shortstring;
begin
  result := BinToBase64Short(pointer(s),length(s));
end;

function BinToBase64(Bin: PAnsiChar; BinBytes: integer): RawUTF8;
begin
  result := '';
  if BinBytes=0 then
    exit;
  FastSetString(result,nil,BinToBase64Length(BinBytes));
  Base64Encode(pointer(result),Bin,BinBytes);
end;

function BinToBase64(const data, Prefix, Suffix: RawByteString; WithMagic: boolean): RawUTF8;
var lendata,lenprefix,lensuffix,len: integer;
    res: PByteArray absolute result;
begin
  result := '';
  lendata := length(data);
  lenprefix := length(Prefix);
  lensuffix := length(Suffix);
  if lendata+lenprefix+lensuffix=0 then
    exit;
  len := ((lendata+2) div 3)*4+lenprefix+lensuffix;
  if WithMagic then
    inc(len,3);
  FastSetString(result,nil,len);
  if lenprefix>0 then
    MoveSmall(pointer(Prefix),res,lenprefix);
  if WithMagic then begin
    PInteger(@res[lenprefix])^ := JSON_BASE64_MAGIC;
    inc(lenprefix,3);
  end;
  Base64Encode(@res[lenprefix],pointer(data),lendata);
  if lensuffix>0 then
    MoveSmall(pointer(Suffix),@res[len-lensuffix],lensuffix);
end;

function BinToBase64WithMagic(const data: RawByteString): RawUTF8;
var len: integer;
begin
  result := '';
  len := length(data);
  if len=0 then
    exit;
  FastSetString(result,nil,((len+2) div 3)*4+3);
  PInteger(pointer(result))^ := JSON_BASE64_MAGIC;
  Base64Encode(PAnsiChar(pointer(result))+3,pointer(data),len);
end;

function BinToBase64WithMagic(Data: pointer; DataLen: integer): RawUTF8;
begin
  result := '';
  if DataLen<=0 then
    exit;
  FastSetString(result,nil,((DataLen+2) div 3)*4+3);
  PInteger(pointer(result))^ := JSON_BASE64_MAGIC;
  Base64Encode(PAnsiChar(pointer(result))+3,Data,DataLen);
end;

function IsBase64Internal(sp: PAnsiChar; len: PtrInt; dec: PBase64Dec): boolean;
var i: PtrInt;
begin
  result := false;
  if (len=0) or (len and 3<>0) then
    exit;
  for i := 0 to len-5 do
    if dec[sp[i]]<0 then
      exit;
  inc(sp,len-4);
  if (dec[sp[0]]=-1) or (dec[sp[1]]=-1) or
     (dec[sp[2]]=-1) or (dec[sp[3]]=-1) then
      exit;
  result := true; // layout seems correct
end;

function IsBase64(sp: PAnsiChar; len: PtrInt): boolean;
begin
  result := IsBase64Internal(sp,len,@ConvertBase64ToBin);
end;

function IsBase64(const s: RawByteString): boolean;
begin
  result := IsBase64Internal(pointer(s),length(s),@ConvertBase64ToBin);
end;

function Base64ToBinLengthSafe(sp: PAnsiChar; len: PtrInt): PtrInt;
var dec: PBase64Dec;
begin
  dec := @ConvertBase64ToBin;
  if IsBase64Internal(sp,len,dec) then begin
    if dec[sp[len-2]]>=0 then
      if dec[sp[len-1]]>=0 then
        result := 0 else
        result := 1 else
        result := 2;
    result := (len shr 2)*3-result;
  end else
    result := 0;
end;

function Base64ToBinLength(sp: PAnsiChar; len: PtrInt): PtrInt;
var dec: PBase64Dec;
begin
  result := 0;
  if (len=0) or (len and 3<>0) then
    exit;
  dec := @ConvertBase64ToBin;
  if dec[sp[len-2]]>=0 then
    if dec[sp[len-1]]>=0 then
      result := 0 else
      result := 1 else
      result := 2;
  result := (len shr 2)*3-result;
end;

function Base64ToBin(const s: RawByteString): RawByteString;
begin
  Base64ToBinSafe(pointer(s),length(s),result);
end;

function Base64ToBin(sp: PAnsiChar; len: PtrInt): RawByteString;
begin
  Base64ToBinSafe(sp,len,result);
end;

function Base64ToBin(sp: PAnsiChar; len: PtrInt; var data: RawByteString): boolean;
begin
  result := Base64ToBinSafe(sp,len,data);
end;

function Base64ToBinSafe(const s: RawByteString): RawByteString;
begin
  Base64ToBinSafe(pointer(s),length(s),result);
end;

function Base64ToBinSafe(sp: PAnsiChar; len: PtrInt): RawByteString;
begin
  Base64ToBinSafe(sp,len,result);
end;

function Base64ToBinSafe(sp: PAnsiChar; len: PtrInt; var data: RawByteString): boolean;
var resultLen: PtrInt;
begin
  resultLen := Base64ToBinLength(sp,len);
  if resultLen<>0 then begin
    SetString(data,nil,resultLen);
    if ConvertBase64ToBin[sp[len-2]]>=0 then
      if ConvertBase64ToBin[sp[len-1]]>=0 then else
        dec(len) else
        dec(len,2); // adjust for Base64AnyDecode() algorithm
    result := Base64AnyDecode(ConvertBase64ToBin,sp,pointer(data),len);
    if not result then
      data := '';
  end else begin
    result := false;
    data := '';
  end;
end;

function Base64ToBin(sp: PAnsiChar; len: PtrInt; var blob: TSynTempBuffer): boolean;
begin
  blob.Init(Base64ToBinLength(sp,len));
  result := (blob.len>0) and Base64Decode(sp,blob.buf,len shr 2);
end;

function Base64ToBin(base64, bin: PAnsiChar; base64len, binlen: PtrInt;
  nofullcheck: boolean): boolean;
begin // nofullcheck is just ignored and deprecated
  result := (bin<>nil) and (Base64ToBinLength(base64,base64len)=binlen) and
    Base64Decode(base64,bin,base64len shr 2);
end;

function Base64ToBin(const base64: RawByteString; bin: PAnsiChar; binlen: PtrInt;
  nofullcheck: boolean): boolean;
begin
  result := Base64ToBin(pointer(base64),bin,length(base64),binlen,nofullcheck);
end;

{ --------- Base64 URI encoding/decoding }

{$ifdef PUREPASCAL}
procedure Base64uriEncode(rp, sp: PAnsiChar; len: cardinal);
var main, c: cardinal;
    enc: PBase64Enc; // faster especially on x86_64 and PIC
begin
  enc := @b64URIenc;
  main := len div 3;
  if main<>0 then begin
    dec(len,main*3); // fast modulo
    repeat
      c := (ord(sp[0]) shl 16) or (ord(sp[1]) shl 8) or ord(sp[2]);
      rp[0] := enc[(c shr 18) and $3f];
      rp[1] := enc[(c shr 12) and $3f];
      rp[2] := enc[(c shr 6) and $3f];
      rp[3] := enc[c and $3f];
      inc(rp,4);
      inc(sp,3);
      dec(main)
    until main=0;
  end;
  case len of
    1: begin
      c := ord(sp[0]) shl 4;
      rp[0] := enc[(c shr 6) and $3f];
      rp[1] := enc[c and $3f];
    end;
    2: begin
      c := (ord(sp[0]) shl 10) or (ord(sp[1]) shl 2);
      rp[0] := enc[(c shr 12) and $3f];
      rp[1] := enc[(c shr 6) and $3f];
      rp[2] := enc[c and $3f];
    end;
  end;
end;
{$else PUREPASCAL}
function Base64uriEncodeMain(rp, sp: PAnsiChar; len: cardinal): integer;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=rp edx=sp ecx=len - pipeline optimized version by AB
        push    ebx
        push    esi
        push    edi
        push    ebp
        mov     ebx, edx
        mov     esi, eax
        mov     eax, ecx
        mov     edx, 1431655766 // faster eax=len div 3 using reciprocal
        sar     ecx, 31
        imul    edx
        mov     eax, edx
        sub     eax, ecx
        mov     edi, offset b64urienc
        mov     ebp, eax
        push    eax
        jz      @z
        // edi=b64urienc[] ebx=sp esi=rp ebp=len div 3
        xor     eax, eax
@1:    // read 3 bytes from sp
        movzx   edx, byte ptr[ebx]
        shl     edx, 16
        mov     al, [ebx + 2]
        mov     ah, [ebx + 1]
        add     ebx, 3
        or      eax, edx
        // encode as Base64uri
        mov     ecx, eax
        mov     edx, eax
        shr     ecx, 6
        and     edx, $3f
        and     ecx, $3f
        mov     dh, [edi + edx]
        mov     dl, [edi + ecx]
        mov     ecx, eax
        shr     eax, 12
        shr     ecx, 18
        shl     edx, 16
        and     ecx, $3f
        and     eax, $3f
        mov     cl, [edi + ecx]
        mov     ch, [edi + eax]
        or      ecx, edx
        // write the 4 encoded bytes into rp
        mov     [esi], ecx
        add     esi, 4
        dec     ebp
        jnz     @1
@z:     pop     eax // result := len div 3
        pop     ebp
        pop     edi
        pop     esi
        pop     ebx
end;

procedure Base64uriEncodeTrailing(rp, sp: PAnsiChar; len: cardinal);
  {$ifdef HASINLINE}inline;{$endif}
var c: cardinal;
begin
  case len of
    1: begin
      c := ord(sp[0]) shl 4;
      rp[0] := b64urienc[(c shr 6) and $3f];
      rp[1] := b64urienc[c and $3f];
    end;
    2: begin
      c := ord(sp[0]) shl 10 + ord(sp[1]) shl 2;
      rp[0] := b64urienc[(c shr 12) and $3f];
      rp[1] := b64urienc[(c shr 6) and $3f];
      rp[2] := b64urienc[c and $3f];
    end;
  end;
end;

procedure Base64uriEncode(rp, sp: PAnsiChar; len: cardinal);
var main: cardinal;
begin
  main := Base64uriEncodeMain(rp,sp,len);
  Base64uriEncodeTrailing(rp+main*4,sp+main*3,len-main*3);
end;
{$endif PUREPASCAL}

function BinToBase64uriLength(len: PtrUInt): PtrUInt;
begin
  result := (len div 3)*4;
  case len-(result shr 2)*3 of // fast len mod 3
  1: inc(result,2);
  2: inc(result,3);
  end;
end;

function BinToBase64uri(const s: RawByteString): RawUTF8;
var len: integer;
begin
  result := '';
  len := length(s);
  if len=0 then
    exit;
  FastSetString(result,nil,BinToBase64uriLength(len));
  Base64uriEncode(pointer(result),pointer(s),len);
end;

function BinToBase64uri(Bin: PAnsiChar; BinBytes: integer): RawUTF8;
begin
  result := '';
  if BinBytes<=0 then
    exit;
  FastSetString(result,nil,BinToBase64uriLength(BinBytes));
  Base64uriEncode(pointer(result),Bin,BinBytes);
end;

function BinToBase64uriShort(Bin: PAnsiChar; BinBytes: integer): shortstring;
var len: integer;
begin
  result := '';
  if BinBytes<=0 then
    exit;
  len := BinToBase64uriLength(BinBytes);
  if len>255 then
    exit;
  byte(result[0]) := len;
  Base64uriEncode(@result[1],Bin,BinBytes);
end;

function Base64uriToBinLength(len: PtrInt): PtrInt;
begin
  if len=0 then
    result := 0 else begin
    result := (len shr 2)*3;
    case len and 3 of
    1: result := 0;
    2: inc(result,1);
    3: inc(result,2);
    end;
  end;
end;

function Base64uriDecode(sp,rp: PAnsiChar; len: PtrInt): boolean;
begin
  result := Base64AnyDecode(ConvertBase64URIToBin,sp,rp,len);
end;

function Base64uriToBin(sp: PAnsiChar; len: PtrInt): RawByteString;
begin
  Base64uriToBin(sp,len,result);
end;

function Base64uriToBin(const s: RawByteString): RawByteString;
begin
  Base64uriToBin(pointer(s),length(s),result);
end;

procedure Base64uriToBin(sp: PAnsiChar; len: PtrInt; var result: RawByteString);
var resultLen: PtrInt;
begin
  resultLen := Base64uriToBinLength(len);
  if resultLen<>0 then begin
    SetString(result,nil,resultLen);
    if Base64AnyDecode(ConvertBase64URIToBin,sp,pointer(result),len) then
      exit;
  end;
  result := '';
end;

function Base64uriToBin(sp: PAnsiChar; len: PtrInt; var temp: TSynTempBuffer): boolean;
begin
  temp.Init(Base64uriToBinLength(len));
  result := (temp.len>0) and Base64AnyDecode(ConvertBase64URIToBin,sp,temp.buf,len);
end;

function Base64uriToBin(const base64: RawByteString; bin: PAnsiChar; binlen: PtrInt): boolean;
begin
  result := Base64uriToBin(pointer(base64),bin,length(base64),binlen);
end;

function Base64uriToBin(base64, bin: PAnsiChar; base64len, binlen: PtrInt): boolean;
var resultLen: PtrInt;
begin
  resultLen := Base64uriToBinLength(base64len);
  result := (resultLen=binlen) and
    Base64AnyDecode(ConvertBase64URIToBin,base64,bin,base64len);
end;

procedure Base64ToURI(var base64: RawUTF8);
var P: PUTF8Char;
begin
  P := UniqueRawUTF8(base64);
  if P<>nil then
    repeat
      case P^ of
      #0: break;
      '+': P^ := '-';
      '/': P^ := '_';
      '=': begin // trim unsignificant trailing '=' characters
        SetLength(base64,P-pointer(base64));
        break;
      end;
      end;
      inc(P);
    until false;
end;


function BinToSource(const ConstName, Comment: RawUTF8;
  Data: pointer; Len, PerLine: integer; const Suffix: RawUTF8): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  if (Data=nil) or (Len<=0) or (PerLine<=0) then
    result := '' else begin
    W := TTextWriter.CreateOwnedStream(temp,Len*5+50+length(Comment)+length(Suffix));
    try
      BinToSource(W,ConstName,Comment,Data,Len,PerLine);
      if Suffix<>'' then begin
        W.AddString(Suffix);
        W.AddCR;
      end;
      W.SetText(result);
    finally
      W.Free;
    end;
  end;
end;

procedure BinToSource(Dest: TTextWriter; const ConstName, Comment: RawUTF8;
  Data: pointer; Len, PerLine: integer);
var line,i: integer;
    P: PByte;
begin
  if (Dest=nil) or (Data=nil) or (Len<=0) or (PerLine<=0) then
    exit;
  Dest.AddShort('const');
  if Comment<>'' then
    Dest.Add(#13#10'  // %',[Comment]);
  Dest.Add(#13#10'  %: array[0..%] of byte = (',[ConstName,Len-1]);
  P := pointer(Data);
  repeat
    if len>PerLine then
      line := PerLine else
      line := Len;
    Dest.AddShort(#13#10'    ');
    for i := 0 to line-1 do begin
      Dest.Add('$');
      Dest.AddByteToHex(P^);
      inc(P);
      Dest.Add(',');
    end;
    dec(Len,line);
  until Len=0;
  Dest.CancelLastComma;
  Dest.Add(');'#13#10'  %_LEN = SizeOf(%);'#13#10,[ConstName,ConstName]);
end;

{$ifdef KYLIX3}
function UpperCaseUnicode(const S: RawUTF8): RawUTF8;
begin
  result := WideStringToUTF8(WideUpperCase(UTF8ToWideString(S)));
end;

function LowerCaseUnicode(const S: RawUTF8): RawUTF8;
begin
  result := WideStringToUTF8(WideLowerCase(UTF8ToWideString(S)));
end;
{$else}
function UpperCaseUnicode(const S: RawUTF8): RawUTF8;
var tmp: TSynTempBuffer;
    len: integer;
begin
  if S='' then begin
    result := '';
    exit;
  end;
  tmp.Init(length(s)*2);
  len := UTF8ToWideChar(tmp.buf,pointer(S),length(S)) shr 1;
  RawUnicodeToUtf8(tmp.buf,CharUpperBuffW(tmp.buf,len),result);
  tmp.Done;
end;

function LowerCaseUnicode(const S: RawUTF8): RawUTF8;
var tmp: TSynTempBuffer;
    len: integer;
begin
  if S='' then begin
    result := '';
    exit;
  end;
  tmp.Init(length(s)*2);
  len := UTF8ToWideChar(tmp.buf,pointer(S),length(S)) shr 1;
  RawUnicodeToUtf8(tmp.buf,CharLowerBuffW(tmp.buf,len),result);
  tmp.Done;
end;
{$endif KYLIX3}

function IsCaseSensitive(const S: RawUTF8): boolean;
begin
  result := IsCaseSensitive(pointer(S),length(S));
end;

function IsCaseSensitive(P: PUTF8Char; PLen: PtrInt): boolean;
begin
  result := true;
  if (P<>nil) and (PLen>0) then
    repeat
      if ord(P^) in [ord('a')..ord('z'), ord('A')..ord('Z')] then
        exit;
      inc(P);
      dec(PLen);
    until PLen=0;
  result := false;
end;

function UpperCase(const S: RawUTF8): RawUTF8;
var L, i: PtrInt;
begin
  L := length(S);
  FastSetString(Result,pointer(S),L);
  for i := 0 to L-1 do
    if PByteArray(result)[i] in [ord('a')..ord('z')] then
      dec(PByteArray(result)[i],32);
end;

procedure UpperCaseCopy(Text: PUTF8Char; Len: PtrInt; var result: RawUTF8);
var i: PtrInt;
begin
  FastSetString(result,Text,Len);
  for i := 0 to Len-1 do
    if PByteArray(result)[i] in [ord('a')..ord('z')] then
      dec(PByteArray(result)[i],32);
end;

procedure UpperCaseCopy(const Source: RawUTF8; var Dest: RawUTF8);
var L, i: PtrInt;
begin
  L := length(Source);
  FastSetString(Dest,pointer(Source),L);
  for i := 0 to L-1 do
    if PByteArray(Dest)[i] in [ord('a')..ord('z')] then
      dec(PByteArray(Dest)[i],32);
end;

procedure UpperCaseSelf(var S: RawUTF8);
var i: PtrInt;
    P: PByteArray;
begin
  P := UniqueRawUTF8(S);
  for i := 0 to length(S)-1 do
    if P[i] in [ord('a')..ord('z')] then
      dec(P[i],32);
end;

function LowerCase(const S: RawUTF8): RawUTF8;
var L, i: PtrInt;
begin
  L := length(S);
  FastSetString(result,pointer(S),L);
  for i := 0 to L-1 do
    if PByteArray(result)[i] in [ord('A')..ord('Z')] then
      inc(PByteArray(result)[i],32);
end;

procedure LowerCaseCopy(Text: PUTF8Char; Len: PtrInt; var result: RawUTF8);
var i: PtrInt;
begin
  FastSetString(result,Text,Len);
  for i := 0 to Len-1 do
    if PByteArray(result)[i] in [ord('A')..ord('Z')] then
      inc(PByteArray(result)[i],32);
end;

procedure LowerCaseSelf(var S: RawUTF8);
var i: PtrInt;
    P: PByteArray;
begin
  P := UniqueRawUTF8(S);
  for i := 0 to length(S)-1 do
    if P[i] in [ord('A')..ord('Z')] then
      inc(P[i],32);
end;

function TrimLeft(const S: RawUTF8): RawUTF8;
var i, l: PtrInt;
begin
  l := Length(S);
  i := 1;
  while (i <= l) and (S[i] <= ' ') do
    Inc(i);
  Result := Copy(S, i, Maxint);
end;

function TrimRight(const S: RawUTF8): RawUTF8;
var i: PtrInt;
begin
  i := Length(S);
  while (i > 0) and (S[i] <= ' ') do
    Dec(i);
  FastSetString(result,pointer(S),i);
end;

procedure TrimCopy(const S: RawUTF8; start, count: PtrInt;
  var result: RawUTF8);
var L: PtrInt;
begin
  if count>0 then begin
    if start<=0 then
      start := 1;
    L := Length(S);
    while (start<=L) and (S[start]<=' ') do begin
      inc(start); dec(count); end;
    dec(start);
    dec(L,start);
    if count<L then
      L := count;
    while L>0 do
      if S[start+L]<=' ' then
        dec(L) else
        break;
    if L>0 then begin
      FastSetString(result,@PByteArray(S)[start],L);
      exit;
    end;
  end;
  result := '';
end;

type
  TAnsiCharToWord = array[AnsiChar] of word;
  TByteToWord = array[byte] of word;
var
  /// fast lookup table for converting hexadecimal numbers from 0 to 15
  // into their ASCII equivalence
  // - is local for better code generation
  TwoDigitsHex: array[byte] of array[1..2] of AnsiChar;
  TwoDigitsHexW: TAnsiCharToWord absolute TwoDigitsHex;
  TwoDigitsHexWB: array[byte] of word absolute TwoDigitsHex;
  /// lowercase hexadecimal lookup table
  TwoDigitsHexLower: array[byte] of array[1..2] of AnsiChar;
  TwoDigitsHexWLower: TAnsiCharToWord absolute TwoDigitsHexLower;
  TwoDigitsHexWBLower: array[byte] of word absolute TwoDigitsHexLower;

procedure BinToHex(Bin, Hex: PAnsiChar; BinBytes: integer);
{$ifdef PUREPASCAL}var tab: ^TAnsiCharToWord;{$endif}
begin
  {$ifdef PUREPASCAL}tab := @TwoDigitsHexW;{$endif}
  if BinBytes>0 then
    repeat
      PWord(Hex)^ := {$ifndef PUREPASCAL}TwoDigitsHexW{$else}tab{$endif}[Bin^];
      inc(Bin);
      inc(Hex,2);
      dec(BinBytes);
    until BinBytes=0;
end;

function BinToHex(const Bin: RawByteString): RawUTF8;
var L: integer;
begin
  L := length(Bin);
  FastSetString(result,nil,L*2);
  SynCommons.BinToHex(pointer(Bin),pointer(Result),L);
end;

function BinToHex(Bin: PAnsiChar; BinBytes: integer): RawUTF8;
begin
  FastSetString(result,nil,BinBytes*2);
  SynCommons.BinToHex(Bin,pointer(Result),BinBytes);
end;

function HexToBin(const Hex: RawUTF8): RawByteString;
var L: integer;
begin
  result := '';
  L := length(Hex);
  if L and 1<>0 then
    L := 0 else // hexadecimal should be in char pairs
    L := L shr 1;
  SetLength(result,L);
  if not SynCommons.HexToBin(pointer(Hex),pointer(result),L) then
    result := '';
end;

function ByteToHex(P: PAnsiChar; Value: byte): PAnsiChar;
begin
  PWord(P)^ := TwoDigitsHexWB[Value];
  result := P+2;
end;

function EscapeBuffer(s,d: PAnsiChar; len,max: integer): PAnsiChar;
var i: integer;
begin
  if len>max then
    len := max;
  for i := 1 to len do begin
    if s^ in [' '..#126] then begin
      d^ := s^;
      inc(d);
    end else begin
      d^ := '$';
      inc(d);
      PWord(d)^ := TwoDigitsHexWB[ord(s^)];
      inc(d,2);
    end;
    inc(s);
  end;
  if len=max then begin
    PCardinal(d)^ := ord('.')+ord('.')shl 8+ord('.')shl 16;
    inc(d,3);
  end else
    d^ := #0;
  result := d;
end;

function LogEscape(source: PAnsiChar; sourcelen: integer; var temp: TLogEscape;
  enabled: boolean): PAnsiChar;
begin
  if enabled then begin
    temp[0] := ' ';
    EscapeBuffer(source,@temp[1],sourcelen,LOGESCAPELEN);
  end else
    temp[0] := #0;
  result := @temp;
end;

function LogEscapeFull(const source: RawByteString): RawUTF8;
begin
  result := LogEscapeFull(pointer(source),length(source));
end;

function LogEscapeFull(source: PAnsiChar; sourcelen: integer): RawUTF8;
begin
  FastSetString(result,nil,sourcelen*3); // worse case
  if sourcelen=0 then
    exit;
  sourcelen := EscapeBuffer(source,pointer(result),sourcelen,length(result))-pointer(result);
  SetLength(result,sourcelen);
end;

function EscapeToShort(source: PAnsiChar; sourcelen: integer): shortstring;
begin
  result[0] := AnsiChar(EscapeBuffer(source,@result[1],sourcelen,80)-@result[1]);
end;

function EscapeToShort(const source: RawByteString): shortstring; overload;
begin
  result[0] := AnsiChar(EscapeBuffer(pointer(source),@result[1],length(source),80)-@result[1]);
end;

procedure BinToHexDisplay(Bin, Hex: PAnsiChar; BinBytes: integer);
{$ifdef PUREPASCAL}var tab: ^TAnsiCharToWord;{$endif}
begin
  {$ifdef PUREPASCAL}tab := @TwoDigitsHexW;{$endif}
  inc(Hex,BinBytes*2);
  if BinBytes>0 then
    repeat
      dec(Hex,2);
      PWord(Hex)^ := {$ifndef PUREPASCAL}TwoDigitsHexW{$else}tab{$endif}[Bin^];
      inc(Bin);
      dec(BinBytes);
    until BinBytes=0;
end;

function BinToHexDisplay(Bin: PAnsiChar; BinBytes: integer): RawUTF8;
begin
  FastSetString(result,nil,BinBytes*2);
  BinToHexDisplay(Bin,pointer(result),BinBytes);
end;

procedure BinToHexLower(Bin, Hex: PAnsiChar; BinBytes: integer);
{$ifdef PUREPASCAL}var tab: ^TAnsiCharToWord;{$endif}
begin
  {$ifdef PUREPASCAL}tab := @TwoDigitsHexWLower;{$endif}
  if BinBytes>0 then
    repeat
      PWord(Hex)^ := {$ifndef PUREPASCAL}TwoDigitsHexWLower{$else}tab{$endif}[Bin^];
      inc(Bin);
      inc(Hex,2);
      dec(BinBytes);
    until BinBytes=0;
end;

function BinToHexLower(const Bin: RawByteString): RawUTF8;
begin
  BinToHexLower(pointer(Bin),length(Bin),result);
end;

procedure BinToHexLower(Bin: PAnsiChar; BinBytes: integer; var result: RawUTF8);
begin
  FastSetString(result,nil,BinBytes*2);
  BinToHexLower(Bin,pointer(result),BinBytes);
end;

function BinToHexLower(Bin: PAnsiChar; BinBytes: integer): RawUTF8;
begin
  BinToHexLower(Bin,BinBytes,result);
end;

procedure BinToHexDisplayLower(Bin, Hex: PAnsiChar; BinBytes: PtrInt);
{$ifdef PUREPASCAL}var tab: ^TAnsiCharToWord;{$endif}
begin
  if (Bin=nil) or (Hex=nil) or (BinBytes<=0) then
    exit;
  {$ifdef PUREPASCAL}tab := @TwoDigitsHexWLower;{$endif}
  inc(Hex,BinBytes*2);
  repeat
    dec(Hex,2);
    PWord(Hex)^ := {$ifdef PUREPASCAL}tab{$else}TwoDigitsHexWLower{$endif}[Bin^];
    inc(Bin);
    dec(BinBytes);
  until BinBytes=0;
end;

function BinToHexDisplayLower(Bin: PAnsiChar; BinBytes: integer): RawUTF8;
begin
  FastSetString(result,nil,BinBytes*2);
  BinToHexDisplayLower(Bin,pointer(result),BinBytes);
end;

function BinToHexDisplayLowerShort(Bin: PAnsiChar; BinBytes: integer): shortstring;
begin
  if BinBytes>127 then
    BinBytes := 127;
  result[0] := AnsiChar(BinBytes * 2);
  BinToHexDisplayLower(Bin,@result[1],BinBytes);
end;

function BinToHexDisplayLowerShort16(Bin: Int64; BinBytes: integer): TShort16;
begin
  if BinBytes>8 then
    BinBytes := 8;
  result[0] := AnsiChar(BinBytes * 2);
  BinToHexDisplayLower(@Bin,@result[1],BinBytes);
end;

function BinToHexDisplayFile(Bin: PAnsiChar; BinBytes: integer): TFileName;
{$ifdef UNICODE}
var temp: TSynTempBuffer;
begin
  temp.Init(BinBytes*2);
  BinToHexDisplayLower(Bin,temp.Buf,BinBytes);
  Ansi7ToString(PWinAnsiChar(temp.buf),BinBytes*2,string(result));
  temp.Done;
end;
{$else}
begin
  SetString(result,nil,BinBytes*2);
  BinToHexDisplayLower(Bin,pointer(result),BinBytes);
end;
{$endif UNICODE}

procedure PointerToHex(aPointer: Pointer; var result: RawUTF8);
begin
  FastSetString(result,nil,SizeOf(Pointer)*2);
  BinToHexDisplay(@aPointer,pointer(result),SizeOf(Pointer));
end;

function PointerToHex(aPointer: Pointer): RawUTF8;
begin
  FastSetString(result,nil,SizeOf(aPointer)*2);
  BinToHexDisplay(@aPointer,pointer(result),SizeOf(aPointer));
end;

function CardinalToHex(aCardinal: Cardinal): RawUTF8;
begin
  FastSetString(result,nil,SizeOf(aCardinal)*2);
  BinToHexDisplay(@aCardinal,pointer(result),SizeOf(aCardinal));
end;

function CardinalToHexLower(aCardinal: Cardinal): RawUTF8;
begin
  FastSetString(result,nil,SizeOf(aCardinal)*2);
  BinToHexDisplayLower(@aCardinal,pointer(result),SizeOf(aCardinal));
end;

function Int64ToHex(aInt64: Int64): RawUTF8;
begin
  FastSetString(result,nil,SizeOf(Int64)*2);
  BinToHexDisplay(@aInt64,pointer(result),SizeOf(Int64));
end;

procedure Int64ToHex(aInt64: Int64; var result: RawUTF8);
begin
  FastSetString(result,nil,SizeOf(Int64)*2);
  BinToHexDisplay(@aInt64,pointer(result),SizeOf(Int64));
end;

function PointerToHexShort(aPointer: Pointer): TShort16;
begin
  result[0] := AnsiChar(SizeOf(aPointer)*2);
  BinToHexDisplay(@aPointer,@result[1],SizeOf(aPointer));
end;

function CardinalToHexShort(aCardinal: Cardinal): TShort16;
begin
  result[0] := AnsiChar(SizeOf(aCardinal)*2);
  BinToHexDisplay(@aCardinal,@result[1],SizeOf(aCardinal));
end;

function Int64ToHexShort(aInt64: Int64): TShort16;
begin
  result[0] := AnsiChar(SizeOf(aInt64)*2);
  BinToHexDisplay(@aInt64,@result[1],SizeOf(aInt64));
end;

procedure Int64ToHexShort(aInt64: Int64; out result: TShort16);
begin
  result[0] := AnsiChar(SizeOf(aInt64)*2);
  BinToHexDisplay(@aInt64,@result[1],SizeOf(aInt64));
end;

function Int64ToHexString(aInt64: Int64): string;
var temp: TShort16;
begin
  Int64ToHexShort(aInt64,temp);
  Ansi7ToString(@temp[1],ord(temp[0]),result);
end;

function UInt3DigitsToUTF8(Value: Cardinal): RawUTF8;
begin
  FastSetString(result,nil,3);
  PWordArray(result)[0] := TwoDigitLookupW[Value div 10];
  PByteArray(result)[2] := (Value mod 10)+48;
end;

function UInt4DigitsToUTF8(Value: Cardinal): RawUTF8;
begin
  FastSetString(result,nil,4);
  if Value>9999 then
    Value := 9999;
  YearToPChar(Value,pointer(result));
end;

function UInt4DigitsToShort(Value: Cardinal): TShort4;
begin
  result[0] := #4;
  if Value>9999 then
    Value := 9999;
  YearToPChar(Value,@result[1]);
end;

function UInt3DigitsToShort(Value: Cardinal): TShort4;
begin
  if Value>999 then
    Value := 999;
  YearToPChar(Value,@result[0]);
  result[0] := #3; // override first digit
end;

function UInt2DigitsToShort(Value: byte): TShort4;
begin
  result[0] := #2;
  if Value>99 then
    Value := 99;
  PWord(@result[1])^ := TwoDigitLookupW[Value];
end;

function UInt2DigitsToShortFast(Value: byte): TShort4;
begin
  result[0] := #2;
  PWord(@result[1])^ := TwoDigitLookupW[Value];
end;

function SameValue(const A, B: Double; DoublePrec: double): Boolean;
var AbsA,AbsB,Res: double;
begin
  if PInt64(@DoublePrec)^=0 then begin // Max(Min(Abs(A),Abs(B))*1E-12,1E-12)
    AbsA := Abs(A);
    AbsB := Abs(B);
    Res := 1E-12;
    if AbsA<AbsB then
      DoublePrec := AbsA*Res else
      DoublePrec := AbsB*Res;
    if DoublePrec<Res then
      DoublePrec := Res;
  end;
  if A<B then
    result := (B-A)<=DoublePrec else
    result := (A-B)<=DoublePrec;
end;

function SameValueFloat(const A, B: TSynExtended; DoublePrec: TSynExtended): Boolean;
var AbsA,AbsB,Res: TSynExtended;
begin
  if DoublePrec=0 then begin // Max(Min(Abs(A),Abs(B))*1E-12,1E-12)
    AbsA := Abs(A);
    AbsB := Abs(B);
    Res := 1E-12; // also for TSynExtended (FPC uses 1E-4!)
    if AbsA<AbsB then
      DoublePrec := AbsA*Res else
      DoublePrec := AbsB*Res;
    if DoublePrec<Res then
      DoublePrec := Res;
  end;
  if A<B then
    result := (B-A)<=DoublePrec else
    result := (A-B)<=DoublePrec;
end;

function CompareFloat(const A, B: double): integer;
begin
  result := ord(A>B)-ord(A<B);
end;

function CompareInteger(const A, B: integer): integer;
begin
  result := ord(A>B)-ord(A<B);
end;

function CompareInt64(const A, B: Int64): integer;
begin
  result := ord(A>B)-ord(A<B);
end;

function CompareCardinal(const A, B: cardinal): integer;
begin
  result := ord(A>B)-ord(A<B);
end;

procedure KahanSum(const Data: double; var Sum, Carry: double);
var y, t: double;
begin
  y := Data - Carry;
  t := Sum + y;
  Carry := (t - Sum) - y;
  Sum := t;
end;

function FindRawUTF8(Values: PRawUTF8; const Value: RawUTF8; ValuesCount: integer;
  CaseSensitive: boolean): integer;
var ValueLen: TStrLen;
begin
  dec(ValuesCount);
  ValueLen := length(Value);
  if ValueLen=0 then
    for result := 0 to ValuesCount do
      if Values^='' then
        exit else
        inc(Values) else
    if CaseSensitive then
      for result := 0 to ValuesCount do
        if (PtrUInt(Values^)<>0) and
           (PStrLen(PtrUInt(Values^)-_STRLEN)^=ValueLen) and
           CompareMemFixed(pointer(PtrInt(Values^)),pointer(Value),ValueLen) then
          exit else
          inc(Values) else
      for result := 0 to ValuesCount do
        if (PtrUInt(Values^)<>0) and // StrIComp() won't change length
           (PStrLen(PtrUInt(Values^)-_STRLEN)^=ValueLen) and
           (StrIComp(pointer(Values^),pointer(Value))=0) then
          exit else
          inc(Values);
  result := -1;
end;

function FindPropName(Values: PRawUTF8; const Value: RawUTF8;
  ValuesCount: integer): integer;
var ValueLen: TStrLen;
begin
  dec(ValuesCount);
  ValueLen := length(Value);
  if ValueLen=0 then
    for result := 0 to ValuesCount do
      if Values^='' then
        exit else
        inc(Values) else
    for result := 0 to ValuesCount do
      if (PtrUInt(Values^)<>0) and
         (PStrLen(PtrUInt(Values^)-_STRLEN)^=ValueLen) and
         IdemPropNameUSameLen(pointer(Values^),pointer(Value),ValueLen) then
        exit else
        inc(Values);
  result := -1;
end;

function FindRawUTF8(const Values: TRawUTF8DynArray; const Value: RawUTF8;
  CaseSensitive: boolean): integer;
begin
  result := FindRawUTF8(pointer(Values),Value,length(Values),CaseSensitive);
end;

function FindRawUTF8(const Values: array of RawUTF8; const Value: RawUTF8;
  CaseSensitive: boolean): integer;
begin
  result := high(Values);
  if result>=0 then
    result := FindRawUTF8(@Values[0],Value,result+1,CaseSensitive);
end;

function FindPropName(const Names: array of RawUTF8; const Name: RawUTF8): integer;
begin
  result := high(Names);
  if result>=0 then
    result := FindPropName(@Names[0],Name,result+1);
end;

function AddRawUTF8(var Values: TRawUTF8DynArray; const Value: RawUTF8;
  NoDuplicates, CaseSensitive: boolean): boolean;
var i: integer;
begin
  if NoDuplicates then begin
    i := FindRawUTF8(Values,Value,CaseSensitive);
    if i>=0 then begin
      result := false;
      exit;
    end;
  end;
  i := length(Values);
  SetLength(Values,i+1);
  Values[i] := Value;
  result := true;
end;

function NextGrow(capacity: integer): integer;
begin // algorithm similar to TFPList.Expand for the increasing ranges
  result := capacity;
  if result<128 shl 20 then
    if result<8 shl 20 then
      if result<=128 then
        if result>8 then
          inc(result,16) else
          inc(result,4) else
        inc(result,result shr 2) else
      inc(result,result shr 3) else
    inc(result,16 shl 20);
end;

procedure AddRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  const Value: RawUTF8);
var capacity: integer;
begin
  capacity := Length(Values);
  if ValuesCount=capacity then
    SetLength(Values,NextGrow(capacity));
  Values[ValuesCount] := Value;
  inc(ValuesCount);
end;

function RawUTF8DynArrayEquals(const A,B: TRawUTF8DynArray): boolean;
var n,i: integer;
begin
  result := false;
  n := length(A);
  if n<>length(B) then
    exit;
  for i := 0 to n-1 do
    if A[i]<>B[i] then
      exit;
  result := true;
end;

function RawUTF8DynArrayEquals(const A,B: TRawUTF8DynArray; Count: integer): boolean;
var i: integer;
begin
  result := false;
  for i := 0 to Count - 1 do
    if A[i]<>B[i] then
      exit;
  result := true;
end;

procedure StringDynArrayToRawUTF8DynArray(const Source: TStringDynArray;
  var Result: TRawUTF8DynArray);
var i: Integer;
begin
  Finalize(result);
  SetLength(Result,length(Source));
  for i := 0 to length(Source)-1 do
    StringToUTF8(Source[i],Result[i]);
end;

procedure StringListToRawUTF8DynArray(Source: TStringList; var Result: TRawUTF8DynArray);
var i: Integer;
begin
  Finalize(result);
  SetLength(Result,Source.Count);
  for i := 0 to Source.Count-1 do
    StringToUTF8(Source[i],Result[i]);
end;

function FindSectionFirstLine(var source: PUTF8Char; search: PAnsiChar): boolean;
{$ifdef PUREPASCAL}
var tab: PTextCharSet;
begin
  result := false;
  if source=nil then
    exit;
  repeat
    if source^='[' then begin
      inc(source);
      result := IdemPChar(source,search);
    end;
    tab := @TEXT_CHARS;
    while tcNot01013 in tab[source^] do inc(source);
    while tc1013 in tab[source^] do inc(source);
    if result then
      exit; // found
  until source^=#0;
  source := nil;
end;
{$else} {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=source edx=search
        push    eax       // save source var
        mov     eax, [eax]  // eax=source
        test    eax, eax
        jz      @z
        push    ebx
        mov     ebx, edx    // save search
        cmp     byte ptr[eax], '['
        lea     eax, [eax + 1]
        jne     @s
@i:     push    eax
        mov     edx, ebx   // edx=search
        call    IdemPChar
        pop     ecx       // ecx=source
        jmp     @1
@s:     mov     ecx, eax
        xor     eax, eax   // result := false
@1:     mov     dl, [ecx]  // while not (source^ in [#0,#10,#13]) do inc(source);
        inc     ecx
        cmp     dl, 13
        ja      @1
        je      @e
        or      dl, dl
        jz      @0
        cmp     dl, 10
        jne     @1
        cmp     byte[ecx], 13
        jbe     @1
        jmp     @4
@e:     cmp     byte ptr[ecx], 10 // jump #13#10
        jne     @4
        inc     ecx
@4:     test    al, al
        jnz     @x         // exit if IdemPChar returned true
        cmp     byte ptr[ecx], '['
        lea     ecx, [ecx + 1]
        jne     @1
        mov     eax, ecx
        jmp     @i
@0:     xor     ecx, ecx    // set source=nil
@x:     pop     ebx
        pop     edx         // restore source var
        mov     [edx], ecx  // update source var
        ret
@z:     pop     edx         // ignore source var, result := false
end;
{$endif PUREPASCAL}

{$ifdef USENORMTOUPPER}
{$ifdef PUREPASCAL}
function IdemPCharW(p: PWideChar; up: PUTF8Char): boolean;
begin
  result := false;
  if (p=nil) or (up=nil) then
    exit;
  while up^<>#0 do begin
    if (p^>#255) or (up^<>AnsiChar(NormToUpperByte[ord(p^)])) then
      exit;
    inc(up);
    inc(p);
  end;
  result := true;
end;
{$else}
function IdemPCharW(p: PWideChar; up: PUTF8Char): boolean; {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=p edx=up
        test    eax, eax
        jz      @e // P=nil -> false
        test    edx, edx
        push    ebx
        push    esi
        jz      @z // up=nil -> true
        mov     esi, offset NormToUpper
        xor     ebx, ebx
        xor     ecx, ecx
@1:     mov     bx, [eax]  // bl=p^
        mov     cl, [edx]  // cl=up^
        test    bh, bh     // p^ > #255 -> FALSE
        jnz     @n
        test    cl, cl
        mov     bl, [ebx + esi] // bl=NormToUpper[p^]
        jz      @z              // up^=#0 -> OK
        inc     edx
        add     eax, 2
        cmp     bl, cl
        je      @1
@n:     pop     esi
        pop     ebx
@e:     xor     eax, eax
        ret
@z:     mov     al, 1 // up^=#0 -> OK
        pop     esi
        pop     ebx
end;
{$endif PUREPASCAL}
{$else}
function IdemPCharW(p: PWideChar; up: PUTF8Char): boolean;
// if the beginning of p^ is same as up^ (ignore case - up^ must be already Upper)
begin
  result := false;
  if (p=nil) or (up=nil) then
    exit;
  while up^<>#0 do begin
    if (p^>#255) or (up^<>AnsiChar(NormToUpperByteAnsi7[ord(p^)])) then
      exit;
    inc(up);
    inc(p);
  end;
  result := true;
end;
{$endif USENORMTOUPPER}

function FindNameValue(P: PUTF8Char; UpperName: PAnsiChar): PUTF8Char;
var
  {$ifdef CPUX86NOTPIC}
  table: TNormTable absolute NormToUpperAnsi7;
  {$else}
  table: PNormTable;
  {$endif}
  c: AnsiChar;
  u: PAnsiChar;
label
  _0;
begin
  if (P = nil) or (UpperName = nil) then
    goto _0;
  {$ifndef CPUX86NOTPIC} table := @NormToUpperAnsi7; {$endif}
  repeat
    c := UpperName^;
    if table[P^] = c then
    begin
      inc(P);
      u := UpperName + 1;
      repeat
        c := u^;
        inc(u);
        if c <> #0 then
        begin
          if table[P^] <> c then
            break;
          inc(P);
          continue;
        end;
        result := P; // if found, points just after UpperName
        exit;
      until false;
    end;
    repeat
      repeat
        c := P^;
        inc(P);
      until c <= #13;
      if c = #13 then // most common case is text ending with #13#10
        repeat
          c := P^;
          if (c <> #10) and (c <> #13) then
            break;
          inc(P);
        until false
      else if c <> #10 then
        if c <> #0 then
          continue // e.g. #9
        else
          goto _0
      else
        repeat
          c := P^;
          if c <> #10 then
            break;
          inc(P);
        until false;
      if c <> #0 then
        break; // check if UpperName is at the begining of the new line
_0:   result := nil; // reached P^=#0 -> not found
      exit;
    until false;
  until false;
end;

function FindNameValue(const NameValuePairs: RawUTF8; UpperName: PAnsiChar;
  var Value: RawUTF8): boolean;
var
  P: PUTF8Char;
  L: PtrInt;
begin
  P := FindNameValue(pointer(NameValuePairs), UpperName);
  if P <> nil then
  begin
    while P^ in [#9, ' '] do // trim left
      inc(P);
    L := 0;
    while P[L] > #13 do // end of line/value
      inc(L);
    while P[L - 1] = ' ' do // trim right
      dec(L);
    FastSetString(Value, P, L);
    result := true;
  end
  else
  begin
    {$ifdef FPC} Finalize(Value); {$else} Value := ''; {$endif}
    result := false;
  end;
end;

function FindSectionFirstLineW(var source: PWideChar; search: PUTF8Char): boolean;
{$ifdef PUREPASCAL}
begin
  result := false;
  if source=nil then
    exit;
  repeat
    if source^='[' then begin
      inc(source);
      result := IdemPCharW(source,search);
    end;
    while not (cardinal(source^) in [0,10,13]) do inc(source);
    while cardinal(source^) in [10,13] do inc(source);
    if result then
      exit; // found
  until source^=#0;
  source := nil;
end;
{$else} {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=source edx=search
        push    eax        // save source var
        mov     eax, [eax] // eax=source
        test    eax, eax
        jz      @z
        push    ebx
        mov     ebx, edx   // save search
        cmp     word ptr[eax], '['
        lea     eax, [eax + 2]
        jne     @s
@i:     push    eax
        mov     edx, ebx   // edx=search
        call    IdemPCharW
        pop     ecx        // ecx=source
        jmp     @1
@s:     mov     ecx, eax
        xor     eax, eax   // result := false
@1:     mov     dx, [ecx]  // while not (source^ in [#0,#10,#13]) do inc(source)
        add     ecx, 2
        cmp     dx, 13
        ja      @1
        je      @e
        or      dx, dx
        jz      @0
        cmp     dx, 10
        jne     @1
        jmp     @4
@e:     cmp     word ptr[ecx], 10 // jump #13#10
        jne     @4
        add     ecx, 2
@4:     test    al, al
        jnz     @x         // exit if IdemPChar returned true
        cmp     word ptr[ecx], '['
        lea     ecx, [ecx + 2]
        jne     @1
        mov     eax, ecx
        jmp     @i
@0:     xor     ecx, ecx    // set source=nil
@x:     pop     ebx
        pop     edx         // restore source var
        mov     [edx], ecx  // update source var
        ret
@z:     pop     edx         // ignore source var, result := false
end;
{$endif PUREPASCAL}

function FindIniNameValue(P: PUTF8Char; UpperName: PAnsiChar): RawUTF8;
var u, PBeg: PUTF8Char;
    by4: cardinal;
    table: {$ifdef CPUX86NOTPIC}TNormTable absolute NormToUpperAnsi7{$else}PNormTable{$endif};
begin // expect UpperName as 'NAME='
  if (P<>nil) and (P^<>'[') and (UpperName<>nil) then begin
    {$ifndef CPUX86NOTPIC}table := @NormToUpperAnsi7;{$endif}
    PBeg := nil;
    u := P;
    repeat
      while u^=' ' do inc(u); // trim left ' '
      if u^=#0 then
        break;
      if table[u^]=UpperName[0] then
        PBeg := u;
      repeat
        by4 := PCardinal(u)^;
        if ToByte(by4)>13 then
          if ToByte(by4 shr 8)>13 then
            if ToByte(by4 shr 16)>13 then
              if ToByte(by4 shr 24)>13 then begin
                inc(u,4);
                continue;
              end else
              inc(u,3) else
            inc(u,2) else
          inc(u);
        if u^ in [#0,#10,#13] then
          break else
          inc(u);
      until false;
      if PBeg<>nil then begin
        inc(PBeg);
        P := u;
        u := pointer(UpperName+1);
        repeat
          if u^<>#0 then
            if table[PBeg^]<>u^ then
              break else begin
              inc(u);
              inc(PBeg);
            end else begin
            FastSetString(result,PBeg,P-PBeg);
            exit;
          end;
        until false;
        PBeg := nil;
        u := P;
      end;
      if u^=#13 then inc(u);
      if u^=#10 then inc(u);
    until u^ in [#0,'['];
  end;
  result := '';
end;

function ExistsIniName(P: PUTF8Char; UpperName: PAnsiChar): boolean;
var table: PNormTable;
begin
  result := false;
  table := @NormToUpperAnsi7;
  if (P<>nil) and (P^<>'[') then
    repeat
      if P^=' ' then begin
        repeat inc(P) until P^<>' '; // trim left ' '
        if P^=#0 then
          break;
      end;
      if IdemPChar2(table,P,UpperName) then begin
        result := true;
        exit;
      end;
      repeat
        if P[0]>#13 then
          if P[1]>#13 then
            if P[2]>#13 then
              if P[3]>#13 then begin
                inc(P,4);
                continue;
              end else
              inc(P,3) else
            inc(P,2) else
          inc(P);
        case P^ of
        #0: exit;
        #10: begin inc(P); break; end;
        #13: begin if P[1]=#10 then inc(P,2) else inc(P); break; end;
        else inc(P);
        end;
      until false;
    until P^='[';
end;

function ExistsIniNameValue(P: PUTF8Char; const UpperName: RawUTF8;
  const UpperValues: array of PAnsiChar): boolean;
var PBeg: PUTF8Char;
begin
  result := true;
  if high(UpperValues)>=0 then
    while (P<>nil) and (P^<>'[') do begin
      if P^=' ' then repeat inc(P) until P^<>' '; // trim left ' '
      PBeg := P;
      if IdemPChar(PBeg,pointer(UpperName)) then begin
        inc(PBeg,length(UpperName));
        if IdemPCharArray(PBeg,UpperValues)>=0 then
          exit; // found one value
        break;
      end;
      P := GotoNextLine(P);
    end;
  result := false;
end;

function GetSectionContent(SectionFirstLine: PUTF8Char): RawUTF8;
var PBeg: PUTF8Char;
begin
  PBeg := SectionFirstLine;
  while (SectionFirstLine<>nil) and (SectionFirstLine^<>'[') do
    SectionFirstLine := GotoNextLine(SectionFirstLine);
  if SectionFirstLine=nil then
    result := PBeg else
    FastSetString(result,PBeg,SectionFirstLine-PBeg);
end;

function GetSectionContent(const Content, SectionName: RawUTF8): RawUTF8;
var P: PUTF8Char;
    UpperSection: array[byte] of AnsiChar;
begin
  P := pointer(Content);
  PWord(UpperCopy255(UpperSection,SectionName))^ := ord(']');
  if FindSectionFirstLine(P,UpperSection) then
    result := GetSectionContent(P) else
    result := '';
end;

function DeleteSection(var Content: RawUTF8; const SectionName: RawUTF8;
  EraseSectionHeader: boolean): boolean;
var P: PUTF8Char;
    UpperSection: array[byte] of AnsiChar;
begin
  result := false; // no modification
  P := pointer(Content);
  PWord(UpperCopy255(UpperSection,SectionName))^ := ord(']');
  if FindSectionFirstLine(P,UpperSection) then
    result := DeleteSection(P,Content,EraseSectionHeader);
end;

function DeleteSection(SectionFirstLine: PUTF8Char; var Content: RawUTF8;
  EraseSectionHeader: boolean): boolean;
var PEnd: PUTF8Char;
    IndexBegin: PtrInt;
begin
  result := false;
  PEnd := SectionFirstLine;
  if EraseSectionHeader then // erase [Section] header line
    while (PtrUInt(SectionFirstLine)>PtrUInt(Content)) and (SectionFirstLine^<>'[') do dec(SectionFirstLine);
  while (PEnd<>nil) and (PEnd^<>'[') do
    PEnd := GotoNextLine(PEnd);
  IndexBegin := SectionFirstLine-pointer(Content);
  if IndexBegin=0 then
    exit; // no modification
  if PEnd=nil then
    SetLength(Content,IndexBegin) else
    delete(Content,IndexBegin+1,PEnd-SectionFirstLine);
  result := true; // Content was modified
end;

procedure ReplaceSection(SectionFirstLine: PUTF8Char;
  var Content: RawUTF8; const NewSectionContent: RawUTF8);
var PEnd: PUTF8Char;
    IndexBegin: PtrInt;
begin
  if SectionFirstLine=nil then
    exit;
  // delete existing [Section] content
  PEnd := SectionFirstLine;
  while (PEnd<>nil) and (PEnd^<>'[') do
    PEnd := GotoNextLine(PEnd);
  IndexBegin := SectionFirstLine-pointer(Content);
  if PEnd=nil then
    SetLength(Content,IndexBegin) else
    delete(Content,IndexBegin+1,PEnd-SectionFirstLine);
  // insert section content
  insert(NewSectionContent,Content,IndexBegin+1);
end;

procedure ReplaceSection(var Content: RawUTF8; const SectionName,
  NewSectionContent: RawUTF8);
var UpperSection: array[byte] of AnsiChar;
    P: PUTF8Char;
begin
  P := pointer(Content);
  PWord(UpperCopy255(UpperSection,SectionName))^ := ord(']');
  if FindSectionFirstLine(P,UpperSection) then
    ReplaceSection(P,Content,NewSectionContent) else
    Content := Content+'['+SectionName+']'#13#10+NewSectionContent;
end;

function FindIniNameValueInteger(P: PUTF8Char; UpperName: PAnsiChar): PtrInt;
begin
  result := GetInteger(pointer(FindIniNameValue(P,UpperName)));
end;

function FindIniEntry(const Content, Section, Name: RawUTF8): RawUTF8;
var P: PUTF8Char;
    UpperSection, UpperName: array[byte] of AnsiChar;
    // possible GPF if length(Section/Name)>255, but should const in code
begin
  result := '';
  P := pointer(Content);
  if P=nil then exit;
  // UpperName := UpperCase(Name)+'=';
  PWord(UpperCopy255(UpperName,Name))^ := ord('=');
  if Section='' then
     // find the Name= entry before any [Section]
    result := FindIniNameValue(P,UpperName) else begin
     // find the Name= entry in the specified [Section]
    PWord(UpperCopy255(UpperSection,Section))^ := ord(']');
    if FindSectionFirstLine(P,UpperSection) then
      result := FindIniNameValue(P,UpperName);
  end;
end;

function FindWinAnsiIniEntry(const Content, Section,Name: RawUTF8): RawUTF8;
begin
  result := WinAnsiToUtf8(WinAnsiString(FindIniEntry(Content,Section,Name)));
end;

function FindIniEntryInteger(const Content,Section,Name: RawUTF8): integer;
begin
  result := GetInteger(pointer(FindIniEntry(Content,Section,Name)));
end;

function FindIniEntryFile(const FileName: TFileName; const Section,Name: RawUTF8): RawUTF8;
var Content: RawUTF8;
begin
  Content := StringFromFile(FileName);
  if Content='' then
    result := '' else
    result := FindIniEntry(Content,Section,Name);
end;

function UpdateIniNameValueInternal(var Content: RawUTF8;
  const NewValue, NewValueCRLF: RawUTF8; var P: PUTF8Char;
  UpperName: PAnsiChar; UpperNameLength: integer): boolean;
var PBeg: PUTF8Char;
    i: integer;
begin
  while (P<>nil) and (P^<>'[') do begin
    while P^=' ' do inc(P);   // trim left ' '
    PBeg := P;
    P := GotoNextLine(P);
    if IdemPChar(PBeg,UpperName) then begin
     // update Name=Value entry
     result := true;
     inc(PBeg,UpperNameLength);
     i := (PBeg-pointer(Content))+1;
     if (i=length(NewValue)) and CompareMem(PBeg,pointer(NewValue),i) then
       exit; // new Value is identical to the old one -> no change
     if P=nil then // avoid last line (P-PBeg) calculation error
       SetLength(Content,i-1) else
       delete(Content,i,P-PBeg); // delete old Value
     insert(NewValueCRLF,Content,i); // set new value
     exit;
    end;
  end;
  result := false;
end;

function UpdateIniNameValue(var Content: RawUTF8; const Name, UpperName, NewValue: RawUTF8): boolean;
var P: PUTF8Char;
begin
  if UpperName='' then
    result := false else begin
    P := pointer(Content);
    result := UpdateIniNameValueInternal(Content,NewValue,NewValue+#13#10,P,
      pointer(UpperName),length(UpperName));
    if result or (Name='') then
      exit;
    if Content<>'' then
      Content := Content+#13#10;
    Content := Content+Name+NewValue;
    result := true;
  end;
end;

procedure UpdateIniEntry(var Content: RawUTF8; const Section,Name,Value: RawUTF8);
const CRLF = #13#10;
var P: PUTF8Char;
    SectionFound: boolean;
    i, UpperNameLength: PtrInt;
    V: RawUTF8;
    UpperSection, UpperName: array[byte] of AnsiChar;
label Sec;
begin
  UpperNameLength := length(Name);
  PWord(UpperCopy255Buf(UpperName,pointer(Name),UpperNameLength))^ := ord('=');
  inc(UpperNameLength);
  V := Value+CRLF;
  P := pointer(Content);
  // 1. find Section, and try update within it
  if Section='' then
    goto Sec; // find the Name= entry before any [Section]
  SectionFound := false;
  PWord(UpperCopy255(UpperSection,Section))^ := ord(']');
  if FindSectionFirstLine(P,UpperSection) then begin
Sec:SectionFound := true;
    if UpdateIniNameValueInternal(Content,Value,V,P,@UpperName,UpperNameLength) then
      exit;
    // we reached next [Section] without having found Name=
   end;
  // 2. section or Name= entry not found: add Name=Value
  V := Name+'='+V;
  if not SectionFound then
    // create not existing [Section]
    V := '['+Section+(']'+CRLF)+V;
  // insert Name=Value at P^ (end of file or end of [Section])
  if P=nil then
    // insert at end of file
    Content := Content+V else begin
    // insert at end of [Section]
    i := (P-pointer(Content))+1;
    insert(V,Content,i);
  end;
end;

procedure UpdateIniEntryFile(const FileName: TFileName; const Section,Name,Value: RawUTF8);
var Content: RawUTF8;
begin
  Content := StringFromFile(FileName);
  UpdateIniEntry(Content,Section,Name,Value);
  FileFromString(Content,FileName);
end;

function StringFromFile(const FileName: TFileName; HasNoSize: boolean): RawByteString;
var F: THandle;
    Read, Size, Chunk: integer;
    P: PUTF8Char;
    tmp: array[0..$7fff] of AnsiChar;
begin
  result := '';
  if FileName='' then
    exit;
  F := FileOpenSequentialRead(FileName);
  if PtrInt(F)>=0 then begin
    if HasNoSize then begin
      Size := 0;
      repeat
        Read := FileRead(F,tmp,SizeOf(tmp));
        if Read<=0 then
          break;
        SetLength(result,Size+Read); // in-place resize
        MoveFast(tmp,PByteArray(result)^[Size],Read);
        inc(Size,Read);
      until false;
    end else begin
      Size := GetFileSize(F,nil);
      if Size>0 then begin
        SetLength(result,Size);
        P := pointer(result);
        repeat
          Chunk := Size;
          {$ifdef MSWINDOWS} // FILE_FLAG_SEQUENTIAL_SCAN has limits on XP
          if Chunk>32 shl 20 then
            Chunk := 32 shl 20; // avoid e.g. ERROR_NO_SYSTEM_RESOURCES
          {$endif}
          Read := FileRead(F,P^,Chunk);
          if Read<=0 then begin
            result := '';
            break;
          end;
          inc(P,Read);
          dec(Size,Read);
        until Size=0;
      end;
    end;
    FileClose(F);
  end;
end;

function FileFromString(const Content: RawByteString; const FileName: TFileName;
  FlushOnDisk: boolean; FileDate: TDateTime): boolean;
var F: THandle;
    P: PByte;
    L,written: integer;
begin
  result := false;
  if FileName='' then
    exit;
  F := FileCreate(FileName);
  if PtrInt(F)<0 then
    exit;
  L := length(Content);
  P := pointer(Content);
  while L>0 do begin
    written := FileWrite(F,P^,L);
    if written<0 then begin
      FileClose(F);
      exit;
    end;
    dec(L,written);
    inc(P,written);
  end;
  if FlushOnDisk then
    FlushFileBuffers(F);
  {$ifdef MSWINDOWS}
  if FileDate<>0 then
    FileSetDate(F,DateTimeToFileDate(FileDate));
  FileClose(F);
  {$else}
  FileClose(F);
  if FileDate<>0 then
    FileSetDate(FileName,DateTimeToFileDate(FileDate));
  {$endif MSWINDOWS}
  result := true;
end;

type
  TTextFileKind = (isUnicode, isUTF8, isAnsi);

function TextFileKind(const Map: TMemoryMap): TTextFileKind;
begin
  result := isAnsi;
  if (Map.Buffer<>nil) and (Map.Size>3) then
    if PWord(Map.Buffer)^=$FEFF then
      result := isUnicode else
    if (PWord(Map.Buffer)^=$BBEF) and (PByteArray(Map.Buffer)[2]=$BF) then
      result := isUTF8;
end;

function AnyTextFileToSynUnicode(const FileName: TFileName; ForceUTF8: boolean): SynUnicode;
var Map: TMemoryMap;
begin
  result := '';
  if Map.Map(FileName) then
  try
    if ForceUTF8 then
      UTF8ToSynUnicode(PUTF8Char(Map.Buffer),Map.Size,Result) else
    case TextFileKind(Map) of
    isUnicode:
      SetString(result,PWideChar(PtrUInt(Map.Buffer)+2),(Map.Size-2) shr 1);
    isUTF8:
      UTF8ToSynUnicode(PUTF8Char(pointer(PtrUInt(Map.Buffer)+3)),Map.Size-3,Result);
    isAnsi:
      result := CurrentAnsiConvert.AnsiToUnicodeString(Map.Buffer, Map.Size);
    end;
  finally
    Map.UnMap;
  end;
end;

function AnyTextFileToRawUTF8(const FileName: TFileName; AssumeUTF8IfNoBOM: boolean): RawUTF8;
var Map: TMemoryMap;
begin
  result := '';
  if Map.Map(FileName) then
  try
    case TextFileKind(Map) of
    isUnicode:
      RawUnicodeToUtf8(PWideChar(PtrUInt(Map.Buffer)+2),(Map.Size-2) shr 1,Result);
    isUTF8:
      FastSetString(result,pointer(PtrUInt(Map.Buffer)+3),Map.Size-3);
    isAnsi:
      if AssumeUTF8IfNoBOM then
        FastSetString(result,Map.Buffer,Map.Size) else
        result := CurrentAnsiConvert.AnsiBufferToRawUTF8(Map.Buffer, Map.Size);
    end;
  finally
    Map.UnMap;
  end;
end;

function AnyTextFileToString(const FileName: TFileName; ForceUTF8: boolean): string;
var Map: TMemoryMap;
begin
  result := '';
  if Map.Map(FileName) then
  try
    if ForceUTF8 then
{$ifdef UNICODE}
      UTF8DecodeToString(PUTF8Char(Map.Buffer),Map.Size,result) {$else}
      result := CurrentAnsiConvert.UTF8BufferToAnsi(PUTF8Char(Map.Buffer),Map.Size)
{$endif} else
    case TextFileKind(Map) of
{$ifdef UNICODE}
    isUnicode:
      SetString(result,PWideChar(PtrUInt(Map.Buffer)+2),(Map.Size-2) shr 1);
    isUTF8:
      UTF8DecodeToString(pointer(PtrUInt(Map.Buffer)+3),Map.Size-3,result);
    isAnsi:
      result := CurrentAnsiConvert.AnsiToUnicodeString(Map.Buffer,Map.Size);
{$else}
    isUnicode:
      result := CurrentAnsiConvert.UnicodeBufferToAnsi(PWideChar(PtrUInt(Map.Buffer)+2),(Map.Size-2) shr 1);
    isUTF8:
      result := CurrentAnsiConvert.UTF8BufferToAnsi(pointer(PtrUInt(Map.Buffer)+3),Map.Size-3);
    isAnsi:
      SetString(result,PAnsiChar(Map.Buffer),Map.Size);
{$endif UNICODE}
    end;
  finally
    Map.UnMap;
  end;
end;

function StreamToRawByteString(aStream: TStream): RawByteString;
var current, size: Int64;
begin
  result := '';
  if aStream=nil then
    exit;
  current := aStream.Position;
  if (current=0) and aStream.InheritsFrom(TRawByteStringStream) then begin
    result := TRawByteStringStream(aStream).DataString; // fast COW
    exit;
  end;
  size := aStream.Size-current;
  if (size=0) or (size>maxInt) then
    exit;
  SetLength(result,size);
  aStream.Read(pointer(result)^,size);
  aStream.Position := current;
end;

function RawByteStringToStream(const aString: RawByteString): TStream;
begin
  result := TRawByteStringStream.Create(aString);
end;

function ReadStringFromStream(S: TStream; MaxAllowedSize: integer): RawUTF8;
var L: integer;
begin
  result := '';
  L := 0;
  if (S.Read(L,4)<>4) or (L<=0) or (L>MaxAllowedSize) then
    exit;
  FastSetString(result,nil,L);
  if S.Read(pointer(result)^,L)<>L then
    result := '';
end;

function WriteStringToStream(S: TStream; const Text: RawUTF8): boolean;
var L: integer;
begin
  L := length(Text);
  if L=0 then
    result := S.Write(L,4)=4 else
    {$ifdef FPC}
    result := (S.Write(L,4)=4) and (S.Write(pointer(Text)^,L)=L);
    {$else}
    result := S.Write(pointer(PtrInt(Text)-SizeOf(integer))^,L+4)=L+4;
    {$endif FPC}
end;

function GetFileNameWithoutExt(const FileName: TFileName;
  Extension: PFileName): TFileName;
var i, max: PtrInt;
begin
  i := length(FileName);
  max := i-16;
  while (i>0) and not(cardinal(FileName[i]) in [ord('\'),ord('/'),ord('.')])
    and (i>=max) do dec(i);
  if (i=0) or (FileName[i]<>'.') then begin
    result := FileName;
    if Extension<>nil then
      Extension^ := '';
  end else begin
    result := copy(FileName,1,i-1);
    if Extension<>nil then
      Extension^ := copy(FileName,i,20);
  end;
end;

function GetFileNameExtIndex(const FileName, CSVExt: TFileName): integer;
var Ext: TFileName;
    P: PChar;
begin
  result := -1;
  P := pointer(CSVExt);
  Ext := ExtractFileExt(FileName);
  if (P=nil) or (Ext='') or (Ext[1]<>'.') then
    exit;
  delete(Ext,1,1);
  repeat
    inc(result);
    if SameText(GetNextItemString(P),Ext) then
      exit;
  until P=nil;
  result := -1;
end;

function FileSize(const FileName: TFileName): Int64;
{$ifdef MSWINDOWS}
var FA: WIN32_FILE_ATTRIBUTE_DATA;
begin // 5 times faster than CreateFile, GetFileSizeEx, CloseHandle
  if GetFileAttributesEx(pointer(FileName),GetFileExInfoStandard,@FA) then begin
    PInt64Rec(@result)^.Lo := FA.nFileSizeLow;
    PInt64Rec(@result)^.Hi := FA.nFileSizeHigh;
  end else
    result := 0;
end;
{$else}
var f: THandle;
    res: Int64Rec absolute result;
begin
  result := 0;
  f := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  if PtrInt(f)>0 then begin
    res.Lo := GetFileSize(f,@res.Hi); // from SynKylix/SynFPCLinux
    FileClose(f);
  end;
end;
{$endif MSWINDOWS}

function FileSize(F: THandle): Int64;
var res: Int64Rec absolute result;
begin
  result := 0;
  if PtrInt(F)>0 then
    res.Lo := GetFileSize(F,@res.Hi); // from WinAPI or SynKylix/SynFPCLinux
end;

function FileInfoByHandle(aFileHandle: THandle; out FileId, FileSize,
  LastWriteAccess, FileCreateDateTime: Int64): Boolean;
var
 lastreadaccess: TUnixMSTime;
 {$ifdef MSWINDOWS}
 lp: TByHandleFileInformation;
 {$else}
 lp: {$ifdef FPC}stat{$else}TStatBuf64{$endif};
 r: integer;
 {$endif MSWINDOWS}
begin
{$ifdef MSWINDOWS}
  result := GetFileInformationByHandle(aFileHandle,lp);
  if not result then
    exit;
  LastWriteAccess := FileTimeToUnixMSTime(lp.ftLastWriteTime);
  FileCreateDateTime := FileTimeToUnixMSTime(lp.ftCreationTime);
  lastreadaccess := FileTimeToUnixMSTime(lp.ftLastAccessTime);
  PInt64Rec(@FileSize).lo := lp.nFileSizeLow;
  PInt64Rec(@FileSize).hi := lp.nFileSizeHigh;
  PInt64Rec(@FileId).lo := lp.nFileIndexLow;
  PInt64Rec(@FileId).hi := lp.nFileIndexHigh;
{$else}
  r := {$ifdef FPC}FpFStat{$else}fstat64{$endif}(aFileHandle, lp);
  result := r >= 0;
  if not result then
    exit;
  FileId := lp.st_ino;
  FileSize := lp.st_size;
  lastreadaccess := lp.st_atime * MSecsPerSec;
  LastWriteAccess := lp.st_mtime * MSecsPerSec;
  {$ifdef OPENBSD}
  if (lp.st_birthtime <> 0) and (lp.st_birthtime < lp.st_ctime) then
    lp.st_ctime:= lp.st_birthtime;
  {$endif}
  FileCreateDateTime := lp.st_ctime * MSecsPerSec;
{$endif MSWINDOWS}
  if LastWriteAccess <> 0 then
    if (FileCreateDateTime = 0) or (FileCreateDateTime > LastWriteAccess) then
      FileCreateDateTime:= LastWriteAccess;
  if lastreadaccess <> 0 then
    if (FileCreateDateTime = 0) or (FileCreateDateTime > lastreadaccess) then
      FileCreateDateTime:= lastreadaccess;
end;

function FileAgeToDateTime(const FileName: TFileName): TDateTime;
{$ifdef MSWINDOWS}
var FA: WIN32_FILE_ATTRIBUTE_DATA;
    ST,LT: TSystemTime;
begin // 5 times faster than CreateFile, GetFileSizeEx, CloseHandle
  if GetFileAttributesEx(pointer(FileName),GetFileExInfoStandard,@FA) and
     FileTimeToSystemTime(FA.ftLastWriteTime,ST) and
     SystemTimeToTzSpecificLocalTime(nil,ST,LT) then
    result := SystemTimeToDateTime(LT) else
    result := 0;
end;
{$else}
{$ifdef HASNEWFILEAGE}
begin
  if not FileAge(FileName,result) then
{$else}
var Age: integer;
begin
  Age := FileAge(FileName);
  if Age<>-1 then
    result := FileDateToDateTime(Age) else
{$endif HASNEWFILEAGE}
    result := 0;
end;
{$endif MSWINDOWS}

function CopyFile(const Source, Target: TFileName; FailIfExists: boolean): boolean;
{$ifdef MSWINDOWS}
begin
  result := Windows.CopyFile(pointer(Source),pointer(Target),FailIfExists);
end;
{$else}
var SourceF, DestF: TFileStream;
begin
  result := false;
  if FailIfExists then
    if FileExists(Target) then
      exit else
      DeleteFile(Target);
  try
    SourceF := TFileStream.Create(Source,fmOpenRead);
    try
      DestF := TFileStream.Create(Target,fmCreate);
      try
        DestF.CopyFrom(SourceF, SourceF.Size);
      finally
        DestF.Free;
      end;
      FileSetDateFrom(Target,SourceF.Handle);
    finally
      SourceF.Free;
    end;
    result := true;
  except
    result := false;
  end;
end;
{$endif}

function SearchRecToDateTime(const F: TSearchRec): TDateTime;
begin
  {$ifdef ISDELPHIXE}
  result := F.Timestamp;
  {$else}
  result := FileDateToDateTime(F.Time);
  {$endif}
end;

function SearchRecValidFile(const F: TSearchRec): boolean; 
begin
  {$ifndef DELPHI5OROLDER}
  {$WARN SYMBOL_DEPRECATED OFF} // for faVolumeID
  {$endif}
  result := (F.Name<>'') and (F.Attr and (faDirectory
    {$ifdef MSWINDOWS}+faVolumeID+faSysFile+faHidden)=0) and (F.Name[1]<>'.')
    {$else})=0){$endif};
  {$ifndef DELPHI5OROLDER}
  {$WARN SYMBOL_DEPRECATED ON}
  {$endif}
end;

function SearchRecValidFolder(const F: TSearchRec): boolean;
begin
  result := (F.Attr and (faDirectory {$ifdef MSWINDOWS}+faHidden{$endif})=faDirectory) and
    (F.Name<>'') and (F.Name<>'.') and (F.Name<>'..');
end;

function DirectoryDelete(const Directory: TFileName; const Mask: TFileName;
  DeleteOnlyFilesNotDirectory: Boolean; DeletedCount: PInteger): Boolean;
var F: TSearchRec;
    Dir: TFileName;
    n: integer;
begin
  n := 0;
  result := true;
  if DirectoryExists(Directory) then begin
    Dir := IncludeTrailingPathDelimiter(Directory);
    if FindFirst(Dir+Mask,faAnyFile-faDirectory,F)=0 then begin
      repeat
        if SearchRecValidFile(F) then
          if DeleteFile(Dir+F.Name) then
            inc(n) else
            result := false;
      until FindNext(F)<>0;
      FindClose(F);
    end;
    if not DeleteOnlyFilesNotDirectory and not RemoveDir(Dir) then
      result := false;
  end;
  if DeletedCount<>nil then
    DeletedCount^ := n;
end;

function DirectoryDeleteOlderFiles(const Directory: TFileName; TimePeriod: TDateTime;
   const Mask: TFileName; Recursive: Boolean; TotalSize: PInt64): Boolean;
var F: TSearchRec;
    Dir: TFileName;
    old: TDateTime;
begin
  if not Recursive and (TotalSize<>nil) then
    TotalSize^ := 0;
  result := true;
  if (Directory='') or not DirectoryExists(Directory) then
    exit;
  Dir := IncludeTrailingPathDelimiter(Directory);
  if FindFirst(Dir+Mask,faAnyFile,F)=0 then begin
    old := Now - TimePeriod;
    repeat
      if F.Name[1]<>'.' then
        if Recursive and (F.Attr and faDirectory<>0) then
          DirectoryDeleteOlderFiles(Dir+F.Name,TimePeriod,Mask,true,TotalSize) else
        if SearchRecValidFile(F) and (SearchRecToDateTime(F) < old) then
          if not DeleteFile(Dir+F.Name) then
            result := false else
            if TotalSize<>nil then
              inc(TotalSize^,F.Size);
    until FindNext(F)<>0;
    FindClose(F);
  end;
end;

procedure TFindFiles.FromSearchRec(const Directory: TFileName; const F: TSearchRec);
begin
  Name := Directory+F.Name;
  {$ifdef MSWINDOWS}
  {$ifdef HASINLINE} // FPC or Delphi 2006+
  Size := F.Size;
  {$else} // F.Size was limited to 32-bit on older Delphi
  PInt64Rec(@Size)^.Lo := F.FindData.nFileSizeLow;
  PInt64Rec(@Size)^.Hi := F.FindData.nFileSizeHigh;
  {$endif}
  {$else}
  Size := F.Size;
  {$endif}
  Attr := F.Attr;
  Timestamp := SearchRecToDateTime(F);
end;

function TFindFiles.ToText: shortstring;
begin
  FormatShort('% % %',[Name,KB(Size),DateTimeToFileShort(Timestamp)],result);
end;

function FindFiles(const Directory,Mask,IgnoreFileName: TFileName;
  SortByName,IncludesDir,SubFolder: boolean): TFindFilesDynArray;
var m,count: integer;
    dir: TFileName;
    da: TDynArray;
    masks: TRawUTF8DynArray;
    masked: TFindFilesDynArray;
  procedure SearchFolder(const folder : TFileName);
  var
    F: TSearchRec;
    ff: TFindFiles;
  begin
    if FindFirst(dir+folder+Mask,faAnyfile-faDirectory,F)=0 then begin
      repeat
        if SearchRecValidFile(F) and ((IgnoreFileName='') or
            (AnsiCompareFileName(F.Name,IgnoreFileName)<>0)) then begin
          if IncludesDir then
            ff.FromSearchRec(dir+folder,F) else
            ff.FromSearchRec(folder,F);
          da.Add(ff);
        end;
      until FindNext(F)<>0;
      FindClose(F);
    end;
    if SubFolder and (FindFirst(dir+folder+'*',faDirectory,F)=0) then begin
      repeat
        if SearchRecValidFolder(F) and ((IgnoreFileName='') or
           (AnsiCompareFileName(F.Name,IgnoreFileName)<>0)) then
          SearchFolder(IncludeTrailingPathDelimiter(folder+F.Name));
      until FindNext(F)<>0;
      FindClose(F);
    end;
  end;
begin
  result := nil;
  da.Init(TypeInfo(TFindFilesDynArray),result,@count);
  if Pos(';',Mask)>0 then
    CSVToRawUTF8DynArray(pointer(StringToUTF8(Mask)),masks,';');
  if masks<>nil then begin
    if SortByName then
      QuickSortRawUTF8(masks,length(masks),nil,{$ifdef MSWINDOWS}@StrIComp{$else}@StrComp{$endif});
    for m := 0 to length(masks)-1 do begin // masks[] recursion
      masked := FindFiles(Directory,UTF8ToString(masks[m]),
        IgnoreFileName,SortByName,IncludesDir,SubFolder);
      da.AddArray(masked);
    end;
  end else begin
    if Directory<>'' then
      dir := IncludeTrailingPathDelimiter(Directory);
    SearchFolder('');
    if SortByName and (da.Count>0) then
      da.Sort(SortDynArrayFileName);
  end;
  da.Capacity := count; // trim result[]
end;

function FindFilesDynArrayToFileNames(const Files: TFindFilesDynArray): TFileNameDynArray;
var i,n: PtrInt;
begin
  Finalize(result);
  n := length(Files);
  SetLength(result,n);
  for i := 0 to n-1 do
    result[i] := Files[i].Name;
end;

function SynchFolders(const Reference, Dest: TFileName;
  SubFolder,ByContent,WriteFileNameToConsole: boolean): integer;
var ref,dst: TFileName;
    fref,fdst: TSearchRec;
    reftime: TDateTime;
    s: RawByteString;
begin
  result := 0;
  ref := IncludeTrailingPathDelimiter(Reference);
  dst := IncludeTrailingPathDelimiter(Dest);
  if DirectoryExists(ref) and (FindFirst(dst+FILES_ALL,faAnyFile,fdst)=0) then begin
    repeat
      if SearchRecValidFile(fdst) then begin
        if ByContent then
          reftime := FileAgeToDateTime(ref+fdst.Name) else
          if FindFirst(ref+fdst.Name,faAnyFile,fref)=0 then begin
            reftime := SearchRecToDateTime(fref);
            if (fdst.Size=fref.Size) and (SearchRecToDateTime(fdst)=reftime) then
              reftime := 0;
            FindClose(fref);
          end else
            reftime := 0; // "continue" trigger unexpected warning on Delphi
        if reftime=0 then
          continue; // skip if no reference file to copy from
        s := StringFromFile(ref+fdst.Name);
        if (s='') or (ByContent and (length(s)=fdst.Size) and
           (DefaultHasher(0,pointer(s),fdst.Size)=HashFile(dst+fdst.Name))) then
          continue;
        FileFromString(s,dst+fdst.Name,false,reftime);
        inc(result);
        if WriteFileNameToConsole then
          {$I-} writeln('synched ',dst,fdst.name); {$I+}
      end else if SubFolder and SearchRecValidFolder(fdst) then
        inc(result,SynchFolders(ref+fdst.Name,dst+fdst.Name,SubFolder,ByContent,WriteFileNameToConsole));
    until FindNext(fdst)<>0;
    FindClose(fdst);
  end;
end;

function EnsureDirectoryExists(const Directory: TFileName;
  RaiseExceptionOnCreationFailure: boolean): TFileName;
begin
  result := IncludeTrailingPathDelimiter(ExpandFileName(Directory));
  if not DirectoryExists(result) then
    if not CreateDir(result) then
      if not RaiseExceptionOnCreationFailure then
        result := '' else
        raise ESynException.CreateUTF8('Impossible to create folder %',[result]);
end;

var
  TemporaryFileNameRandom: integer;

function TemporaryFileName: TFileName;
var folder: TFileName;
begin // fast cross-platform implementation
  folder := GetSystemPath(spTempFolder);
  if TemporaryFileNameRandom=0 then
    TemporaryFileNameRandom := Random32gsl;
  repeat // thread-safe unique file name generation
    FormatString('%%_%.tmp',[folder,ExeVersion.ProgramName,
      CardinalToHexShort(InterlockedIncrement(TemporaryFileNameRandom))],string(result));
  until not FileExists(result);
end;

function IsDirectoryWritable(const Directory: TFileName): boolean;
var fn: TFileName;
begin
  fn := ExcludeTrailingPathDelimiter(Directory);
  result := {$ifndef DELPHI5OROLDER}not FileIsReadOnly{$else}DirectoryExists{$endif}(fn);
  if not result then
    exit;
  fn := FormatString('%%.%%',[fn,PathDelim,CardinalToHexShort(integer(GetCurrentThreadID)),
    BinToBase64uriShort(@ExeVersion.Hash,SizeOf(ExeVersion.Hash))]);
  result := FileFromString('tobedeleted',fn); // actually try to write something
  DeleteFile(fn);
end;

{$ifdef DELPHI5OROLDER}

function DirectoryExists(const Directory: string): boolean;
var Code: Integer;
begin
  Code := GetFileAttributes(pointer(Directory));
  result := (Code<>-1) and (FILE_ATTRIBUTE_DIRECTORY and Code<>0);
end;

function SameFileName(const S1, S2: TFileName): Boolean;
begin
  result := AnsiCompareFileName(S1,S2)=0;
end;

function GetEnvironmentVariable(const Name: string): string;
var Len: Integer;
    Buffer: array[0..1023] of Char;
begin
  Result := '';
  Len := Windows.GetEnvironmentVariable(pointer(Name),@Buffer,SizeOf(Buffer));
  if Len<SizeOf(Buffer) then
    SetString(result,Buffer,Len) else begin
    SetLength(result,Len-1);
    Windows.GetEnvironmentVariable(pointer(Name),pointer(result),Len);
  end;
end;

function GetModuleName(Module: HMODULE): TFileName;
var tmp: array[byte] of char;
begin
  SetString(Result,tmp,GetModuleFileName(Module,tmp,SizeOf(tmp)));
end;

function TryEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;
begin
  if (Hour<24) and (Min<60) and (Sec<60) and (MSec<1000) then begin
    Time := (Hour*3600000+Min*60000+Sec*1000+MSec)/MSecsPerDay;
    result := true;
  end else
    result := false;
end;

function ExcludeTrailingPathDelimiter(const FileName: TFileName): TFileName;
begin
  result := ExcludeTrailingBackslash(FileName);
end;

function IncludeTrailingPathDelimiter(const FileName: TFileName): TFileName;
begin
  result := IncludeTrailingBackslash(FileName);
end;

procedure RaiseLastOSError;
var LastError: Integer;
    Error: EOSError;
begin
  LastError := GetLastError;
  if LastError <> 0 then
    Error := EOSError.CreateFmt('System Error.  Code: %d.'#13#10'%s',
      [LastError,SysErrorMessage(LastError)]) else
    Error := EOSError.Create('A call to an OS function failed');
  Error.ErrorCode := LastError;
  raise Error;
end;

{$endif DELPHI5OROLDER}

{$ifdef DELPHI6OROLDER}
procedure VarCastError;
begin
  raise EVariantError.Create('Variant Type Cast Error');
end;
{$endif}

{$ifdef MSWINDOWS}
function FileSetDateFrom(const Dest: TFileName; SourceHandle: integer): boolean;
var FileTime: TFileTime;
    D: THandle;
begin
  D := FileOpen(Dest,fmOpenWrite);
  if D<>THandle(-1) then begin
    result := GetFileTime(SourceHandle,nil,nil,@FileTime) and
              SetFileTime(D,nil,nil,@FileTime);
    FileClose(D);
  end else
    result := false;
end;
{$else}
function FileSetDateFrom(const Dest: TFileName; SourceHandle: integer): boolean;
begin
  result := FileSetDate(Dest,FileGetDate(SourceHandle))=0;
end;
{$endif}

{$IFDEF PUREPASCAL}
{$IFNDEF HASCODEPAGE}
function Pos(const substr, str: RawUTF8): Integer; overload;
begin // the RawByteString version is fast enough
  Result := PosEx(substr,str,1);
end;
{$ENDIF}
{$ENDIF}

function FindObjectEntry(const Content, Name: RawUTF8): RawUTF8;
var L: integer;
begin
  result := Trim(FindIniEntry(Content,'',Name+' ')); // 'Name = Value' format
  if (result<>'') and (result[1]='''') then begin
    L := length(result);
    if result[L]='''' then
      result := copy(result,2,L-2); // 'testDI6322.IAS' -> testDI6322.IAS
  end;
end;

function FindObjectEntryWithoutExt(const Content, Name: RawUTF8): RawUTF8;
begin
  result := RawUTF8(GetFileNameWithoutExt(
    ExtractFileName(TFileName(FindObjectEntry(Content,Name)))));
end;


function Int64ScanExists(P: PInt64Array; Count: PtrInt; const Value: Int64): boolean;
begin
  if P<>nil then begin
    result := true;
    Count := PtrInt(@P[Count-4]);
    repeat
      if PtrUInt(P)>PtrUInt(Count) then
        break;
      if (P^[0]=Value) or (P^[1]=Value) or (P^[2]=Value) or (P^[3]=Value) then
        exit;
      P := @P[4];
    until false;
    inc(Count,4*SizeOf(Value));
    repeat
      if PtrUInt(P)>=PtrUInt(Count) then
        break;
      if P^[0]=Value then
        exit else
        P := @P[1];
    until false;
  end;
  result := false;
end;

function Int64Scan(P: PInt64Array; Count: PtrInt; const Value: Int64): PInt64;
begin
  result := nil;
  if P=nil then
    exit;
  Count := PtrInt(@P[Count-4]);
  repeat
    if PtrUInt(P)>PtrUInt(Count) then
      break;
    if P^[0]<>Value then
    if P^[1]<>Value then
    if P^[2]<>Value then
    if P^[3]<>Value then begin
      P := @P[4];
      continue;
    end else
      result := @P[3] else
      result := @P[2] else
      result := @P[1] else
      result := pointer(P);
    exit;
  until false;
  inc(Count,4*SizeOf(Value));
  result := pointer(P);
  repeat
    if PtrUInt(result)>=PtrUInt(Count) then
      break;
    if result^=Value then
      exit else
      inc(result);
  until false;
  result := nil;
end;

function AddInteger(var Values: TIntegerDynArray; Value: integer;
  NoDuplicates: boolean): boolean;
var n: PtrInt;
begin
  n := Length(Values);
  if NoDuplicates and IntegerScanExists(pointer(Values),n,Value) then begin
    result := false;
    exit;
  end;
  SetLength(Values,n+1);
  Values[n] := Value;
  result := true
end;

procedure AddInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer);
begin
  if ValuesCount=length(Values) then
    SetLength(Values,NextGrow(ValuesCount));
  Values[ValuesCount] := Value;
  inc(ValuesCount);
end;

function AddInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer; NoDuplicates: boolean): boolean;
begin
  if NoDuplicates and IntegerScanExists(pointer(Values),ValuesCount,Value) then begin
    result := false;
    exit;
  end;
  if ValuesCount=length(Values) then
    SetLength(Values,NextGrow(ValuesCount));
  Values[ValuesCount] := Value;
  inc(ValuesCount);
  result := true;
end;

function AddInteger(var Values: TIntegerDynArray; const Another: TIntegerDynArray): PtrInt;
var v,a: PtrInt;
begin
  v := length(Values);
  a := length(Another);
  if a>0 then begin
    SetLength(Values,v+a);
    MoveFast(Another[0],Values[v],a*SizeOf(Integer));
  end;
  result := v+a;
end;

function AddWord(var Values: TWordDynArray; var ValuesCount: integer; Value: Word): PtrInt;
begin
  result := ValuesCount;
  if result=length(Values) then
    SetLength(Values,NextGrow(result));
  Values[result] := Value;
  inc(ValuesCount);
end;

function AddInt64(var Values: TInt64DynArray; var ValuesCount: integer; Value: Int64): PtrInt;
begin
  result := ValuesCount;
  if result=length(Values) then
    SetLength(Values,NextGrow(result));
  Values[result] := Value;
  inc(ValuesCount);
end;

function AddInt64(var Values: TInt64DynArray; Value: Int64): PtrInt;
begin
  result := length(Values);
  SetLength(Values,result+1);
  Values[result] := Value;
end;

function AddInt64(var Values: TInt64DynArray; const Another: TInt64DynArray): PtrInt;
var v,a: PtrInt;
begin
  v := length(Values);
  a := length(Another);
  if a>0 then begin
    SetLength(Values,v+a);
    MoveFast(Another[0],Values[v],a*SizeOf(Int64));
  end;
  result := v+a;
end;

procedure AddInt64Sorted(var Values: TInt64DynArray; Value: Int64);
var last: integer;
begin
  last := high(Values);
  if FastFindInt64Sorted(pointer(Values),last,Value)<0 then begin
    inc(last);
    SetLength(Values,last+1);
    Values[last] := Value;
    QuickSortInt64(pointer(Values),0,last);
  end;
end;

function AddInt64Once(var Values: TInt64DynArray; Value: Int64): PtrInt;
begin
  result := Int64ScanIndex(pointer(Values),length(Values),Value);
  if result<0 then
    result := AddInt64(Values,Value);
end;

procedure DynArrayMakeUnique(Values: PPointer; TypeInfo: pointer);
var da: TDynArray;
    n: PtrInt;
begin // caller ensured that Values<>nil, Values^<>nil and RefCnt>1
  da.Init(TypeInfo,Values^);
  n := PDALen(PPtrUInt(Values)^-_DALEN)^{$ifdef FPC}+1{$endif};
  da.InternalSetLength(n,n); // make copy
end;

procedure DeleteWord(var Values: TWordDynArray; Index: PtrInt);
var n: PtrInt;
begin
  n := Length(Values);
  if PtrUInt(Index)>=PtrUInt(n) then
    exit; // wrong Index
  dec(n);
  if n>Index then begin
    if PRefCnt(PtrUInt(Values)-_DAREFCNT)^>1 then
      DynArrayMakeUnique(@Values,TypeInfo(TWordDynArray));
    MoveFast(Values[Index+1],Values[Index],(n-Index)*SizeOf(Word));
  end;
  SetLength(Values,n);
end;

procedure DeleteInteger(var Values: TIntegerDynArray; Index: PtrInt);
var n: PtrInt;
begin
  n := Length(Values);
  if PtrUInt(Index)>=PtrUInt(n) then
    exit; // wrong Index
  dec(n);
  if n>Index then begin
    if PRefCnt(PtrUInt(Values)-_DAREFCNT)^>1 then
      DynArrayMakeUnique(@Values,TypeInfo(TIntegerDynArray));
    MoveFast(Values[Index+1],Values[Index],(n-Index)*SizeOf(Integer));
  end;
  SetLength(Values,n);
end;

procedure DeleteInteger(var Values: TIntegerDynArray; var ValuesCount: Integer; Index: PtrInt);
var n: PtrInt;
begin
  n := ValuesCount;
  if PtrUInt(Index)>=PtrUInt(n) then
    exit; // wrong Index
  dec(n,Index+1);
  if n>0 then begin
    if PRefCnt(PtrUInt(Values)-_DAREFCNT)^>1 then
      DynArrayMakeUnique(@Values,TypeInfo(TIntegerDynArray));
    MoveFast(Values[Index+1],Values[Index],n*SizeOf(Integer));
  end;
  dec(ValuesCount);
end;

procedure DeleteInt64(var Values: TInt64DynArray; Index: PtrInt);
var n: PtrInt;
begin
  n := Length(Values);
  if PtrUInt(Index)>=PtrUInt(n) then
    exit; // wrong Index
  dec(n);
  if n>Index then begin
    if PRefCnt(PtrUInt(Values)-_DAREFCNT)^>1 then
      DynArrayMakeUnique(@Values,TypeInfo(TInt64DynArray));
    MoveFast(Values[Index+1],Values[Index],(n-Index)*SizeOf(Int64));
  end;
  SetLength(Values,n);
end;

procedure DeleteInt64(var Values: TInt64DynArray; var ValuesCount: Integer; Index: PtrInt);
var n: PtrInt;
begin
  n := ValuesCount;
  if PtrUInt(Index)>=PtrUInt(n) then
    exit; // wrong Index
  dec(n,Index+1);
  if n>0 then begin
    if PRefCnt(PtrUInt(Values)-_DAREFCNT)^>1 then
      DynArrayMakeUnique(@Values,TypeInfo(TInt64DynArray));
    MoveFast(Values[Index+1],Values[Index],n*SizeOf(Int64));
  end;
  dec(ValuesCount);
end;

procedure ExcludeInteger(var Values, Excluded: TIntegerDynArray; ExcludedSortSize: integer);
var i,v,x,n: PtrInt;
begin
  if (Values=nil) or (Excluded=nil) then
    exit; // nothing to exclude
  if PRefCnt(PtrUInt(Values)-_DAREFCNT)^>1 then
    DynArrayMakeUnique(@Values,TypeInfo(TIntegerDynArray));
  if PRefCnt(PtrUInt(Excluded)-_DAREFCNT)^>1 then
    DynArrayMakeUnique(@Excluded,TypeInfo(TIntegerDynArray));
  v := length(Values);
  n := 0;
  x := Length(Excluded);
  if (x>ExcludedSortSize) or (v>ExcludedSortSize) then begin // sort if worth it
    dec(x);
    QuickSortInteger(pointer(Excluded),0,x);
    for i := 0 to v-1 do
      if FastFindIntegerSorted(pointer(Excluded),x,Values[i])<0 then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  end else
    for i := 0 to v-1 do
      if not IntegerScanExists(pointer(Excluded),x,Values[i]) then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  if n<>v then
    SetLength(Values,n);
end;

procedure IncludeInteger(var Values, Included: TIntegerDynArray;
  IncludedSortSize: Integer);
var i,v,x,n: PtrInt;
begin
  if (Values=nil) or (Included=nil) then begin
    Values := nil;
    exit;
  end;
  if PRefCnt(PtrUInt(Values)-_DAREFCNT)^>1 then
    DynArrayMakeUnique(@Values,TypeInfo(TIntegerDynArray));
  if PRefCnt(PtrUInt(Included)-_DAREFCNT)^>1 then
    DynArrayMakeUnique(@Included,TypeInfo(TIntegerDynArray));
  v := length(Values);
  n := 0;
  x := Length(Included);
  if (x>IncludedSortSize) or (v>IncludedSortSize) then begin // sort if worth it
    dec(x);
    QuickSortInteger(pointer(Included),0,x);
    for i := 0 to v-1 do
      if FastFindIntegerSorted(pointer(Included),x,Values[i])>=0 then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  end else
    for i := 0 to v-1 do
      if IntegerScanExists(pointer(Included),x,Values[i]) then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  if n<>v then
    SetLength(Values,n);
end;

procedure ExcludeInt64(var Values, Excluded: TInt64DynArray; ExcludedSortSize: Integer);
var i,v,x,n: PtrInt;
begin
  if (Values=nil) or (Excluded=nil) then
    exit; // nothing to exclude
  v := length(Values);
  n := 0;
  x := Length(Excluded);
  if (x>ExcludedSortSize) or (v>ExcludedSortSize) then begin // sort if worth it
    dec(x);
    QuickSortInt64(pointer(Excluded),0,x);
    for i := 0 to v-1 do
      if FastFindInt64Sorted(pointer(Excluded),x,Values[i])<0 then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  end else
    for i := 0 to v-1 do
      if not Int64ScanExists(pointer(Excluded),x,Values[i]) then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  if n<>v then
    SetLength(Values,n);
end;

procedure IncludeInt64(var Values, Included: TInt64DynArray;
  IncludedSortSize: integer);
var i,v,x,n: PtrInt;
begin
  if (Values=nil) or (Included=nil) then begin
    Values := nil;
    exit;
  end;
  v := length(Values);
  n := 0;
  x := Length(Included);
  if (x>IncludedSortSize) or (v>IncludedSortSize) then begin // sort if worth it
    dec(x);
    QuickSortInt64(pointer(Included),0,x);
    for i := 0 to v-1 do
      if FastFindInt64Sorted(pointer(Included),x,Values[i])>=0 then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  end else
    for i := 0 to v-1 do
      if Int64ScanExists(pointer(Included),x,Values[i]) then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  if n<>v then
    SetLength(Values,n);
end;

procedure DeduplicateInteger(var Values: TIntegerDynArray);
begin
  DeduplicateInteger(Values, length(Values));
end;

function DeduplicateIntegerSorted(val: PIntegerArray; last: PtrInt): PtrInt;
var i: PtrInt;
begin // sub-function for better code generation
  i := 0;
  repeat // here last>0 so i<last
    if val[i]=val[i+1] then
      break;
    inc(i);
    if i<>last then
      continue;
    result := i;
    exit;
  until false;
  result := i;
  inc(i);
  if i<>last then begin
    repeat
      if val[i]<>val[i+1] then begin
        val[result] := val[i];
        inc(result);
      end;
      inc(i);
    until i=last;
    val[result] := val[i];
  end;
end;

function DeduplicateInteger(var Values: TIntegerDynArray; Count: integer): integer;
begin
  result := Count;
  dec(Count);
  if Count>0 then begin
    QuickSortInteger(pointer(Values),0,Count);
    result := DeduplicateIntegerSorted(pointer(Values),Count)+1;
  end;
  if result<>length(Values) then
    SetLength(Values,result);
end;

procedure DeduplicateInt64(var Values: TInt64DynArray);
begin
  DeduplicateInt64(Values, length(Values));
end;

function DeduplicateInt64Sorted(val: PInt64Array; last: PtrInt): PtrInt;
var i: PtrInt;
begin // sub-function for better code generation
  i := 0;
  repeat // here last>0 so i<last
    if val[i]=val[i+1] then
      break;
    inc(i);
    if i<>last then
      continue;
    result := i;
    exit;
  until false;
  result := i;
  inc(i);
  if i<>last then begin
    repeat
      if val[i]<>val[i+1] then begin
        val[result] := val[i];
        inc(result);
      end;
      inc(i);
    until i=last;
    val[result] := val[i];
  end;
end;

function DeduplicateInt64(var Values: TInt64DynArray; Count: integer): integer;
begin
  result := Count;
  dec(Count);
  if Count>0 then begin
    QuickSortInt64(pointer(Values),0,Count);
    result := DeduplicateInt64Sorted(pointer(Values),Count)+1;
  end;
  if result<>length(Values) then
    SetLength(Values,result);
end;

procedure CopyInteger(const Source: TIntegerDynArray; out Dest: TIntegerDynArray);
var n: integer;
begin
  n := length(Source);
  SetLength(Dest,n);
  MoveFast(Source[0],Dest[0],n*SizeOf(Integer));
end;

procedure CopyInt64(const Source: TInt64DynArray; out Dest: TInt64DynArray);
var n: integer;
begin
  n := length(Source);
  SetLength(Dest,n);
  MoveFast(Source[0],Dest[0],n*SizeOf(Int64));
end;

function MaxInteger(const Values: TIntegerDynArray; ValuesCount: PtrInt; MaxStart: integer): Integer;
var i: PtrInt;
    v: integer;
begin
  result := MaxStart;
  for i := 0 to ValuesCount-1 do begin
    v := Values[i];
    if v>result then
      result := v; // branchless opcode on FPC
  end;
end;

function SumInteger(const Values: TIntegerDynArray; ValuesCount: PtrInt): Integer;
var i: PtrInt;
begin
  result := 0;
  for i := 0 to ValuesCount-1 do
    inc(result,Values[i]);
end;

procedure Reverse(const Values: TIntegerDynArray; ValuesCount: PtrInt;
  Reversed: PIntegerArray);
var i: PtrInt;
begin
  i := 0;
  if ValuesCount>=4 then begin
    dec(ValuesCount,4);
    while i<ValuesCount do begin // faster pipelined version
      Reversed[Values[i]] := i;
      Reversed[Values[i+1]] := i+1;
      Reversed[Values[i+2]] := i+2;
      Reversed[Values[i+3]] := i+3;
      inc(i,4);
    end;
    inc(ValuesCount,4);
  end;
  while i<ValuesCount do begin
    Reversed[Values[i]] := i;
    inc(i);
  end;
  //for i := 0 to Count-1 do Assert(Reverse[Orig[i]]=i);
end;

procedure FillIncreasing(Values: PIntegerArray; StartValue: integer; Count: PtrUInt);
var i: PtrUInt;
begin
  if Count>0 then
    if StartValue=0 then
      for i := 0 to Count-1 do
        Values[i] := i else
      for i := 0 to Count-1 do begin
        Values[i] := StartValue;
        inc(StartValue);
      end;
end;

procedure Int64ToUInt32(Values64: PInt64Array; Values32: PCardinalArray; Count: PtrInt);
var i: PtrInt;
begin
  for i := 0 to Count-1 do
    Values32[i] := Values64[i];
end;

procedure CSVToIntegerDynArray(CSV: PUTF8Char; var Result: TIntegerDynArray; Sep: AnsiChar);
begin
  while CSV<>nil do begin
    SetLength(Result,length(Result)+1);
    Result[high(Result)] := GetNextItemInteger(CSV,Sep);
  end;
end;

procedure CSVToInt64DynArray(CSV: PUTF8Char; var Result: TInt64DynArray; Sep: AnsiChar);
begin
  while CSV<>nil do begin
    SetLength(Result,length(Result)+1);
    Result[high(Result)] := GetNextItemInt64(CSV,Sep);
  end;
end;

function CSVToInt64DynArray(CSV: PUTF8Char; Sep: AnsiChar): TInt64DynArray;
begin
  Finalize(result);
  while CSV<>nil do begin
    SetLength(Result,length(Result)+1);
    Result[high(Result)] := GetNextItemInt64(CSV,Sep);
  end;
end;

function IntegerDynArrayToCSV(Values: PIntegerArray; ValuesCount: integer;
  const Prefix, Suffix: RawUTF8; InlinedValue: boolean): RawUTF8;
type
  TInts16 = packed array[word] of string[15]; // shortstring are faster (no heap allocation)
var i, L, Len: PtrInt;
    tmp: array[0..15] of AnsiChar;
    ints: ^TInts16;
    P: PAnsiChar;
    tmpbuf: TSynTempBuffer;
begin
  result := '';
  if ValuesCount=0 then
    exit;
  if InlinedValue then
    Len := 4*ValuesCount else
    Len := 0;
  tmpbuf.Init(ValuesCount*SizeOf(ints[0])+Len); // faster than a dynamic array
  try
    ints := tmpbuf.buf;
     // compute whole result length at once
    dec(ValuesCount);
    inc(Len,length(Prefix)+length(Suffix));
    tmp[15] := ',';
    for i := 0 to ValuesCount do begin
      P := StrInt32(@tmp[15],Values[i]);
      L := @tmp[15]-P;
      if i<ValuesCount then
        inc(L); // append tmp[15]=','
      inc(Len,L);
      SetString(ints[i],P,L);
    end;
    // create result
    FastSetString(result,nil,Len);
    P := pointer(result);
    if Prefix<>'' then begin
      L := length(Prefix);
      MoveSmall(pointer(Prefix),P,L);
      inc(P,L);
    end;
    for i := 0 to ValuesCount do begin
      if InlinedValue then begin
        PWord(P)^ := ord(':')+ord('(')shl 8;
        inc(P,2);
      end;
      L := ord(ints[i][0]);
      MoveSmall(@ints[i][1],P,L);
      inc(P,L);
      if InlinedValue then begin
        PWord(P)^ := ord(')')+ord(':')shl 8;
        inc(P,2);
      end;
    end;
    if Suffix<>'' then
      MoveSmall(pointer(Suffix),P,length(Suffix));
  finally
    tmpbuf.Done;
  end;
end;

function Int64DynArrayToCSV(Values: PInt64Array; ValuesCount: integer;
  const Prefix, Suffix: RawUTF8; InlinedValue: boolean): RawUTF8;
type
  TInt = packed record
    Len: byte;
    Val: array[0..19] of AnsiChar; // Int64: 19 digits, then - sign
  end;
var i, L, Len: PtrInt;
    int: ^TInt;
    P: PAnsiChar;
    tmp: TSynTempBuffer;
begin
  result := '';
  if ValuesCount=0 then
    exit;
  if InlinedValue then
    Len := 4*ValuesCount else
    Len := 0;
  int := tmp.Init(ValuesCount*SizeOf(TInt)+Len); // faster than a dynamic array
  try
     // compute whole result length at once
    dec(ValuesCount);
    inc(Len,length(Prefix)+length(Suffix));
    for i := 0 to ValuesCount do begin
      P := StrInt64(PAnsiChar(int)+21,Values[i]);
      L := PAnsiChar(int)+21-P;
      int^.Len := L;
      if i<ValuesCount then
        inc(L); // for ,
      inc(Len,L);
      inc(int);
    end;
    // create result
    FastSetString(result,nil,Len);
    P := pointer(result);
    if Prefix<>'' then begin
      L := length(Prefix);
      MoveSmall(pointer(Prefix),P,L);
      inc(P,L);
    end;
    int := tmp.buf;
    repeat
      if InlinedValue then begin
        PWord(P)^ := ord(':')+ord('(')shl 8;
        inc(P,2);
      end;
      L := int^.Len;
      MoveSmall(PAnsiChar(int)+21-L,P,L);
      inc(P,L);
      if InlinedValue then begin
        PWord(P)^ := ord(')')+ord(':')shl 8;
        inc(P,2);
      end;
      if ValuesCount=0 then
        break;
      inc(int);
      P^ := ',';
      inc(P);
      dec(ValuesCount);
    until false;
    if Suffix<>'' then
      MoveSmall(pointer(Suffix),P,length(Suffix));
  finally
    tmp.Done;
  end;
end;

function IntegerDynArrayToCSV(const Values: TIntegerDynArray;
  const Prefix, Suffix: RawUTF8; InlinedValue: boolean): RawUTF8;
begin
  result := IntegerDynArrayToCSV(pointer(Values),length(Values),Prefix,Suffix,InlinedValue);
end;

function Int64DynArrayToCSV(const Values: TInt64DynArray;
  const Prefix: RawUTF8; const Suffix: RawUTF8; InlinedValue: boolean): RawUTF8;
begin
  result := Int64DynArrayToCSV(pointer(Values),length(Values),Prefix,Suffix,InlinedValue);
end;

function Int64ScanIndex(P: PInt64Array; Count: PtrInt; const Value: Int64): PtrInt;
begin
  result := 0;
  dec(Count,8);
  if P<>nil then begin
    repeat
      if result>Count then
        break;
      if P^[result]<>Value then
      if P^[result+1]<>Value then
      if P^[result+2]<>Value then
      if P^[result+3]<>Value then
      if P^[result+4]<>Value then
      if P^[result+5]<>Value then
      if P^[result+6]<>Value then
      if P^[result+7]<>Value then begin
        inc(result,8);
        continue;
      end else
        inc(result,7) else
        inc(result,6) else
        inc(result,5) else
        inc(result,4) else
        inc(result,3) else
        inc(result,2) else
        inc(result);
      exit;
    until false;
    inc(Count,8);
    repeat
      if result>=Count then
        break;
      if P^[result]=Value then
        exit else
        inc(result);
    until false;
  end;
  result := -1;
end;

function QWordScanIndex(P: PQWordArray; Count: PtrInt; const Value: QWord): PtrInt;
begin
  result := Int64ScanIndex(pointer(P),Count,Value); // this is the very same code
end;

function PtrUIntScan(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): pointer;
{$ifdef HASINLINE}
begin
  result := {$ifdef CPU64}Int64Scan{$else}IntegerScan{$endif}(pointer(P),Count,Value);
end;
{$else}
asm
  jmp IntegerScan
end;
{$endif HASINLINE}

function PtrUIntScanExists(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): boolean;
{$ifdef HASINLINE}
begin
  result := {$ifdef CPU64}Int64ScanExists{$else}IntegerScanExists{$endif}(pointer(P),Count,Value);
end;
{$else}
asm
  jmp IntegerScanExists;
end;
{$endif HASINLINE}

function PtrUIntScanIndex(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): PtrInt;
{$ifdef HASINLINE}
begin
  result := {$ifdef CPU64}Int64ScanIndex{$else}IntegerScanIndex{$endif}(pointer(P),Count,Value);
end;
{$else}
asm // identical to IntegerScanIndex() asm stub
        push    eax
        call    IntegerScan
        pop     edx
        test    eax, eax
        jnz     @e
        dec     eax // returns -1
        ret
@e:     sub     eax, edx
        shr     eax, 2
end;
{$endif HASINLINE}

function ByteScanIndex(P: PByteArray; Count: PtrInt; Value: Byte): PtrInt;
begin
{$ifdef FPC}
  result := IndexByte(P^,Count,Value); // will use fast FPC SSE version
{$else}
  result := 0;
  if P<>nil then
    repeat
      if result>=Count then
        break;
      if P^[result]=Value then
        exit else
        inc(result);
    until false;
  result := -1;
{$endif FPC}
end;

function WordScanIndex(P: PWordArray; Count: PtrInt; Value: word): PtrInt;
begin
{$ifdef FPC}
  result := IndexWord(P^,Count,Value); // will use fast FPC SSE version
{$else}
  result := 0;
  if P<>nil then
    repeat
      if result>=Count then
        break;
      if P^[result]=Value then
        exit else
        inc(result);
    until false;
  result := -1;
{$endif FPC}
end;

function AnyScanIndex(P,Elem: pointer; Count,ElemSize: PtrInt): PtrInt;
begin
  case ElemSize of
    // optimized versions for arrays of byte,word,integer,Int64,Currency,Double
    1: result := ByteScanIndex(P,Count,PByte(Elem)^);
    2: result := WordScanIndex(P,Count,PWord(Elem)^);
    4: result := IntegerScanIndex(P,Count,PInteger(Elem)^);
    8: result := Int64ScanIndex(P,Count,PInt64(Elem)^);
    // small ElemSize version (<SizeOf(PtrInt))
    3,5..7: begin
      for result := 0 to Count-1 do
        if CompareMemSmall(P,Elem,ElemSize) then
          exit else
          inc(PByte(P),ElemSize);
      result := -1;
    end;
  else begin // generic binary comparison (fast with inlined CompareMemFixed)
    for result := 0 to Count-1 do
      if (PInt64(P)^=PInt64(Elem)^) and
         CompareMemSmall(PAnsiChar(P)+8,PAnsiChar(Elem)+8,ElemSize-8) then
        exit else
        inc(PByte(P),ElemSize);
    result := -1;
  end;
  end;
end;

function AnyScanExists(P,Elem: pointer; Count,ElemSize: PtrInt): boolean;
begin
  case ElemSize of
    // optimized versions for arrays of byte,word,integer,Int64,Currency,Double
    1: result := ByteScanIndex(P,Count,PInteger(Elem)^)>=0;
    2: result := WordScanIndex(P,Count,PInteger(Elem)^)>=0;
    4: result := IntegerScanExists(P,Count,PInteger(Elem)^);
    8: result := Int64ScanExists(P,Count,PInt64(Elem)^);
    // small ElemSize version (<SizeOf(PtrInt))
    3,5..7: begin
      result := true;
      if Count>0 then
        repeat
          if CompareMemSmall(P,Elem,ElemSize) then
            exit;
          inc(PByte(P),ElemSize);
          dec(Count);
        until Count=0;
      result := false;
    end;
  else begin // generic binary comparison (fast with leading 64-bit comparison)
    result := true;
    if Count>0 then
      repeat
        if (PInt64(P)^=PInt64(Elem)^) and
           CompareMemSmall(PAnsiChar(P)+8,PAnsiChar(Elem)+8,ElemSize-8) then
          exit;
        inc(PByte(P),ElemSize);
        dec(Count);
      until Count=0;
    result := false;
  end;
  end;
end;


procedure QuickSortInteger(ID: PIntegerArray; L,R: PtrInt);
var I, J, P: PtrInt;
    tmp: integer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      tmp := ID^[P];
      if ID[I]<tmp then repeat inc(I) until ID[I]>=tmp;
      if ID[J]>tmp then repeat dec(J) until ID[J]<=tmp;
      if I <= J then begin
        tmp := ID[J]; ID[J] := ID[I]; ID[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortInteger(ID, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortInteger(ID, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortInteger(var ID: TIntegerDynArray);
begin
  QuickSortInteger(pointer(ID),0,high(ID));
end;

procedure QuickSortInteger(ID,CoValues: PIntegerArray; L,R: PtrInt);
var I, J, P: PtrInt;
    tmp: integer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      tmp := ID[P];
      if ID[I]<tmp then repeat inc(I) until ID[I]>=tmp;
      if ID[J]>tmp then repeat dec(J) until ID[J]<=tmp;
      if I <= J then begin
        tmp := ID[J]; ID[J] := ID[I]; ID[I] := tmp;
        tmp := CoValues[J]; CoValues[J] := CoValues[I]; CoValues[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortInteger(ID, CoValues, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortInteger(ID, CoValues, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortWord(ID: PWordArray; L, R: PtrInt);
var I, J, P: PtrInt;
    tmp: word;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      tmp := ID[P];
      if ID[I]<tmp then repeat inc(I) until ID[I]>=tmp;
      if ID[J]>tmp then repeat dec(J) until ID[J]<=tmp;
      if I <= J then begin
        tmp := ID[J]; ID[J] := ID[I]; ID[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortWord(ID, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortWord(ID, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortInt64(ID: PInt64Array; L, R: PtrInt);
var I, J, P: PtrInt;
    tmp: Int64;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      {$ifdef CPU64}
      tmp := ID^[P];
      if ID[I]<tmp then repeat inc(I) until ID[I]>=tmp;
      if ID[J]>tmp then repeat dec(J) until ID[J]<=tmp;
      {$else}
      while ID[I]<ID[P] do inc(I);
      while ID[J]>ID[P] do dec(J);
      {$endif}
      if I <= J then begin
        tmp := ID[J]; ID[J] := ID[I]; ID[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortInt64(ID, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortInt64(ID, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortQWord(ID: PQWordArray; L, R: PtrInt);
var I, J, P: PtrInt;
    tmp: QWord;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      {$ifdef CPUX86} // circumvent QWord comparison slowness (and bug)
      while SortDynArrayQWord(ID[I],ID[P])<0 do inc(I);
      while SortDynArrayQWord(ID[J],ID[P])>0 do dec(J);
      {$else}
      tmp := ID[P];
      if ID[I]<tmp then repeat inc(I) until ID[I]>=tmp;
      if ID[J]>tmp then repeat dec(J) until ID[J]<=tmp;
      {$endif}
      if I <= J then begin
        tmp := ID[J]; ID[J] := ID[I]; ID[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortQWord(ID, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortQWord(ID, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortInt64(ID,CoValues: PInt64Array; L, R: PtrInt);
var I, J, P: PtrInt;
    tmp: Int64;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      {$ifdef CPU64}
      tmp := ID^[P];
      if ID[I]<tmp then repeat inc(I) until ID[I]>=tmp;
      if ID[J]>tmp then repeat dec(J) until ID[J]<=tmp;
      {$else}
      while ID[I]<ID[P] do inc(I);
      while ID[J]>ID[P] do dec(J);
      {$endif}
      if I <= J then begin
        tmp := ID[J]; ID[J] := ID[I]; ID[I] := tmp;
        tmp := CoValues[J]; CoValues[J] := CoValues[I]; CoValues[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortInt64(ID, CoValues, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortInt64(ID, CoValues, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortPtrInt(P: PPtrIntArray; L, R: PtrInt);
begin
  {$ifdef CPU64}
  QuickSortInt64(PInt64Array(P),L,R);
  {$else}
  QuickSortInteger(PIntegerArray(P),L,R);
  {$endif}
end;

function FastFindPtrIntSorted(P: PPtrIntArray; R: PtrInt; Value: PtrInt): PtrInt;
begin
  {$ifdef CPU64}
  result := FastFindInt64Sorted(PInt64Array(P),R,Value);
  {$else}
  result := FastFindIntegerSorted(PIntegerArray(P),R,Value);
  {$endif}
end;

procedure QuickSortPointer(P: PPointerArray; L, R: PtrInt);
begin
  {$ifdef CPU64}
  QuickSortInt64(PInt64Array(P),L,R);
  {$else}
  QuickSortInteger(PIntegerArray(P),L,R);
  {$endif}
end;

function FastFindPointerSorted(P: PPointerArray; R: PtrInt; Value: pointer): PtrInt;
begin
  {$ifdef CPU64}
  result := FastFindInt64Sorted(PInt64Array(P),R,Int64(Value));
  {$else}
  result := FastFindIntegerSorted(PIntegerArray(P),R,integer(Value));
  {$endif}
end;

procedure NotifySortedIntegerChanges(old, new: PIntegerArray; oldn, newn: PtrInt;
  const added, deleted: TOnNotifySortedIntegerChange; const sender);
var o, n: PtrInt;
begin
  o := 0;
  n := 0;
  repeat
    while (n<newn) and (o<oldn) and (old[o]=new[n]) do begin
      inc(o);
      inc(n);
    end;
    while (o<oldn) and ((n>=newn) or (old[o]<new[n])) do begin
      if Assigned(deleted) then
        deleted(sender,old[o]);
      inc(o);
    end;
    while (n<newn) and ((o>=oldn) or (new[n]<old[o])) do begin
      if Assigned(added) then
        added(sender,new[n]);
      inc(n);
    end;
  until (o>=oldn) and (n>=newn);
end;

procedure CopyAndSortInteger(Values: PIntegerArray; ValuesCount: integer;
  var Dest: TIntegerDynArray);
begin
  if ValuesCount>length(Dest) then
    SetLength(Dest,ValuesCount);
  MoveFast(Values^[0],Dest[0],ValuesCount*SizeOf(Integer));
  QuickSortInteger(pointer(Dest),0,ValuesCount-1);
end;

procedure CopyAndSortInt64(Values: PInt64Array; ValuesCount: integer;
  var Dest: TInt64DynArray);
begin
  if ValuesCount>length(Dest) then
    SetLength(Dest,ValuesCount);
  MoveFast(Values^[0],Dest[0],ValuesCount*SizeOf(Int64));
  QuickSortInt64(pointer(Dest),0,ValuesCount-1);
end;

function FastFindIntegerSorted(P: PIntegerArray; R: PtrInt; Value: integer): PtrInt;
{$ifdef CPUX64} // P=rcx/rdi R=rdx/rsi Value=r8d/edx
{$ifdef FPC} assembler; nostackframe; asm {$else} asm .noframe {$endif}
        xor     r9, r9  // r9=L rax=result
        test    R, R
        jl      @ko
        lea     rax, [r9 + R]
{$ifdef FPC} align 8 {$else} .align 8 {$endif}
@s:     shr     rax, 1
        lea     r10, qword ptr[rax - 1]  // efficient branchless binary search
        lea     r11, qword ptr[rax + 1]
        cmp     Value, dword ptr[P + rax * 4]
        je      @ok
        cmovl   R, r10
        cmovg   r9, r11
        lea     rax, [r9 + R]
        cmp     r9, R
        jle     @s
@ko:    or      rax, -1
@ok:
end;
{$else}
var L: PtrInt;
    cmp: integer;
begin
  L := 0;
  if 0<=R then
    repeat
      result := (L + R) shr 1;
      cmp := P^[result]-Value;
      if cmp=0 then
        exit;
      if cmp<0 then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      R := result-1;
      if L<=R  then
        continue;
      break;
    until false;
  result := -1
end;
{$endif CPUX64}


function FastFindIntegerSorted(const Values: TIntegerDynArray; Value: integer): PtrInt;
begin
  result := FastFindIntegerSorted(pointer(Values),length(Values)-1,Value);
end;

function FastFindInt64Sorted(P: PInt64Array; R: PtrInt; const Value: Int64): PtrInt;
{$ifdef CPUX64} // P=rcx/rdi R=rdx/rsi Value=r8d/edx
{$ifdef FPC} assembler; nostackframe; asm {$else} asm .noframe {$endif}
        xor     r9, r9  // r9=L rax=result
        test    R, R
        jl      @ko
        lea     rax, [r9 + R]
{$ifdef FPC} align 8 {$else} .align 8 {$endif}
@s:     shr     rax, 1
        lea     r10, qword ptr[rax - 1]  // efficient branchless binary search
        lea     r11, qword ptr[rax + 1]
        cmp     Value, qword ptr[P + rax * 8]
        je      @ok
        cmovl   R, r10
        cmovg   r9, r11
        lea     rax, [r9 + R]
        cmp     r9, R
        jle     @s
@ko:    or      rax, -1
@ok:
end;
{$else}
var L: PtrInt;
    {$ifdef CPUX86}
    cmp: Integer;
    {$endif}
begin
  L := 0;
  if 0<=R then
    repeat
      result := (L + R) shr 1;
      {$ifndef CPUX86}
      if P^[result]=Value then
        exit else
      if P^[result]<Value then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      {$else} // circumvent Int64 comparison slowness
      cmp := {$ifdef HASINLINE}CompareInt64{$else}SortDynArrayInt64{$endif}(P^[result],Value);
      if cmp=0 then
        exit else
      if cmp<0 then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      {$endif}
      R := result-1;
      if L<=R  then
        continue;
      break;
    until false;
  result := -1
end;
{$endif CPUX64}

function FastFindQWordSorted(P: PQWordArray; R: PtrInt; const Value: QWord): PtrInt;
var L: PtrInt;
    {$ifdef CPUX86}
    cmp: Integer;
    {$endif}
begin
  L := 0;
  if 0<=R then
    repeat
      result := (L + R) shr 1;
      {$ifndef CPUX86}
      if P^[result]=Value then
        exit else
      if P^[result]<Value then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      {$else} // circumvent QWord comparison slowness (and bug)
      cmp := SortDynArrayQWord(P^[result],Value);
      if cmp=0 then
        exit else
      if cmp<0 then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      {$endif}
      R := result-1;
      if L<=R  then
        continue;
      break;
    until false;
  result := -1
end;

function FastLocateIntegerSorted(P: PIntegerArray; R: PtrInt; Value: integer): PtrInt;
var L,i: PtrInt;
    cmp: integer;
begin
  if R<0 then
    result := 0 else begin
    L := 0;
    result := -1; // return -1 if found
    repeat
      i := (L + R) shr 1;
      cmp := P^[i]-Value;
      if cmp=0 then
        exit;
      if cmp<0 then
        L := i + 1 else
        R := i - 1;
    until L > R;
    while (i>=0) and (P^[i]>=Value) do dec(i);
    result := i+1; // return the index where to insert
  end;
end;

function AddSortedInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer; CoValues: PIntegerDynArray): PtrInt;
begin
  result := FastLocateIntegerSorted(pointer(Values),ValuesCount-1,Value);
  if result>=0 then // if Value exists -> fails
    result := InsertInteger(Values,ValuesCount,Value,result,CoValues);
end;

function AddSortedInteger(var Values: TIntegerDynArray;
  Value: integer; CoValues: PIntegerDynArray): PtrInt;
var ValuesCount: integer;
begin
  ValuesCount := length(Values);
  result := FastLocateIntegerSorted(pointer(Values),ValuesCount-1,Value);
  if result>=0 then begin // if Value exists -> fails
    SetLength(Values,ValuesCount+1); // manual size increase
    result := InsertInteger(Values,ValuesCount,Value,result,CoValues);
  end;
end;

function TSortedIntegerArray.Add(aValue: Integer): PtrInt;
begin
  result := Count; // optimistic check of perfectly increasing aValue
  if (result>0) and (aValue<=Values[result-1]) then
    result := FastLocateIntegerSorted(pointer(Values),result-1,aValue);
  if result<0 then // aValue already exists in Values[] -> fails
    exit;
  if Count=length(Values) then
    SetLength(Values,NextGrow(Count));
  if result<Count then
    MoveFast(Values[result],Values[result+1],(Count-result)*SizeOf(Integer)) else
    result := Count;
  Values[result] := aValue;
  inc(Count);
end;

function TSortedIntegerArray.IndexOf(aValue: Integer): PtrInt;
begin
  result := FastFindIntegerSorted(pointer(Values),Count-1,aValue);
end;

function InsertInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: Integer; Index: PtrInt; CoValues: PIntegerDynArray): PtrInt;
var n: PtrInt;
begin
  result := Index;
  n := Length(Values);
  if ValuesCount=n then begin
    n := NextGrow(n);
    SetLength(Values,n);
    if CoValues<>nil then
      SetLength(CoValues^,n);
  end;
  n := ValuesCount;
  if PtrUInt(result)<PtrUInt(n) then begin
    n := (n-result)*SizeOf(Integer);
    MoveFast(Values[result],Values[result+1],n);
    if CoValues<>nil then
      MoveFast(CoValues^[result],CoValues^[result+1],n);
  end else
    result := n;
  Values[result] := Value;
  inc(ValuesCount);
end;

function TIntegerDynArrayFrom(const Values: array of integer): TIntegerDynArray;
var i: PtrInt;
begin
  Finalize(result);
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

function TIntegerDynArrayFrom64(const Values: TInt64DynArray;
  raiseExceptionOnOverflow: boolean): TIntegerDynArray;
var i: PtrInt;
const MinInt = -MaxInt-1;
begin
  Finalize(result);
  SetLength(result,length(Values));
  for i := 0 to length(Values)-1 do
    if Values[i]>MaxInt then
      if raiseExceptionOnOverflow then
        raise ESynException.CreateUTF8('TIntegerDynArrayFrom64: Values[%]=%>%',
          [i,Values[i],MaxInt]) else
        result[i] := MaxInt else
    if Values[i]<MinInt then
      if raiseExceptionOnOverflow then
        raise ESynException.CreateUTF8('TIntegerDynArrayFrom64: Values[%]=%<%',
          [i,Values[i],MinInt]) else
        result[i] := MinInt else
    result[i] := Values[i];
end;

function TInt64DynArrayFrom(const Values: TIntegerDynArray): TInt64DynArray;
var i: PtrInt;
begin
  Finalize(result);
  SetLength(result,length(Values));
  for i := 0 to length(Values)-1 do
    result[i] := Values[i];
end;

function TQWordDynArrayFrom(const Values: TCardinalDynArray): TQWordDynArray;
var i: PtrInt;
begin
  Finalize(result);
  SetLength(result,length(Values));
  for i := 0 to length(Values)-1 do
    result[i] := Values[i];
end;

function FromI32(const Values: array of integer): TIntegerDynArray;
var i: PtrInt;
begin
  Finalize(result);
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

function FromU32(const Values: array of cardinal): TCardinalDynArray;
var i: PtrInt;
begin
  Finalize(result);
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

function FromI64(const Values: array of Int64): TInt64DynArray;
var i: PtrInt;
begin
  Finalize(result);
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

function FromU64(const Values: array of QWord): TQWordDynArray;
var i: PtrInt;
begin
  Finalize(result);
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

function GetInteger(P: PUTF8Char): PtrInt;
var c: byte;
    minus: boolean;
begin
  result := 0;
  if P=nil then
    exit;
  c := byte(P^);
  repeat
    if c=0 then
      exit;
    if c>ord(' ') then
      break;
    inc(P);
    c := byte(P^);
  until false;
  if c=ord('-') then begin
    minus := true;
    repeat inc(P); c := byte(P^); until c<>ord(' ');
  end else begin
    minus := false;
    if c=ord('+') then
      repeat inc(P); c := byte(P^); until c<>ord(' ');
  end;
  dec(c,48);
  if c>9 then
    exit;
  result := c;
  repeat
    inc(P);
    c := byte(P^);
    dec(c,48);
    if c>9 then
      break;
    result := result*10+PtrInt(c);
  until false;
  if minus then
    result := -result;
end;

function GetInteger(P,PEnd: PUTF8Char): PtrInt;
var c: byte;
    minus: boolean;
begin
  result := 0;
  if (P=nil) or (P>=PEnd) then
    exit;
  c := byte(P^);
  repeat
    if c=0 then
      exit;
    if c>ord(' ') then
      break;
    inc(P);
    if P=PEnd then
      exit;
    c := byte(P^);
  until false;
  if c=ord('-') then begin
    minus := true;
    repeat inc(P); if P=PEnd then exit; c := byte(P^); until c<>ord(' ');
  end else begin
    minus := false;
    if c=ord('+') then
      repeat inc(P); if P=PEnd then exit; c := byte(P^); until c<>ord(' ');
  end;
  dec(c,48);
  if c>9 then
    exit;
  result := c;
  repeat
    inc(P);
    if P=PEnd then
      break;
    c := byte(P^);
    dec(c,48);
    if c>9 then
      break;
    result := result*10+PtrInt(c);
  until false;
  if minus then
    result := -result;
end;

function GetInteger(P: PUTF8Char; var err: integer): PtrInt;
var c: byte;
    minus: boolean;
begin
  result := 0;
  err := 1; // don't return the exact index, just 1 as error flag
  if P=nil then
    exit;
  c := byte(P^);
  repeat
    if c=0 then
      exit;
    if c>ord(' ') then
      break;
    inc(P);
    c := byte(P^);
  until false;
  if c=ord('-') then begin
    minus := true;
    repeat inc(P); c := byte(P^); until c<>ord(' ');
  end else begin
    minus := false;
    if c=ord('+') then
      repeat inc(P); c := byte(P^); until c<>ord(' ');
  end;
  dec(c,48);
  if c>9 then
    exit;
  result := c;
  repeat
    inc(P);
    c := byte(P^);
    dec(c,48);
    if c<=9 then
      result := result*10+PtrInt(c) else
      if c<>256-48 then
        exit else
        break;
  until false;
  err := 0; // success
  if minus then
    result := -result;
end;

function GetIntegerDef(P: PUTF8Char; Default: PtrInt): PtrInt;
var err: integer;
begin
  result := GetInteger(P,err);
  if err<>0 then
    result := Default;
end;

function UTF8ToInteger(const value: RawUTF8; Default: PtrInt=0): PtrInt;
var err: integer;
begin
  result := GetInteger(pointer(value),err);
  if err<>0 then
    result := Default;
end;

function UTF8ToInteger(const value: RawUTF8; Min,max: PtrInt; Default: PtrInt=0): PtrInt;
var err: integer;
begin
  result := GetInteger(pointer(value),err);
  if (err<>0) or (result<Min) or (result>max) then
    result := Default;
end;

function ToInteger(const text: RawUTF8; out value: integer): boolean;
var err: integer;
begin
  value := GetInteger(pointer(text),err);
  result := err=0;
end;

function ToCardinal(const text: RawUTF8; out value: cardinal; minimal: cardinal): boolean;
begin
  value := GetCardinalDef(pointer(text),cardinal(-1));
  result := (value<>cardinal(-1)) and (value>=minimal);
end;

function ToInt64(const text: RawUTF8; out value: Int64): boolean;
var err: integer;
begin
  value := GetInt64(pointer(text),err);
  result := err=0;
end;

function ToDouble(const text: RawUTF8; out value: double): boolean;
var err: integer;
begin
  value := GetExtended(pointer(text),err);
  result := err=0;
end;

function UTF8ToInt64(const text: RawUTF8; const default: Int64): Int64;
var err: integer;
begin
  result := GetInt64(pointer(text),err);
  if err<>0 then
    result := default;
end;

function GetBoolean(P: PUTF8Char): boolean;
begin
  if P<>nil then
    case PInteger(P)^ of
      TRUE_LOW:  result := true;
      FALSE_LOW: result := false;
      else result := PWord(P)^<>ord('0');
    end else
    result := false;
end;

function GetCardinalDef(P: PUTF8Char; Default: PtrUInt): PtrUInt;
var c: byte;
begin
  result := Default;
  if P=nil then
    exit;
  c := byte(P^);
  repeat
    if c=0 then
      exit;
    if c>ord(' ') then
      break;
    inc(P);
    c := byte(P^);
  until false;
  dec(c,48);
  if c>9 then
    exit;
  result := c;
  repeat
    inc(P);
    c := byte(P^)-48;
    if c>9 then
      break;
    result := result*10+PtrUInt(c);
  until false;
end;

function GetCardinal(P: PUTF8Char): PtrUInt;
var c: byte;
begin
  result := 0;
  if P=nil then
    exit;
  c := byte(P^);
  repeat
    if c=0 then
      exit;
    if c>ord(' ') then
      break;
    inc(P);
    c := byte(P^);
  until false;
  dec(c,48);
  if c>9 then
    exit;
  result := c;
  repeat
    inc(P);
    c := byte(P^);
    dec(c,48);
    if c>9 then
      break;
    result := result*10+PtrUInt(c);
  until false;
end;

function GetCardinalW(P: PWideChar): PtrUInt;
var c: PtrUInt;
begin
  result := 0;
  if P=nil then
    exit;
  c := ord(P^);
  repeat
    if c=0 then
      exit;
    if c>ord(' ') then
      break;
    inc(P);
    c := ord(P^);
  until false;
  dec(c,48);
  if c>9 then
    exit;
  result := c;
  repeat
    inc(P);
    c := ord(P^);
    dec(c,48);
    if c>9 then
      break;
    result := result*10+c;
  until false;
end;

{$ifdef CPU64}
procedure SetInt64(P: PUTF8Char; var result: Int64);
begin // PtrInt is already int64 -> call PtrInt version
  result := GetInteger(P);
end;
{$else}
procedure SetInt64(P: PUTF8Char; var result: Int64);
var c: cardinal;
    minus: boolean;
begin
  result := 0;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^='-' then begin
    minus := true;
    repeat inc(P) until P^<>' ';
  end else begin
    minus := false;
    if P^='+' then
      repeat inc(P) until P^<>' ';
  end;
  c := byte(P^)-48;
  if c>9 then
    exit;
  PCardinal(@result)^ := c;
  inc(P);
  repeat // fast 32-bit loop
    c := byte(P^)-48;
    if c>9 then
      break else
      PCardinal(@result)^ := PCardinal(@result)^*10+c;
    inc(P);
    if PCardinal(@result)^>=high(cardinal)div 10 then begin
      repeat // 64-bit loop
        c := byte(P^)-48;
        if c>9 then
          break;
        result := result shl 3+result+result; // fast result := result*10
        inc(result,c);
        inc(P);
      until false;
      break;
    end;
  until false;
  if minus then
    result := -result;
end;
{$endif}

{$ifdef CPU64}
procedure SetQWord(P: PUTF8Char; var result: QWord);
begin // PtrUInt is already QWord -> call PtrUInt version
  result := GetCardinal(P);
end;
{$else}
procedure SetQWord(P: PUTF8Char; var result: QWord);
var c: cardinal;
begin
  result := 0;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^='+' then
    repeat inc(P) until P^<>' ';
  c := byte(P^)-48;
  if c>9 then
    exit;
  PCardinal(@result)^ := c;
  inc(P);
  repeat // fast 32-bit loop
    c := byte(P^)-48;
    if c>9 then
      break else
      PCardinal(@result)^ := PCardinal(@result)^*10+c;
    inc(P);
    if PCardinal(@result)^>=high(cardinal)div 10 then begin
      repeat // 64-bit loop
        c := byte(P^)-48;
        if c>9 then
          break;
        result := result shl 3+result+result; // fast result := result*10
        inc(result,c);
        inc(P);
      until false;
      break;
    end;
  until false;
end;
{$endif}

{$ifdef CPU64}
function GetInt64(P: PUTF8Char): Int64;
begin // PtrInt is already int64 -> call previous version
  result := GetInteger(P);
end;
{$else}
function GetInt64(P: PUTF8Char): Int64;
begin
  SetInt64(P,result);
end;
{$endif}

function GetInt64Def(P: PUTF8Char; const Default: Int64): Int64;
var err: integer;
begin
  result := GetInt64(P,err);
  if err>0 then
    result := Default;
end;

{$ifdef CPU64}
function GetInt64(P: PUTF8Char; var err: integer): Int64;
begin // PtrInt is already int64 -> call previous version
  result := GetInteger(P,err);
end;
{$else}
function GetInt64(P: PUTF8Char; var err: integer): Int64;
var c: cardinal;
    minus: boolean;
begin
  err := 0;
  result := 0;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^='-' then begin
    minus := true;
    repeat inc(P) until P^<>' ';
  end else begin
    minus := false;
    if P^='+' then
      repeat inc(P) until P^<>' ';
  end;
  inc(err);
  c := byte(P^)-48;
  if c>9 then
    exit;
  PCardinal(@result)^ := c;
  inc(P);
  repeat // fast 32-bit loop
    c := byte(P^);
    if c<>0 then begin
      dec(c,48);
      inc(err);
      if c>9 then
        exit;
      PCardinal(@result)^ := PCardinal(@result)^*10+c;
      inc(P);
      if PCardinal(@result)^>=high(cardinal)div 10 then begin
        repeat // 64-bit loop
          c := byte(P^);
          if c=0 then begin
            err := 0; // conversion success without error
            break;
          end;
          dec(c,48);
          inc(err);
          if c>9 then
            exit else
            {$ifdef CPU32DELPHI}
            result := result shl 3+result+result;
            {$else}
            result := result*10;
            {$endif}
          inc(result,c);
          if result<0 then
            exit; // overflow (>$7FFFFFFFFFFFFFFF)
          inc(P);
        until false;
        break;
      end;
    end else begin
      err := 0; // reached P^=#0 -> conversion success without error
      break;
    end;
  until false;
  if minus then
    result := -result;
end;
{$endif}

function GetQWord(P: PUTF8Char; var err: integer): QWord;
var c: PtrUInt;
begin
  err := 1; // error
  result := 0;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  c := byte(P^)-48;
  if c>9 then
    exit;
  {$ifdef CPU64}
  result := c;
  inc(P);
  repeat
    c := byte(P^);
    if c=0 then
      break;
    dec(c,48);
    if c>9 then
      exit;
    result := result*10+c;
    inc(P);
  until false;
  err := 0; // success
  {$else}
  PByte(@result)^ := c;
  inc(P);
  repeat // fast 32-bit loop
    c := byte(P^);
    if c<>0 then begin
      dec(c,48);
      inc(err);
      if c>9 then
        exit;
      PCardinal(@result)^ := PCardinal(@result)^*10+c;
      inc(P);
      if PCardinal(@result)^>=high(cardinal)div 10 then begin
        repeat // 64-bit loop
          c := byte(P^);
          if c=0 then begin
            err := 0; // conversion success without error
            break;
          end;
          dec(c,48);
          inc(err);
          if c>9 then
            exit else
            {$ifdef CPU32DELPHI}
            result := result shl 3+result+result;
            {$else}
            result := result*10;
            {$endif}
          inc(result,c);
          inc(P);
        until false;
        break;
      end;
    end else begin
      err := 0; // reached P^=#0 -> conversion success without error
      break;
    end;
  until false;
  {$endif CPU64}
end;

function GetExtended(P: PUTF8Char): TSynExtended;
var err: integer;
begin
  result := GetExtended(P,err);
  if err<>0 then
    result := 0;
end;

const POW10: array[-31..33] of TSynExtended = (
  1E-31,1E-30,1E-29,1E-28,1E-27,1E-26,1E-25,1E-24,1E-23,1E-22,1E-21,1E-20,
  1E-19,1E-18,1E-17,1E-16,1E-15,1E-14,1E-13,1E-12,1E-11,1E-10,1E-9,1E-8,1E-7,
  1E-6,1E-5,1E-4,1E-3,1E-2,1E-1,1E0,1E1,1E2,1E3,1E4,1E5,1E6,1E7,1E8,1E9,1E10,
  1E11,1E12,1E13,1E14,1E15,1E16,1E17,1E18,1E19,1E20,1E21,1E22,1E23,1E24,1E25,
  1E26,1E27,1E28,1E29,1E30,1E31,0,-1);

function HugePower10(exponent: integer): TSynExtended; {$ifdef HASINLINE}inline;{$endif}
var e: TSynExtended;
begin
  result := POW10[0];
  if exponent<0 then begin
    e := POW10[-1];
    exponent := -exponent;
  end else
    e := POW10[1];
  repeat
    while exponent and 1=0 do begin
      exponent := exponent shr 1;
      e := sqr(e);
    end;
    result := result*e;
    dec(exponent);
  until exponent=0;
end;

function GetExtended(P: PUTF8Char; out err: integer): TSynExtended;
{$ifndef CPU32DELPHI}
var digit: byte;
    frac, exp: PtrInt;
    c: AnsiChar;
    flags: set of (fNeg, fNegExp, fValid);
    v: Int64; // allows 64-bit resolution for the digits
label e;
begin
  byte(flags) := 0;
  v := 0;
  frac := 0;
  if P=nil then
    goto e;
  c := P^;
  if c=' ' then
    repeat
      inc(P);
      c := P^;
    until c<>' '; // trailing spaces
  if c='+' then begin
    inc(P);
    c := P^;
  end else
  if c='-' then begin
    inc(P);
    c := P^;
    include(flags,fNeg);
  end;
  digit := 18; // max Int64 resolution
  repeat
    inc(P);
    if (c>='0') and (c<='9') then begin
      if digit <> 0 then begin
        dec(c,ord('0'));
        {$ifdef CPU64}
        v := v*10;
        {$else}
        v := v shl 3+v+v;
        {$endif}
        inc(v,byte(c));
        dec(digit); // over-required digits are just ignored
        include(flags,fValid);
        if frac<>0 then
          dec(frac);
      end else
      if frac>=0 then
        inc(frac); // handle #############00000
      c := P^;
      continue;
    end;
    if c<>'.' then
      break;
    if frac>0 then
      goto e;
    dec(frac);
    c := P^;
  until false;
  if frac<0 then
    inc(frac);
  if (c='E') or (c='e') then begin
    exp := 0;
    exclude(flags,fValid);
    c := P^;
    if c='+' then
      inc(P) else
    if c='-' then begin
      inc(P);
      include(flags,fNegExp);
    end;
    repeat
      c := P^;
      inc(P);
      if (c<'0') or (c>'9') then
        break;
      dec(c,ord('0'));
      exp := (exp*10)+byte(c);
      include(flags,fValid);
    until false;
    if fNegExp in flags then
      dec(frac,exp) else
      inc(frac,exp);
  end;
  if (fValid in flags) and (c=#0) then
    err := 0 else
e:  err := 1; // return the (partial) value even if not ended with #0
  if (frac>=-31) and (frac<=31) then
    result := POW10[frac] else
    result := HugePower10(frac);
  if fNeg in flags then
    result := result*POW10[33]; // *-1
  result := result*v;
end;
{$else}
const Ten: double = 10.0;
asm     // in: eax=text, edx=@err  out: st(0)=result
        push    ebx                 // save used registers
        push    esi
        push    edi
        mov     esi, eax            // string pointer
        push    eax                 // save for error condition
        xor     ebx, ebx
        push    eax                 // allocate local storage for loading fpu
        test    esi, esi
        jz      @nil                // nil string
@trim:  movzx   ebx, byte ptr[esi]  // strip leading spaces
        inc     esi
        cmp     bl, ' '
        je      @trim
        xor     ecx, ecx            // clear sign flag
        fld     qword[Ten]          // load 10 into fpu
        xor     eax, eax            // zero number of decimal places
        fldz                        // zero result in fpu
        cmp     bl, '0'
        jl      @chksig             // check for sign character
@dig1:  xor     edi, edi            // zero exponent value
@digl:  sub     bl, '0'
        cmp     bl, 9
        ja      @frac               // non-digit
        mov     cl, 1               // set digit found flag
        mov     [esp], ebx          // store for fpu use
        fmul    st(0), st(1)        // multply by 10
        fiadd   dword ptr[esp]      // add next digit
        movzx   ebx, byte ptr[esi]  // get next char
        inc     esi
        test    bl, bl              // end reached?
        jnz     @digl               // no,get next digit
        jmp     @finish             // yes,finished
@chksig:cmp     bl, '-'
        je      @minus
        cmp     bl, '+'
        je      @sigset
@gdig1: test    bl, bl
        jz      @error              // no digits found
        jmp     @dig1
@minus: mov     ch, 1               // set sign flag
@sigset:movzx   ebx, byte ptr[esi]  // get next char
        inc     esi
        jmp     @gdig1
@frac:  cmp     bl, '.' - '0'
        jne     @exp                // no decimal point
        movzx   ebx, byte ptr[esi]  // get next char
        test    bl, bl
        jz      @dotend             // string ends with '.'
        inc     esi
@fracl: sub     bl, '0'
        cmp     bl, 9
        ja      @exp                // non-digit
        mov     [esp], ebx
        dec     eax                 // -(number of decimal places)
        fmul    st(0), st(1)        // multply by 10
        fiadd   dword ptr[esp]      // add next digit
        movzx   ebx, byte ptr[esi]  // get next char
        inc     esi
        test    bl, bl              // end reached?
        jnz     @fracl              // no, get next digit
        jmp     @finish             // yes, finished (no exponent)
@dotend:test    cl, cl              // any digits found before '.'?
        jnz     @finish             // yes, valid
        jmp     @error              // no,invalid
@exp:   or      bl, $20
        cmp     bl, 'e' - '0'
        jne     @error              // not 'e' or 'e'
        movzx   ebx, byte ptr[esi]  // get next char
        inc     esi
        mov     cl, 0               // clear exponent sign flag
        cmp     bl, '-'
        je      @minexp
        cmp     bl, '+'
        je      @expset
        jmp     @expl
@minexp:mov     cl, 1               // set exponent sign flag
@expset:movzx   ebx, byte ptr[esi]  // get next char
        inc     esi
@expl:  sub     bl, '0'
        cmp     bl, 9
        ja      @error              // non-digit
        lea     edi, [edi + edi * 4]// multiply by 10
        add     edi, edi
        add     edi, ebx            // add next digit
        movzx   ebx, byte ptr[esi]  // get next char
        inc     esi
        test    bl, bl              // end reached?
        jnz     @expl               // no, get next digit
@endexp:test    cl, cl              // positive exponent?
        jz      @finish             // yes, keep exponent value
        neg     edi                 // no, negate exponent value
@finish:add     eax, edi            // exponent value - number of decimal places
        mov     [edx], ebx          // result code = 0
        jz      @pow                // no call to _pow10 needed
        mov     edi, ecx            // save decimal sign flag
        call    System.@Pow10       // raise to power of 10
        mov     ecx, edi            // restore decimal sign flag
@pow:   test    ch, ch              // decimal sign flag set?
        jnz     @negate             // yes, negate value
@ok:    add     esp, 8              // dump local storage and string pointer
@exit:  ffree   st(1)               // remove ten value from fpu
        pop     edi                 // restore used registers
        pop     esi
        pop     ebx
        ret                         // finished
@negate:fchs                        // negate result in fpu
        jmp     @ok
@nil:   inc     esi                 // force result code = 1
        fldz                        // result value = 0
@error: pop     ebx                 // dump local storage
        pop     eax                 // string pointer
        sub     esi, eax            // error offset
        mov     [edx], esi          // set result code
        test    ch, ch              // decimal sign flag set?
        jz      @exit               // no,exit
        fchs                        // yes. negate result in fpu
        jmp     @exit               // exit setting result code
end;
{$endif CPU32DELPHI}

function FloatStrCopy(s, d: PUTF8Char): PUTF8Char;
var c: AnsiChar;
begin
  while s^=' ' do inc(s);
  c := s^;
  if (c='+') or (c='-') then begin
    inc(s);
    d^ := c;
    inc(d);
    c := s^;
  end;
  if c='.' then begin
    PCardinal(d)^ := ord('0')+ord('.')shl 8; // '.5' -> '0.5'
    inc(d,2);
    inc(s);
    c := s^;
  end;
  if (c>='0') and (c<='9') then
    repeat
      inc(s);
      d^ := c;
      inc(d);
      c := s^;
      if ((c>='0') and (c<='9')) or (c='.') then
        continue;
      if (c<>'e') and (c<>'E') then
        break;
      inc(s);
      d^ := c; // 1.23e120 or 1.23e-45
      inc(d);
      c := s^;
      if c='-' then begin
        inc(s);
        d^ := c;
        inc(d);
        c := s^;
      end;
      while (c>='0') and (c<='9') do begin
        inc(s);
        d^ := c;
        inc(d);
        c := s^;
      end;
      break;
    until false;
  result := d;
end;

function GetUTF8Char(P: PUTF8Char): cardinal;
begin
  if P<>nil then begin
    result := ord(P[0]);
    if result and $80<>0 then begin
      result := GetHighUTF8UCS4(P);
      if result>$ffff then
        result := ord('?'); // do not handle surrogates now
    end;
  end else
    result := PtrUInt(P);
end;

function NextUTF8UCS4(var P: PUTF8Char): cardinal;
begin
  if P<>nil then begin
    result := byte(P[0]);
    if result<=127 then
      inc(P) else begin
      if result and $20=0  then begin
        result := result shl 6+byte(P[1])-$3080; // fast direct process $0..$7ff
        inc(P,2);
      end else
        result := GetHighUTF8UCS4(P); // handle even surrogates
    end;
  end else
    result := 0;
end;

function ContainsUTF8(p, up: PUTF8Char): boolean;
var u: PByte;
begin
  if (p<>nil) and (up<>nil) and (up^<>#0) then begin
    result := true;
    repeat
      u := pointer(up);
      repeat
        if GetNextUTF8Upper(p)<>u^ then
          break else
          inc(u);
        if u^=0 then
          exit; // up^ was found inside p^
      until false;
      p := FindNextUTF8WordBegin(p);
    until p=nil;
  end;
  result := false;
end;

function IdemFileExt(p: PUTF8Char; extup: PAnsiChar; sepChar: AnsiChar): Boolean;
var ext: PUTF8Char;
begin
  if (p<>nil) and (extup<>nil) then begin
    ext := nil;
    repeat
      if p^=sepChar then
        ext := p; // get last '.' position from p into ext
      inc(p);
    until p^=#0;
    result := IdemPChar(ext,extup);
  end else
    result := false;
end;

function IdemFileExts(p: PUTF8Char; const extup: array of PAnsiChar;
  sepChar: AnsiChar): integer;
var ext: PUTF8Char;
begin
  result := -1;
  if (p<>nil) and (high(extup)>0) then begin
    ext := nil;
    repeat
      if p^=sepChar then
        ext := p; // get last '.' position from p into ext
      inc(p);
    until p^=#0;
    if ext<>nil then
      result := IdemPCharArray(ext,extup);
  end;
end;

function IdemPCharWithoutWhiteSpace(p: PUTF8Char; up: PAnsiChar): boolean;
begin
  result := False;
  if p=nil then
    exit;
  if up<>nil then
    while up^<>#0 do begin
      while p^<=' ' do // trim white space
        if p^=#0 then
          exit else
          inc(p);
      if up^<>NormToUpperAnsi7[p^] then
        exit;
      inc(up);
      inc(p);
    end;
  result := true;
end;

function IdemPCharArray(p: PUTF8Char; const upArray: array of PAnsiChar): integer;
var w: word;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute NormToUpperAnsi7{$else}PNormTableByte{$endif};
    up: ^PAnsiChar;
begin
  if p<>nil then begin
    {$ifndef CPUX86NOTPIC}tab := @NormToUpperAnsi7;{$endif} // faster on PIC and x86_64
    w := tab[ord(p[0])]+tab[ord(p[1])]shl 8;
    up := @upArray[0];
    for result := 0 to high(upArray) do
      if (PWord(up^)^=w) and
        {$ifdef CPUX86NOTPIC}IdemPChar({$else}IdemPChar2(pointer(tab),{$endif}p+2,up^+2) then
        exit else
        inc(up);
  end;
  result := -1;
end;

function IdemPCharArray(p: PUTF8Char; const upArrayBy2Chars: RawUTF8): integer;
var w: word;
begin
  if p<>nil then begin
    w := NormToUpperAnsi7Byte[ord(p[0])]+NormToUpperAnsi7Byte[ord(p[1])]shl 8;
    for result := 0 to pred(length(upArrayBy2Chars) shr 1) do
      if PWordArray(upArrayBy2Chars)[result]=w then
        exit;
  end;
  result := -1;
end;

function IdemPCharU(p, up: PUTF8Char): boolean;
begin
  result := false;
  if (p=nil) or (up=nil) then
    exit;
  while up^<>#0 do begin
    if GetNextUTF8Upper(p)<>ord(up^) then
      exit;
    inc(up);
  end;
  result := true;
end;

function EndWith(const text, upText: RawUTF8): boolean;
var o: PtrInt;
begin
  o := length(text)-length(upText);
  result := (o>=0) and IdemPChar(PUTF8Char(pointer(text))+o,pointer(upText));
end;

function EndWithArray(const text: RawUTF8; const upArray: array of RawUTF8): integer;
var t,o: PtrInt;
begin
  t := length(text);
  if t>0 then
    for result := 0 to high(upArray) do begin
      o := t-length(UpArray[result]);
      if (o>=0) and IdemPChar(PUTF8Char(pointer(text))+o,pointer(upArray[result])) then
        exit;
    end;
  result := -1;
end;

function UpperCopy255(dest: PAnsiChar; const source: RawUTF8): PAnsiChar;
begin
  if source<>'' then
    result := UpperCopy255Buf(dest,pointer(source),PStrLen(PtrUInt(source)-_STRLEN)^) else
    result := dest;
end;

function UpperCopy255BufPas(dest: PAnsiChar; source: PUTF8Char; sourceLen: PtrInt): PAnsiChar;
var i,c,d{$ifdef CPU64},_80,_61,_7b{$endif}: PtrUInt;
begin
  if sourceLen>0 then begin
    if sourceLen>248 then
      sourceLen := 248; // avoid buffer overflow
    // we allow to copy up to 3/7 more chars in Dest^ since its size is 255
    {$ifdef CPU64} // unbranched uppercase conversion of 8 chars blocks
    _80 := PtrUInt($8080808080808080); // use registers for constants
    _61 := $6161616161616161;
    _7b := $7b7b7b7b7b7b7b7b;
    for i := 0 to sourceLen shr 3 do begin
      c := PPtrUIntArray(source)^[i];
      d := c or _80;
      PPtrUIntArray(dest)^[i] := c-((d-PtrUInt(_61)) and not(d-_7b)) and
        ((not c) and _80)shr 2;
    end;
    {$else} // unbranched uppercase conversion of 4 chars blocks
    for i := 0 to sourceLen shr 2 do begin
      c := PPtrUIntArray(source)^[i];
      d := c or PtrUInt($80808080);
      PPtrUIntArray(dest)^[i] := c-((d-PtrUInt($61616161)) and not(d-PtrUInt($7b7b7b7b))) and
        ((not c) and PtrUInt($80808080))shr 2;
    end;
    {$endif}
    result := dest+sourceLen; // but we always return the exact size
  end else
    result := dest;
end;

function UpperCopyWin255(dest: PWinAnsiChar; const source: RawUTF8): PWinAnsiChar;
var i, L: PtrInt;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute NormToUpperByte{$else}PNormTableByte{$endif};
begin
  if source='' then
    result := dest else begin
    L := PStrLen(PtrUInt(source)-_STRLEN)^;
    if L>250 then
      L := 250; // avoid buffer overflow
    result := dest+L;
    {$ifndef CPUX86NOTPIC}tab := @NormToUpperByte;{$endif} // faster on PIC and x86_64
    for i := 0 to L-1 do
      dest[i] := AnsiChar(tab[PByteArray(source)[i]]);
  end;
end;

function UTF8UpperCopy(Dest, Source: PUTF8Char; SourceChars: Cardinal): PUTF8Char;
var c: cardinal;
    endSource, endSourceBy4, up: PUTF8Char;
    extra,i: PtrInt;
label By1, By4, set1; // ugly but faster
begin
  if (Source<>nil) and (Dest<>nil) then begin
    // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
    endSource := Source+SourceChars;
    endSourceBy4 := endSource-4;
    up := @NormToUpper;
    if (PtrUInt(Source) and 3=0) and (Source<=endSourceBy4) then
      repeat
    By4:c := PCardinal(Source)^;
        if c and $80808080<>0 then
          goto By1; // break on first non ASCII quad
        inc(Source,4);
        Dest[0] := up[ToByte(c)];
        Dest[1] := up[ToByte(c shr 8)];
        Dest[2] := up[ToByte(c shr 16)];
        Dest[3] := up[ToByte(c shr 24)];
        inc(Dest,4);
      until Source>endSourceBy4;
    // generic loop, handling one UCS4 char per iteration
    if Source<endSource then
    repeat
  By1:c := byte(Source^);
      inc(Source);
      if c<=127 then begin
        Dest^ := up[c];
Set1:   inc(Dest);
        if (PtrUInt(Source) and 3=0) and (Source<EndSourceBy4) then goto By4 else
        if Source<endSource then continue else break;
      end else begin
        extra := UTF8_EXTRABYTES[c];
        if (extra=0) or (Source+extra>endSource) then break;
        for i := 0 to extra-1 do
          c := c shl 6+byte(Source[i]);
        with UTF8_EXTRA[extra] do begin
          dec(c,offset);
          if c<minimum then
            break; // invalid input content
        end;
        if (c<=255) and (up[c]<=#127) then begin
          Dest^ := up[c];
          inc(Source,extra);
          goto set1;
        end;
        Dest^ := Source[-1];
        repeat // here we now extra>0 - just copy UTF-8 input untouched
          inc(Dest);
          Dest^ := Source^;
          inc(Source);
          dec(extra);
          if extra=0 then
            goto Set1;
        until false;
      end;
    until false;
  end;
  result := Dest;
end;

function UTF8UpperCopy255(dest: PAnsiChar; const source: RawUTF8): PUTF8Char;
var L: integer;
begin
  L := length(source);
  if L>0 then begin
    if L>250 then
      L := 250; // avoid buffer overflow
    result := UTF8UpperCopy(pointer(dest),pointer(source),L);
  end else
    result := pointer(dest);
end;

function UpperCopy255W(dest: PAnsiChar; const source: SynUnicode): PAnsiChar;
var c: cardinal;
    i,L: integer;
begin
  L := length(source);
  if L>0 then begin
    if L>250 then
      L := 250; // avoid buffer overflow
    result := dest+L;
    for i := 0 to L-1 do begin
      c := PWordArray(source)[i];
      if c<255 then
        dest[i] := AnsiChar(NormToUpperAnsi7Byte[c]) else
        dest[i] := '?';
    end;
  end else
    result := dest;
end;

function UpperCopy255W(dest: PAnsiChar; source: PWideChar; L: integer): PAnsiChar;
var c: cardinal;
    i: integer;
begin
  if L>0 then begin
    if L>250 then
      L := 250; // avoid buffer overflow
    result := dest+L;
    for i := 0 to L-1 do begin
      c := PWordArray(source)[i];
      if c<255 then
        dest[i] := AnsiChar(NormToUpperAnsi7Byte[c]) else
        dest[i] := '?';
    end;
  end else
    result := dest;
end;

function GetNextLine(source: PUTF8Char; out next: PUTF8Char; andtrim: boolean): RawUTF8;
var beg: PUTF8Char;
begin
  if source=nil then begin
    {$ifdef FPC}Finalize(result){$else}result := ''{$endif};
    next := source;
    exit;
  end;
  if andtrim then // optional trim left
    while source^ in [#9,' '] do inc(source);
  beg := source;
  repeat // just here to avoid a goto
    if source[0]>#13 then
      if source[1]>#13 then
        if source[2]>#13 then
          if source[3]>#13 then begin
            inc(source,4); // fast process 4 chars per loop
            continue;
          end else
          inc(source,3) else
        inc(source,2) else
      inc(source);
    case source^ of
      #0: next := nil;
      #10: next := source+1;
      #13: if source[1]=#10 then next := source+2 else next := source+1;
      else begin
        inc(source);
        continue;
      end;
    end;
    if andtrim then // optional trim right
      while (source>beg) and (source[-1] in [#9,' ']) do dec(source);
    FastSetString(result,beg,source-beg);
    exit;
  until false;
end;

{$ifdef UNICODE}
function GetNextLineW(source: PWideChar; out next: PWideChar): string;
begin
  next := source;
  if source=nil then begin
    result := '';
    exit;
  end;
  while not (cardinal(source^) in [0,10,13]) do inc(source);
  SetString(result,PChar(next),source-next);
  if source^=#13 then inc(source);
  if source^=#10 then inc(source);
  if source^=#0 then
    next := nil else
    next := source;
end;

function FindIniNameValueW(P: PWideChar; UpperName: PUTF8Char): string;
var PBeg: PWideChar;
    L: PtrInt;
begin
  while (P<>nil) and (P^<>'[') do begin
    PBeg := P;
    while not (cardinal(P^) in [0,10,13]) do inc(P);
    while cardinal(P^) in [10,13] do inc(P);
    if P^=#0 then P := nil;
    if PBeg^=' ' then repeat inc(PBeg) until PBeg^<>' ';   // trim left ' '
    if IdemPCharW(PBeg,UpperName) then begin
      inc(PBeg,StrLen(UpperName));
      L := 0; while PBeg[L]>=' ' do inc(L); // get line length
      SetString(result,PBeg,L);
      exit;
    end;
  end;
  result := '';
end;

function FindIniEntryW(const Content: string; const Section, Name: RawUTF8): string;
var P: PWideChar;
    UpperSection, UpperName: array[byte] of AnsiChar;
    // possible GPF if length(Section/Name)>255, but should const in code
begin
  result := '';
  P := pointer(Content);
  if P=nil then exit;
  // UpperName := UpperCase(Name)+'=';
  PWord(UpperCopy255(UpperName,Name))^ := ord('=');
  if Section='' then
     // find the Name= entry before any [Section]
    result := FindIniNameValueW(P,UpperName) else begin
     // find the Name= entry in the specified [Section]
    PWord(UpperCopy255(UpperSection,Section))^ := ord(']');
    if FindSectionFirstLineW(P,UpperSection) then
      result := FindIniNameValueW(P,UpperName);
  end;
end;
{$endif UNICODE}

function IdemPCharAndGetNextItem(var source: PUTF8Char; const searchUp: RawUTF8;
  var Item: RawUTF8; Sep: AnsiChar): boolean;
begin
  if source=nil then
    result := false else begin
    result := IdemPChar(source,Pointer(searchUp));
    if result then begin
      inc(source,Length(searchUp));
      GetNextItem(source,Sep,Item);
    end;
  end;
end;

function GotoNextLine(source: PUTF8Char): PUTF8Char;
label
  _z, _0, _1, _2, _3; // ugly but faster
var
  c: AnsiChar;
begin
  if source<>nil then
    repeat
      if source[0]<#13 then
        goto _0
      else if source[1]<#13 then
        goto _1
      else if source[2]<#13 then
        goto _2
      else if source[3]<#13 then
        goto _3
      else begin
        inc(source, 4);
        continue;
      end;
_3:   inc(source);
_2:   inc(source);
_1:   inc(source);
_0:   c := source^;
      if c=#13 then begin
        if source[1]=#10 then begin
          result := source+2; // most common case is text ending with #13#10
          exit;
        end;
      end else
      if c=#0 then
        goto _z else
      if c<>#10 then begin
        inc(source);
        continue; // e.g. #9
      end;
      result := source+1;
      exit;
    until false;
_z: result := nil;
end;

function BufferLineLength(Text, TextEnd: PUTF8Char): PtrInt;
{$ifdef CPUX64}
{$ifdef FPC} nostackframe; assembler; asm {$else} asm .noframe {$endif}
{$ifdef MSWINDOWS} // Win64 ABI to System-V ABI
        push    rsi
        push    rdi
        mov     rdi, rcx
        mov     rsi, rdx
{$endif}mov     r8, rsi
        sub     r8, rdi // rdi=Text, rsi=TextEnd, r8=TextLen
        jz      @fail
        mov     ecx, edi
        movaps  xmm0, [rip + @for10]
        movaps  xmm1, [rip + @for13]
        and     rdi, -16 // check first aligned 16 bytes
        and     ecx, 15  // lower cl 4 bits indicate misalignment
        movaps  xmm2, [rdi]
        movaps  xmm3, xmm2
        pcmpeqb xmm2, xmm0
        pcmpeqb xmm3, xmm1
        por     xmm3, xmm2
        pmovmskb eax, xmm3
        shr     eax, cl  // shift out unaligned bytes
        test    eax, eax
        jz      @main
        bsf     eax, eax
        add     rax, rcx
        add     rax, rdi
        sub     rax, rsi
        jae     @fail   // don't exceed TextEnd
        add     rax, r8 // rax = TextFound - TextEnd + (TextEnd - Text) = offset
{$ifdef MSWINDOWS}
        pop     rdi
        pop     rsi
{$endif}ret
@main:  add     rdi, 16
        sub     rdi, rsi
        jae     @fail
        jmp     @by16
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@for10: dq      $0a0a0a0a0a0a0a0a
        dq      $0a0a0a0a0a0a0a0a
@for13: dq      $0d0d0d0d0d0d0d0d
        dq      $0d0d0d0d0d0d0d0d
@by16:  movaps  xmm2, [rdi + rsi] // check 16 bytes per loop
        movaps  xmm3, xmm2
        pcmpeqb xmm2, xmm0
        pcmpeqb xmm3, xmm1
        por     xmm3, xmm2
        pmovmskb eax, xmm3
        test    eax, eax
        jnz     @found
        add     rdi, 16
        jnc     @by16
@fail:  mov     rax, r8 // returns TextLen if no CR/LF found
{$ifdef MSWINDOWS}
        pop     rdi
        pop     rsi
{$endif}ret
@found: bsf     eax, eax
        add     rax, rdi
        jc      @fail
        add     rax, r8
{$ifdef MSWINDOWS}
        pop     rdi
        pop     rsi
{$endif}
end;
{$else}
begin
  result := PtrUInt(Text)-1;
  repeat
    inc(result);
    if PtrUInt(result)<PtrUInt(TextEnd) then
      if (PByte(result)^>13) or ((PByte(result)^<>10) and (PByte(result)^<>13)) then
        continue;
    break;
  until false;
  dec(result,PtrInt(Text)); // returns length
end;
{$endif CPUX64}

function GetLineSize(P, PEnd: PUTF8Char): PtrUInt;
var c: byte;
begin
  {$ifdef CPUX64}
  if PEnd <> nil then begin
    result := BufferLineLength(P,PEnd); // use branchless SSE2 on x86_64
    exit;
  end;
  result := PtrUInt(P)-1;
  {$else}
  result := PtrUInt(P)-1;
  if PEnd<>nil then
    repeat // inlined BufferLineLength()
      inc(result);
      if PtrUInt(result)<PtrUInt(PEnd) then begin
        c := PByte(result)^;
        if (c>13) or ((c<>10) and (c<>13)) then
          continue;
      end;
      break;
    until false else
  {$endif CPUX64}
    repeat // inlined BufferLineLength() ending at #0 for PEnd=nil
      inc(result);
      c := PByte(result)^;
      if (c>13) or ((c<>0) and (c<>10) and (c<>13)) then
        continue;
      break;
    until false;
  dec(result,PtrUInt(P)); // returns length
end;

function GetNextItem(var P: PUTF8Char; Sep: AnsiChar): RawUTF8;
begin
  GetNextItem(P,Sep,result);
end;

procedure GetNextItem(var P: PUTF8Char; Sep: AnsiChar; var result: RawUTF8);
var S: PUTF8Char;
begin
  if P=nil then
    result := '' else begin
    S := P;
    while (S^<>#0) and (S^<>Sep) do
      inc(S);
    FastSetString(result,P,S-P);
    if S^<>#0 then
      P := S+1 else
      P := nil;
  end;
end;

procedure GetNextItem(var P: PUTF8Char; Sep, Quote: AnsiChar; var result: RawUTF8);
begin
  if P=nil then
    result := ''
  else if P^=Quote then begin
    P := UnQuoteSQLStringVar(P,result);
    if P=nil then
      result := ''
    else if P^<>#0 then
      inc(P);
  end else
    GetNextItem(P,Sep,result);
end;

procedure GetNextItemTrimed(var P: PUTF8Char; Sep: AnsiChar; var result: RawUTF8);
var S,E: PUTF8Char;
begin
  if (P=nil) or (Sep<=' ') then
    result := '' else begin
    while (P^<=' ') and (P^<>#0) do inc(P); // trim left
    S := P;
    while (S^<>#0) and (S^<>Sep) do
      inc(S);
    E := S;
    while (E>P) and (E[-1] in [#1..' ']) do dec(E); // trim right
    FastSetString(result,P,E-P);
    if S^<>#0 then
      P := S+1 else
      P := nil;
  end;
end;

procedure GetNextItemTrimedCRLF(var P: PUTF8Char; var result: RawUTF8);
var S,E: PUTF8Char;
begin
  if P=nil then
    result := '' else begin
    S := P;
    while (S^<>#0) and (S^<>#10) do
      inc(S);
    E := S;
    if (E>P) and (E[-1]=#13) then
      dec(E);
    FastSetString(result,P,E-P);
    if S^<>#0 then
      P := S+1 else
      P := nil;
  end;
end;

function GetNextItemString(var P: PChar; Sep: Char): string;
// this function will compile into AnsiString or UnicodeString, depending
// of the compiler version
var S: PChar;
begin
  if P=nil then
    result := '' else begin
    S := P;
    while (S^<>#0) and (S^<>Sep) do
      inc(S);
    SetString(result,P,S-P);
    if S^<>#0 then
      P := S+1 else
      P := nil;
  end;
end;

function GetNextStringLineToRawUnicode(var P: PChar): RawUnicode;
var S: PChar;
begin
  if P=nil then
    result := '' else begin
    S := P;
    while S^>=' ' do
      inc(S);
    result := StringToRawUnicode(P,S-P);
    while (S^<>#0) and (S^<' ') do inc(S); // ignore e.g. #13 or #10
    if S^<>#0 then
      P := S else
      P := nil;
  end;
end;

procedure AppendCSVValues(const CSV: string; const Values: array of string;
  var Result: string; const AppendBefore: string);
var Caption: string;
    i, bool: integer;
    P: PChar;
    first: Boolean;
begin
  P := pointer(CSV);
  if P=nil then
    exit;
  first := True;
  for i := 0 to high(Values) do begin
    Caption := GetNextItemString(P);
    if Values[i]<>'' then begin
      if first then begin
        Result := Result+#13#10;
        first := false;
      end else
        Result := Result+AppendBefore;
      bool := FindCSVIndex('0,-1',RawUTF8(Values[i]));
      Result := Result+Caption+': ';
      if bool<0 then
        Result := Result+Values[i] else
        Result := Result+GetCSVItemString(pointer(GetNextItemString(P)),bool,'/');
    end;
  end;
end;

procedure GetNextItemShortString(var P: PUTF8Char; out Dest: ShortString; Sep: AnsiChar);
var S: PUTF8Char;
    len: PtrInt;
begin
  S := P;
  if S<>nil then begin
    while (S^<=' ') and (S^<>#0) do inc(S);
    P := S;
    if (S^<>#0) and (S^<>Sep) then
      repeat
        inc(S);
      until (S^=#0) or (S^=Sep);
    len := S-P;
    repeat
      dec(len);
    until (len<0) or not(P[len] in [#1..' ']); // trim right spaces
    if len>=255 then
      len := 255 else
      inc(len);
    Dest[0] := AnsiChar(len);
    MoveSmall(P,@Dest[1],Len);
    if S^<>#0 then
      P := S+1 else
      P := nil;
  end else
    Dest[0] := #0;
end;

function GetNextItemHexDisplayToBin(var P: PUTF8Char; Bin: PByte; BinBytes: integer;
  Sep: AnsiChar): boolean;
var S: PUTF8Char;
    len: integer;
begin
  result := false;
  FillCharFast(Bin^,BinBytes,0);
  if P=nil then
    exit;
  if P^=' ' then repeat inc(P) until P^<>' ';
  S := P;
  if Sep=#0 then
    while S^>' ' do
      inc(S) else
    while (S^<>#0) and (S^<>Sep) do
      inc(S);
  len := S-P;
  while (P[len-1] in [#1..' ']) and (len>0) do dec(len); // trim right spaces
  if len<>BinBytes*2 then
    exit;
  if not HexDisplayToBin(PAnsiChar(P),Bin,BinBytes) then
    FillCharFast(Bin^,BinBytes,0) else begin
    if S^=#0 then
      P := nil else
      if Sep<>#0 then
        P := S+1 else
        P := S;
    result := true;
  end;
end;

function GetNextItemCardinal(var P: PUTF8Char; Sep: AnsiChar): PtrUInt;
var c: PtrUInt;
begin
  if P=nil then begin
    result := 0;
    exit;
  end;
  if P^=' ' then repeat inc(P) until P^<>' ';
  c := byte(P^)-48;
  if c>9 then
    result := 0 else begin
    result := c;
    inc(P);
    repeat
      c := byte(P^)-48;
      if c>9 then
        break else
        result := result*10+c;
      inc(P);
    until false;
  end;
  if Sep<>#0 then
    while (P^<>#0) and (P^<>Sep) do // go to end of CSV item (ignore any decimal)
      inc(P);
  if P^=#0 then
    P := nil else
    if Sep<>#0 then
      inc(P);
end;

function GetNextItemCardinalStrict(var P: PUTF8Char): PtrUInt;
var c: PtrUInt;
begin
  if P=nil then begin
    result := 0;
    exit;
  end;
  c := byte(P^)-48;
  if c>9 then
    result := 0 else begin
    result := c;
    inc(P);
    repeat
      c := byte(P^)-48;
      if c>9 then
        break else
        result := result*10+c;
      inc(P);
    until false;
  end;
  if P^=#0 then
    P := nil;
end;

function CSVOfValue(const Value: RawUTF8; Count: cardinal; const Sep: RawUTF8): RawUTF8;
var ValueLen, SepLen: cardinal;
    i: cardinal;
    P: PAnsiChar;
begin // CSVOfValue('?',3)='?,?,?'
  result := '';
  if Count=0 then
    exit;
  ValueLen := length(Value);
  SepLen := Length(Sep);
  FastSetString(result,nil,ValueLen*Count+SepLen*pred(Count));
  P := pointer(result);
  i := 1;
  repeat
    if ValueLen>0 then begin
      MoveSmall(Pointer(Value),P,ValueLen);
      inc(P,ValueLen);
    end;
    if i=Count then
      break;
    if SepLen>0 then begin
      MoveSmall(Pointer(Sep),P,SepLen);
      inc(P,SepLen);
    end;
    inc(i);
  until false;
//  assert(P-pointer(result)=length(result));
end;

procedure SetBitCSV(var Bits; BitsCount: integer; var P: PUTF8Char);
var bit,last: cardinal;
begin
  while P<>nil do begin
    bit := GetNextItemCardinalStrict(P)-1; // '0' marks end of list
    if bit>=cardinal(BitsCount) then
      break; // avoid GPF
    if (P=nil) or (P^=',') then
      SetBitPtr(@Bits,bit) else
    if P^='-' then begin
      inc(P);
      last := GetNextItemCardinalStrict(P)-1; // '0' marks end of list
      if last>=Cardinal(BitsCount) then
        exit;
      while bit<=last do begin
        SetBitPtr(@Bits,bit);
        inc(bit);
      end;
    end;
    if (P<>nil) and (P^=',') then
      inc(P);
  end;
  if (P<>nil) and (P^=',') then
    inc(P);
end;

function GetBitCSV(const Bits; BitsCount: integer): RawUTF8;
var i,j: integer;
begin
  result := '';
  i := 0;
  while i<BitsCount do
  if GetBitPtr(@Bits,i) then begin
    j := i;
    while (j+1<BitsCount) and GetBitPtr(@Bits,j+1) do
      inc(j);
    result := result+UInt32ToUtf8(i+1);
    if j=i then
      result := result+',' else
    if j=i+1 then
      result := result+','+UInt32ToUtf8(j+1)+',' else
      result := result+'-'+UInt32ToUtf8(j+1)+',';
    i := j+1;
  end else
    inc(i);
  result := result+'0'; // '0' marks end of list
end;

function GetNextItemCardinalW(var P: PWideChar; Sep: WideChar= ','): PtrUInt;
var c: PtrUInt;
begin
  if P=nil then begin
    result := 0;
    exit;
  end;
  c := word(P^)-48;
  if c>9 then
    result := 0 else begin
    result := c;
    inc(P);
    repeat
      c := word(P^)-48;
      if c>9 then
        break else
        result := result*10+c;
      inc(P);
    until false;
  end;
  while (P^<>#0) and (P^<>Sep) do // go to end of CSV item (ignore any decimal)
    inc(P);
  if P^=#0 then
    P := nil else
    inc(P);
end;

function GetNextItemInteger(var P: PUTF8Char; Sep: AnsiChar): PtrInt;
var minus: boolean;
begin
  if P=nil then begin
    result := 0;
    exit;
  end;
  if P^=' ' then repeat inc(P) until P^<>' ';
  if (P^ in ['+','-']) then begin
    minus := P^='-';
    inc(P);
  end else
    minus := false;
  result := PtrInt(GetNextItemCardinal(P,Sep));
  if minus then
    result := -result;
end;

function GetNextTChar64(var P: PUTF8Char; Sep: AnsiChar; out Buf: TChar64): PtrInt;
var S: PUTF8Char;
    c: AnsiChar;
begin
  result := 0;
  S := P;
  if S=nil then
    exit;
  if Sep=#0 then
    repeat // store up to next whitespace
      c := S[result];
      if c<=' ' then break;
      Buf[result] := c;
      inc(result);
      if result>=SizeOf(Buf) then
        exit; // avoid buffer overflow
    until false else
    repeat // store up to Sep or end of string
      c := S[result];
      if (c=#0) or (c=Sep) then break;
      Buf[result] := c;
      inc(result);
      if result>=SizeOf(Buf) then
        exit; // avoid buffer overflow
    until false;
  Buf[result] := #0; // make asciiz
  inc(S,result); // S[result]=Sep or #0
  if S^=#0 then
    P := nil else
    if Sep=#0 then
      P := S else
      P := S+1;
end;

function GetNextItemInt64(var P: PUTF8Char; Sep: AnsiChar): Int64;
{$ifdef CPU64}
begin
  result := GetNextItemInteger(P,Sep); // PtrInt=Int64
end;
{$else}
var tmp: TChar64;
begin
  if GetNextTChar64(P,Sep,tmp)>0 then
    SetInt64(tmp,result) else
    result := 0;
end;
{$endif}

function GetNextItemQWord(var P: PUTF8Char; Sep: AnsiChar): QWord;
{$ifdef CPU64}
begin
  result := GetNextItemCardinal(P,Sep); // PtrUInt=QWord
end;
{$else}
var tmp: TChar64;
begin
  if GetNextTChar64(P,Sep,tmp)>0 then
    SetQWord(tmp,result) else
    result := 0;
end;
{$endif}

function GetNextItemHexa(var P: PUTF8Char; Sep: AnsiChar): QWord;
var tmp: TChar64;
    L: integer;
begin
  result := 0;
  L := GetNextTChar64(P,Sep,tmp);
  if (L>0) and (L and 1=0) then
    if not HexDisplayToBin(@tmp,@result,L shr 1) then
      result := 0;
end;

function GetNextItemDouble(var P: PUTF8Char; Sep: AnsiChar): double;
var tmp: TChar64;
    err: integer;
begin
  if GetNextTChar64(P,Sep,tmp)>0 then begin
    result := GetExtended(tmp,err);
    if err<>0 then
      result := 0;
  end else
    result := 0;
end;

function GetNextItemCurrency(var P: PUTF8Char; Sep: AnsiChar): currency;
begin
  GetNextItemCurrency(P,result,Sep);
end;

procedure GetNextItemCurrency(var P: PUTF8Char; out result: currency; Sep: AnsiChar);
var tmp: TChar64;
begin
  if GetNextTChar64(P,Sep,tmp)>0 then
    PInt64(@result)^ := StrToCurr64(tmp) else
    result := 0;
end;

function GetCSVItem(P: PUTF8Char; Index: PtrUInt; Sep: AnsiChar): RawUTF8;
var i: PtrUInt;
begin
  if P=nil then
    result := '' else
    for i := 0 to Index do
      GetNextItem(P,Sep,result);
end;

function GetUnQuoteCSVItem(P: PUTF8Char; Index: PtrUInt; Sep, Quote: AnsiChar): RawUTF8;
var i: PtrUInt;
begin
  if P=nil then
    result := '' else
    for i := 0 to Index do
      GetNextItem(P,Sep,Quote,result);
end;

function GetLastCSVItem(const CSV: RawUTF8; Sep: AnsiChar): RawUTF8;
var i: integer;
begin
  for i := length(CSV) downto 1 do
    if CSV[i]=Sep then begin
      result := copy(CSV,i+1,maxInt);
      exit;
    end;
  result := CSV;
end;

function GetCSVItemString(P: PChar; Index: PtrUInt; Sep: Char): string;
var i: PtrUInt;
begin
  if P=nil then
    result := '' else
    for i := 0 to Index do
      result := GetNextItemString(P,Sep);
end;

function FindCSVIndex(CSV: PUTF8Char; const Value: RawUTF8; Sep: AnsiChar;
  CaseSensitive,TrimValue: boolean): integer;
var s: RawUTF8;
begin
  result := 0;
  while CSV<>nil do begin
    GetNextItem(CSV,Sep,s);
    if TrimValue then
      s := trim(s);
    if CaseSensitive then begin
      if s=Value then
        exit;
    end else
     if SameTextU(s,Value) then
       exit;
    inc(result);
  end;
  result := -1; // not found
end;

procedure CSVToRawUTF8DynArray(CSV: PUTF8Char; var Result: TRawUTF8DynArray;
  Sep: AnsiChar; TrimItems, AddVoidItems: boolean);
var s: RawUTF8;
    n: integer;
begin
  n := length(Result);
  while CSV<>nil do begin
    if TrimItems then
      GetNextItemTrimed(CSV,Sep,s) else
      GetNextItem(CSV,Sep,s);
    if (s<>'') or AddVoidItems then
      AddRawUTF8(Result,n,s);
  end;
  if n<>length(Result) then
    SetLength(Result,n);
end;

procedure CSVToRawUTF8DynArray(const CSV,Sep,SepEnd: RawUTF8; var Result: TRawUTF8DynArray);
var offs,i: integer;
begin
  offs := 1;
  while offs<=length(CSV) do begin
    SetLength(Result,length(Result)+1);
    i := PosEx(Sep,CSV,offs);
    if i=0 then begin
      i := PosEx(SepEnd,CSV,offs);
      if i=0 then
        i := MaxInt else
        dec(i,offs);
      Result[high(Result)] := Copy(CSV,offs,i);
      exit;
    end;
    Result[high(Result)] := Copy(CSV,offs,i-offs);
    offs := i+length(sep);
  end;
end;

function AddPrefixToCSV(CSV: PUTF8Char; const Prefix: RawUTF8; Sep: AnsiChar): RawUTF8;
var s: RawUTF8;
begin
  GetNextItem(CSV,Sep,result);
  if result='' then
    exit;
  result := Prefix+result;
  while CSV<>nil do begin
    GetNextItem(CSV,Sep,s);
    if s<>'' then
      result := result+','+Prefix+s;
  end;
end;

procedure AddToCSV(const Value: RawUTF8; var CSV: RawUTF8; const Sep: RawUTF8);
begin
  if CSV='' then
    CSV := Value else
    CSV := CSV+Sep+Value;
end;

function RenameInCSV(const OldValue, NewValue: RawUTF8; var CSV: RawUTF8;
  const Sep: RawUTF8): boolean;
var pattern: RawUTF8;
    i,j: integer;
begin
  result := OldValue=NewValue;
  i := length(OldValue);
  if result or (length(Sep)<>1) or (length(CSV)<i) or
     (PosEx(Sep,OldValue)>0) or (PosEx(Sep,NewValue)>0) then
    exit;
  if CompareMem(pointer(OldValue),pointer(CSV),i) and // first (or unique) item
     ((CSV[i+1]=Sep[1]) or (CSV[i+1]=#0)) then
    i := 1 else begin
    j := 1;
    pattern := Sep+OldValue;
    repeat
      i := PosEx(pattern,CSV,j);
      if i=0 then
        exit;
      j := i+length(pattern);
    until (CSV[j]=Sep[1]) or (CSV[j]=#0);
    inc(i);
  end;
  delete(CSV,i,length(OldValue));
  insert(NewValue,CSV,i);
  result := true;
end;

function RawUTF8ArrayToCSV(const Values: array of RawUTF8; const Sep: RawUTF8): RawUTF8;
var i, len, seplen, L: Integer;
    P: PAnsiChar;
begin
  result := '';
  if high(Values)<0 then
    exit;
  seplen := length(Sep);
  len := seplen*high(Values);
  for i := 0 to high(Values) do
    inc(len,length(Values[i]));
  FastSetString(result,nil,len);
  P := pointer(result);
  i := 0;
  repeat
    L := length(Values[i]);
    if L>0 then begin
      MoveFast(pointer(Values[i])^,P^,L);
      inc(P,L);
    end;
    if i=high(Values) then
      Break;
    if seplen>0 then begin
      MoveSmall(pointer(Sep),P,seplen);
      inc(P,seplen);
    end;
    inc(i);
  until false;
end;

function RawUTF8ArrayToQuotedCSV(const Values: array of RawUTF8; const Sep: RawUTF8;
  Quote: AnsiChar): RawUTF8;
var i: integer;
    tmp: TRawUTF8DynArray;
begin
  SetLength(tmp,length(Values));
  for i := 0 to High(Values) do
    tmp[i] := QuotedStr(Values[i],Quote);
  result := RawUTF8ArrayToCSV(tmp,Sep);
end;

function TRawUTF8DynArrayFrom(const Values: array of RawUTF8): TRawUTF8DynArray;
var i: integer;
begin
  Finalize(result);
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

{$ifdef HASCODEPAGE}
function LStringCodePage(info: PTypeInfo): integer; inline;
begin // caller checked that info^.kind=tkLString
  result := PWord({$ifdef FPC}AlignTypeData{$endif}(pointer(PtrUInt(info)+info^.NameLen+2)))^;
end;
{$endif HASCODEPAGE}

function IsRawUTF8DynArray(typeinfo: pointer): boolean;
var nfo: PTypeInfo;
begin
  if typeinfo=System.TypeInfo(TRawUTF8DynArray) then
    result := true else begin
    nfo := GetTypeInfo(typeinfo,tkDynArray);
    if (nfo<>nil) and (nfo^.elSize=SizeOf(pointer)) and
       (nfo^.elType<>nil) then begin
      nfo := DeRef(nfo^.elType);
      result := (nfo^.kind=tkLString)
        {$ifdef HASCODEPAGE}and (LStringCodePage(nfo)=CP_UTF8){$endif};
    end else
      result := false;
  end;
end;

procedure AddArrayOfConst(var Dest: TTVarRecDynArray; const Values: array of const);
var i,n: Integer;
begin
  n := length(Dest);
  SetLength(Dest,n+length(Values));
  for i := 0 to high(Values) do
    Dest[i+n] := Values[i];
end;

var
  DefaultTextWriterTrimEnum: boolean;

function ObjectToJSON(Value: TObject; Options: TTextWriterWriteObjectOptions): RawUTF8;
var temp: TTextWriterStackBuffer;
begin
  if Value=nil then
    result := NULL_STR_VAR else
    with DefaultTextWriterSerializer.CreateOwnedStream(temp) do
    try
      include(fCustomOptions,twoForceJSONStandard);
      WriteObject(Value,Options);
      SetText(result);
    finally
      Free;
    end;
end;

function ObjectsToJSON(const Names: array of RawUTF8; const Values: array of TObject;
  Options: TTextWriterWriteObjectOptions): RawUTF8;
var i,n: integer;
    temp: TTextWriterStackBuffer;
begin
  with DefaultTextWriterSerializer.CreateOwnedStream(temp) do
  try
    n := length(Names);
    Add('{');
    for i := 0 to high(Values) do
    if Values[i]<>nil then begin
      if i<n then
        AddFieldName(Names[i]) else
        AddPropName(ClassNameShort(Values[i])^);
      WriteObject(Values[i],Options);
      Add(',');
    end;
    CancelLastComma;
    Add('}');
    SetText(result);
  finally
    Free;
  end;
end;

function UrlEncode(const svar: RawUTF8): RawUTF8;
begin
  result := UrlEncode(pointer(svar));
end;

procedure _UrlEncode_Write(s, p: PByte; tab: PTextByteSet);
var c: cardinal;
    hex: ^TByteToWord;
begin
 hex := @TwoDigitsHexWB;
 repeat
   c := s^;
   inc(s);
   if tcURIUnreserved in tab[c] then begin
     p^ := c; // cf. rfc3986 2.3. Unreserved Characters
     inc(p);
   end else
   if c=0 then
     exit else
   if c=32 then begin
     p^ := ord('+');
     inc(p);
   end else begin
     p^ := ord('%'); inc(p);
     PWord(p)^ := hex[c];
     inc(p,2);
   end;
 until false;
end;

function _UrlEncode_ComputeLen(s: PByte; tab: PTextByteSet): PtrInt;
var c: cardinal;
begin
 result := 0;
 repeat
   c := s^;
   inc(s);
   if (tcURIUnreserved in tab[c]) or (c=32) then begin
     inc(result);
     continue;
   end;
   if c=0 then
     exit;
   inc(result,3);
 until false;
end;

function UrlEncode(Text: PUTF8Char): RawUTF8;
begin
  result := '';
  if Text=nil then
    exit;
  FastSetString(result,nil,_UrlEncode_ComputeLen(pointer(Text),@TEXT_CHARS));
  _UrlEncode_Write(pointer(Text),pointer(result),@TEXT_BYTES);
end;

function UrlEncode(const NameValuePairs: array of const): RawUTF8;
// (['select','*','where','ID=12','offset',23,'object',aObject]);
var A, n: PtrInt;
    name, value: RawUTF8;
begin
  result := '';
  n := high(NameValuePairs);
  if (n>0) and (n and 1=1) then begin
    for A := 0 to n shr 1 do begin
      VarRecToUTF8(NameValuePairs[A*2],name);
      if not IsUrlValid(pointer(name)) then
        continue; // just skip invalid names
      with NameValuePairs[A*2+1] do
        if VType=vtObject then
          value := ObjectToJSON(VObject,[]) else
          VarRecToUTF8(NameValuePairs[A*2+1],value);
      result := result+'&'+name+'='+UrlEncode(value);
    end;
    result[1] := '?';
  end;
end;

function IsUrlValid(P: PUTF8Char): boolean;
var tab: PTextCharSet;
begin
  result := false;
  if P=nil then
    exit;
  tab := @TEXT_CHARS;
  repeat // cf. rfc3986 2.3. Unreserved Characters
    if tcURIUnreserved in tab[P^] then
      inc(P) else
      exit;
  until P^=#0;
  result := true;
end;

function AreUrlValid(const Url: array of RawUTF8): boolean;
var i: integer;
begin
  result := false;
  for i := 0 to high(Url) do
    if not IsUrlValid(pointer(Url[i])) then
      exit;
  result := true;
end;

function IncludeTrailingURIDelimiter(const URI: RawByteString): RawByteString;
begin
  if (URI<>'') and (URI[length(URI)]<>'/') then
    result := URI+'/' else
    result := URI;
end;

function UrlEncodeJsonObject(const URIName: RawUTF8; ParametersJSON: PUTF8Char;
  const PropNamesToIgnore: array of RawUTF8; IncludeQueryDelimiter: Boolean): RawUTF8;
var i,j: integer;
    sep: AnsiChar;
    Params: TNameValuePUTF8CharDynArray;
    temp: TTextWriterStackBuffer;
begin
  if ParametersJSON=nil then
    result := URIName else
    with TTextWriter.CreateOwnedStream(temp) do
    try
      AddString(URIName);
      if (JSONDecode(ParametersJSON,Params,true)<>nil) and (Params<>nil) then begin
        sep := '?';
        for i := 0 to length(Params)-1 do
        with Params[i] do begin
          for j := 0 to high(PropNamesToIgnore) do
            if IdemPropNameU(PropNamesToIgnore[j],Name,NameLen) then begin
              NameLen := 0;
              break;
            end;
          if NameLen=0 then
            continue;
          if IncludeQueryDelimiter then
            Add(sep);
          AddNoJSONEscape(Name,NameLen);
          Add('=');
          AddString(UrlEncode(Value));
          sep := '&';
          IncludeQueryDelimiter := true;
        end;
      end;
      SetText(result);
    finally
      Free;
    end;
end;

function UrlEncodeJsonObject(const URIName, ParametersJSON: RawUTF8;
  const PropNamesToIgnore: array of RawUTF8; IncludeQueryDelimiter: Boolean): RawUTF8;
var temp: TSynTempBuffer;
begin
  temp.Init(ParametersJSON);
  try
    result := UrlEncodeJsonObject(URIName,temp.buf,PropNamesToIgnore,IncludeQueryDelimiter);
  finally
    temp.Done;
  end;
end;

function UrlDecode(const s: RawUTF8; i,len: PtrInt): RawUTF8;
var L: PtrInt;
    P: PUTF8Char;
    tmp: TSynTempBuffer;
begin
  result := '';
  L := PtrInt(s);
  if L=0 then
    exit;
  L := PStrLen(L-_STRLEN)^;
  if len<0 then
    len := L;
  if i>L then
    exit;
  dec(i);
  if len=i then
    exit;
  P := tmp.Init(len-i);  // reserve enough space for result
  while i<len do begin
    case s[i+1] of
      #0:  break; // reached end of s
      '%': if not HexToChar(PAnsiChar(pointer(s))+i+1,P) then
             P^ := s[i+1] else
             inc(i,2); // browsers may not follow the RFC (e.g. encode % as % !)
      '+': P^  := ' ';
    else
      P^ := s[i+1];
    end; // case s[i] of
    inc(i);
    inc(P);
  end;
  tmp.Done(P,result);
end;

function UrlDecode(U: PUTF8Char): RawUTF8;
var P: PUTF8Char;
    L: integer;
    tmp: TSynTempBuffer;
begin
result := '';
  L := StrLen(U);
  if L=0 then
    exit;
  P := tmp.Init(L);
  repeat
    case U^ of
      #0:  break; // reached end of URI
      '%': if not HexToChar(PAnsiChar(U+1),P) then
             P^ := U^ else
             inc(U,2); // browsers may not follow the RFC (e.g. encode % as % !)
      '+': P^  := ' ';
    else
      P^ := U^;
    end; // case s[i] of
    inc(U);
    inc(P);
  until false;
  tmp.Done(P,result);
end;

function UrlDecodeNextValue(U: PUTF8Char; out Value: RawUTF8): PUTF8Char;
var Beg,V: PUTF8Char;
    len: PtrInt;
begin
  if U<>nil then begin
    // compute resulting length of value
    Beg := U;
    len := 0;
    while (U^<>#0) and (U^<>'&') do begin
      if (U^='%') and HexToCharValid(PAnsiChar(U+1)) then
        inc(U,3) else
        inc(U);
      inc(len);
    end;
    // decode value content
    if len<>0 then begin
      FastSetString(Value,nil,len);
      V := pointer(Value);
      U := Beg;
      repeat
        if (U^='%') and HexToChar(PAnsiChar(U+1),V) then begin
          inc(V);
          inc(U,3);
        end else begin
          if U^='+' then
            V^ := ' ' else
            V^ := U^;
          inc(V);
          inc(U);
        end;
        dec(len);
      until len=0;
    end;
  end;
  result := U;
end;

function UrlDecodeNextName(U: PUTF8Char; out Name: RawUTF8): PUTF8Char;
var Beg, V: PUTF8Char;
    len: PtrInt;
begin
  result := nil;
  if U=nil then
    exit;
  // compute resulting length of name
  Beg := U;
  len := 0;
  repeat
    case U^ of
    #0:  exit;
    '=': begin
      result := U+1;
      break;
    end;
    '%': if (U[1]='3') and (U[2] in ['D','d']) then begin
           result := U+3;
           break;  // %3d means = according to the RFC
         end else
         if HexToCharValid(PAnsiChar(U+1)) then
           inc(U,3) else
           inc(U);
    else inc(U);
    end;
    inc(len);
  until false;
  if len=0 then
    exit;
  // decode name content
  FastSetString(Name,nil,len);
  V := pointer(Name);
  U := Beg;
  repeat
    if (U^='%') and HexToChar(PAnsiChar(U+1),V) then begin
      inc(V);
      inc(U,3);
    end else begin
      if U^='+' then
        V^ := ' ' else
        V^ := U^;
      inc(V);
      inc(U);
    end;
    dec(len);
  until len=0;
end;

function UrlDecodeNextNameValue(U: PUTF8Char; var Name,Value: RawUTF8): PUTF8Char;
begin
  result := nil;
  if U=nil then
    exit;
  U := UrlDecodeNextName(U,Name);
  if U=nil then
    exit;
  U := UrlDecodeNextValue(U,Value);
  if U^=#0 then
    result := U else
    result := U+1; // jump '&' to let decode the next name=value pair
end;

function UrlDecodeValue(U: PUTF8Char; const Upper: RawUTF8; var Value: RawUTF8;
  Next: PPUTF8Char): boolean;
begin
  // UrlDecodeValue('select=%2A&where=LastName%3D%27M%C3%B4net%27','SELECT=',V,@U)
  // -> U^='where=...' and V='*'
  result := false; // mark value not modified by default
  if U=nil then begin
    if Next<>nil then
      Next^ := U;
    exit;
  end;
  if IdemPChar(U,pointer(Upper)) then begin
    result := true;
    inc(U,length(Upper));
    U := UrlDecodeNextValue(U,Value);
  end;
  if Next=nil then
    exit;
  while not(U^ in [#0,'&']) do inc(U);
  if U^=#0 then
    Next^ := nil else
    Next^ := U+1; // jump '&'
end;

function UrlDecodeInteger(U: PUTF8Char; const Upper: RawUTF8;
  var Value: integer; Next: PPUTF8Char): boolean;
var V: PtrInt;
    SignNeg: boolean;
begin
  // UrlDecodeInteger('offset=20&where=LastName%3D%27M%C3%B4net%27','OFFSET=',O,@Next)
  // -> Next^='where=...' and O=20
  result := false; // mark value not modified by default
  if U=nil then begin
    if Next<>nil then
      Next^ := U;
    exit;
  end;
  if IdemPChar(U,pointer(Upper)) then begin
    inc(U,length(Upper));
    if U^='-' then begin
      SignNeg := True;
      Inc(U);
    end else
      SignNeg := false;
    if U^ in ['0'..'9'] then begin
      V := 0;
      repeat
        V := (V*10)+ord(U^)-48;
        inc(U);
      until not (U^ in ['0'..'9']);
      if SignNeg then
        Value := -V else
        Value := V;
      result := true;
    end;
  end;
  if Next=nil then
    exit;
  while not(U^ in [#0,'&']) do inc(U);
  if U^=#0 then
    Next^ := nil else
    Next^ := U+1; // jump '&'
end;

function UrlDecodeCardinal(U: PUTF8Char; const Upper: RawUTF8;
  var Value: Cardinal; Next: PPUTF8Char): boolean;
var V: PtrInt;
begin
  // UrlDecodeInteger('offset=20&where=LastName%3D%27M%C3%B4net%27','OFFSET=',O,@Next)
  // -> Next^='where=...' and O=20
  result := false; // mark value not modified by default
  if U=nil then begin
    if Next<>nil then
      Next^ := U;
    exit;
  end;
  if IdemPChar(U,pointer(Upper)) then begin
    inc(U,length(Upper));
    if U^ in ['0'..'9'] then begin
      V := 0;
      repeat
        V := (V*10)+ord(U^)-48;
        inc(U);
      until not (U^ in ['0'..'9']);
      Value := V;
      result := true;
    end;
  end;
  if Next=nil then
    exit;
  while not(U^ in [#0,'&']) do inc(U);
  if U^=#0 then
    Next^ := nil else
    Next^ := U+1; // jump '&'
end;

function UrlDecodeInt64(U: PUTF8Char; const Upper: RawUTF8;
  var Value: Int64; Next: PPUTF8Char): boolean;
var tmp: RawUTF8;
begin
  result := UrlDecodeValue(U,Upper,tmp,Next);
  if result then
    SetInt64(pointer(tmp),Value);
end;

function UrlDecodeExtended(U: PUTF8Char; const Upper: RawUTF8;
  var Value: TSynExtended; Next: PPUTF8Char): boolean;
var tmp: RawUTF8;
    err: integer;
begin
  result := UrlDecodeValue(U,Upper,tmp,Next);
  if result then begin
    Value := GetExtended(pointer(tmp),err);
    if err<>0 then
      result := false;
  end;
end;

function UrlDecodeDouble(U: PUTF8Char; const Upper: RawUTF8; var Value: double;
  Next: PPUTF8Char): boolean;
var tmp: RawUTF8;
    err: integer;
begin
  result := UrlDecodeValue(U,Upper,tmp,Next);
  if result then begin
    Value := GetExtended(pointer(tmp),err);
    if err<>0 then
      result := false;
  end;
end;

function UrlDecodeNeedParameters(U, CSVNames: PUTF8Char): boolean;
var tmp: array[byte] of AnsiChar;
    L: integer;
    Beg: PUTF8Char;
// UrlDecodeNeedParameters('price=20.45&where=LastName%3D','price,where') will
// return TRUE
begin
  result := (CSVNames=nil);
  if result then
    exit; // no parameter to check -> success
  if U=nil then
    exit; // no input data -> error
  repeat
    L := 0;
    while (CSVNames^<>#0) and (CSVNames^<>',') do begin
      tmp[L] := NormToUpper[CSVNames^];
      if L=high(tmp) then
        exit else // invalid CSV parameter
        inc(L);
      inc(CSVNames);
    end;
    if L=0 then
      exit; // invalid CSV parameter
    PWord(@tmp[L])^ := ord('=');
    Beg := U;
    repeat
      if IdemPChar(U,tmp) then
        break;
      while not(U^ in [#0,'&']) do inc(U);
      if U^=#0 then
        exit else // didn't find tmp in U
        inc(U); // Jump &
    until false;
    U := Beg;
    if CSVNames^=#0 then
      Break else // no more parameter to check
      inc(CSVNames); // jump &
  until false;
  result := true; // all parameters found
end;

function CSVEncode(const NameValuePairs: array of const;
  const KeySeparator, ValueSeparator: RawUTF8): RawUTF8;
var i: integer;
    temp: TTextWriterStackBuffer;
begin
  if length(NameValuePairs)<2 then
    result := '' else
    with DefaultTextWriterSerializer.CreateOwnedStream(temp) do
    try
      for i := 1 to length(NameValuePairs) shr 1 do begin
        Add(NameValuePairs[i*2-2],twNone);
        AddNoJSONEscape(pointer(KeySeparator),length(KeySeparator));
        Add(NameValuePairs[i*2-1],twNone);
        AddNoJSONEscape(pointer(ValueSeparator),length(ValueSeparator));
      end;
      SetText(result);
    finally
      Free;
    end;
end;

function ArrayOfConstValueAsText(const NameValuePairs: array of const;
  const aName: RawUTF8): RawUTF8;
var i: integer;
    name: RawUTF8;
begin
  for i := 1 to length(NameValuePairs) shr 1 do
    if VarRecToUTF8IsString(NameValuePairs[i*2-2],name) and
       IdemPropNameU(name,aName) then begin
      VarRecToUTF8(NameValuePairs[i*2-1],result);
      exit;
    end;
  result := '';
end;

function IsZero(P: pointer; Length: integer): boolean;
var i: integer;
begin
  result := false;
  for i := 1 to Length shr 4 do // 16 bytes (4 DWORD) by loop - aligned read
    {$ifdef CPU64}
    if (PInt64Array(P)^[0]<>0) or (PInt64Array(P)^[1]<>0) then
    {$else}
    if (PCardinalArray(P)^[0]<>0) or (PCardinalArray(P)^[1]<>0) or
       (PCardinalArray(P)^[2]<>0) or (PCardinalArray(P)^[3]<>0) then
    {$endif}
      exit else
      inc(PByte(P),16);
  for i := 1 to (Length shr 2)and 3 do // 4 bytes (1 DWORD) by loop
    if PCardinal(P)^<>0 then
      exit else
      inc(PByte(P),4);
  for i := 1 to Length and 3 do // remaining content
    if PByte(P)^<>0 then
      exit else
      inc(PByte(P));
  result := true;
end;

function IsZeroSmall(P: pointer; Length: PtrInt): boolean;
begin
  result := false;
  repeat
    if PByte(P)^<>0 then
      exit;
    inc(PByte(P));
    dec(Length);
    if Length=0 then
      break;
  until false;
  result := true;
end;

function IsZero(const Values: TRawUTF8DynArray): boolean;
var i: integer;
begin
  result := false;
  for i := 0 to length(Values)-1 do
    if Values[i]<>'' then
      exit;
  result := true;
end;

function IsZero(const Values: TIntegerDynArray): boolean;
var i: integer;
begin
  result := false;
  for i := 0 to length(Values)-1 do
    if Values[i]<>0 then
      exit;
  result := true;
end;

function IsZero(const Values: TInt64DynArray): boolean;
var i: integer;
begin
  result := false;
  for i := 0 to length(Values)-1 do
    if Values[i]<>0 then
      exit;
  result := true;
end;

procedure FillZero(var Values: TRawUTF8DynArray);
var i: integer;
begin
  for i := 0 to length(Values)-1 do
    {$ifdef FPC}Finalize(Values[i]){$else}Values[i] := ''{$endif};
end;

procedure FillZero(var Values: TIntegerDynArray);
begin
  FillCharFast(Values[0],length(Values)*SizeOf(integer),0);
end;

procedure FillZero(var Values: TInt64DynArray);
begin
  FillCharFast(Values[0],length(Values)*SizeOf(Int64),0);
end;


function crc16(Data: PAnsiChar; Len: integer): cardinal;
var i, j: Integer;
begin
  result := $ffff;
  for i := 0 to Len-1 do begin
    result := result xor (ord(Data[i]) shl 8);
    for j := 1 to 8 do
      if result and $8000<>0 then
        result := (result shl 1) xor $1021 else
        result := result shl 1;
  end;
  result := result and $ffff;
end;

function Hash32(const Text: RawByteString): cardinal;
begin
  result := Hash32(pointer(Text),length(Text));
end;

function Hash32(Data: PCardinalArray; Len: integer): cardinal;
{$ifdef CPUX64} {$ifdef FPC}nostackframe; assembler;
asm {$else} asm .noframe {$endif} // rcx/rdi=Data edx/esi=Len
        xor     eax, eax
        xor     r9d, r9d
        test    Data, Data
        jz      @z
        {$ifdef win64}
        mov     r8, rdx
        shr     r8, 4
        {$else}
        mov     edx, esi
        shr     esi, 4
        {$endif}
        jz      @by4
        {$ifdef FPC} align 16 {$else} .align 16 {$endif}
@by16:  add     eax, dword ptr[Data]
        add     r9d, eax
        add     eax, dword ptr[Data+4]
        add     r9d, eax
        add     eax, dword ptr[Data+8]
        add     r9d, eax
        add     eax, dword ptr[Data+12]
        add     r9d, eax
        add     Data, 16
        {$ifdef win64}
        dec     r8d
        {$else}
        dec     esi
        {$endif}
        jnz     @by16
@by4:   mov     dh, dl
        and     dl, 15
        jz      @0
        shr     dl, 2
        jz      @rem
@4:     add     eax, dword ptr[Data]
        add     r9d, eax
        add     Data, 4
        dec     dl
        jnz     @4
@rem:   and     dh, 3
        jz      @0
        dec     dh
        jz      @1
        dec     dh
        jz      @2
        mov     ecx, dword ptr[Data]
        and     ecx, $ffffff
        jmp     @e
@2:     movzx   ecx, word ptr[Data]
        jmp     @e
@1:     movzx   ecx, byte ptr[Data]
@e:     add     eax, ecx
@0:     add     r9d, eax
        shl     r9d, 16
        xor     eax, r9d
@z:
end;
{$else}
{$ifdef PUREPASCAL}
var s1,s2: cardinal;
    i: integer;
begin
  if Data<>nil then begin
    s1 := 0;
    s2 := 0;
    for i := 1 to Len shr 4 do begin // 16 bytes (128-bit) loop - aligned read
      inc(s1,Data[0]);
      inc(s2,s1);
      inc(s1,Data[1]);
      inc(s2,s1);
      inc(s1,Data[2]);
      inc(s2,s1);
      inc(s1,Data[3]);
      inc(s2,s1);
      Data := @Data[4];
    end;
    for i := 1 to (Len shr 2)and 3 do begin // 4 bytes (DWORD) by loop
      inc(s1,Data[0]);
      inc(s2,s1);
      Data := @Data[1];
    end;
    case Len and 3 of // remaining 0..3 bytes
    1: inc(s1,PByte(Data)^);
    2: inc(s1,PWord(Data)^);
    3: inc(s1,PWord(Data)^ or (PByteArray(Data)^[2] shl 16));
    end;
    inc(s2,s1);
    result := s1 xor (s2 shl 16);
  end else
    result := 0;
end;
{$else} {$ifdef FPC} nostackframe; assembler; {$endif}
asm  // eax=Data edx=Len
        push    esi
        push    edi
        mov     cl, dl
        mov     ch, dl
        xor     esi, esi
        xor     edi, edi
        test    eax, eax
        jz      @z
        shr     edx, 4
        jz      @by4
        nop  
@by16:  add     esi, dword ptr[eax]
        add     edi, esi
        add     esi, dword ptr[eax+4]
        add     edi, esi
        add     esi, dword ptr[eax+8]
        add     edi, esi
        add     esi, dword ptr[eax+12]
        add     edi, esi
        add     eax, 16
        dec     edx
        jnz     @by16
@by4:   and     cl, 15
        jz      @0
        shr     cl, 2
        jz      @rem
@4:     add     esi, dword ptr[eax]
        add     edi, esi
        add     eax, 4
        dec     cl
        jnz     @4
@rem:   and     ch, 3
        jz      @0
        dec     ch
        jz      @1
        dec     ch
        jz      @2
        mov     eax, dword ptr[eax]
        and     eax, $ffffff
        jmp     @e
@2:     movzx   eax, word ptr[eax]
        jmp     @e
@1:     movzx   eax, byte ptr[eax]
@e:     add     esi, eax
@0:     add     edi, esi
        mov     eax, esi
        shl     edi, 16
        xor     eax, edi
@z:     pop     edi
        pop     esi
end;
{$endif PUREPASCAL}
{$endif CPUX64}

procedure OrMemory(Dest,Source: PByteArray; size: PtrInt);
begin
  while size>=SizeOf(PtrInt) do begin
    dec(size,SizeOf(PtrInt));
    PPtrInt(Dest)^ := PPtrInt(Dest)^ or PPtrInt(Source)^;
    inc(PPtrInt(Dest));
    inc(PPtrInt(Source));
  end;
  while size>0 do begin
    dec(size);
    Dest[size] := Dest[size] or Source[size];
  end;
end;

procedure XorMemory(Dest,Source: PByteArray; size: PtrInt);
begin
  while size>=SizeOf(PtrInt) do begin
    dec(size,SizeOf(PtrInt));
    PPtrInt(Dest)^ := PPtrInt(Dest)^ xor PPtrInt(Source)^;
    inc(PPtrInt(Dest));
    inc(PPtrInt(Source));
  end;
  while size>0 do begin
    dec(size);
    Dest[size] := Dest[size] xor Source[size];
  end;
end;

procedure XorMemory(Dest,Source1,Source2: PByteArray; size: PtrInt);
begin
  while size>=SizeOf(PtrInt) do begin
    dec(size,SizeOf(PtrInt));
    PPtrInt(Dest)^ := PPtrInt(Source1)^ xor PPtrInt(Source2)^;
    inc(PPtrInt(Dest));
    inc(PPtrInt(Source1));
    inc(PPtrInt(Source2));
  end;
  while size>0 do begin
    dec(size);
    Dest[size] := Source1[size] xor Source2[size];
  end;
end;

procedure AndMemory(Dest,Source: PByteArray; size: PtrInt);
begin
  while size>=SizeOf(PtrInt) do begin
    dec(size,SizeOf(PtrInt));
    PPtrInt(Dest)^ := PPtrInt(Dest)^ and PPtrInt(Source)^;
    inc(PPtrInt(Dest));
    inc(PPtrInt(Source));
  end;
  while size>0 do begin
    dec(size);
    Dest[size] := Dest[size] and Source[size];
  end;
end;

{$ifdef CPUINTEL} // use optimized x86/x64 asm versions for xxHash32

{$ifdef CPUX86}
function xxHash32(crc: cardinal; P: PAnsiChar; len: integer): cardinal;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm
        xchg    edx, ecx
        push    ebp
        push    edi
        lea     ebp, [ecx+edx]
        push    esi
        push    ebx
        sub     esp, 8
        mov     ebx, eax
        mov     dword ptr [esp], edx
        lea     eax, [ebx+165667B1H]
        cmp     edx, 15
        jbe     @2
        lea     eax, [ebp-10H]
        lea     edi, [ebx+24234428H]
        lea     esi, [ebx-7A143589H]
        mov     dword ptr [esp+4H], ebp
        mov     edx, eax
        lea     eax, [ebx+61C8864FH]
        mov     ebp, edx
@1:     mov     edx, dword ptr [ecx]
        imul    edx, -2048144777
        add     edi, edx
        rol     edi, 13
        imul    edi, -1640531535
        mov     edx, dword ptr [ecx+4]
        imul    edx, -2048144777
        add     esi, edx
        rol     esi, 13
        imul    esi, -1640531535
        mov     edx, dword ptr [ecx+8]
        imul    edx, -2048144777
        add     ebx, edx
        rol     ebx, 13
        imul    ebx, -1640531535
        mov     edx, dword ptr [ecx+12]
        lea     ecx, [ecx+16]
        imul    edx, -2048144777
        add     eax, edx
        rol     eax, 13
        imul    eax, -1640531535
        cmp     ebp, ecx
        jnc     @1
        rol     edi, 1
        rol     esi, 7
        rol     ebx, 12
        add     esi, edi
        mov     ebp, dword ptr [esp+4H]
        ror     eax, 14
        add     ebx, esi
        add     eax, ebx
@2:     lea     esi, [ecx+4H]
        add     eax, dword ptr [esp]
        cmp     ebp, esi
        jc      @4
        mov     ebx, esi
        nop
@3:     imul    edx, dword ptr [ebx-4H], -1028477379
        add     ebx, 4
        add     eax, edx
        ror     eax, 15
        imul    eax, 668265263
        cmp     ebp, ebx
        jnc     @3
        lea     edx, [ebp-4H]
        sub     edx, ecx
        mov     ecx, edx
        and     ecx, 0FFFFFFFCH
        add     ecx, esi
@4:     cmp     ebp, ecx
        jbe     @6
@5:     movzx   edx, byte ptr [ecx]
        add     ecx, 1
        imul    edx, 374761393
        add     eax, edx
        rol     eax, 11
        imul    eax, -1640531535
        cmp     ebp, ecx
        jnz     @5
        nop
@6:     mov     edx, eax
        add     esp, 8
        shr     edx, 15
        xor     eax, edx
        imul    eax, -2048144777
        pop     ebx
        pop     esi
        mov     edx, eax
        shr     edx, 13
        xor     eax, edx
        imul    eax, -1028477379
        pop     edi
        pop     ebp
        mov     edx, eax
        shr     edx, 16
        xor     eax, edx
end;
{$endif CPUX86}

{$ifdef CPUX64}
function xxHash32(crc: cardinal; P: PAnsiChar; len: integer): cardinal;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe{$endif}
        {$ifdef LINUX} // crc=rdi P=rsi len=rdx
        mov     r8, rdi
        mov     rcx, rsi
        {$else} // crc=r8 P=rcx len=rdx
        mov     r10, r8
        mov     r8, rcx
        mov     rcx, rdx
        mov     rdx, r10
        push    rsi   // Win64 expects those registers to be preserved
        push    rdi
        {$endif}
        // P=r8 len=rcx crc=rdx
        push    r12
        push    rbx
        mov     r12d, -1640531535
        lea     r10, [rcx+rdx]
        lea     eax, [r8+165667B1H]
        cmp     rdx, 15
        jbe     @2
        lea     rsi, [r10-10H]
        lea     ebx, [r8+24234428H]
        lea     edi, [r8-7A143589H]
        lea     eax, [r8+61C8864FH]
@1:     imul    r9d, dword ptr [rcx], -2048144777
        add     rcx, 16
        imul    r11d, dword ptr [rcx-0CH], -2048144777
        add     ebx, r9d
        lea     r9d, [r11+rdi]
        rol     ebx, 13
        rol     r9d, 13
        imul    ebx, r12d
        imul    edi, r9d, -1640531535
        imul    r9d, dword ptr [rcx-8H], -2048144777
        add     r8d, r9d
        imul    r9d, dword ptr [rcx-4H], -2048144777
        rol     r8d, 13
        imul    r8d, r12d
        add     eax, r9d
        rol     eax, 13
        imul    eax, r12d
        cmp     rsi, rcx
        jnc     @1
        rol     edi, 7
        rol     ebx, 1
        rol     r8d, 12
        mov     r9d, edi
        ror     eax, 14
        add     r9d, ebx
        add     r8d, r9d
        add     eax, r8d
@2:     lea     r9, [rcx+4H]
        add     eax, edx
        cmp     r10, r9
        jc      @4
        mov     r8, r9
@3:     imul    edx, dword ptr [r8-4H], -1028477379
        add     r8, 4
        add     eax, edx
        ror     eax, 15
        imul    eax, 668265263
        cmp     r10, r8
        jnc     @3
        lea     rdx, [r10-4H]
        sub     rdx, rcx
        mov     rcx, rdx
        and     rcx, 0FFFFFFFFFFFFFFFCH
        add     rcx, r9
@4:     cmp     r10, rcx
        jbe     @6
@5:     movzx   edx, byte ptr [rcx]
        add     rcx, 1
        imul    edx, 374761393
        add     eax, edx
        rol     eax, 11
        imul    eax, r12d
        cmp     r10, rcx
        jnz     @5
@6:     mov     edx, eax
        shr     edx, 15
        xor     eax, edx
        imul    eax, -2048144777
        mov     edx, eax
        shr     edx, 13
        xor     eax, edx
        imul    eax, -1028477379
        mov     edx, eax
        shr     edx, 16
        xor     eax, edx
        pop     rbx
        pop     r12
        {$ifndef LINUX}
        pop     rdi
        pop     rsi
        {$endif}
end;
{$endif CPUX64}

{$else not CPUINTEL}

const
  PRIME32_1 = 2654435761;
  PRIME32_2 = 2246822519;
  PRIME32_3 = 3266489917;
  PRIME32_4 = 668265263;
  PRIME32_5 = 374761393;

{$ifdef FPC} // RolDWord is an intrinsic function under FPC :)
function Rol13(value: cardinal): cardinal; inline;
begin
  result := RolDWord(value, 13);
end;
{$else}
{$ifdef HASINLINENOTX86}
function RolDWord(value: cardinal; count: integer): cardinal; inline;
begin
  result := (value shl count) or (value shr (32-count));
end;

function Rol13(value: cardinal): cardinal; inline;
begin
  result := (value shl 13) or (value shr 19);
end;
{$else}
function RolDWord(value: cardinal; count: integer): cardinal;
asm
      mov     cl, dl
      rol     eax, cl
end;

function Rol13(value: cardinal): cardinal;
asm
      rol     eax, 13
end;
{$endif HASINLINENOTX86}
{$endif FPC}

function xxHash32(crc: cardinal; P: PAnsiChar; len: integer): cardinal;
var c1, c2, c3, c4: cardinal;
    PLimit, PEnd: PAnsiChar;
begin
  PEnd := P + len;
  if len >= 16 then begin
    PLimit := PEnd - 16;
    c3 := crc;
    c2 := c3 + PRIME32_2;
    c1 := c2 + PRIME32_1;
    c4 := c3 - PRIME32_1;
    repeat
      c1 := PRIME32_1 * Rol13(c1 + PRIME32_2 * PCardinal(P)^);
      c2 := PRIME32_1 * Rol13(c2 + PRIME32_2 * PCardinal(P+4)^);
      c3 := PRIME32_1 * Rol13(c3 + PRIME32_2 * PCardinal(P+8)^);
      c4 := PRIME32_1 * Rol13(c4 + PRIME32_2 * PCardinal(P+12)^);
      inc(P, 16);
    until not (P <= PLimit);
    result := RolDWord(c1, 1) + RolDWord(c2, 7) + RolDWord(c3, 12) + RolDWord(c4, 18);
  end else
    result := crc + PRIME32_5;
  inc(result, len);
  while P + 4 <= PEnd do begin
    inc(result, PCardinal(P)^ * PRIME32_3);
    result := RolDWord(result, 17) * PRIME32_4;
    inc(P, 4);
  end;
  while P < PEnd do begin
    inc(result, PByte(P)^ * PRIME32_5);
    result := RolDWord(result, 11) * PRIME32_1;
    inc(P);
  end;
  result := result xor (result shr 15);
  result := result * PRIME32_2;
  result := result xor (result shr 13);
  result := result * PRIME32_3;
  result := result xor (result shr 16);
end;

{$endif CPUINTEL}

type
 TRegisters = record
   eax,ebx,ecx,edx: cardinal;
 end;

{$ifdef CPUINTEL}
{$ifdef CPU64}
procedure GetCPUID(Param: Cardinal; var Registers: TRegisters);
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // ecx=param, rdx=Registers (Linux: edi,rsi)
{$endif FPC}
        mov     eax, Param
        mov     r9, Registers
        mov     r10, rbx // preserve rbx
        xor     ebx, ebx
        xor     ecx, ecx
        xor     edx, edx
        cpuid
        mov     TRegisters(r9).&eax, eax
        mov     TRegisters(r9).&ebx, ebx
        mov     TRegisters(r9).&ecx, ecx
        mov     TRegisters(r9).&edx, edx
        mov     rbx, r10
end;

{$ifndef ABSOLUTEPASCAL}
const
  CMP_RANGES = $44; // see https://msdn.microsoft.com/en-us/library/bb531425
  _UpperCopy255BufSSE42: array[0..31] of AnsiChar =
    'azazazazazazazaz                ';

function UpperCopy255BufSSE42(dest: PAnsiChar; source: PUTF8Char; sourceLen: PtrInt): PAnsiChar;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx=dest, rdx=source, r8=len (Linux: rdi,rsi,rdx)
{$endif FPC}
       {$ifdef win64}
       mov     rax, rcx
       mov     r9, rdx
       mov     rdx, r8
       {$else}
       mov     rax, rdi
       mov     r9, rsi
       {$endif}
       lea     rcx, [rip + _UpperCopy255BufSSE42]
       test    rdx, rdx
       jz      @z
       movups  xmm1, dqword ptr [rcx]
       movups  xmm3, dqword ptr [rcx + 16]
       cmp     rdx, 16
       ja      @big
       // optimize the common case of sourceLen<=16
       movups  xmm2, [r9]
       {$ifdef HASAESNI}
       pcmpistrm xmm1, xmm2, CMP_RANGES // find in range a-z, return mask in xmm0
       {$else}
       db $66, $0F, $3A, $62, $CA, CMP_RANGES
       {$endif}
       pand    xmm0, xmm3
       pxor    xmm2, xmm0
       movups  [rax], xmm2
       add     rax, rdx
@z:    ret
@big:  mov     rcx, rax
       cmp     rdx, 240
       jb      @ok
       mov     rdx, 239
@ok:   add     rax, rdx // return end position with the exact size
       shr     rdx, 4
       sub     r9, rcx
       add     rdx, 1
{$ifdef FPC} align 16 {$else} .align 16{$endif}
@s:    movups  xmm2, [r9 + rcx]
       {$ifdef HASAESNI}
       pcmpistrm xmm1, xmm2, CMP_RANGES
       {$else}
       db $66, $0F, $3A, $62, $CA, CMP_RANGES
       {$endif}
       pand    xmm0, xmm3
       pxor    xmm2, xmm0
       movups  [rcx], xmm2
       add     rcx, 16
       dec     rdx
       jnz     @s
end;

{$ifdef HASAESNI}
const
  EQUAL_EACH = 8;   // see https://msdn.microsoft.com/en-us/library/bb531463
  NEGATIVE_POLARITY = 16;

function StrLenSSE42(S: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
        xor     rax, rax
        mov     rdx, S
        test    S, S
        jz      @null
        xor     rcx, rcx
        pxor    xmm0, xmm0
        pcmpistri xmm0, [rdx], EQUAL_EACH // result in ecx
        jnz     @L
        mov     eax, ecx
@null:  ret
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@L:     add     rax, 16   // add before comparison flag
        pcmpistri xmm0, [rdx + rax], EQUAL_EACH // result in ecx
        jnz     @L
        add     rax, rcx
end;

function StrCompSSE42(Str1, Str2: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx=Str1, rdx=Str2 (Linux: rdi,rsi)
{$endif FPC}
      {$ifdef win64}
      mov       rax, rcx
      test      rcx, rdx
      {$else}
      mov       rax, rdi
      mov       rdx, rsi
      test      rdi, rsi  // is one of Str1/Str2 nil ?
      {$endif}
      jz        @n
@ok:  sub       rax, rdx
      xor       rcx, rcx
      movups    xmm0, dqword [rdx]
      pcmpistri xmm0, dqword [rdx + rax], EQUAL_EACH + NEGATIVE_POLARITY // result in rcx
      ja        @1
      jc        @2
      xor       rax, rax
      ret
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@1:   add       rdx, 16
      movups    xmm0, dqword [rdx]
      pcmpistri xmm0, dqword [rdx + rax], EQUAL_EACH + NEGATIVE_POLARITY
      ja        @1
      jc        @2
@0:   xor       rax, rax // Str1=Str2
      ret
@n:   cmp       rax, rdx
      je        @0
      test      rax, rax  // Str1='' ?
      jz        @max
      test      rdx, rdx  // Str2='' ?
      jnz       @ok
      mov       rax, 1
      ret
@max: dec       rax  // returns -1
      ret
@2:   add       rax, rdx
      movzx     rax, byte ptr [rax + rcx]
      movzx     rdx, byte ptr [rdx + rcx]
      sub       rax, rdx
end;
{$endif HASAESNI}
{$endif ABSOLUTEPASCAL}

function crc32csse42(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // ecx=crc, rdx=buf, r8=len (Linux: edi,rsi,edx)
{$endif FPC}
        mov     eax, crc
        not     eax
        test    len, len
        jz      @0
        test    buf, buf
        jz      @0
        jmp     @align
@7:     crc32   eax, byte ptr[buf]
        inc     buf
        dec     len
        jz      @0
@align: test    buf, 7
        jnz     @7
        mov     ecx, len
        shr     len, 3
        jnz     @s
@2:     test    cl, 4
        jz      @3
        crc32   eax, dword ptr[buf]
        add     buf, 4
@3:     test    cl, 2
        jz      @1
        crc32   eax, word ptr[buf]
        add     buf, 2
@1:     test    cl, 1
        jz      @0
        crc32   eax, byte ptr[buf]
@0:     not     eax
        ret
{$ifdef FPC} align 16
@s:     crc32   rax, qword [buf] // hash 8 bytes per loop
{$else} .align 16
@s:     db $F2,$48,$0F,$38,$F1,$02 // circumvent Delphi inline asm compiler bug
{$endif}add     buf, 8
        dec     len
        jnz     @s
        jmp     @2
end;

function StrLenSSE2(S: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx=S (Linux: rdi)
{$endif FPC} // from GPL strlen64.asm by Agner Fog - www.agner.org/optimize
        {$ifdef win64}
        mov     rax, rcx             // get pointer to string from rcx
        mov     r8,  rcx             // copy pointer
        test    rcx, rcx
        {$else}
        mov     rax, rdi
        mov     ecx, edi
        test    rdi, rdi
        {$endif}
        jz      @null                // returns 0 if S=nil
        // rax=s,ecx=32-bit of s
        pxor    xmm0, xmm0           // set to zero
        and     ecx, 15              // lower 4 bits indicate misalignment
        and     rax, -16             // align pointer by 16
        // will never read outside a memory page boundary, so won't trigger GPF
        movaps  xmm1, [rax]          // read from nearest preceding boundary
        pcmpeqb xmm1, xmm0           // compare 16 bytes with zero
        pmovmskb edx, xmm1           // get one bit for each byte result
        shr     edx, cl              // shift out false bits
        shl     edx, cl              // shift back again
        bsf     edx, edx             // find first 1-bit
        jnz     @L2                  // found
        // Main loop, search 16 bytes at a time
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@L1:    add     rax, 10H             // increment pointer by 16
        movaps  xmm1, [rax]          // read 16 bytes aligned
        pcmpeqb xmm1, xmm0           // compare 16 bytes with zero
        pmovmskb edx, xmm1           // get one bit for each byte result
        bsf     edx, edx             // find first 1-bit
        // (moving the bsf out of the loop and using test here would be faster
        // for long strings on old processors, but we are assuming that most
        // strings are short, and newer processors have higher priority)
        jz      @L1                  // loop if not found
@L2:    // Zero-byte found. Compute string length
        {$ifdef win64}
        sub     rax, r8              // subtract start address
        {$else}
        sub     rax, rdi
        {$endif}
        add     rax, rdx             // add byte index
@null:
end;

{$endif CPU64}

procedure crcblockssse42(crc128, data128: PBlock128; count: integer);
{$ifdef CPUX64} {$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe {$endif FPC}
          test    count, count
          jle     @z
          mov     rax, data128
          {$ifdef win64}
          mov     rdx, rcx
          mov     ecx, r8d
          {$else}
          mov     ecx, edx
          mov     rdx, rdi
          {$endif win64}
          mov     r8d,  dword ptr [rdx] // we can't use qword ptr here
          mov     r9d,  dword ptr [rdx + 4]
          mov     r10d, dword ptr [rdx + 8]
          mov     r11d, dword ptr [rdx + 12]
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@s:       crc32   r8d,  dword ptr [rax]
          crc32   r9d,  dword ptr [rax + 4]
          crc32   r10d, dword ptr [rax + 8]
          crc32   r11d, dword ptr [rax + 12]
          add     rax, 16
          dec     ecx
          jnz     @s
          mov     dword ptr [rdx], r8d
          mov     dword ptr [rdx + 4], r9d
          mov     dword ptr [rdx + 8], r10d
          mov     dword ptr [rdx + 12], r11d
@z:
end;
{$else} {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=crc128 edx=data128 ecx=count
          push    ebx
          push    esi
          push    edi
          push    ebp
          test    count, count
          jle     @z
          mov     ebp, count
          mov     esi, crc128
          mov     edi, data128
          mov     eax, dword ptr[esi]
          mov     ebx, dword ptr[esi + 4]
          mov     ecx, dword ptr[esi + 8]
          mov     edx, dword ptr[esi + 12]
{$ifdef FPC_X86ASM} align 8
@s:       crc32   eax, dword ptr[edi]
          crc32   ebx, dword ptr[edi + 4]
          crc32   ecx, dword ptr[edi + 8]
          crc32   edx, dword ptr[edi + 12]
{$else}@s:db $F2, $0F, $38, $F1, $07
          db $F2, $0F, $38, $F1, $5F, $04
          db $F2, $0F, $38, $F1, $4F, $08
          db $F2, $0F, $38, $F1, $57, $0C
{$endif}  add     edi, 16
          dec     ebp
          jnz     @s
          mov     dword ptr[esi], eax
          mov     dword ptr[esi + 4], ebx
          mov     dword ptr[esi + 8], ecx
          mov     dword ptr[esi + 12], edx
@z:       pop     ebp
          pop     edi
          pop     esi
          pop     ebx
end;
{$endif CPUX64}
{$endif CPUINTEL}

procedure crcblocksfast(crc128, data128: PBlock128; count: integer);
{$ifdef PUREPASCAL} // efficient registers use on 64-bit, ARM or PIC
var c: cardinal;
    tab: PCrc32tab;
begin
  tab := @crc32ctab;
  if count>0 then
    repeat
      c := crc128^[0] xor data128^[0];
      crc128^[0] := tab[3,ToByte(c)] xor tab[2,ToByte(c shr 8)]
                xor tab[1,ToByte(c shr 16)] xor tab[0,ToByte(c shr 24)];
      c := crc128^[1] xor data128^[1];
      crc128^[1] := tab[3,ToByte(c)] xor tab[2,ToByte(c shr 8)]
                xor tab[1,ToByte(c shr 16)] xor tab[0,ToByte(c shr 24)];
      c := crc128^[2] xor data128^[2];
      crc128^[2] := tab[3,ToByte(c)] xor tab[2,ToByte(c shr 8)]
                xor tab[1,ToByte(c shr 16)] xor tab[0,ToByte(c shr 24)];
      c := crc128^[3] xor data128^[3];
      crc128^[3] := tab[3,ToByte(c)] xor tab[2,ToByte(c shr 8)]
                xor tab[1,ToByte(c shr 16)] xor tab[0,ToByte(c shr 24)];
      inc(data128);
      dec(count);
    until count=0;
end;
{$else} // call optimized x86 asm within the loop
begin
  while count>0 do begin
    crcblockNoSSE42(crc128,data128);
    inc(data128);
    dec(count);
  end;
end;
{$endif PUREPASCAL}

{$ifdef CPUINTEL}
function crc32cBy4SSE42(crc, value: cardinal): cardinal;
{$ifdef CPU64} {$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe {$endif FPC}
        mov     eax, crc
        crc32   eax, value
end;
{$else} {$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=crc, edx=value
        {$ifdef FPC_X86ASM}
        crc32   eax, edx
        {$else}
        db      $F2, $0F, $38, $F1, $C2
        {$endif}
end;
{$endif CPU64}

procedure crcblockSSE42(crc128, data128: PBlock128);
{$ifdef CPU64} {$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx=crc128, rdx=data128 (Linux: rdi,rsi)
{$endif FPC}
        mov     eax,  dword ptr[crc128] // we can't use two qword ptr here
        mov     r8d,  dword ptr[crc128 + 4]
        mov     r9d,  dword ptr[crc128 + 8]
        mov     r10d, dword ptr[crc128 + 12]
        crc32   eax,  dword ptr[data128]
        crc32   r8d,  dword ptr[data128 + 4]
        crc32   r9d,  dword ptr[data128 + 8]
        crc32   r10d, dword ptr[data128 + 12]
        mov     dword ptr[crc128],      eax
        mov     dword ptr[crc128 + 4],  r8d
        mov     dword ptr[crc128 + 8],  r9d
        mov     dword ptr[crc128 + 12], r10d
end;
{$else} {$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=crc128, edx=data128
        mov     ecx, eax
        {$ifdef FPC_X86ASM}
        mov     eax, dword ptr[ecx]
        crc32   eax, dword ptr[edx]
        mov     dword ptr[ecx], eax
        mov     eax, dword ptr[ecx + 4]
        crc32   eax, dword ptr[edx + 4]
        mov     dword ptr[ecx + 4], eax
        mov     eax, dword ptr[ecx + 8]
        crc32   eax, dword ptr[edx + 8]
        mov     dword ptr[ecx + 8], eax
        mov     eax, dword ptr[ecx + 12]
        crc32   eax, dword ptr[edx + 12]
        mov     dword ptr[ecx + 12], eax
        {$else}
        mov     eax, dword ptr[ecx]
        db      $F2, $0F, $38, $F1, $02
        mov     dword ptr[ecx], eax
        mov     eax, dword ptr[ecx + 4]
        db      $F2, $0F, $38, $F1, $42, $04
        mov     dword ptr[ecx + 4], eax
        mov     eax, dword ptr[ecx + 8]
        db      $F2, $0F, $38, $F1, $42, $08
        mov     dword ptr[ecx + 8], eax
        mov     eax, dword ptr[ecx + 12]
        db      $F2, $0F, $38, $F1, $42, $0C
        mov     dword ptr[ecx + 12], eax
        {$endif FPC_OR_UNICODE}
end;
{$endif CPU64}
{$endif CPUINTEL}

function crc32cBy4fast(crc, value: cardinal): cardinal;
var tab: PCrc32tab;
begin
  tab := @crc32ctab;
  result := crc xor value;
  result := tab[3,ToByte(result)] xor
            tab[2,ToByte(result shr 8)] xor
            tab[1,ToByte(result shr 16)] xor
            tab[0,ToByte(result shr 24)];
end;

function crc32cinlined(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$ifdef HASINLINE}
var tab: PCrc32tab;
begin
  result := not crc;
  if len>0 then begin
    tab := @crc32ctab;
    repeat
      result := tab[0,ToByte(result) xor ord(buf^)] xor (result shr 8);
      inc(buf);
      dec(len);
    until len=0;
  end;
  result := not result;
end;
{$else}
begin
  result := crc32c(crc,buf,len);
end;
{$endif}

{$ifdef CPUX86}
procedure GetCPUID(Param: Cardinal; var Registers: TRegisters);
{$ifdef FPC}nostackframe; assembler;{$endif}
asm
        push    esi
        push    edi
        mov     esi, edx
        mov     edi, eax
        pushfd
        pop     eax
        mov     edx, eax
        xor     eax, $200000
        push    eax
        popfd
        pushfd
        pop     eax
        xor     eax, edx
        jz      @nocpuid
        push    ebx
        mov     eax, edi
        xor     ecx, ecx
        {$ifdef DELPHI5OROLDER}
        db      $0f, $a2
        {$else}
        cpuid
        {$endif}
        mov     TRegisters(esi).&eax, eax
        mov     TRegisters(esi).&ebx, ebx
        mov     TRegisters(esi).&ecx, ecx
        mov     TRegisters(esi).&edx, edx
        pop     ebx
@nocpuid:
        pop     edi
        pop     esi
end;

function crc32csse42(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=crc, edx=buf, ecx=len
        not     eax
        test    ecx, ecx
        jz      @0
        test    edx, edx
        jz      @0
        jmp     @align
        db      $8D, $0B4, $26, $00, $00, $00, $00 // manual @by8 align 16
@a:     {$ifdef FPC_X86ASM}
        crc32   eax, byte ptr[edx]
        {$else}
        db      $F2, $0F, $38, $F0, $02
        {$endif}
        inc     edx
        dec     ecx
        jz      @0
@align: test    dl, 3
        jnz     @a
        push    ecx
        shr     ecx, 3
        jnz     @by8
@rem:   pop     ecx
        test    cl, 4
        jz      @4
        {$ifdef FPC_X86ASM}
        crc32   eax, dword ptr[edx]
        {$else}
        db      $F2, $0F, $38, $F1, $02
        {$endif}
        add     edx, 4
@4:     test    cl, 2
        jz      @2
        {$ifdef FPC_X86ASM}
        crc32   eax, word ptr[edx]
        {$else}
        db      $66, $F2, $0F, $38, $F1, $02
        {$endif}
        add     edx, 2
@2:     test    cl, 1
        jz      @0
        {$ifdef FPC_X86ASM}
        crc32   eax, byte ptr[edx]
        {$else}
        db      $F2, $0F, $38, $F0, $02
        {$endif}
@0:     not     eax
        ret
@by8:   {$ifdef FPC_X86ASM}
        crc32   eax, dword ptr[edx]
        crc32   eax, dword ptr[edx + 4]
        {$else}
        db      $F2, $0F, $38, $F1, $02
        db      $F2, $0F, $38, $F1, $42, $04
        {$endif}
        add     edx, 8
        dec     ecx
        jnz     @by8
        jmp     @rem
end;
{$endif CPUX86}

function crc32cUTF8ToHex(const str: RawUTF8): RawUTF8;
begin
  result := CardinalToHex(crc32c(0,pointer(str),length(str)));
end;

function crc64c(buf: PAnsiChar; len: cardinal): Int64;
var hilo: Int64Rec absolute result;
begin
  hilo.Lo := crc32c(0,buf,len);
  hilo.Hi := crc32c(hilo.Lo,buf,len);
end;

function crc63c(buf: PAnsiChar; len: cardinal): Int64;
var hilo: Int64Rec absolute result;
begin
  hilo.Lo := crc32c(0,buf,len);
  hilo.Hi := crc32c(hilo.Lo,buf,len) and $7fffffff;
end;

procedure crc128c(buf: PAnsiChar; len: cardinal; out crc: THash128);
var h: THash128Rec absolute crc;
    h1,h2: cardinal;
begin // see https://goo.gl/Pls5wi
  h1 := crc32c(0,buf,len);
  h2 := crc32c(h1,buf,len);
  h.i0 := h1; inc(h1,h2);
  h.i1 := h1; inc(h1,h2);
  h.i2 := h1; inc(h1,h2);
  h.i3 := h1;
end;

function IsZero(const dig: THash128): boolean;
var a: TPtrIntArray absolute dig;
begin
  result := a[0] or a[1] {$ifndef CPU64}or a[2] or a[3]{$endif} = 0;
end;

function IsEqual(const A,B: THash128): boolean;
var a_: TPtrIntArray absolute A;
    b_: TPtrIntArray absolute B;
begin // uses anti-forensic time constant "xor/or" pattern
  result := ((a_[0] xor b_[0]) or (a_[1] xor b_[1])
    {$ifndef CPU64} or (a_[2] xor b_[2]) or (a_[3] xor b_[3]){$endif})=0;
end;

procedure FillZero(out dig: THash128);
var d: TInt64Array absolute dig;
begin
  d[0] := 0;
  d[1] := 0;
end;

function Hash128Index(P: PHash128Rec; Count: integer; h: PHash128Rec): integer;
{$ifdef CPU64}
var _0, _1: PtrInt;
begin
  if P<>nil then begin
    _0 := h^.Lo;
    _1 := h^.Hi;
    for result := 0 to Count-1 do
      if (P^.Lo=_0) and (P^.Hi=_1) then
        exit else
        inc(P);
  end;
  result := -1; // not found
end;
{$else}
begin // fast O(n) brute force search
  if P<>nil then
    for result := 0 to Count-1 do
      if (P^.i0=h^.i0) and (P^.i1=h^.i1) and (P^.i2=h^.i2) and (P^.i3=h^.i3) then
        exit else
        inc(P);
  result := -1; // not found
end;
{$endif CPU64}

function IP4Text(ip4: cardinal): shortstring;
var b: array[0..3] of byte absolute ip4;
begin
  if ip4=0 then
    result := '' else
    FormatShort('%.%.%.%',[b[0],b[1],b[2],b[3]],result);
end;

procedure IP6Text(ip6: PHash128; result: PShortString);
var i: integer;
    p: PByte;
    {$ifdef PUREPASCAL}tab: ^TByteToWord;{$endif}
begin
  if IsZero(ip6^) then
    result^ := '' else begin
    result^[0] := AnsiChar(39);
    p := @result^[1];
    {$ifdef PUREPASCAL}tab := @TwoDigitsHexWBLower;{$endif}
    for i := 0 to 7 do begin
      PWord(p)^ := {$ifdef PUREPASCAL}tab{$else}TwoDigitsHexWBLower{$endif}[ip6^[0]]; inc(p,2);
      PWord(p)^ := {$ifdef PUREPASCAL}tab{$else}TwoDigitsHexWBLower{$endif}[ip6^[1]]; inc(p,2);
      inc(PWord(ip6));
      p^ := ord(':'); inc(p);
    end;
  end;
end;

function IP6Text(ip6: PHash128): shortstring;
begin
  IP6Text(ip6, @result);
end;

function IsZero(const dig: THash160): boolean;
var a: TIntegerArray absolute dig;
begin
  result := a[0] or a[1] or a[2] or a[3] or a[4] = 0;
end;

function IsEqual(const A,B: THash160): boolean;
var a_: TIntegerArray absolute A;
    b_: TIntegerArray absolute B;
begin // uses anti-forensic time constant "xor/or" pattern
  result := ((a_[0] xor b_[0]) or (a_[1] xor b_[1]) or (a_[2] xor b_[2]) or
    (a_[3] xor b_[3]) or (a_[4] xor b_[4]))=0;
end;

procedure FillZero(out dig: THash160);
begin
  PInt64Array(@dig)^[0] := 0;
  PInt64Array(@dig)^[1] := 0;
  PIntegerArray(@dig)^[4] := 0;
end;

procedure crc256c(buf: PAnsiChar; len: cardinal; out crc: THash256);
var h: THash256Rec absolute crc;
    h1,h2: cardinal;
begin // see https://goo.gl/Pls5wi
  h1 := crc32c(0,buf,len);
  h2 := crc32c(h1,buf,len);
  h.i0 := h1; inc(h1,h2);
  h.i1 := h1; inc(h1,h2);
  h.i2 := h1; inc(h1,h2);
  h.i3 := h1; inc(h1,h2);
  h.i4 := h1; inc(h1,h2);
  h.i5 := h1; inc(h1,h2);
  h.i6 := h1; inc(h1,h2);
  h.i7 := h1;
end;

function IsZero(const dig: THash256): boolean;
var a: TPtrIntArray absolute dig;
begin
  result := a[0] or a[1] or a[2] or a[3]
     {$ifndef CPU64} or a[4] or a[5] or a[6] or a[7]{$endif} = 0;
end;

function IsEqual(const A,B: THash256): boolean;
var a_: TPtrIntArray absolute A;
    b_: TPtrIntArray absolute B;
begin // uses anti-forensic time constant "xor/or" pattern
  result := ((a_[0] xor b_[0]) or (a_[1] xor b_[1]) or
             (a_[2] xor b_[2]) or (a_[3] xor b_[3])
    {$ifndef CPU64} or (a_[4] xor b_[4]) or (a_[5] xor b_[5])
                    or (a_[6] xor b_[6]) or (a_[7] xor b_[7]) {$endif})=0;
end;

function Hash256Index(P: PHash256Rec; Count: integer; h: PHash256Rec): integer;
{$ifdef CPU64} 
var _0, _1: PtrInt;
begin // fast O(n) brute force search
  if P<>nil then begin
    _0 := h^.d0;
    _1 := h^.d1;
    for result := 0 to Count-1 do
      if (P^.d0=_0) and (P^.d1=_1) and (P^.d2=h^.d2) and (P^.d3=h^.d3) then
        exit else
        inc(P);
  end;
  result := -1; // not found
end;
{$else}
begin
  if P<>nil then
    for result := 0 to Count-1 do
      if (P^.i0=h^.i0) and (P^.i1=h^.i1) and (P^.i2=h^.i2) and (P^.i3=h^.i3) and
         (P^.i4=h^.i4) and (P^.i5=h^.i5) and (P^.i6=h^.i6) and (P^.i7=h^.i7) then
        exit else
        inc(P);
  result := -1; // not found
end;
{$endif CPU64}

procedure FillZero(out dig: THash256);
var d: TInt64Array absolute dig;
begin
  d[0] := 0;
  d[1] := 0;
  d[2] := 0;
  d[3] := 0;
end;

function IsZero(const dig: THash384): boolean;
var a: TPtrIntArray absolute dig;
begin
  result := a[0] or a[1] or a[2] or a[3] or a[4] or a[5]
     {$ifndef CPU64} or a[6] or a[7] or a[8] or a[9] or a[10] or a[11] {$endif} = 0;
end;

function IsEqual(const A,B: THash384): boolean;
var a_: TPtrIntArray absolute A;
    b_: TPtrIntArray absolute B;
begin // uses anti-forensic time constant "xor/or" pattern
  result := ((a_[0] xor b_[0]) or (a_[1] xor b_[1]) or
             (a_[2] xor b_[2]) or (a_[3] xor b_[3]) or
             (a_[4] xor b_[4]) or (a_[5] xor b_[5])
    {$ifndef CPU64} or (a_[6] xor b_[6]) or (a_[7] xor b_[7])
                    or (a_[8] xor b_[8]) or (a_[9] xor b_[9])
                    or (a_[10] xor b_[10]) or (a_[11] xor b_[11]) {$endif})=0;
end;

procedure FillZero(out dig: THash384);
var d: TInt64Array absolute dig;
begin
  d[0] := 0;
  d[1] := 0;
  d[2] := 0;
  d[3] := 0;
  d[4] := 0;
  d[5] := 0;
end;

function IsZero(const dig: THash512): boolean;
var a: TPtrIntArray absolute dig;
begin
  result := a[0] or a[1] or a[2] or a[3] or a[4] or a[5] or a[6] or a[7] {$ifndef CPU64}
    or a[8] or a[9] or a[10] or a[11] or a[12] or a[13]  or a[14] or a[15] {$endif} = 0;
end;

function IsEqual(const A,B: THash512): boolean;
var a_: TPtrIntArray absolute A;
    b_: TPtrIntArray absolute B;
begin // uses anti-forensic time constant "xor/or" pattern
  result := ((a_[0] xor b_[0]) or (a_[1] xor b_[1]) or
             (a_[2] xor b_[2]) or (a_[3] xor b_[3]) or
             (a_[4] xor b_[4]) or (a_[5] xor b_[5]) or
             (a_[6] xor b_[6]) or (a_[7] xor b_[7])
    {$ifndef CPU64} or (a_[8] xor b_[8]) or (a_[9] xor b_[9])
                    or (a_[10] xor b_[10]) or (a_[11] xor b_[11])
                    or (a_[12] xor b_[12]) or (a_[13] xor b_[13])
                    or (a_[14] xor b_[14]) or (a_[15] xor b_[15]) {$endif})=0;
end;

procedure FillZero(out dig: THash512);
var d: TInt64Array absolute dig;
begin
  d[0] := 0;
  d[1] := 0;
  d[2] := 0;
  d[3] := 0;
  d[4] := 0;
  d[5] := 0;
  d[6] := 0;
  d[7] := 0;
end;

procedure crc512c(buf: PAnsiChar; len: cardinal; out crc: THash512);
var h: THash512Rec absolute crc;
    h1,h2: cardinal;
begin // see https://goo.gl/Pls5wi
  h1 := crc32c(0,buf,len);
  h2 := crc32c(h1,buf,len);
  h.i0 := h1; inc(h1,h2);
  h.i1 := h1; inc(h1,h2);
  h.i2 := h1; inc(h1,h2);
  h.i3 := h1; inc(h1,h2);
  h.i4 := h1; inc(h1,h2);
  h.i5 := h1; inc(h1,h2);
  h.i6 := h1; inc(h1,h2);
  h.i7 := h1; inc(h1,h2);
  h.i8 := h1; inc(h1,h2);
  h.i9 := h1; inc(h1,h2);
  h.i10 := h1; inc(h1,h2);
  h.i11 := h1; inc(h1,h2);
  h.i12 := h1; inc(h1,h2);
  h.i13 := h1; inc(h1,h2);
  h.i14 := h1; inc(h1,h2);
  h.i15 := h1;
end;

procedure FillZero(var secret: RawByteString);
begin
  if secret<>'' then
    with PStrRec(Pointer(PtrInt(secret)-STRRECSIZE))^ do
    if refCnt=1 then // avoid GPF if const
      FillCharFast(pointer(secret)^,length,0);
end;

procedure FillZero(var secret: RawUTF8);
begin
  if secret<>'' then
    with PStrRec(Pointer(PtrInt(secret)-STRRECSIZE))^ do
    if refCnt=1 then // avoid GPF if const
      FillCharFast(pointer(secret)^,length,0);
end;

procedure mul64x64(const left, right: QWord; out product: THash128Rec);
{$ifdef CPUX64} {$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx/rdi=left, rdx/rsi=right r8/rdx=product
{$endif}{$ifdef WIN64}
        mov     rax, rcx
        mul     rdx // uses built-in 64-bit -> 128-bit multiplication
{$else} mov     r8, rdx
        mov     rax, rdi
        mul     rsi
{$endif}mov     qword ptr [r8], rax
        mov     qword ptr [r8+8], rdx
end;
{$else}
{$ifdef CPUX86} {$ifdef FPC} nostackframe; assembler; {$endif}
asm // adapted from FPC compiler output, which is much better than Delphi's here
        {$ifdef FPC}
        push    ebp
        mov     ebp, esp
        {$endif FPC}
        mov     ecx, eax
        mov     eax, dword ptr [ebp+8H]
        mul     dword ptr [ebp+10H]
        mov     dword ptr [ecx], eax
        mov     dword ptr [ebp-4H], edx
        mov     eax, dword ptr [ebp+8H]
        mul     dword ptr [ebp+14H]
        add     eax, dword ptr [ebp-4H]
        adc     edx, 0
        mov     dword ptr [ebp-10H], eax
        mov     dword ptr [ebp-0CH], edx
        mov     eax, dword ptr [ebp+0CH]
        mul     dword ptr [ebp+10H]
        add     eax, dword ptr [ebp-10H]
        adc     edx, 0
        mov     dword ptr [ecx+4H], eax
        mov     dword ptr [ebp-14H], edx
        mov     eax, dword ptr [ebp+0CH]
        mul     dword ptr [ebp+14H]
        add     eax, dword ptr [ebp-0CH]
        adc     edx, 0
        add     eax, dword ptr [ebp-14H]
        adc     edx, 0
        mov     dword ptr [ecx+8H], eax
        mov     dword ptr [ecx+0CH], edx
        {$ifdef FPC}
        pop     ebp
        {$endif FPC}
end;
{$else} // CPU-neutral implementation
var l: TQWordRec absolute left;
    r: TQWordRec absolute right;
    t1,t2,t3: TQWordRec;
begin
  t1.V := QWord(l.L)*r.L;
  t2.V := QWord(l.H)*r.L+t1.H;
  t3.V := QWord(l.L)*r.H+t2.L;
  product.H := QWord(l.H)*r.H+t2.H+t3.H;
  product.L := t3.V shl 32 or t1.L;
end;
{$endif CPUX86}
{$endif CPUX64}

{$ifndef ABSOLUTEPASCAL}
{$ifdef CPUX64}
const
  // non-temporal writes should bypass the cache when the size is bigger than
  // half the size of the largest level cache - we assume low 1MB cache here
  CPUCACHEX64 = 512*1024;

{
  regarding benchmark numbers from TTestLowLevelCommon.CustomRTL
  -> FillCharFast/MoveFast are faster, especially for small lengths (strings)
  -> Delphi RTL is lower than FPC's, and it doesn't support AVX assembly yet
  -> cpuERMS - of little benefit - is disabled, unless WITH_ERMS is defined
  http://blog.synopse.info/post/2020/02/17/New-move/fillchar-optimized-sse2/avx-asm-version
}

// these stand-alone functions will use CPUIDX64 to adjust the algorithm
procedure MoveFast(const src; var dst; cnt: PtrInt);
{$ifdef FPC}nostackframe; assembler;
asm {$else} asm .noframe {$endif} // rcx/rdi=src rdx/rsi=dst r8/rdx=cnt
        {$ifdef WIN64}
        mov     rax, r8
        {$else}
        mov     rax, rdx // rax=r8=cnt
        mov     r8, rdx
        {$endif}
        lea     r10, [rip+@jmptab]
        cmp     src, dst
        je      @equal
        cmp     cnt, 32
        ja      @lrg  // >32 or <0
        sub     rax, 8
        jg      @sml  // 9..32
        jmp     qword ptr[r10 + 64 + rax * 8]  // 0..8
@equal: ret
{$ifdef FPC} align 8 {$else} .align 8 {$endif}
@jmptab:dq      @exit, @01, @02, @03, @04, @05, @06, @07, @08
@sml:   mov     r8, qword ptr[src + rax] // last 8
        mov     r9, qword ptr[src]       // first 8
        cmp     al, 8
        jle     @sml16
        mov     r10, qword ptr[src + 8]  // second 8
        cmp     al, 16
        jle     @sml24
        mov     r11, qword ptr[src + 16] // third 8
        mov     qword ptr[dst + 16], r11 // third 8
@sml24: mov     qword ptr[dst + 8], r10  // second 8
@sml16: mov     qword ptr[dst], r9       // first 8
        mov     qword ptr[dst + rax], r8 // last 8 (may be overlapping)
        ret
@02:    movzx   eax, word ptr[src] // use small size moves as code alignment
        mov     word ptr[dst], ax
        ret
@04:    mov     eax, [src]
        mov     dword ptr[dst], eax
        ret
@08:    mov     rax, [src]
        mov     [dst], rax
@exit:  ret
@lrg:   jng     @exit   // cnt < 0
        cmp     src, dst
        ja      @lrgfwd
        sub     dst, rax
        cmp     src, dst
        lea     dst, [dst + rax]
        ja     @lrgbwd
@lrgfwd:{$ifdef WITH_ERMS}
        test    byte ptr[rip+CPUIDX64], 1 shl cpuERMS
        jz      @nofwe
        cmp     rax, 2048
        jb      @nofwe
        cld
@repmov:{$ifdef WIN64}
        push    rsi
        push    rdi
        mov     rsi, src
        mov     rdi, dst
        mov     rcx, r8
        rep movsb
        pop     rdi
        pop     rsi
        {$else}
        mov     rax, dst // dst=rsi and src=rdi -> rax to swap
        mov     rsi, src
        mov     rdi, rax
        mov     rcx, r8
        rep movsb
        {$endif}
        ret
@nofwe: {$endif WITH_ERMS}
        mov     r9, dst
        {$ifdef FPC} // no AVX asm on Delphi :(
        cmp     rax, 256  // vzeroupper penaly for cnt>255
        jb      @fsse2
        test    byte ptr[rip+CPUIDX64], 1 shl cpuAVX
        jnz     @fwdavx
        {$endif FPC}
@fsse2: movups  xmm2, oword ptr[src]  // first 16
        lea     src, [src + rax - 16]
        lea     rax, [rax + dst - 16]
        movups  xmm1, oword ptr[src]  // last 16
        mov     r10, rax
        neg     rax
        and     dst,  -16  // 16-byte aligned writes
        lea     rax, [rax + dst + 16]
        cmp     r8, CPUCACHEX64
        ja      @fwdnv  // bypass cache for cnt>512KB
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@fwd:   movups  xmm0, oword ptr[src + rax]  // regular loop
        movaps  [r10 + rax], xmm0
        add     rax, 16
        jl      @fwd
@fwdend:movups  [r10], xmm1 // last 16
        movups  [r9], xmm2  // first 16
        ret
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@fwdnv: movups  xmm0, oword ptr[src + rax]  // non-temporal loop
        movntdq [r10 + rax], xmm0
        add     rax, 16
        jl      @fwdnv
        sfence
        jmp     @fwdend
{$ifdef FPC}
@fwdavx:vmovups ymm2, oword ptr[src]  // first 32
        lea     src, [src + rax - 32]
        lea     rax, [rax + dst - 32]
        vmovups ymm1, oword ptr[src]  // last 32
        mov     r10, rax
        neg     rax
        and     dst,  -32  // 32-byte aligned writes
        lea     rax, [rax + dst + 32]
        cmp     r8, CPUCACHEX64
        ja      @favxn  // bypass cache for cnt>512KB
        align 16
@favxr: vmovups ymm0, oword ptr[src + rax]  // regular loop
        vmovaps [r10 + rax], ymm0
        add     rax, 32
        jl      @favxr
@favxe: vmovups [r10], ymm1 // last 32
        vmovups [r9], ymm2  // first 32
// https://software.intel.com/en-us/articles/avoiding-avx-sse-transition-penalties
        vzeroupper
        ret
        align 16
@favxn: vmovups ymm0, oword ptr[src + rax]  // non-temporal loop
        vmovntps [r10 + rax], ymm0
        add     rax, 32
        jl      @favxn
        sfence
        jmp     @favxe
{$endif FPC}
@lrgbwd:{$ifdef WITH_ERMS}  // backward move
        test    byte ptr[rip+CPUIDX64], 1 shl cpuERMS
        jz      @nobwe
        cmp     rax, 2048
        jb      @nobwe
        std
        lea     src, [src + rax - 1]
        lea     dst, [dst + rax - 1]
        jmp     @repmov
@nobwe: {$endif WITH_ERMS}
        {$ifdef FPC}
        cmp     rax, 256
        jb      @bsse2
        test    byte ptr[rip+CPUIDX64], 1 shl cpuAVX
        jnz      @bwdavx
        {$endif FPC}
@bsse2: sub     rax, 16
        mov     r9, rax
        movups  xmm2, oword ptr[src + rax]  // last 16
        movups  xmm1, oword ptr[src]        // first 16
        add     rax, dst
        and     rax, -16  // 16-byte aligned writes
        sub     rax, dst
        cmp     r8, CPUCACHEX64
        ja      @bwdnv    // bypass cache for cnt>512KB
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@bwd:   movups  xmm0, oword ptr[src + rax]  // regular loop
        movaps  oword ptr[dst + rax], xmm0
        sub     rax, 16
        jg      @bwd
@bwdend:movups  oword ptr[dst], xmm1       // first 16
        movups  oword ptr[dst + r9], xmm2  // last 16
        ret
@01:    mov     al, byte ptr[src]
        mov     byte ptr[dst], al
        ret
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@bwdnv: movups  xmm0, oword ptr[src + rax]  // non-temporal loop
        movntdq oword ptr[dst + rax], xmm0
        sub     rax, 16
        jg      @bwdnv
        sfence
        jmp     @bwdend
{$ifdef FPC}
@bwdavx:sub     rax, 32
        mov     r9, rax
        vmovups ymm2, oword ptr[src + rax]  // last 32
        vmovups ymm1, oword ptr[src]        // first 32
        add     rax, dst
        and     rax, -32  // 32-byte aligned writes
        sub     rax, dst
        cmp     r8, CPUCACHEX64
        ja      @bavxn    // bypass cache for cnt>512KB
        align 16
@bavxr: vmovups ymm0, oword ptr[src + rax]  // regular loop
        vmovaps oword ptr[dst + rax], ymm0
        sub     rax, 32
        jg      @bavxr
@bavxe: vmovups oword ptr[dst], ymm1       // first 32
        vmovups oword ptr[dst + r9], ymm2  // last 32
        vzeroupper
        ret
        align 16
@bavxn: vmovups ymm0, oword ptr[src + rax]  // non-temporal loop
        vmovntps oword ptr[dst + rax], ymm0
        sub     rax, 32
        jg      @bavxn
        sfence
        jmp     @bavxe
{$endif FPC}
@03:    movzx   eax, word ptr[src]
        mov     cl, byte ptr[src + 2]
        mov     word ptr[dst], ax
        mov     byte ptr[dst + 2], cl
        ret
@05:    mov     eax, dword ptr[src]
        mov     cl, byte ptr[src + 4]
        mov     dword ptr[dst], eax
        mov     byte ptr[dst + 4], cl
        ret
@06:    mov     eax, dword ptr[src]
        mov     cx, word ptr[src + 4]
        mov     dword ptr[dst], eax
        mov     word ptr[dst + 4], cx
        ret
@07:    mov     r8d, dword ptr[src]    // faster with no overlapping
        mov     ax, word ptr[src + 4]
        mov     cl, byte ptr[src + 6]
        mov     dword ptr[dst], r8d
        mov     word ptr[dst + 4], ax
        mov     byte ptr[dst + 6], cl
end;

procedure FillCharFast(var dst; cnt: PtrInt; value: byte);
{$ifdef FPC}nostackframe; assembler;
asm {$else} asm .noframe {$endif} // rcx/rdi=dst rdx/rsi=cnt r8b/dl=val
        mov     r9, $0101010101010101
        lea     r10, [rip+@jmptab]
        {$ifdef WIN64}
        movzx   eax, r8b
        {$else}
        movzx   eax, dl
        mov     rdx, rsi // rdx=cnt
        {$endif}
        imul    rax, r9  // broadcast value into all bytes of rax (in 1 cycle)
        cmp     cnt, 32
        ja      @abv32  // >32 or <0
        sub     rdx, 8
        jg      @sml    // small 9..32
        jmp     qword ptr[r10 + 64 + rdx*8] // tiny 0..8 bytes
{$ifdef FPC} align 8 {$else} .align 8 {$endif}
@jmptab:dq @00, @01, @02, @03, @04, @05, @06, @07, @08
@sml:   cmp     dl, 8  // 9..32 bytes
        jle     @sml16
        cmp     dl, 16
        jle     @sml24
        mov     qword ptr[dst+16], rax
@sml24: mov     qword ptr[dst+8], rax
@sml16: mov     qword ptr[dst+rdx], rax // last 8 (may be overlapping)
@08:    mov     qword ptr[dst], rax
@00:    ret
@07:    mov     dword ptr[dst+3], eax
@03:    mov     word ptr[dst+1], ax
@01:    mov     byte ptr[dst], al
        ret
@06:    mov     dword ptr[dst+2], eax
@02:    mov     word ptr[dst], ax
        ret
@05:    mov     byte ptr[dst+4], al
@04:    mov     dword ptr[dst], eax
        ret
{$ifdef FPC} align 8{$else} .align 8{$endif}
@abv32: jng     @00  // < 0
        movd    xmm0, eax
        lea     r8, [dst+cnt]  // r8 point to end
        pshufd  xmm0, xmm0, 0  // broadcast value into all bytes of xmm0
        mov     r10, rdx       // save rdx=cnt
        {$ifdef FPC} // Delphi doesn't support avx, and erms is slower
        cmp     rdx, 256
        jae     @abv256  // try erms or avx if cnt>255 (vzeroupper penalty)
        {$endif FPC}
@sse2:  movups  oword ptr[dst], xmm0  // first unaligned 16 bytes
        lea     rdx, [dst+rdx-1]
        and     rdx, -16
        add     dst, 16
        and     dst, -16 // dst is 16-bytes aligned
        sub     dst, rdx
        jnb     @last
        cmp     r10, CPUCACHEX64
        ja      @nv  // bypass cache for cnt>512KB
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@reg:   movaps  oword ptr[rdx+dst], xmm0  // regular loop
        add     dst, 16
        jnz     @reg
@last:  movups  oword ptr[r8-16], xmm0 // last unaligned 16 bytes
        ret
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@nv:    movntdq [rdx+dst], xmm0 // non-temporal loop
        add     dst, 16
        jnz     @nv
        sfence
        movups  oword ptr[r8-16], xmm0
        ret
{$ifdef FPC}
@abv256:{$ifdef WITH_ERMS}
        mov     r9b, byte ptr[rip+CPUIDX64]
        test    r9b, 1 shl cpuERMS
        jz      @noerms
        cmp     rdx, 2048  // ERMS is worth it for cnt>2KB
        jb      @noerms
        cmp     rdx, CPUCACHEX64  // non-temporal moves are still faster
        jae     @noerms
        cld
{$ifdef WIN64}
        mov     r8, rdi
        mov     rdi, dst
        mov     rcx, cnt
        rep     stosb
        mov     rdi, r8
{$else} mov     rcx, cnt
        rep stosb
{$endif}ret
@noerms:test    r9b, 1 shl cpuAVX
{$else} test    byte ptr[rip+CPUIDX64], 1 shl cpuAVX
        {$endif WITH_ERMS}
        jz      @sse2
        movups  oword ptr[dst], xmm0 // first unaligned 1..16 bytes
        add     dst, 16
        and     dst, -16
        movaps  oword ptr[dst], xmm0 // aligned 17..32 bytes
        vinsertf128 ymm0,ymm0,xmm0,1
        add     dst, 16
        and     dst, -32 // dst is 32-bytes aligned
        mov     rdx, r8
        and     rdx, -32
        sub     dst, rdx
        cmp     r10, CPUCACHEX64
        ja      @avxnv
        align 16
@avxreg:vmovaps ymmword ptr[rdx+dst], ymm0  // regular loop
        add     dst, 32
        jnz     @avxreg
@avxok: vmovups oword ptr[r8-32], ymm0  // last unaligned 32 bytes
        vzeroupper
        ret
        align 16
@avxnv: vmovntps oword ptr [rdx+dst], ymm0 // non-temporal loop
        add      dst, 32
        jnz      @avxnv
        sfence
        jmp      @avxok
{$endif FPC}
end;
{$endif CPUX64}
{$endif ABSOLUTEPASCAL}

procedure SymmetricEncrypt(key: cardinal; var data: RawByteString);
var i,len: integer;
    d: PCardinal;
    tab: PCrc32tab;
begin
  if data='' then
    exit; // nothing to cypher
  tab := @crc32ctab;
  {$ifdef FPC}
  UniqueString(data); // @data[1] won't call UniqueString() under FPC :(
  {$endif}
  d := @data[1];
  len := length(data);
  key := key xor cardinal(len);
  for i := 0 to (len shr 2)-1 do begin
    key := key xor tab[0,(cardinal(i) xor key)and 1023];
    d^ := d^ xor key;
    inc(d);
  end;
  for i := 0 to (len and 3)-1 do
    PByteArray(d)^[i] := PByteArray(d)^[i] xor key xor tab[0,17 shl i];
end;

function UnixTimeToDateTime(const UnixTime: TUnixTime): TDateTime;
begin
  result := UnixTime / SecsPerDay + UnixDateDelta;
end;

function DateTimeToUnixTime(const AValue: TDateTime): TUnixTime;
begin
  result := Round((AValue - UnixDateDelta) * SecsPerDay);
end;

const
  UnixFileTimeDelta = 116444736000000000; // from year 1601 to 1970
  DateFileTimeDelta =  94353120000000000; // from year 1601 to 1899

{$ifdef MSWINDOWS}
function FileTimeToUnixTime(const FT: TFileTime): TUnixTime;
{$ifdef CPU64}var nano100: Int64;{$endif}
begin
  {$ifdef CPU64}
  FileTimeToInt64(ft,nano100);
  result := (nano100-UnixFileTimeDelta) div 10000000;
  {$else} // use PInt64 to avoid URW699 with Delphi 6 / Kylix
  result := (PInt64(@ft)^-UnixFileTimeDelta) div 10000000;
  {$endif}
end;

function FileTimeToUnixMSTime(const FT: TFileTime): TUnixMSTime;
{$ifdef CPU64}var nano100: Int64;{$endif}
begin
  {$ifdef CPU64}
  FileTimeToInt64(ft,nano100);
  result := (nano100-UnixFileTimeDelta) div 10000;
  {$else} // use PInt64 to avoid URW699 with Delphi 6 / Kylix
  result := (PInt64(@ft)^-UnixFileTimeDelta) div 10000;
  {$endif}
end;

function UnixTimeUTC: TUnixTime;
var ft: TFileTime;
begin
  GetSystemTimeAsFileTime(ft); // very fast, with 100 ns unit
  result := FileTimeToUnixTime(ft);
end;

function UnixMSTimeUTC: TUnixMSTime;
var ft: TFileTime;
begin
  GetSystemTimePreciseAsFileTime(ft); // slower, but try to achieve ms resolution
  result := FileTimeToUnixMSTime(ft);
end;

function UnixMSTimeUTCFast: TUnixMSTime;
var ft: TFileTime;
begin
  GetSystemTimeAsFileTime(ft); // faster, but with HW interupt resolution
  result := FileTimeToUnixMSTime(ft);
end;
{$else MSWINDOWS}
function UnixTimeUTC: TUnixTime;
begin
  result := GetUnixUTC; // direct retrieval from UNIX API
end;

function UnixMSTimeUTC: TUnixMSTime;
begin
  result := GetUnixMSUTC; // direct retrieval from UNIX API
end;

function UnixMSTimeUTCFast: TUnixMSTime;
begin
  result := GetUnixMSUTC; // direct retrieval from UNIX API
end;
{$endif MSWINDOWS}

function DaysToIso8601(Days: cardinal; Expanded: boolean): RawUTF8;
var Y,M: cardinal;
begin
  Y := 0;
  while Days>365 do begin
    dec(Days,366);
    inc(Y);
  end;
  M := 0;
  if Days>31 then begin
    inc(M);
    while Days>MonthDays[false][M] do begin
      dec(Days,MonthDays[false][M]);
      inc(M);
    end;
  end;
  result := DateToIso8601(Y,M,Days,Expanded);
end;

function UnixTimeToString(const UnixTime: TUnixTime; Expanded: boolean;
  FirstTimeChar: AnsiChar): RawUTF8;
begin // inlined UnixTimeToDateTime
  result := DateTimeToIso8601(UnixTime/SecsPerDay+UnixDateDelta,Expanded,
    FirstTimeChar,false);
end;

function DateTimeToFileShort(const DateTime: TDateTime): TShort16;
begin
  DateTimeToFileShort(DateTime,result);
end;

procedure DateTimeToFileShort(const DateTime: TDateTime; out result: TShort16);
var T: TSynSystemTime;
    tab: {$ifdef CPUX86NOTPIC}TWordArray absolute TwoDigitLookupW{$else}PWordArray{$endif};
begin // use 'YYMMDDHHMMSS' format
  if DateTime<=0 then begin
    PWord(@result[0])^ := 1+ord('0') shl 8;
    exit;
  end;
  T.FromDate(DateTime);
  if T.Year > 1999 then
    if T.Year < 2100 then
      dec(T.Year,2000) else
      T.Year := 99 else
    T.Year := 0;
  T.FromTime(DateTime);
  {$ifndef CPUX86NOTPIC}tab := @TwoDigitLookupW;{$endif}
  result[0] := #12;
  PWord(@result[1])^ := tab[T.Year];
  PWord(@result[3])^ := tab[T.Month];
  PWord(@result[5])^ := tab[T.Day];
  PWord(@result[7])^ := tab[T.Hour];
  PWord(@result[9])^ := tab[T.Minute];
  PWord(@result[11])^ := tab[T.Second];
end;

procedure UnixTimeToFileShort(const UnixTime: TUnixTime; out result: TShort16);
begin // use 'YYMMDDHHMMSS' format
  if UnixTime<=0 then
    PWord(@result[0])^ := 1+ord('0') shl 8 else
    DateTimeToFileShort(UnixTime/SecsPerDay+UnixDateDelta, result);
end;

function UnixTimeToFileShort(const UnixTime: TUnixTime): TShort16;
begin
  UnixTimeToFileShort(UnixTime, result);
end;

function UnixMSTimeToFileShort(const UnixMSTime: TUnixMSTime): TShort16;
begin
  UnixTimeToFileShort(UnixMSTime div MSecsPerSec, result);
end;

function UnixTimePeriodToString(const UnixTime: TUnixTime; FirstTimeChar: AnsiChar): RawUTF8;
begin
  if UnixTime<SecsPerDay then
    result := TimeToIso8601(UnixTime/SecsPerDay,true,FirstTimeChar) else
    result := DaysToIso8601(UnixTime div SecsPerDay,true);
end;

function UnixMSTimeToDateTime(const UnixMSTime: TUnixMSTime): TDateTime;
begin
  result := UnixMSTime/MSecsPerDay + UnixDateDelta;
end;

function UnixMSTimePeriodToString(const UnixMSTime: TUnixMSTime; FirstTimeChar: AnsiChar): RawUTF8;
begin
  if UnixMSTime<MSecsPerDay then
    result := TimeToIso8601(UnixMSTime/MSecsPerDay,true,FirstTimeChar,UnixMSTime<1000) else
    result := DaysToIso8601(UnixMSTime div MSecsPerDay,true);
end;

function DateTimeToUnixMSTime(const AValue: TDateTime): TUnixMSTime;
begin
  if AValue=0 then
    result := 0 else
    result := Round((AValue - UnixDateDelta) * MSecsPerDay);
end;

function UnixMSTimeToString(const UnixMSTime: TUnixMSTime; Expanded: boolean;
  FirstTimeChar: AnsiChar; const TZD: RawUTF8): RawUTF8;
begin // inlined UnixMSTimeToDateTime()
  if UnixMSTime<=0 then
    result := '' else
    result := DateTimeMSToString(UnixMSTime/MSecsPerDay+UnixDateDelta,Expanded,
      FirstTimeChar,TZD);
end;

function NowUTC: TDateTime;
{$ifdef MSWINDOWS}
var ft: TFileTime;
    {$ifdef CPU64}nano100: Int64; d: double;{$endif}
begin
  GetSystemTimeAsFileTime(ft); // very fast, with 100 ns unit and 16ms resolution
  {$ifdef CPU64}
  FileTimeToInt64(ft,nano100);
  // in two explicit steps to circumvent weird precision error on FPC
  // having d: double is important here
  d := (nano100-DateFileTimeDelta) / 10000000;
  result := d/SecsPerDay;
  {$else} // use PInt64 to avoid URW699 with Delphi 6 / Kylix
  dec(PInt64(@ft)^,DateFileTimeDelta);
  result := PInt64(@ft)^/(10000000.0*SecsPerDay);
  {$endif}
end;
{$else}
begin
  result := GetNowUTC; // calls clock_gettime(CLOCK_REALTIME_COARSE)
end;
{$endif}

function Iso8601ToDateTimePUTF8Char(P: PUTF8Char; L: integer): TDateTime;
var tmp: TDateTime; // circumvent FPC limitation
begin
  Iso8601ToDateTimePUTF8CharVar(P,L,tmp);
  result := tmp;
end;

function Iso8601CheckAndDecode(P: PUTF8Char; L: integer; var Value: TDateTime): boolean;
// handle 'YYYY-MM-DDThh:mm:ss[.sss]' or 'YYYY-MM-DD' or 'Thh:mm:ss[.sss]'
begin
  if P=nil then
    result := false else
    if (((L=9)or(L=13)) and (P[0]='T') and (P[3]=':')) or // 'Thh:mm:ss[.sss]'
       ((L=10) and (P[4]='-') and (P[7]='-')) or // 'YYYY-MM-DD'
       (((L=19)or(L=23)) and (P[4]='-') and (P[10]='T')) then begin
        Iso8601ToDateTimePUTF8CharVar(P,L,Value);
        result := PInt64(@Value)^<>0;
      end else
      result := false;
end;

function Char2ToByte(P: PUTF8Char; out Value: Cardinal): Boolean;
var B: PtrUInt;
begin
  B := ConvertHexToBin[ord(P[0])];
  if B<=9 then begin
    Value := B;
    B := ConvertHexToBin[ord(P[1])];
    if B<=9 then begin
      Value := Value*10+B;
      result := false;
      exit;
    end;
  end;
  result := true; // error
end;

function Char3ToWord(P: PUTF8Char; out Value: Cardinal): Boolean;
var B: PtrUInt;
begin
  B := ConvertHexToBin[ord(P[0])];
  if B<=9 then begin
    Value := B;
    B := ConvertHexToBin[ord(P[1])];
    if B<=9 then begin
      Value := Value*10+B;
      B := ConvertHexToBin[ord(P[2])];
      if B<=9 then begin
        Value := Value*10+B;
        result := false;
        exit;
      end;
    end;
  end;
  result := true; // error
end;

function Char4ToWord(P: PUTF8Char; out Value: Cardinal): Boolean;
var B: PtrUInt;
begin
  B := ConvertHexToBin[ord(P[0])];
  if B<=9 then begin
    Value := B;
    B := ConvertHexToBin[ord(P[1])];
    if B<=9 then begin
      Value := Value*10+B;
      B := ConvertHexToBin[ord(P[2])];
      if B<=9 then begin
        Value := Value*10+B;
        B := ConvertHexToBin[ord(P[3])];
        if B<=9 then begin
          Value := Value*10+B;
          result := false;
          exit;
        end;
      end;
    end;
  end;
  result := true; // error
end;

procedure Iso8601ToDateTimePUTF8CharVar(P: PUTF8Char; L: integer; var result: TDateTime);
var B: cardinal;
    Y,M,D, H,MI,SS,MS: cardinal;
    d100: TDiv100Rec;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute ConvertHexToBin{$else}PNormTableByte{$endif};
// expect 'YYYYMMDDThhmmss[.sss]' format but handle also 'YYYY-MM-DDThh:mm:ss[.sss]'
begin
  unaligned(result) := 0;
  if P=nil then
    exit;
  if L=0 then
    L := StrLen(P);
  if L<4 then
    exit; // we need 'YYYY' at least
  if (P[0]='''') and (P[L-1]='''') then begin // unquote input
    inc(P);
    dec(L, 2);
    if L<4 then exit;
  end;
  if P[0]='T' then begin
    dec(P,8);
    inc(L,8);
  end else begin
    {$ifndef CPUX86NOTPIC}tab := @ConvertHexToBin;{$endif} // faster on PIC and x86_64
    B := tab[ord(P[0])]; // first digit
    if B>9 then exit else Y := B; // fast check '0'..'9'
    B := tab[ord(P[1])];
    if B>9 then exit else Y := Y*10+B;
    B := tab[ord(P[2])];
    if B>9 then exit else Y := Y*10+B;
    B := tab[ord(P[3])];
    if B>9 then exit else Y := Y*10+B;
    if P[4] in ['-','/'] then begin inc(P); dec(L); end; // allow YYYY-MM-DD
    D := 1;
    if L>=6 then begin // YYYYMM
      M := ord(P[4])*10+ord(P[5])-(48+480);
      if (M=0) or (M>12) then exit;
      if P[6] in ['-','/'] then begin inc(P); dec(L); end; // allow YYYY-MM-DD
      if L>=8 then begin // YYYYMMDD
        if (L>8) and not(P[8] in [#0,' ','T']) then
          exit; // invalid date format
        D := ord(P[6])*10+ord(P[7])-(48+480);
        if (D=0) or (D>MonthDays[true][M]) then exit; // worse is leap year=true
      end;
    end else
      M := 1;
    if M>2 then // inlined EncodeDate(Y,M,D)
      dec(M,3) else
    if M>0 then begin
      inc(M,9);
      dec(Y);
    end;
    if Y>9999 then
      exit; // avoid integer overflow e.g. if '0000' is an invalid date
    Div100(Y,d100);
    unaligned(result) := (146097*d100.d) shr 2 + (1461*d100.m) shr 2 +
          (153*M+2) div 5+D;
    unaligned(result) := unaligned(result)-693900; // as float: avoid sign issue
    if L<15 then
      exit; // not enough space to retrieve the time
  end;
  H := ord(P[9])*10+ord(P[10])-(48+480);
  if P[11]=':' then begin inc(P); dec(L); end;// allow hh:mm:ss
  MI := ord(P[11])*10+ord(P[12])-(48+480);
  if P[13]=':' then begin inc(P); dec(L); end; // allow hh:mm:ss
  SS := ord(P[13])*10+ord(P[14])-(48+480);
  if (L>16) and (P[15]='.') then begin
    // one or more digits representing a decimal fraction of a second
    MS := ord(P[16])*100-4800;
    if L>17 then MS := MS+ord(P[17])*10-480;
    if L>18 then MS := MS+ord(P[18])-48;
    if MS>1000 then
      MS := 0;
  end else
    MS := 0;
  if (H<24) and (MI<60) and (SS<60) then // inlined EncodeTime()
    result := result+(H*(MinsPerHour*SecsPerMin*MSecsPerSec)+
              MI*(SecsPerMin*MSecsPerSec)+SS*MSecsPerSec+MS)/MSecsPerDay;
end;

function Iso8601ToTimePUTF8Char(P: PUTF8Char; L: integer): TDateTime;
begin
  Iso8601ToTimePUTF8CharVar(P,L,result);
end;

procedure Iso8601ToTimePUTF8CharVar(P: PUTF8Char; L: integer; var result: TDateTime);
var H,MI,SS,MS: cardinal;
begin
  if Iso8601ToTimePUTF8Char(P,L,H,MI,SS,MS) then
    result := (H*(MinsPerHour*SecsPerMin*MSecsPerSec)+
               MI*(SecsPerMin*MSecsPerSec)+SS*MSecsPerSec+MS)/MSecsPerDay else
    result := 0;
end;

function Iso8601ToTimePUTF8Char(P: PUTF8Char; L: integer; var H,M,S,MS: cardinal): boolean;
begin
  result := false; // error
  if P=nil then
    exit;
  if L=0 then
    L := StrLen(P);
  if L<6 then
    exit; // we need 'hhmmss' at least
  H := ord(P[0])*10+ord(P[1])-(48+480);
  if P[2]=':' then begin inc(P); dec(L); end; // allow hh:mm:ss
  M := ord(P[2])*10+ord(P[3])-(48+480);
  if P[4]=':' then begin inc(P); dec(L); end; // allow hh:mm:ss
  S := ord(P[4])*10+ord(P[5])-(48+480);
  if (L>6) and (P[6]='.') then begin
    // one or more digits representing a decimal fraction of a second
    MS := ord(P[7])*100-4800;
    if L>7 then MS := MS+ord(P[8])*10-480;
    if L>8 then MS := MS+ord(P[9])-48;
  end else
    MS := 0;
  if (H<24) and (M<60) and (S<60) and (MS<1000) then
    result := true;
end;

function Iso8601ToDatePUTF8Char(P: PUTF8Char; L: integer; var Y,M,D: cardinal): boolean;
begin
  result := false; // error
  if P=nil then
    exit;
  if L=0 then
    L := StrLen(P);
  if (L<8) or not (P[0] in ['0'..'9']) or not (P[1] in ['0'..'9']) or
              not (P[2] in ['0'..'9']) or not (P[3] in ['0'..'9']) then
    exit; // we need 'YYYYMMDD' at least
  Y := ord(P[0])*1000+ord(P[1])*100+ord(P[2])*10+ord(P[3])-(48+480+4800+48000);
  if (Y<1000) or (Y>2999) then
    exit;
  if P[4] in ['-','/'] then inc(P); // allow YYYY-MM-DD
  M := ord(P[4])*10+ord(P[5])-(48+480);
  if (M=0) or (M>12) then
    exit;
  if P[6] in ['-','/'] then inc(P);
  D := ord(P[6])*10+ord(P[7])-(48+480);
  if (D<>0) and (D<=MonthDays[true][M]) then
    result := true;
end;

function IntervalTextToDateTime(Text: PUTF8Char): TDateTime;
begin
  IntervalTextToDateTimeVar(Text,result);
end;

procedure IntervalTextToDateTimeVar(Text: PUTF8Char; var result: TDateTime);
var negative: boolean;
    Time: TDateTime;
begin // e.g. IntervalTextToDateTime('+0 06:03:20')
  result := 0;
  if Text=nil then
    exit;
  if Text^ in ['+','-'] then begin
    negative := (Text^='-');
    result := GetNextItemDouble(Text,' ');
  end else
    negative := false;
  Iso8601ToTimePUTF8CharVar(Text,0,Time);
  if negative then
    result := result-Time else
    result := result+Time;
end;

function Iso8601ToDateTime(const S: RawByteString): TDateTime;
begin
  result := Iso8601ToDateTimePUTF8Char(pointer(S),length(S));
end;

function TimeLogToDateTime(const Timestamp: TTimeLog): TDateTime;
begin
  result := PTimeLogBits(@Timestamp)^.ToDateTime;
end;

function TimeLogToUnixTime(const Timestamp: TTimeLog): TUnixTime;
begin
  result := PTimeLogBits(@Timestamp)^.ToUnixTime;
end;

function DateToIso8601PChar(P: PUTF8Char; Expanded: boolean; Y,M,D: PtrUInt): PUTF8Char;
// use 'YYYYMMDD' format if not Expanded, 'YYYY-MM-DD' format if Expanded
var tab: {$ifdef CPUX86NOTPIC}TWordArray absolute TwoDigitLookupW{$else}PWordArray{$endif};
begin
  {$ifdef CPUX86NOTPIC}
  YearToPChar(Y,P);
  {$else}
  tab := @TwoDigitLookupW;
  YearToPChar2(tab,Y,P);
  {$endif}
  inc(P,4);
  if Expanded then begin
    P^ := '-';
    inc(P);
  end;
  PWord(P)^ := tab[M];
  inc(P,2);
  if Expanded then begin
    P^ := '-';
    inc(P);
  end;
  PWord(P)^ := tab[D];
  result := P+2;
end;

function TimeToIso8601PChar(P: PUTF8Char; Expanded: boolean; H,M,S,MS: PtrUInt;
  FirstChar: AnsiChar; WithMS: boolean): PUTF8Char;
var tab: {$ifdef CPUX86NOTPIC}TWordArray absolute TwoDigitLookupW{$else}PWordArray{$endif};
begin // use Thhmmss[.sss] format
  if FirstChar<>#0 then begin
    P^ := FirstChar;
    inc(P);
  end;
  {$ifndef CPUX86NOTPIC}tab := @TwoDigitLookupW;{$endif}
  PWord(P)^ := tab[H];
  inc(P,2);
  if Expanded then begin
    P^ := ':';
    inc(P);
  end;
  PWord(P)^ := tab[M];
  inc(P,2);
  if Expanded then begin
    P^ := ':';
    inc(P);
  end;
  PWord(P)^ := tab[S];
  inc(P,2);
  if WithMS then begin
    {$ifdef CPUX86NOTPIC}YearToPChar(MS{$else}YearToPChar2(tab,MS{$endif},P);
    P^ := '.'; // override first '0' digit
    inc(P,4);
  end;
  result := P;
end;

function DateToIso8601PChar(Date: TDateTime; P: PUTF8Char; Expanded: boolean): PUTF8Char;
var T: TSynSystemTime;
begin // use YYYYMMDD / YYYY-MM-DD date format
  T.FromDate(Date);
  result := DateToIso8601PChar(P,Expanded,T.Year,T.Month,T.Day);
end;

function DateToIso8601Text(Date: TDateTime): RawUTF8;
begin // into 'YYYY-MM-DD' date format
  if Date=0 then
    result := '' else begin
    FastSetString(result,nil,10);
    DateToIso8601PChar(Date,pointer(result),True);
  end;
end;

function TimeToIso8601PChar(Time: TDateTime; P: PUTF8Char; Expanded: boolean;
  FirstChar: AnsiChar; WithMS: boolean): PUTF8Char;
var T: TSynSystemTime;
begin
  T.FromTime(Time);
  result := TimeToIso8601PChar(P,Expanded,T.Hour,T.Minute,T.Second,T.MilliSecond,FirstChar,WithMS);
end;

function DateTimeToIso8601(P: PUTF8Char; D: TDateTime; Expanded: boolean;
  FirstChar: AnsiChar; WithMS: boolean; QuotedChar: AnsiChar): integer;
var S: PUTF8Char;
begin
  S := P;
  if QuotedChar<>#0 then begin
    P^ := QuotedChar;
    inc(P);
  end;
  P := DateToIso8601PChar(D,P,Expanded);
  P := TimeToIso8601PChar(D,P,Expanded,FirstChar,WithMS);
  if QuotedChar<>#0 then begin
    P^ := QuotedChar;
    inc(P);
  end;
  result := P-S;
end;

function DateTimeToIso8601(D: TDateTime; Expanded: boolean;
  FirstChar: AnsiChar; WithMS: boolean; QuotedChar: AnsiChar): RawUTF8;
var tmp: array[0..31] of AnsiChar;
begin // D=0 is handled in DateTimeToIso8601Text()
  FastSetString(result,@tmp,DateTimeToIso8601(@tmp,D,Expanded,FirstChar,WithMS,QuotedChar));
end;

function DateToIso8601(Date: TDateTime; Expanded: boolean): RawUTF8;
// use YYYYMMDD / YYYY-MM-DD date format
begin
  FastSetString(result,nil,8+2*integer(Expanded));
  DateToIso8601PChar(Date,pointer(result),Expanded);
end;

function DateToIso8601(Y,M,D: cardinal; Expanded: boolean): RawUTF8;
// use 'YYYYMMDD' format if not Expanded, 'YYYY-MM-DD' format if Expanded
begin
  FastSetString(result,nil,8+2*integer(Expanded));
  DateToIso8601PChar(pointer(result),Expanded,Y,M,D);
end;

function TimeToIso8601(Time: TDateTime; Expanded: boolean; FirstChar: AnsiChar;
  WithMS: boolean): RawUTF8;
// use Thhmmss[.sss] / Thh:mm:ss[.sss] format
begin
  FastSetString(result,nil,7+2*integer(Expanded)+4*integer(WithMS));
  TimeToIso8601PChar(Time,pointer(result),Expanded,FirstChar,WithMS);
end;

function DateTimeToIso8601Text(DT: TDateTime; FirstChar: AnsiChar;
  WithMS: boolean): RawUTF8;
begin
  DateTimeToIso8601TextVar(DT,FirstChar,result,WithMS);
end;

procedure DateTimeToIso8601TextVar(DT: TDateTime; FirstChar: AnsiChar;
  var result: RawUTF8; WithMS: boolean);
begin
  if DT=0 then
    result := '' else
    if frac(DT)=0 then
      result := DateToIso8601(DT,true) else
    if trunc(DT)=0 then
      result := TimeToIso8601(DT,true,FirstChar,WithMS) else
      result := DateTimeToIso8601(DT,true,FirstChar,WithMS);
end;

procedure DateTimeToIso8601StringVar(DT: TDateTime; FirstChar: AnsiChar;
  var result: string; WithMS: boolean);
var tmp: RawUTF8;
begin
  DateTimeToIso8601TextVar(DT,FirstChar,tmp,WithMS);
  Ansi7ToString(Pointer(tmp),length(tmp),result);
end;

function DateTimeToIso8601ExpandedPChar(const Value: TDateTime; Dest: PUTF8Char;
  FirstChar: AnsiChar; WithMS: boolean): PUTF8Char;
begin
  if Value<>0 then begin
    if trunc(Value)<>0 then
      Dest := DateToIso8601PChar(Value,Dest,true);
    if frac(Value)<>0 then
      Dest := TimeToIso8601PChar(Value,Dest,true,FirstChar,WithMS);
  end;
  Dest^ := #0;
  result := Dest;
end;

function Iso8601ToTimeLogPUTF8Char(P: PUTF8Char; L: integer; ContainsNoTime: PBoolean): TTimeLog;
// bits: S=0..5 M=6..11 H=12..16 D=17..21 M=22..25 Y=26..40
// i.e. S<64 M<64 H<32 D<32 M<16 Y<9999: power of 2 -> use fast shl/shr
var V,B: PtrUInt;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute ConvertHexToBin{$else}PNormTableByte{$endif};
begin
  result := 0;
  if P=nil then
    exit;
  if L=0 then
    L := StrLen(P);
  if L<4 then
    exit; // we need 'YYYY' at least
  if P[0]='T' then
    dec(P,8) else begin // 'YYYY' -> year decode
    {$ifndef CPUX86NOTPIC}tab := @ConvertHexToBin;{$endif} // faster on PIC/x86_64
    V := tab[ord(P[0])];
    if V>9 then exit;
    B := tab[ord(P[1])];
    if B>9 then exit else V := V*10+B;
    B := tab[ord(P[2])];
    if B>9 then exit else V := V*10+B;
    B := tab[ord(P[3])];
    if B>9 then exit else V := V*10+B;
    result := Int64(V) shl 26;  // store YYYY
    if P[4] in ['-','/'] then begin inc(P); dec(L); end; // allow YYYY-MM-DD
    if L>=6 then begin // YYYYMM
      V := ord(P[4])*10+ord(P[5])-(48+480+1); // Month 1..12 -> 0..11
      if V<=11 then
        inc(result,V shl 22) else begin
        result := 0;
        exit;
      end;
      if P[6] in ['-','/'] then begin inc(P); dec(L); end; // allow YYYY-MM-DD
      if L>=8 then begin  // YYYYMMDD
        V := ord(P[6])*10+ord(P[7])-(48+480+1); // Day 1..31 -> 0..30
        if (V<=30) and ((L=8) or (P[8] in [#0,' ','T'])) then
          inc(result,V shl 17) else begin
          result := 0;
          exit;
        end;
      end;
    end;
    if L<15 then begin // not enough place to retrieve a time
      if ContainsNoTime<>nil then
        ContainsNoTime^ := true;
      exit;
    end;
  end;
  if ContainsNoTime<>nil then
    ContainsNoTime^ := false;
  B := ord(P[9])*10+ord(P[10])-(48+480);
  if B<=23 then V := B shl 12 else exit;
  if P[11]=':' then inc(P); // allow hh:mm:ss
  B := ord(P[11])*10+ord(P[12])-(48+480);
  if B<=59 then inc(V,B shl 6) else exit;
  if P[13]=':' then inc(P); // allow hh:mm:ss
  B := ord(P[13])*10+ord(P[14])-(48+480);
  if B<=59 then inc(result,PtrUInt(V+B));
end;

function IsIso8601(P: PUTF8Char; L: integer): boolean;
begin
  result := Iso8601ToTimeLogPUTF8Char(P,L)<>0;
end;

function DateTimeToi18n(const DateTime: TDateTime): string;
begin
  if Assigned(i18nDateTimeText) then
    result := i18nDateTimeText(DateTime) else
    result := {$ifdef UNICODE}Ansi7ToString{$endif}(DateTimeToIso8601(DateTime,true,' ',true));
end;


{ TTimeLogBits }

// bits: S=0..5 M=6..11 H=12..16 D=17..21 M=22..25 Y=26..40
// size: S=6 M=6  H=5  D=5  M=4  Y=12
// i.e. S<64 M<64 H<32 D<32 M<16 Y<=9999: power of 2 -> use fast shl/shr

procedure TTimeLogBits.From(Y, M, D, HH, MM, SS: cardinal);
begin
  inc(HH,D shl 5+M shl 10+Y shl 14-(1 shl 5+1 shl 10));
  Value := SS+MM shl 6+Int64(HH) shl 12;
end;

procedure TTimeLogBits.From(P: PUTF8Char; L: integer);
begin
  Value := Iso8601ToTimeLogPUTF8Char(P,L);
end;

procedure TTimeLogBits.Expand(out Date: TSynSystemTime);
var V: PtrUInt;
begin
  V := PPtrUint(@Value)^;
  Date.Year := {$ifdef CPU32}Value{$else}V{$endif} shr (6+6+5+5+4);
  Date.Month := 1+(V shr (6+6+5+5)) and 15;
  Date.DayOfWeek := 0;
  Date.Day := 1+(V shr (6+6+5)) and 31;
  Date.Hour := (V shr (6+6)) and 31;
  Date.Minute := (V shr 6) and 63;
  Date.Second := V and 63;
end;

procedure TTimeLogBits.From(const S: RawUTF8);
begin
  Value := Iso8601ToTimeLogPUTF8Char(pointer(S),length(S));
end;

procedure TTimeLogBits.From(FileDate: integer);
begin
{$ifdef MSWINDOWS}
  From(PInt64Rec(@FileDate)^.Hi shr 9+1980,
       PInt64Rec(@FileDate)^.Hi shr 5 and 15,
       PInt64Rec(@FileDate)^.Hi and 31,
       PInt64Rec(@FileDate)^.Lo shr 11,
       PInt64Rec(@FileDate)^.Lo shr 5 and 63,
       PInt64Rec(@FileDate)^.Lo and 31 shl 1);
{$else} // FileDate depends on the running OS
  From(FileDateToDateTime(FileDate));
{$endif}
end;

procedure TTimeLogBits.From(DateTime: TDateTime; DateOnly: Boolean);
var T: TSynSystemTime;
    V: PtrInt;
begin
  T.FromDate(DateTime);
  if DateOnly then
    T.Hour := 0 else
    T.FromTime(DateTime);
  V := T.Day shl 5+T.Month shl 10+T.Year shl 14-(1 shl 5+1 shl 10);
  Value := V; // circumvent C1093 error on Delphi 5
  Value := Value shl 12;
  if not DateOnly then begin
    V := T.Second+T.Minute shl 6+T.Hour shl 12;
    Value := Value+V;
  end;
end;

procedure TTimeLogBits.FromUnixTime(const UnixTime: TUnixTime);
begin
  From(UnixTimeToDateTime(UnixTime));
end;

procedure TTimeLogBits.FromUnixMSTime(const UnixMSTime: TUnixMSTime);
begin
  From(UnixMSTimeToDateTime(UnixMSTime));
end;

procedure TTimeLogBits.From(Time: PSynSystemTime);
var V: PtrInt;
begin
  V := Time^.Hour+Time^.Day shl 5+Time^.Month shl 10+Time^.Year shl 14-(1 shl 5+1 shl 10);
  Value := V; // circumvent C1093 error on Delphi 5
  V := Time^.Second+Time^.Minute shl 6;
  Value := (Value shl 12)+V;
end;

var // GlobalTime[LocalTime] cache protected using RCU128()
  GlobalTime: array[boolean] of record
    time: TSystemTime;
    clock: PtrInt; // avoid slower API call with 8-16ms loss of precision
  end;

{$ifndef FPC}{$ifdef CPUINTEL} // intrinsic in FPC
procedure ReadBarrier;
asm
  {$ifdef CPUX86}
  lock add dword ptr [esp], 0
  {$else}
  lfence // lfence requires an SSE CPU, which is OK on x86-64
  {$endif}
end;
{$endif}{$endif}

procedure RCU32(var src,dst);
begin
  repeat
    Integer(dst) := Integer(src);
    ReadBarrier;
  until Integer(dst)=Integer(src);
end;

procedure RCU64(var src,dst);
begin
  repeat
    Int64(dst) := Int64(src);
    ReadBarrier;
  until Int64(dst)=Int64(src);
end;

procedure RCUPtr(var src,dst);
begin
  repeat
    PtrInt(dst) := PtrInt(src);
    ReadBarrier;
  until PtrInt(dst)=PtrInt(src);
end;

procedure RCU128(var src,dst);
var s: THash128Rec absolute src;
    d: THash128Rec absolute dst;
begin
  repeat
    d := s;
    ReadBarrier;
  until (d.L=s.L) and (d.H=s.H);
end;

procedure RCU(var src,dst; len: integer);
begin
  if len>0 then
    repeat
      MoveSmall(@src,@dst,len); // per-byte inlined copy
      ReadBarrier;
    until CompareMemSmall(@src,@dst,len);
end;

procedure FromGlobalTime(LocalTime: boolean; out NewTime: TSynSystemTime);
var tix: PtrInt;
    newtimesys: TSystemTime absolute NewTime;
begin
  with GlobalTime[LocalTime] do begin
    tix := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64
      {$ifndef MSWINDOWS}shr 3{$endif}; // Linux: 8ms refresh
    if clock<>tix then begin // Windows: typically in range of 10-16 ms
      clock := tix;
      NewTime.Clear;
      if LocalTime then
        GetLocalTime(newtimesys) else
        {$ifdef MSWINDOWS}GetSystemTime{$else}GetNowUTCSystem{$endif}(newtimesys);
      RCU128(newtimesys,time);
    end else
      RCU128(time,NewTime);
  end;
  {$ifndef MSWINDOWS} // those TSystemTime fields are inverted in datih.inc :(
  tix := newtimesys.DayOfWeek;
  NewTime.Day := newtimesys.Day;
  NewTime.DayOfWeek := tix;
  {$endif}
end;

procedure TTimeLogBits.FromUTCTime;
var now: TSynSystemTime;
begin
  FromGlobalTime(false,now);
  From(@now);
end;

procedure TTimeLogBits.FromNow;
var now: TSynSystemTime;
begin
  FromGlobalTime(true,now);
  From(@now);
end;

function TTimeLogBits.ToTime: TDateTime;
var lo: PtrUInt;
begin
  lo := {$ifdef CPU64}Value{$else}PCardinal(@Value)^{$endif};
  if lo and (1 shl (6+6+5)-1)=0 then
    result := 0 else
    result := EncodeTime((lo shr(6+6))and 31, (lo shr 6)and 63, lo and 63, 0);
end;

function IsLeapYear(Year: cardinal): boolean;
var d100: TDiv100Rec;
begin
  if Year and 3 = 0 then begin
    Div100(Year,d100);
    result := ((d100.M <> 0) or // (Year mod 100 > 0)
               (Year - ((d100.D shr 2) * 400) = 0)); // (Year mod 400 = 0))
  end else
    result := false;
end;

function TryEncodeDate(Year, Month, Day: cardinal; out Date: TDateTime): Boolean;
var d100: TDiv100Rec;
begin // faster version by AB
  result := False;
  if (Year>0) and (Year<10000) and (Month>0) and (Month<13) and (Day>0) and
     (Day <= MonthDays[IsLeapYear(Year)][Month]) then begin
    if Month>2 then
      dec(Month,3) else
    if (Month>0) then begin
      inc(Month,9);
      dec(Year);
    end
      else exit; // Month <= 0
    Div100(Year,d100);
    Date := (146097*d100.D) shr 2+(1461*d100.M) shr 2+
            (153*Month+2) div 5+Day;
    Date := Date-693900; // should be separated to avoid sign issues
    result := true;
  end;
end;

function TTimeLogBits.ToDate: TDateTime;
var Y, lo: PtrUInt;
begin
  {$ifdef CPU64}
  lo := Value;
  Y := lo shr (6+6+5+5+4);
  {$else}
  Y := Value shr (6+6+5+5+4);
  lo := PCardinal(@Value)^;
  {$endif}
  if (Y=0) or not TryEncodeDate(Y,1+(lo shr(6+6+5+5))and 15,1+(lo shr(6+6+5))and 31,result) then
    result := 0;
end;

function TTimeLogBits.ToDateTime: TDateTime;
var Y, lo: PtrUInt;
    Time: TDateTime;
begin
  {$ifdef CPU64}
  lo := Value;
  Y := lo shr (6+6+5+5+4);
  {$else}
  Y := Value shr (6+6+5+5+4);
  lo := PCardinal(@Value)^;
  {$endif}
  if (Y=0) or not TryEncodeDate(Y,1+(lo shr(6+6+5+5))and 15,1+(lo shr(6+6+5))and 31,result) then
    result := 0;
  if (lo and (1 shl(6+6+5)-1)<>0) and TryEncodeTime((lo shr(6+6)) and 31,
      (lo shr 6)and 63, lo and 63, 0, Time) then
    result := result+Time;
end;

function TTimeLogBits.Year: Integer;
begin
  result := Value shr (6+6+5+5+4);
end;

function TTimeLogBits.Month: Integer;
begin
  result := 1+(PCardinal(@Value)^ shr (6+6+5+5)) and 15;
end;

function TTimeLogBits.Day: Integer;
begin
  result := 1+(PCardinal(@Value)^ shr (6+6+5)) and 31;
end;

function TTimeLogBits.Hour: Integer;
begin
  result := (PCardinal(@Value)^ shr (6+6)) and 31;
end;

function TTimeLogBits.Minute: Integer;
begin
  result := (PCardinal(@Value)^ shr 6) and 63;
end;

function TTimeLogBits.Second: Integer;
begin
  result := PCardinal(@Value)^ and 63;
end;

function TTimeLogBits.ToUnixTime: TUnixTime;
begin
  result := DateTimeToUnixTime(ToDateTime);
end;

function TTimeLogBits.ToUnixMSTime: TUnixMSTime;
begin
  result := DateTimeToUnixMSTime(ToDateTime);
end;

function TTimeLogBits.Text(Dest: PUTF8Char; Expanded: boolean; FirstTimeChar: AnsiChar): integer;
var lo: PtrUInt;
    S: PUTF8Char;
begin
  if Value=0 then begin
    result := 0;
    exit;
  end;
  S := Dest;
  lo := {$ifdef CPU64}Value{$else}PCardinal(@Value)^{$endif};
  if lo and (1 shl (6+6+5)-1)=0 then
    // no Time: just convert date
    result := DateToIso8601PChar(Dest, Expanded,
      {$ifdef CPU64}lo{$else}Value{$endif} shr (6+6+5+5+4),
      1+(lo shr (6+6+5+5)) and 15, 1+(lo shr (6+6+5)) and 31)-S else
  if {$ifdef CPU64}lo{$else}Value{$endif} shr (6+6+5)=0 then
    // no Date: just convert time
    result := TimeToIso8601PChar(Dest, Expanded, (lo shr (6+6)) and 31,
      (lo shr 6) and 63, lo and 63, 0, FirstTimeChar)-S else begin
    // convert time and date
    Dest := DateToIso8601PChar(Dest, Expanded,
      {$ifdef CPU64}lo{$else}Value{$endif} shr (6+6+5+5+4),
      1+(lo shr (6+6+5+5)) and 15, 1+(lo shr (6+6+5)) and 31);
    result := TimeToIso8601PChar(Dest, Expanded, (lo shr (6+6)) and 31,
      (lo shr 6) and 63, lo and 63, 0, FirstTimeChar)-S;
  end;
end;

function TTimeLogBits.Text(Expanded: boolean; FirstTimeChar: AnsiChar): RawUTF8;
var tmp: array[0..31] of AnsiChar;
begin
  if Value=0 then
    result := '' else
    FastSetString(result,@tmp,Text(tmp,Expanded,FirstTimeChar));
end;

function TTimeLogBits.FullText(Dest: PUTF8Char; Expanded: boolean;
  FirstTimeChar,QuotedChar: AnsiChar): PUTF8Char;
var lo: PtrUInt;
begin // convert full time and date
  if QuotedChar<>#0 then begin
    Dest^ := QuotedChar;
    inc(Dest);
  end;
  lo := {$ifdef CPU64}Value{$else}PCardinal(@Value)^{$endif};
  Dest := DateToIso8601PChar(Dest, Expanded,
    {$ifdef CPU64}lo{$else}Value{$endif} shr (6+6+5+5+4),
    1+(lo shr (6+6+5+5)) and 15, 1+(lo shr (6+6+5)) and 31);
  Dest := TimeToIso8601PChar(Dest, Expanded, (lo shr (6+6)) and 31,
    (lo shr 6) and 63, lo and 63, 0, FirstTimeChar);
  if QuotedChar<>#0 then begin
    Dest^ := QuotedChar;
    inc(Dest);
  end;
  result := Dest;
end;

function TTimeLogBits.FullText(Expanded: boolean; FirstTimeChar,QuotedChar: AnsiChar): RawUTF8;
var tmp: array[0..31] of AnsiChar;
begin
  FastSetString(result,@tmp,FullText(tmp,Expanded,FirstTimeChar,QuotedChar)-@tmp);
end;

function TTimeLogBits.i18nText: string;
begin
  if Assigned(i18nDateText) then
    result := i18nDateText(Value) else
    result := {$ifdef UNICODE}Ansi7ToString{$endif}(Text(true,' '));
end;

function TimeLogNow: TTimeLog;
begin
  PTimeLogBits(@result)^.FromNow;
end;

function TimeLogNowUTC: TTimeLog;
begin
  PTimeLogBits(@result)^.FromUTCTime;
end;

function NowToString(Expanded: boolean; FirstTimeChar: AnsiChar): RawUTF8;
var I: TTimeLogBits;
begin
  I.FromNow;
  result := I.Text(Expanded,FirstTimeChar);
end;

function NowUTCToString(Expanded: boolean; FirstTimeChar: AnsiChar): RawUTF8;
var I: TTimeLogBits;
begin
  I.FromUTCTime;
  result := I.Text(Expanded,FirstTimeChar);
end;

const
  DTMS_FMT: array[boolean] of RawUTF8 = ('%%%%%%%%%', '%-%-%%%:%:%.%%');

function DateTimeMSToString(DateTime: TDateTime; Expanded: boolean;
  FirstTimeChar: AnsiChar; const TZD: RawUTF8): RawUTF8;
var T: TSynSystemTime;
begin //  'YYYY-MM-DD hh:mm:ss.sssZ' or 'YYYYMMDD hhmmss.sssZ' format
  if DateTime=0 then
    result := '' else begin
    T.FromDateTime(DateTime);
    result := DateTimeMSToString(T.Hour,T.Minute,T.Second,T.MilliSecond,
      T.Year,T.Month,T.Day,Expanded,FirstTimeChar,TZD);
  end;
end;

function DateTimeMSToString(HH,MM,SS,MS,Y,M,D: cardinal; Expanded: boolean;
  FirstTimeChar: AnsiChar; const TZD: RawUTF8): RawUTF8;
begin //  'YYYY-MM-DD hh:mm:ss.sssZ' or 'YYYYMMDD hhmmss.sssZ' format
  FormatUTF8(DTMS_FMT[Expanded], [UInt4DigitsToShort(Y),UInt2DigitsToShortFast(M),
    UInt2DigitsToShortFast(D),FirstTimeChar,UInt2DigitsToShortFast(HH),
    UInt2DigitsToShortFast(MM),UInt2DigitsToShortFast(SS),UInt3DigitsToShort(MS),TZD], result);
end;

function DateTimeToHTTPDate(dt: TDateTime; const tz: RawUTF8): RawUTF8;
var T: TSynSystemTime;
begin
  if dt=0 then
    result := '' else begin
    T.FromDateTime(dt);
    T.ToHTTPDate(result,tz);
  end;
end;

function TimeToString: RawUTF8;
var I: TTimeLogBits;
begin
  I.FromNow;
  I.Value := I.Value and (1 shl (6+6+5)-1); // keep only time
  result := I.Text(true,' ');
end;

function TimeLogFromFile(const FileName: TFileName): TTimeLog;
var Date: TDateTime;
begin
  Date := FileAgeToDateTime(FileName);
  if Date=0 then
    result := 0 else
    PTimeLogBits(@result)^.From(Date);
end;

function TimeLogFromDateTime(const DateTime: TDateTime): TTimeLog;
begin
  PTimeLogBits(@result)^.From(DateTime);
end;

function TimeLogFromUnixTime(const UnixTime: TUnixTime): TTimeLog;
begin
  PTimeLogBits(@result)^.FromUnixTime(UnixTime);
end;


{ TSynDate }

procedure TSynDate.Clear;
begin
  PInt64(@self)^ := 0;
end;

procedure TSynDate.SetMax;
begin
  PInt64(@self)^ := $001F0000000C270F; // 9999 + 12 shl 16 + 31 shl 48
end;

function TSynDate.IsZero: boolean;
begin
  result := PInt64(@self)^=0;
end;

function TSynDate.ParseFromText(var P: PUTF8Char): boolean;
var L: PtrInt;
    Y,M,D: cardinal;
begin
  result := false;
  if P=nil then
    exit;
  while P^ in [#9,' '] do inc(P);
  L := 0;
  while P[L] in ['0'..'9','-','/'] do inc(L);
  if not Iso8601ToDatePUTF8Char(P,L,Y,M,D) then
    exit;
  Year := Y;
  Month := M;
  DayOfWeek := 0;
  Day := D;
  inc(P,L); // move P^ just after the date
  result := true;
end;

procedure TSynDate.FromNow(localtime: boolean);
var dt: TSynSystemTime;
begin
  FromGlobalTime(localtime,dt);
  self := PSynDate(@dt)^; // 4 first fields of TSynSystemTime do match
end;

procedure TSynDate.FromDate(date: TDate);
var dt: TSynSystemTime;
begin
  dt.FromDate(date); // faster than DecodeDate
  self := PSynDate(@dt)^;
end;

function TSynDate.IsEqual({$ifdef FPC}constref{$else}const{$endif} another{$ifndef DELPHI5OROLDER}: TSynDate{$endif}): boolean;
begin
  result := (PCardinal(@Year)^=PCardinal(@TSynDate(another).Year)^) and (Day=TSynDate(another).Day);
end;

function TSynDate.Compare({$ifdef FPC}constref{$else}const{$endif} another{$ifndef DELPHI5OROLDER}: TSynDate{$endif}): integer;
begin
  result := Year-TSynDate(another).Year;
  if result=0 then begin
    result := Month-TSynDate(another).Month;
    if result=0 then
      result := Day-TSynDate(another).Day;
  end;
end;

procedure TSynDate.ComputeDayOfWeek;
var d: TDateTime;
    i: PtrInt;
begin
  if not TryEncodeDate(Year,Month,Day,d) then begin
    DayOfWeek := 0;
    exit;
  end;
  i := ((trunc(d)-1) mod 7)+1; // sunday is day 1
  if i<=0 then
    DayOfWeek := i+7 else
    DayOfWeek := i;
end;

function TSynDate.ToDate: TDate;
begin
  if not TryEncodeDate(Year,Month,Day,PDateTime(@result)^) then
    result := 0;
end;

function TSynDate.ToText(Expanded: boolean): RawUTF8;
begin
  if PInt64(@self)^=0 then
    result := '' else
    result := DateToIso8601(Year,Month,Day,Expanded);
end;


{ TSynSystemTime }

function TryEncodeDayOfWeekInMonth(AYear, AMonth, ANthDayOfWeek, ADayOfWeek: integer;
  out AValue: TDateTime): Boolean;
var LStartOfMonth, LDay: integer;
begin // adapted from DateUtils
  result := TryEncodeDate(AYear,AMonth,1,aValue);
  if not result then
    exit;
  LStartOfMonth := (DateTimeToTimestamp(aValue).Date-1)mod 7+1;
  if LStartOfMonth<=ADayOfWeek then
    dec(ANthDayOfWeek);
  LDay := (ADayOfWeek-LStartOfMonth+1)+7*ANthDayOfWeek;
  result := TryEncodeDate(AYear,AMonth,LDay,AValue);
end;

function TSynSystemTime.EncodeForTimeChange(const aYear: word): TDateTime;
var dow,d: word;
begin
  if DayOfWeek=0 then
    dow := 7 else // Delphi Sunday = 7
    dow := DayOfWeek;
  // Encoding the day of change
  d := Day;
  while not TryEncodeDayOfWeekInMonth(aYear,Month,d,dow,Result) do begin
    // if Day = 5 then try it and if needed decrement to find the last
    // occurence of the day in this month
    if d=0 then begin
      TryEncodeDayOfWeekInMonth(aYear,Month,1,7,Result);
      break;
    end;
    dec(d);
  end;
  // finally add the time when change is due
  result := result+EncodeTime(Hour,Minute,Second,MilliSecond);
end;

procedure TSynSystemTime.Clear;
begin
  PInt64Array(@self)[0] := 0;
  PInt64Array(@self)[1] := 0;
end;

function TSynSystemTime.IsZero: boolean;
begin
  result := (PInt64Array(@self)[0]=0) and (PInt64Array(@self)[1]=0);
end;

function TSynSystemTime.IsEqual(const another{$ifndef DELPHI5OROLDER}: TSynSystemTime{$endif}): boolean;
begin
  result := (PInt64Array(@self)[0]=PInt64Array(@another)[0]) and
            (PInt64Array(@self)[1]=PInt64Array(@another)[1]);
end;

function TSynSystemTime.IsDateEqual(const date{$ifndef DELPHI5OROLDER}: TSynDate{$endif}): boolean;
begin
  result := (PCardinal(@Year)^=PCardinal(@TSynDate(date).Year)^) and
            (Day=TSynDate(date).Day);
end;

procedure TSynSystemTime.FromNowUTC;
begin
  FromGlobalTime(false,self);
end;

procedure TSynSystemTime.FromNowLocal;
begin
  FromGlobalTime(true,self);
end;

procedure TSynSystemTime.FromDateTime(const dt: TDateTime);
begin
  FromDate(dt);
  FromTime(dt);
end;

procedure TSynSystemTime.FromDate(const dt: TDateTime);
var t,t2,t3: PtrUInt;
begin
  t := Trunc(dt);
  t := (t+693900)*4-1;
  if PtrInt(t)>=0 then begin
    t3 := t div 146097;
    t2 := (t-t3*146097) and not 3;
    t := PtrUInt(t2+3) div 1461; // PtrUInt() needed for FPC i386
    Year := t3*100+t;
    t2 := ((t2+7-t*1461)shr 2)*5;
    t3 := PtrUInt(t2-3) div 153;
    Day := PtrUInt(t2+2-t3*153) div 5;
    if t3<10 then
      inc(t3,3) else begin
      dec(t3,9);
      inc(Year);
    end;
    Month := t3;
    DayOfWeek := 0; // not set by default
  end else
    PInt64(@Year)^ := 0;
end;

procedure TSynSystemTime.FromTime(const dt: TDateTime);
begin
  FromMS(QWord(round(abs(dt)*MSecsPerDay)) mod MSecsPerDay);
end;

procedure TSynSystemTime.FromMS(ms: PtrUInt);
var t: PtrUInt;
begin
  t := ms div 3600000;
  Hour := t;
  dec(ms,t*3600000);
  t := ms div 60000;
  Minute := t;
  dec(ms,t*60000);
  t := ms div 1000;
  Second := t;
  dec(ms,t*1000);
  MilliSecond := ms;
end;

procedure TSynSystemTime.FromSec(s: PtrUInt);
var t: PtrUInt;
begin
  t := s div 3600;
  Hour := t;
  dec(s,t*3600);
  t := s div 60;
  Minute := t;
  dec(s,t*60);
  Second := s;
  MilliSecond := 0;
end;

function TSynSystemTime.FromText(const iso: RawUTF8): boolean;
var t: TTimeLogBits;
begin
  t.From(iso);
  if t.Value=0 then
    result := false else begin
    t.Expand(self); // TTimeLogBits is faster than FromDateTime()
    result := true;
  end;
end;

function TSynSystemTime.ToText(Expanded: boolean;
  FirstTimeChar: AnsiChar; const TZD: RawUTF8): RawUTF8;
begin
  result := DateTimeMSToString(Hour,Minute,Second,MilliSecond,Year,Month,Day,
    Expanded,FirstTimeChar,TZD);
end;

procedure TSynSystemTime.AddLogTime(WR: TTextWriter);
var y,d100: PtrUInt;
    P: PUTF8Char;
    tab: {$ifdef CPUX86NOTPIC}TWordArray absolute TwoDigitLookupW{$else}PWordArray{$endif};
begin
  if WR.BEnd-WR.B<=18 then
    WR.FlushToStream;
  {$ifndef CPUX86NOTPIC}tab := @TwoDigitLookupW;{$endif}
  y := Year;
  d100 := y div 100;
  P := WR.B+1;
  PWord(P)^ := tab[d100];
  PWord(P+2)^ := tab[y-(d100*100)];
  PWord(P+4)^ := tab[Month];
  PWord(P+6)^ := tab[Day];
  P[8] := ' ';
  PWord(P+9)^ := tab[Hour];
  PWord(P+11)^ := tab[Minute];
  PWord(P+13)^ := tab[Second];
  y := Millisecond;
  PWord(P+15)^ := tab[y shr 4];
  inc(WR.B,17);
end;

const
  HTML_WEEK_DAYS: array[1..7] of string[3] =
    ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  HTML_MONTH_NAMES: array[1..12] of string[3] =
    ('Jan','Feb','Mar','Apr','May','Jun', 'Jul','Aug','Sep','Oct','Nov','Dec');

function TSynSystemTime.ToNCSAText(P: PUTF8Char): PtrInt;
var y,d100: PtrUInt;
    tab: {$ifdef CPUX86NOTPIC}TWordArray absolute TwoDigitLookupW{$else}PWordArray{$endif};
begin
  {$ifndef CPUX86NOTPIC}tab := @TwoDigitLookupW;{$endif}
  PWord(P)^ := tab[Day];
  PCardinal(P+2)^ := PCardinal(@HTML_MONTH_NAMES[Month])^;
  P[2] := '/'; // overwrite HTML_MONTH_NAMES[][0]
  P[6] := '/';
  y := Year;
  d100 := y div 100;
  PWord(P+7)^ := tab[d100];
  PWord(P+9)^ := tab[y-(d100*100)];
  P[11] := ':';
  PWord(P+12)^ := tab[Hour];
  P[14] := ':';
  PWord(P+15)^ := tab[Minute];
  P[17] := ':';
  PWord(P+18)^ := tab[Second];
  P[20] := ' ';
  result := 21;
end;

procedure TSynSystemTime.ToHTTPDate(out text: RawUTF8; const tz: RawUTF8);
begin
  if DayOfWeek=0 then
    PSynDate(@self)^.ComputeDayOfWeek; // first 4 fields do match
  FormatUTF8('%, % % % %:%:% %', [HTML_WEEK_DAYS[DayOfWeek],
    UInt2DigitsToShortFast(Day),HTML_MONTH_NAMES[Month],UInt4DigitsToShort(Year),
    UInt2DigitsToShortFast(Hour),UInt2DigitsToShortFast(Minute),
    UInt2DigitsToShortFast(Second),tz],text);
end;

procedure TSynSystemTime.ToIsoDateTime(out text: RawUTF8; const FirstTimeChar: AnsiChar);
begin
  FormatUTF8('%-%-%%%:%:%', [UInt4DigitsToShort(Year),UInt2DigitsToShortFast(Month),
    UInt2DigitsToShortFast(Day),FirstTimeChar,UInt2DigitsToShortFast(Hour),
    UInt2DigitsToShortFast(Minute),UInt2DigitsToShortFast(Second)],text);
end;

procedure TSynSystemTime.ToIsoDate(out text: RawUTF8);
begin
  FormatUTF8('%-%-%', [UInt4DigitsToShort(Year),UInt2DigitsToShortFast(Month),
    UInt2DigitsToShortFast(Day)],text);
end;

procedure TSynSystemTime.ToIsoTime(out text: RawUTF8; const FirstTimeChar: RawUTF8);
begin
  FormatUTF8('%%:%:%', [FirstTimeChar,UInt2DigitsToShortFast(Hour),
    UInt2DigitsToShortFast(Minute),UInt2DigitsToShortFast(Second)],text);
end;

procedure TSynSystemTime.AddNCSAText(WR: TTextWriter);
begin
  if WR.BEnd-WR.B<=21 then
    WR.FlushToStream;
  inc(WR.B,ToNCSAText(WR.B+1));
end;

function TSynSystemTime.ToDateTime: TDateTime;
var time: TDateTime;
begin
  if TryEncodeDate(Year,Month,Day,result) then
    if TryEncodeTime(Hour,Minute,Second,MilliSecond,time) then
      result := result+time else
      result := 0 else
    result := 0;
end;

procedure TSynSystemTime.ToSynDate(out date: TSynDate);
begin
  date := PSynDate(@self)^; // first 4 fields do match
end;

procedure TSynSystemTime.ComputeDayOfWeek;
begin
  PSynDate(@self)^.ComputeDayOfWeek; // first 4 fields do match
end;

procedure TSynSystemTime.IncrementMS(ms: integer);
begin
  inc(MilliSecond, ms);
  if MilliSecond >= 1000 then
    repeat
      dec(MilliSecond, 1000);
      if Second < 60 then
        inc(Second)
      else begin
        Second := 0;
        if Minute < 60 then
          inc(Minute)
        else begin
          Minute := 0;
          if Hour < 24 then
            inc(Hour)
          else begin
            Hour := 0;
            if Day < MonthDays[false, Month] then
              inc(Day)
            else begin
              Day := 1;
              if Month < 12 then
                inc(Month)
              else begin
                Month := 1;
                inc(Year);
              end;
            end;
          end;
        end;
      end;
    until MilliSecond < 1000;
end;

procedure AppendToTextFile(aLine: RawUTF8; const aFileName: TFileName;
    aMaxSize: Int64; aUTCTimeStamp: boolean);
var F: THandle;
    Old: TFileName;
    Date: array[1..22] of AnsiChar;
    size: Int64;
    i: integer;
    now: TSynSystemTime;
begin
  if aFileName='' then
    exit;
  F := FileOpen(aFileName,fmOpenWrite or fmShareDenyNone);
  if PtrInt(F)<0 then begin
    F := FileCreate(aFileName);
    if PtrInt(F)<0 then
      exit; // you may not have write access to this folder
  end;
  // append to end of file
  size := FileSeek64(F,0,soFromEnd);
  if (aMaxSize>0) and (size>aMaxSize) then begin
    // rotate log file if too big
    FileClose(F);
    Old := aFileName+'.bak'; // '.log.bak'
    DeleteFile(Old); // rotate once
    RenameFile(aFileName,Old);
    F := FileCreate(aFileName);
    if PtrInt(F)<0 then
      exit;
  end;
  PWord(@Date)^ := 13+10 shl 8; // first go to next line
  if aUTCTimeStamp then
    now.FromNowUTC else
    now.FromNowLocal;
  DateToIso8601PChar(@Date[3],true,Now.Year,Now.Month,Now.Day);
  TimeToIso8601PChar(@Date[13],true,Now.Hour,Now.Minute,Now.Second,0,' ');
  Date[22] := ' ';
  FileWrite(F,Date,SizeOf(Date));
  for i := 1 to length(aLine) do
    if aLine[i]<' ' then
      aLine[i] := ' '; // avoid line feed in text log file
  FileWrite(F,pointer(aLine)^,length(aLine));
  FileClose(F);
end;

procedure LogToTextFile(Msg: RawUTF8);
begin
  if Msg='' then begin
    StringToUTF8(SysErrorMessage(GetLastError),Msg);
    if Msg='' then
      exit;
  end;
  AppendToTextFile(Msg,{$ifndef MSWINDOWS}ExtractFileName{$endif}
    (ChangeFileExt(ExeVersion.ProgramFileName,'.log')));
end;

function IsEqualGUID(const guid1, guid2: TGUID): Boolean;
begin
  result := (PHash128Rec(@guid1).L=PHash128Rec(@guid2).L) and
            (PHash128Rec(@guid1).H=PHash128Rec(@guid2).H);
end;

function IsEqualGUID(guid1, guid2: PGUID): Boolean;
begin
  result := (PHash128Rec(guid1).L=PHash128Rec(guid2).L) and
            (PHash128Rec(guid1).H=PHash128Rec(guid2).H);
end;

function IsEqualGUIDArray(const guid: TGUID; const guids: array of TGUID): integer;
begin
  result := Hash128Index(@guids[0],length(guids),@guid);
end;

function IsNullGUID({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): Boolean;
var a: TPtrIntArray absolute guid;
begin
  result := (a[0]=0) and (a[1]=0) {$ifndef CPU64} and (a[2]=0) and (a[3]=0){$endif};
end;

function AddGUID(var guids: TGUIDDynArray; const guid: TGUID;
  NoDuplicates: boolean): integer;
begin
  if NoDuplicates then begin
    result := Hash128Index(pointer(guids),length(guids),@guid);
    if result>=0 then
      exit;
  end;
  result := length(guids);
  SetLength(guids,result+1);
  guids[result] := guid;
end;

function GUIDToText(P: PUTF8Char; guid: PByteArray): PUTF8Char;
var i: integer;
begin // encode as '3F2504E0-4F89-11D3-9A0C-0305E82C3301'
  for i := 3 downto 0 do begin
    PWord(P)^ := TwoDigitsHexWB[guid[i]];
    inc(P,2);
  end;
  inc(PByte(guid),4);
  for i := 1 to 2 do begin
    P[0] := '-';
    PWord(P+1)^ := TwoDigitsHexWB[guid[1]];
    PWord(P+3)^ := TwoDigitsHexWB[guid[0]];
    inc(PByte(guid),2);
    inc(P,5);
  end;
  P[0] := '-';
  PWord(P+1)^ := TwoDigitsHexWB[guid[0]];
  PWord(P+3)^ := TwoDigitsHexWB[guid[1]];
  P[5] := '-';
  inc(PByte(guid),2);
  inc(P,6);
  for i := 0 to 5 do begin
    PWord(P)^ := TwoDigitsHexWB[guid[i]];
    inc(P,2);
  end;
  result := P;
end;

function HexaToByte(P: PUTF8Char; var Dest: byte): boolean; {$ifdef HASINLINE}inline;{$endif}
var B,C: PtrUInt;
begin
  B := ConvertHexToBin[Ord(P[0])];
  if B<=15 then begin
    C := ConvertHexToBin[Ord(P[1])];
    if C<=15 then begin
      Dest := B shl 4+C;
      result := true;
      exit;
    end;
  end;
  result := false; // mark error
end;

function TextToGUID(P: PUTF8Char; guid: PByteArray): PUTF8Char;
var i: integer;
begin // decode from '3F2504E0-4F89-11D3-9A0C-0305E82C3301'
  result := nil;
  for i := 3 downto 0 do begin
    if not HexaToByte(P,guid[i]) then
      exit;
    inc(P,2);
  end;
  inc(PByte(guid),4);
  for i := 1 to 2 do begin
    if (P^<>'-') or not HexaToByte(P+1,guid[1]) or not HexaToByte(P+3,guid[0]) then
      exit;
    inc(P,5);
    inc(PByte(guid),2);
  end;
  if (P[0]<>'-') or (P[5]<>'-') or
     not HexaToByte(P+1,guid[0]) or not HexaToByte(P+3,guid[1]) then
    exit;
  inc(PByte(guid),2);
  inc(P,6);
  for i := 0 to 5 do
    if HexaToByte(P,guid[i]) then
      inc(P,2) else
      exit;
  result := P;
end;

function GUIDToRawUTF8({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): RawUTF8;
var P: PUTF8Char;
begin
  FastSetString(result,nil,38);
  P := pointer(result);
  P^ := '{';
  GUIDToText(P+1,@guid)^ := '}';
end;

function GUIDToShort({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): TGUIDShortString;
begin
  GUIDToShort(guid,result);
end;

procedure GUIDToShort({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID;
  out dest: TGUIDShortString);
begin
  dest[0] := #38;
  dest[1] := '{';
  dest[38] := '}';
  GUIDToText(@dest[2],@guid);
end;

function GUIDToString({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): string;
{$ifdef UNICODE}
var tmp: array[0..35] of AnsiChar;
    i: integer;
begin
  GUIDToText(tmp,@guid);
  SetString(result,nil,38);
  PWordArray(result)[0] := ord('{');
  for i := 1 to 36 do
    PWordArray(result)[i] := ord(tmp[i-1]); // no conversion for 7 bit Ansi
  PWordArray(result)[37] := ord('}');
end;
{$else}
begin
  result := GUIDToRawUTF8(guid);
end;
{$endif}

{$ifdef CPUINTEL} /// NIST SP 800-90A compliant RDRAND Intel x86/x64 opcode
function RdRand32: cardinal; {$ifdef CPU64}
{$ifdef FPC}nostackframe; assembler; asm{$else} asm .noframe {$endif FPC} {$else}
{$ifdef FPC}nostackframe; assembler;{$endif} asm {$endif}
  // rdrand eax: same opcodes for x86 and x64
  db $0f, $c7, $f0
  // returns in eax, ignore carry flag (eax=0 won't hurt)
end;
{$endif CPUINTEL}

threadvar
  _Lecuyer: TLecuyer; // uses only 16 bytes per thread

procedure TLecuyer.Seed(entropy: PByteArray; entropylen: PtrInt);
var time, crc: THash128Rec;
    i, j: PtrInt;
begin
  repeat
    QueryPerformanceCounter(time.Lo);
    time.Hi := UnixMSTimeUTCFast xor PtrUInt(GetCurrentThreadID);
    crcblock(@crc.b,@time.b);
    crcblock(@crc.b,@ExeVersion.Hash.b);
    if entropy<>nil then
      for i := 0 to entropylen-1 do begin
        j := i and 15;
        crc.b[j] := crc.b[j] xor entropy^[i];
      end;
    rs1 := rs1 xor crc.c0;
    rs2 := rs2 xor crc.c1;
    rs3 := rs3 xor crc.c2;
    {$ifdef CPUINTEL}
    if cfRAND in CpuFeatures then begin // won't hurt e.g. from Random32gsl
      rs1 := rs1 xor RdRand32;
      rs2 := rs2 xor RdRand32;
      rs3 := rs3 xor RdRand32;
    end;
    {$endif CPUINTEL}
  until (rs1>1) and (rs2>7) and (rs3>15);
  seedcount := 1;
  for i := 1 to crc.i3 and 15 do
    Next; // warm up
end;

function TLecuyer.Next: cardinal;
begin
  if word(seedcount)=0 then // reseed after 256KB of output
    Seed(nil,0) else
    inc(seedcount);
  result := rs1;
  rs1 := ((result and -2)shl 12) xor (((result shl 13)xor result)shr 19);
  result := rs2;
  rs2 := ((result and -8)shl 4) xor (((result shl 2)xor result)shr 25);
  result := rs3;
  rs3 := ((result and -16)shl 17) xor (((result shl 3)xor result)shr 11);
  result := rs1 xor rs2 xor result;
end;

function TLecuyer.Next(max: cardinal): cardinal;
begin
  result := (QWord(Next)*max)shr 32;
end;

procedure Random32Seed(entropy: pointer; entropylen: PtrInt);
begin
  _Lecuyer.Seed(entropy,entropylen);
end;

function Random32: cardinal;
begin
  {$ifdef CPUINTEL}
  if cfRAND in CpuFeatures then begin
    result := RdRand32;
    if ((integer(result)<>-1) and (result<>0)) or (RdRand32<>result) then
      exit; // ensure not affected by old AMD bug after suspend to RAM
    exclude(CpuFeatures,cfRAND); // disable if weakness detected
  end;
  {$endif CPUINTEL}
    result := _Lecuyer.Next;
end;

function Random32(max: cardinal): cardinal;
begin
  result := (QWord(Random32)*max)shr 32;
end;

function Random32gsl: cardinal;
begin
  result := _Lecuyer.Next;
end;

function Random32gsl(max: cardinal): cardinal;
begin
  result := (QWord(_Lecuyer.Next)*max)shr 32;
end;

procedure FillRandom(Dest: PCardinalArray; CardinalCount: integer; forcegsl: boolean);
var i: PtrInt;
    c: cardinal;
    seed: TQWordRec;
    lecuyer: ^TLecuyer;
begin
  if CardinalCount<=0 then
    exit;
  {$ifdef CPUINTEL}
  if (cfRAND in CpuFeatures) and not forcegsl then
    lecuyer := nil else
  {$endif CPUINTEL}
    lecuyer := @_Lecuyer;
  QueryPerformanceCounter(PInt64(@seed)^);
  c := crc32cBy4(seed.L,seed.H);
  for i := 0 to CardinalCount-1 do begin
    {$ifdef CPUINTEL}
    if lecuyer=nil then
      c := crc32cBy4(c,RdRand32) else // never trust plain Intel values
    {$endif CPUINTEL}
      c := c xor lecuyer^.Next;
    Dest^[i] := Dest^[i] xor c;
  end;
end;

function RandomGUID: TGUID;
begin
  FillRandom(@result,SizeOf(TGUID) shr 2,{forcegsl=}true);
end;

procedure RandomGUID(out result: TGUID);
begin
  FillRandom(@result,SizeOf(TGUID) shr 2,{forcegsl=}true);
end;

procedure FillZero(var result: TGUID);
begin
  FillZero(PHash128(@result)^);
end;

function RawUTF8ToGUID(const text: RawByteString): TGUID;
begin
  if (length(text)<>38) or (text[1]<>'{') or (text[38]<>'}') or
     (TextToGUID(@text[2],@result)=nil) then
   FillZero(PHash128(@result)^);
end;

function StringToGUID(const text: string): TGUID;
{$ifdef UNICODE}
var tmp: array[0..35] of byte;
    i: integer;
{$endif}
begin
  if (length(text)=38) and (text[1]='{') and (text[38]='}') then begin
    {$ifdef UNICODE}
    for i := 0 to 35 do
      tmp[i] := PWordArray(text)[i+1];
    if TextToGUID(@tmp,@result)<>nil then
    {$else}
    if TextToGUID(@text[2],@result)<>nil then
    {$endif}
      exit; // conversion OK
  end;
  FillZero(PHash128(@result)^);
end;

function StrCurr64(P: PAnsiChar; const Value: Int64): PAnsiChar;
var c: QWord;
    d: cardinal;
    {$ifndef CPU64}c64: Int64Rec absolute c;{$endif}
begin
  if Value=0 then begin
    result := P-1;
    result^ := '0';
    exit;
  end;
  if Value<0 then
    c := -Value else
    c := Value;
  if {$ifdef CPU64}c<10000{$else}(c64.Hi=0) and (c64.Lo<10000){$endif} then begin
    result := P-6; // only decimals -> append '0.xxxx'
    PWord(result)^ := ord('0')+ord('.')shl 8;
    YearToPChar(c,PUTF8Char(P)-4);
  end else begin
    result := StrUInt64(P-1,c);
    d := PCardinal(P-5)^; // in two explit steps for CPUARM (alf)
    PCardinal(P-4)^ := d;
    P[-5] := '.'; // insert '.' just before last 4 decimals
  end;
  if Value<0 then begin
    dec(result);
    result^ := '-';
  end;
end;

procedure Curr64ToStr(const Value: Int64; var result: RawUTF8);
var tmp: array[0..31] of AnsiChar;
    P: PAnsiChar;
    Decim, L: Cardinal;
begin
  if Value=0 then
    result := SmallUInt32UTF8[0] else begin
    P := StrCurr64(@tmp[31],Value);
    L := @tmp[31]-P;
    if L>4 then begin
      Decim := PCardinal(P+L-SizeOf(cardinal))^; // 4 last digits = 4 decimals
      if Decim=ord('0')+ord('0')shl 8+ord('0')shl 16+ord('0')shl 24 then
        dec(L,5) else // no decimal
      if Decim and $ffff0000=ord('0')shl 16+ord('0')shl 24 then
        dec(L,2); // 2 decimals
    end;
    FastSetString(result,P,L);
  end;
end;

function Curr64ToStr(const Value: Int64): RawUTF8;
begin
  Curr64ToStr(Value,result);
end;

function CurrencyToStr(Value: currency): RawUTF8;
begin
  result := Curr64ToStr(PInt64(@Value)^);
end;

function Curr64ToPChar(const Value: Int64; Dest: PUTF8Char): PtrInt;
var tmp: array[0..31] of AnsiChar;
    P: PAnsiChar;
    Decim: Cardinal;
begin
  P := StrCurr64(@tmp[31],Value);
  result := @tmp[31]-P;
  if result>4 then begin
    Decim := PCardinal(P+result-SizeOf(cardinal))^; // 4 last digits = 4 decimals
    if Decim=ord('0')+ord('0')shl 8+ord('0')shl 16+ord('0')shl 24 then
      dec(result,5) else // no decimal
    if Decim and $ffff0000=ord('0')shl 16+ord('0')shl 24 then
      dec(result,2); // 2 decimals
  end;
  MoveSmall(P,Dest,result);
end;

function StrToCurr64(P: PUTF8Char; NoDecimal: PBoolean): Int64;
var c: cardinal;
    minus: boolean;
    Dec: cardinal;
begin
  result := 0;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^='-' then begin
    minus := true;
    repeat inc(P) until P^<>' ';
  end else begin
    minus := false;
    if P^='+' then
      repeat inc(P) until P^<>' ';
  end;
  if P^='.' then begin // '.5' -> 500
    Dec := 2;
    inc(P);
  end else
    Dec := 0;
  c := byte(P^)-48;
  if c>9 then
    exit;
  PCardinal(@result)^ := c;
  inc(P);
  repeat
    if P^<>'.' then begin
      c := byte(P^)-48;
      if c>9 then
        break;
      {$ifdef CPU32DELPHI}
      result := result shl 3+result+result;
      {$else}
      result := result*10;
      {$endif}
      inc(result,c);
      inc(P);
      if Dec<>0 then begin
        inc(Dec);
        if Dec<5 then continue else break;
      end;
    end else begin
      inc(Dec);
      inc(P);
    end;
  until false;
  if NoDecimal<>nil then
    if Dec=0 then begin
      NoDecimal^ := true;
      if minus then
        result := -result;
      exit;
    end else
      NoDecimal^ := false;
  if Dec<>5 then // Dec=5 most of the time
  case Dec of
  0,1: result := result*10000;
  {$ifdef CPU32DELPHI}
  2: result := result shl 10-result shl 4-result shl 3;
  3: result := result shl 6+result shl 5+result shl 2;
  4: result := result shl 3+result+result;
  {$else}
  2: result := result*1000;
  3: result := result*100;
  4: result := result*10;
  {$endif}
  end;
  if minus then
    result := -result;
end;

function StrToCurrency(P: PUTF8Char): currency;
begin
  PInt64(@result)^ := StrToCurr64(P,nil);
end;

function TruncTo2Digits(Value: Currency): Currency;
var V64: Int64 absolute Value; // to avoid any floating-point precision issues
begin
  dec(V64,V64 mod 100);
  result := Value;
end;

procedure TruncTo2DigitsCurr64(var Value: Int64);
begin
  dec(Value,Value mod 100);
end;

function TruncTo2Digits64(Value: Int64): Int64;
begin
  result := Value-Value mod 100;
end;

function SimpleRoundTo2Digits(Value: Currency): Currency;
var V64: Int64 absolute Value; // to avoid any floating-point precision issues
begin
  SimpleRoundTo2DigitsCurr64(V64);
  result := Value;
end;

procedure SimpleRoundTo2DigitsCurr64(var Value: Int64);
var Spare: PtrInt;
begin
  Spare := Value mod 100;
  if Spare<>0 then
    if Spare>50 then
      inc(Value,100-Spare) else
    if Spare<-50 then
      dec(Value,100+Spare) else
      dec(Value,Spare);
end;

function TrimLeftLowerCase(const V: RawUTF8): PUTF8Char;
begin
  result := Pointer(V);
  if result<>nil then begin
    while result^ in ['a'..'z'] do
      inc(result);
    if result^=#0 then
      result := Pointer(V);
  end;
end;

function TrimLeftLowerCaseToShort(V: PShortString): ShortString;
begin
  TrimLeftLowerCaseToShort(V,result);
end;

procedure TrimLeftLowerCaseToShort(V: PShortString; out result: ShortString);
var P: PAnsiChar;
    L: integer;
begin
  L := length(V^);
  P := @V^[1];
  while (L>0) and (P^ in ['a'..'z']) do begin
    inc(P);
    dec(L);
  end;
  if L=0 then
    result := V^ else
    SetString(result,P,L);
end;

{$ifdef FPC_OR_PUREPASCAL}
function TrimLeftLowerCaseShort(V: PShortString): RawUTF8;
var P: PAnsiChar;
    L: integer;
begin
  L := length(V^);
  P := @V^[1];
  while (L>0) and (P^ in ['a'..'z']) do begin
    inc(P);
    dec(L);
  end;
  if L=0 then
    FastSetString(result,@V^[1],length(V^)) else
    FastSetString(result,P,L);
end;
{$else}
function TrimLeftLowerCaseShort(V: PShortString): RawUTF8;
asm // eax=V
        xor     ecx, ecx
        push    edx // save result RawUTF8
        test    eax, eax
        jz      @2 // avoid GPF
        lea     edx, [eax + 1]
        mov     cl, [eax]
@1:     mov     ch, [edx] // edx=source cl=length
        sub     ch, 'a'
        sub     ch, 'z' - 'a'
        ja      @2 // not a lower char -> create a result string starting at edx
        inc     edx
        dec     cl
        jnz     @1
        mov     cl, [eax]
        lea     edx, [eax + 1]  // no UpperCase -> retrieve full text (result := V^)
@2:     pop     eax
        movzx   ecx, cl
{$ifdef UNICODE}
        push    CP_UTF8 // UTF-8 code page for Delphi 2009+ + call below, not jump
        call    System.@LStrFromPCharLen // eax=Dest edx=Source ecx=Length
        rep     ret // we need a call just above for right push CP_UTF8 retrieval
{$else} jmp     System.@LStrFromPCharLen // eax=dest edx=source ecx=length(source)
{$endif}
end;
{$endif FPC_OR_PUREPASCAL}

function UnCamelCase(const S: RawUTF8): RawUTF8;
var tmp: TSynTempBuffer;
    destlen: PtrInt;
begin
  if S='' then
    result := '' else begin
    destlen := UnCamelCase(tmp.Init(length(S)*2),pointer(S));
    tmp.Done(PAnsiChar(tmp.buf)+destlen,result);
  end;
end;

function UnCamelCase(D, P: PUTF8Char): integer;
var Space, SpaceBeg, DBeg: PUTF8Char;
    CapitalCount: integer;
    Number: boolean;
label Next;
begin
  DBeg := D;
  if (D<>nil) and (P<>nil) then begin // avoid GPF
    Space := D;
    SpaceBeg := D;
    repeat
      CapitalCount := 0;
      Number := P^ in  ['0'..'9'];
      if Number then
        repeat
          inc(CapitalCount);
          D^ := P^;
          inc(P);
          inc(D);
        until not (P^ in ['0'..'9']) else
        repeat
          inc(CapitalCount);
          D^ := P^;
          inc(P);
          inc(D);
        until not (P^ in ['A'..'Z']);
      if P^=#0 then break; // no lowercase conversion of last fully uppercased word
      if (CapitalCount > 1) and not Number then begin
        dec(P);
        dec(D);
      end;
      while P^ in ['a'..'z'] do begin
        D^  := P^;
        inc(D);
        inc(P);
      end;
      if P^='_' then
      if P[1]='_' then begin
        D^ := ':';
        inc(P);
        inc(D);
        goto Next;
      end else begin
        PWord(D)^ := ord(' ')+ord('-')shl 8;
        inc(D,2);
  Next: if Space=SpaceBeg then
          SpaceBeg := D+1;
        inc(P);
        Space := D+1;
      end else
        Space := D;
      if P^=#0 then break;
      D^ := ' ';
      inc(D);
    until false;
    if Space>DBeg then
      dec(Space);
    while Space>SpaceBeg do begin
      if Space^ in ['A'..'Z'] then
        if not (Space[1] in ['A'..'Z',' ']) then
          inc(Space^,32); // lowercase conversion of not last fully uppercased word
      dec(Space);
    end;
  end;
  result := D-DBeg;
end;

procedure CamelCase(P: PAnsiChar; len: PtrInt; var s: RawUTF8;
  const isWord: TSynByteSet);
var i: PtrInt;
    d: PAnsiChar;
    tmp: array[byte] of AnsiChar;
begin
  if len > SizeOf(tmp) then
    len := SizeOf(tmp);
  for i := 0 to len-1 do
    if not(ord(P[i]) in isWord) then begin
      if i>0 then begin
        MoveSmall(P,@tmp,i);
        inc(P,i);
        dec(len,i);
      end;
      d := @tmp[i];
      while len > 0 do begin
        while (len > 0) and not (ord(P^) in isWord) do begin
          inc(P);
          dec(len);
        end;
        if len = 0 then
          break;
        d^ := NormToUpperAnsi7[P^];
        inc(d);
        repeat
          inc(P);
          dec(len);
          if not (ord(P^) in isWord) then
            break;
          d^ := P^;
          inc(d);
        until len = 0;
      end;
      P := @tmp;
      len := d-tmp;
      break;
    end;
  FastSetString(s,P,len);
end;

procedure CamelCase(const text: RawUTF8; var s: RawUTF8; const isWord: TSynByteSet);
begin
  CamelCase(pointer(text), length(text), s, isWord);
end;

procedure GetCaptionFromPCharLen(P: PUTF8Char; out result: string);
var Temp: array[byte] of AnsiChar;
begin // "out result" parameter definition already made result := ''
  if P=nil then
    exit;
{$ifdef UNICODE}
  // property and enumeration names are UTF-8 encoded with Delphi 2009+
  UTF8DecodeToUnicodeString(Temp,UnCamelCase(@Temp,P),result);
{$else}
  SetString(result,Temp,UnCamelCase(@Temp,P));
{$endif}
{$ifndef LVCL} // LVCL system.pas doesn't implement LoadResStringTranslate()
  if Assigned(LoadResStringTranslate) then
    LoadResStringTranslate(result);
{$endif}
end;

function GetDisplayNameFromClass(C: TClass): RawUTF8;
var DelphiName: PShortString;
    TrimLeft: integer;
begin
  if C=nil then begin
    result := '';
    exit;
  end;
  DelphiName := ClassNameShort(C);
  TrimLeft := 0;
  if DelphiName^[0]>#4 then
    case PInteger(@DelphiName^[1])^ and $DFDFDFDF of
      // fast case-insensitive compare
      ord('T')+ord('S')shl 8+ord('Q')shl 16+ord('L')shl 24:
        if (DelphiName^[0]<=#10) or
         (PInteger(@DelphiName^[5])^ and $DFDFDFDF<> // fast case-insensitive compare
           ord('R')+ord('E')shl 8+ord('C')shl 16+ord('O')shl 24) or
         (PWord(@DelphiName^[9])^ and $DFDF<>ord('R')+ord('D')shl 8) then
        TrimLeft := 4 else
        TrimLeft := 10;
      ord('T')+ord('S')shl 8+ord('Y')shl 16+ord('N')shl 24:
        TrimLeft := 4;
    end;
  if (Trimleft=0) and (DelphiName^[1]='T') then
    Trimleft := 1;
  FastSetString(result,@DelphiName^[TrimLeft+1],ord(DelphiName^[0])-TrimLeft);
end;

function GetPublishedMethods(Instance: TObject; out Methods: TPublishedMethodInfoDynArray;
  aClass: TClass): integer;
  procedure AddParentsFirst(C: TClass);
  type
    TMethodInfo = packed record
      {$ifdef FPC}
      Name: PShortString;
      Addr: Pointer;
      {$else}
      Len: Word;
      Addr: Pointer;
      Name: ShortString;
      {$endif}
    end;
  var Table: {$ifdef FPC}PCardinalArray{$else}PWordArray{$endif};
      M: ^TMethodInfo;
      i: integer;
  begin
    if C=nil then
      exit;
    AddParentsFirst(GetClassParent(C)); // put children published methods afterward
    Table := PPointer(PtrUInt(C)+PtrUInt(vmtMethodTable))^;
    if Table=nil then
      exit;
    SetLength(Methods,result+Table^[0]);
    M := @Table^[1];
    for i := 1 to Table^[0] do  // Table^[0] = methods count
      with Methods[result] do begin
        ShortStringToAnsi7String(M^.Name{$ifdef FPC}^{$endif},Name);
        Method.Data := Instance;
        Method.Code := M^.Addr;
        {$ifdef FPC}
        inc(M);
        {$else}
        inc(PByte(M),M^.Len);
        {$endif}
        inc(result);
      end;
  end;
begin
  result := 0;
  if aClass <> nil then
    AddParentsFirst(aClass)
  else if Instance<>nil then
    AddParentsFirst(PPointer(Instance)^); // use recursion for adding
end;

function GetCaptionFromClass(C: TClass): string;
var tmp: RawUTF8;
    P: PUTF8Char;
begin
  if C=nil then
    result := '' else begin
    ToText(C,tmp);
    P := pointer(tmp);
    if IdemPChar(P,'TSQL') or IdemPChar(P,'TSYN') then
      inc(P,4) else
    if P^='T' then
       inc(P);
    GetCaptionFromPCharLen(P,result);
  end;
end;

function GetCaptionFromEnum(aTypeInfo: pointer; aIndex: integer): string;
begin
  GetCaptionFromTrimmed(GetEnumName(aTypeInfo,aIndex),result);
end;

function CharSetToCodePage(CharSet: integer): cardinal;
begin
  case CharSet of
    SHIFTJIS_CHARSET:   result := 932;
    HANGEUL_CHARSET:    result := 949;
    GB2312_CHARSET:     result := 936;
    HEBREW_CHARSET:     result := 1255;
    ARABIC_CHARSET:     result := 1256;
    GREEK_CHARSET:      result := 1253;
    TURKISH_CHARSET:    result := 1254;
    VIETNAMESE_CHARSET: result := 1258;
    THAI_CHARSET:       result := 874;
    EASTEUROPE_CHARSET: result := 1250;
    RUSSIAN_CHARSET:    result := 1251;
    BALTIC_CHARSET:     result := 1257;
  else result := CODEPAGE_US; // default is ANSI_CHARSET = iso-8859-1 = windows-1252
  end;
end;

function CodePageToCharSet(CodePage: Cardinal): Integer;
begin
  case CodePage of
    932:  result := SHIFTJIS_CHARSET;
    949:  result := HANGEUL_CHARSET;
    936:  result := GB2312_CHARSET;
    1255: result := HEBREW_CHARSET;
    1256: result := ARABIC_CHARSET;
    1253: result := GREEK_CHARSET;
    1254: result := TURKISH_CHARSET;
    1258: result := VIETNAMESE_CHARSET;
    874:  result := THAI_CHARSET;
    1250: result := EASTEUROPE_CHARSET;
    1251: result := RUSSIAN_CHARSET;
    1257: result := BALTIC_CHARSET;
  else result := ANSI_CHARSET; // default is iso-8859-1 = windows-1252
  end;
end;

function GetMimeContentTypeFromBuffer(Content: Pointer; Len: PtrInt;
  const DefaultContentType: RawUTF8): RawUTF8;
begin // see http://www.garykessler.net/library/file_sigs.html for magic numbers
  result := DefaultContentType;
  if (Content<>nil) and (Len>4) then
    case PCardinal(Content)^ of
    $04034B50: result := 'application/zip'; // 50 4B 03 04
    $46445025: result := 'application/pdf'; //  25 50 44 46 2D 31 2E
    $21726152: result := 'application/x-rar-compressed'; // 52 61 72 21 1A 07 00
    $AFBC7A37: result := 'application/x-7z-compressed';  // 37 7A BC AF 27 1C
    $694C5153: result := 'application/x-sqlite3'; // SQlite format 3 = 53 51 4C 69
    $75B22630: result := 'audio/x-ms-wma'; // 30 26 B2 75 8E 66
    $9AC6CDD7: result := 'video/x-ms-wmv'; // D7 CD C6 9A 00 00
    $474E5089: result := 'image/png'; // 89 50 4E 47 0D 0A 1A 0A
    $38464947: result := 'image/gif'; // 47 49 46 38
    $46464F77: result := 'application/font-woff'; // wOFF in BigEndian
    $A3DF451A: result := 'video/webm'; // 1A 45 DF A3 MKV Matroska stream file
    $002A4949, $2A004D4D, $2B004D4D:
      result := 'image/tiff'; // 49 49 2A 00 or 4D 4D 00 2A or 4D 4D 00 2B
    $46464952: if Len>16 then // RIFF
      case PCardinalArray(Content)^[2] of
      $50424557: result := 'image/webp';
      $20495641: if PCardinalArray(Content)^[3]=$5453494C then
        result := 'video/x-msvideo'; // Windows Audio Video Interleave file
      end;
    $E011CFD0: // Microsoft Office applications D0 CF 11 E0=DOCFILE
      if Len>600 then
      case PWordArray(Content)^[256] of // at offset 512
        $A5EC: result := 'application/msword'; // EC A5 C1 00
        $FFFD: // FD FF FF
          case PByteArray(Content)^[516] of
            $0E,$1C,$43: result := 'application/vnd.ms-powerpoint';
            $10,$1F,$20,$22,$23,$28,$29: result := 'application/vnd.ms-excel';
          end;
      end;
    $5367674F:
      if Len>14 then // OggS
        if (PCardinalArray(Content)^[1]=$00000200) and
           (PCardinalArray(Content)^[2]=$00000000) and
           (PWordArray(Content)^[6]=$0000) then
          result := 'video/ogg';
    $1C000000:
      if Len>12 then
        if PCardinalArray(Content)^[1]=$70797466 then  // ftyp
          case PCardinalArray(Content)^[2] of
            $6D6F7369, // isom: ISO Base Media file (MPEG-4) v1
            $3234706D: // mp42: MPEG-4 video/QuickTime file
              result := 'video/mp4';
            $35706733: // 3gp5: MPEG-4 video files
              result := 'video/3gpp';
          end;
    else
      case PCardinal(Content)^ and $00ffffff of
        $685A42: result := 'application/bzip2'; // 42 5A 68
        $088B1F: result := 'application/gzip'; // 1F 8B 08
        $492049: result := 'image/tiff'; // 49 20 49
        $FFD8FF: result := JPEG_CONTENT_TYPE; // FF D8 FF DB/E0/E1/E2/E3/E8
        else
          case PWord(Content)^ of
            $4D42: result := 'image/bmp'; // 42 4D
          end;
      end;
    end;
end;

function GetMimeContentType(Content: Pointer; Len: PtrInt;
  const FileName: TFileName): RawUTF8;
begin
  if FileName<>'' then begin // file extension is more precise -> check first
    result := LowerCase(StringToAnsi7(ExtractFileExt(FileName)));
    case PosEx(copy(result,2,4),
      'png,gif,tiff,jpg,jpeg,bmp,doc,htm,html,css,js,ico,wof,txt,svg,'+
     // 1   5   9    14  18   23  27  31  35   40  44 47  51  55  59
      'atom,rdf,rss,webp,appc,mani,docx,xml,json,woff,ogg,ogv,mp4,m2v,'+
     // 63  68  72  76   81   86   91   96  100  105  110 114 118 122
      'm2p,mp3,h264,text,log,gz,webm,mkv,rar,7z') of
     // 126 130 134 139  144 148 151 156 160 164
      1:           result := 'image/png';
      5:           result := 'image/gif';
      9:           result := 'image/tiff';
      14,18:       result := JPEG_CONTENT_TYPE;
      23:          result := 'image/bmp';
      27,91:       result := 'application/msword';
      31,35:       result := HTML_CONTENT_TYPE;
      40:          result := 'text/css';
      44:          result := 'application/javascript';
      // text/javascript and application/x-javascript are obsolete (RFC 4329)
      47:          result := 'image/x-icon';
      51,105:      result := 'application/font-woff';
      55,139,144:  result := TEXT_CONTENT_TYPE;
      59:          result := 'image/svg+xml';
      63,68,72,96: result := XML_CONTENT_TYPE;
      76:          result := 'image/webp';
      81,86:       result := 'text/cache-manifest';
      100:         result := JSON_CONTENT_TYPE_VAR;
      110,114:     result := 'video/ogg';  // RFC 5334
      118:         result := 'video/mp4';  // RFC 4337 6381
      122,126:     result := 'video/mp2';
      130:         result := 'audio/mpeg'; // RFC 3003
      134:         result := 'video/H264'; // RFC 6184
      148:         result := 'application/gzip';
      151,156:     result := 'video/webm';
      160:         result := 'application/x-rar-compressed';
      164:         result := 'application/x-7z-compressed';
      else
        result := GetMimeContentTypeFromBuffer(Content,Len,'application/'+copy(result,2,20));
    end;
  end else
    result := GetMimeContentTypeFromBuffer(Content,Len,BINARY_CONTENT_TYPE);
end;

function GetMimeContentTypeHeader(const Content: RawByteString;
  const FileName: TFileName): RawUTF8;
begin
  result := HEADER_CONTENT_TYPE+
    GetMimeContentType(Pointer(Content),length(Content),FileName);
end;

function IsContentCompressed(Content: Pointer; Len: PtrInt): boolean;
begin // see http://www.garykessler.net/library/file_sigs.html
  result := false;
  if (Content<>nil) and (Len>8) then
    case PCardinal(Content)^ of
    $002a4949, $2a004d4d, $2b004d4d, // 'image/tiff'
    $04034b50, // 'application/zip' = 50 4B 03 04
    $184d2204, // LZ4 stream format = 04 22 4D 18
    $21726152, // 'application/x-rar-compressed' = 52 61 72 21 1A 07 00
    $28635349, // cab = 49 53 63 28
    $38464947, // 'image/gif' = 47 49 46 38
    $43614c66, // FLAC = 66 4C 61 43 00 00 00 22
    $4643534d, // cab = 4D 53 43 46 [MSCF]
    $46464952, // avi,webp,wav = 52 49 46 46 [RIFF]
    $46464f77, // 'application/font-woff' = wOFF in BigEndian
    $474e5089, // 'image/png' = 89 50 4E 47 0D 0A 1A 0A
    $4d5a4cff, // LZMA = FF 4C 5A 4D 41 00
    $72613c21, // .ar/.deb files = '!<arch>' (assuming compressed)
    $75b22630, // 'audio/x-ms-wma' = 30 26 B2 75 8E 66
    $766f6f6d, // mov = 6D 6F 6F 76 [....moov]
    $89a8275f, // jar = 5F 27 A8 89
    $9ac6cdd7, // 'video/x-ms-wmv' = D7 CD C6 9A 00 00
    $a5a5a5a5, // .mab file = MAGIC_MAB in SynLog.pas
    $a5aba5a5, // .data = TSQLRESTSTORAGEINMEMORY_MAGIC in mORMot.pas
    $aba51051, // .log.synlz = LOG_MAGIC in SynLog.pas
    $aba5a5ab, // .dbsynlz = SQLITE3_MAGIC in SynSQLite3.pas
    $afbc7a37, // 'application/x-7z-compressed' = 37 7A BC AF 27 1C
    $b7010000, $ba010000, // mpeg = 00 00 01 Bx
    $cececece, // jceks = CE CE CE CE
    $dbeeabed, // .rpm package file
    $e011cfd0: // msi = D0 CF 11 E0 A1 B1 1A E1
      result := true;
    else
      case PCardinal(Content)^ and $00ffffff of
        $088b1f, // 'application/gzip' = 1F 8B 08
        $334449, // mp3 = 49 44 33 [ID3]
        $492049, // 'image/tiff' = 49 20 49
        $535746, // swf = 46 57 53 [FWS]
        $535743, // swf = 43 57 53 [zlib]
        $53575a, // zws/swf = 5A 57 53 [FWS]
        $564c46, // flv = 46 4C 56 [FLV]
        $685a42, // 'application/bzip2' = 42 5A 68
        $ffd8ff: // JPEG_CONTENT_TYPE = FF D8 FF DB/E0/E1/E2/E3/E8
          result := true;
        else
        case PCardinalArray(Content)^[1] of // 4 byte offset
        1{TAlgoSynLZ.AlgoID}: // crc32 01 00 00 00 crc32 = Compress() header
          result := PCardinalArray(Content)^[0]<>PCardinalArray(Content)^[2];
        $70797466, // mp4,mov = 66 74 79 70 [33 67 70 35/4D 53 4E 56..]
        $766f6f6d: // mov = 6D 6F 6F 76
          result := true;
        end;
      end;
    end;
end;

function GetJpegSize(jpeg: PAnsiChar; len: PtrInt; out Height, Width: integer): boolean;
var je: PAnsiChar;
begin // see https://en.wikipedia.org/wiki/JPEG#Syntax_and_structure
  result := false;
  if (jpeg=nil) or (len<100) or (PWord(jpeg)^<>$d8ff) then // SOI
    exit;
  je := jpeg+len-1;
  inc(jpeg,2);
  while jpeg<je do begin
    if jpeg^<>#$ff then
      exit;
    inc(jpeg);
    case ord(jpeg^) of
      $c0..$c3,$c5..$c7,$c9..$cb,$cd..$cf: begin // SOF
        Height := swap(PWord(jpeg+4)^);
        Width  := swap(PWord(jpeg+6)^);
        result := (Height>0) and (Height<20000) and (Width>0) and (Width<20000);
        exit;
      end;
      $d0..$d8,$01: inc(jpeg); // RST, SOI
      $d9: break;   // EOI
      $ff: ;        // padding
      else inc(jpeg,swap(PWord(jpeg+1)^)+1);
    end;
  end;
end;

function GetJpegSize(const jpeg: TFileName; out Height, Width: integer): boolean;
var map: TMemoryMap;
begin
  if map.Map(jpeg) then
    try
      result := GetJpegSize(map.Buffer,map.Size,Height,Width);
    finally
      map.UnMap;
    end else
    result := false;
end;

function IsHTMLContentTypeTextual(Headers: PUTF8Char): Boolean;
begin
  result := ExistsIniNameValue(Headers,HEADER_CONTENT_TYPE_UPPER,
    [JSON_CONTENT_TYPE_UPPER,'TEXT/','APPLICATION/XML','APPLICATION/JAVASCRIPT',
     'APPLICATION/X-JAVASCRIPT','IMAGE/SVG+XML']);
end;

function MultiPartFormDataDecode(const MimeType,Body: RawUTF8;
  var MultiPart: TMultiPartDynArray): boolean;
var boundary,endBoundary: RawUTF8;
    i,j: integer;
    P: PUTF8Char;
    part: TMultiPart;
begin
  result := false;
  i := PosEx('boundary=',MimeType);
  if i=0 then
    exit;
  TrimCopy(MimeType,i+9,200,boundary);
  if (boundary<>'') and (boundary[1]='"') then
    boundary := copy(boundary,2,length(boundary)-2); // "boundary" -> boundary
  boundary := '--'+boundary;
  endBoundary := boundary+'--'+#13#10;
  boundary := boundary+#13#10;
  i := PosEx(boundary,Body);
  if i<>0 then
  repeat
    inc(i,length(boundary));
    if i=length(body) then
      exit; // reached the end
    P := PUTF8Char(Pointer(Body))+i-1;
    Finalize(part);
    repeat
      if IdemPChar(P,'CONTENT-DISPOSITION: ') then begin
        inc(P,21);
        if IdemPCharAndGetNextItem(P,'FORM-DATA; NAME="',part.Name,'"') then
          IdemPCharAndGetNextItem(P,'; FILENAME="',part.FileName,'"') else
          IdemPCharAndGetNextItem(P,'FILE; FILENAME="',part.FileName,'"')
      end else
      if not IdemPCharAndGetNextItem(P,'CONTENT-TYPE: ',part.ContentType) then
         IdemPCharAndGetNextItem(P,'CONTENT-TRANSFER-ENCODING: ',part.Encoding);
      P := GotoNextLine(P);
      if P=nil then
        exit;
    until PWord(P)^=13+10 shl 8;
    i := P-PUTF8Char(Pointer(Body))+3; // i = just after header
    j := PosEx(boundary,Body,i);
    if j=0 then begin
     j := PosEx(endboundary,Body,i); // try last boundary
     if j=0 then
      exit;
    end;
    part.Content := copy(Body,i,j-i-2); // -2 to ignore latest #13#10
    if (part.ContentType='') or (PosEx('-8',part.ContentType)>0) then begin
      part.ContentType := TEXT_CONTENT_TYPE;
      {$ifdef HASCODEPAGE}
      SetCodePage(part.Content,CP_UTF8,false); // ensure raw field value is UTF-8
      {$endif}
    end;
    if IdemPropNameU(part.Encoding,'base64') then
      part.Content := Base64ToBin(part.Content);
    // note: "quoted-printable" not yet handled here
    SetLength(MultiPart,length(MultiPart)+1);
    MultiPart[high(MultiPart)] := part;
    result := true;
    i := j;
  until false;
end;

function MultiPartFormDataEncode(const MultiPart: TMultiPartDynArray;
  var MultiPartContentType, MultiPartContent: RawUTF8): boolean;
var len, boundcount, filescount, i: integer;
    boundaries: array of RawUTF8;
    bound: RawUTF8;
    W: TTextWriter;
    temp: TTextWriterStackBuffer;
  procedure NewBound;
  var random: array[1..3] of cardinal;
  begin
    FillRandom(@random,3,{forcegsl=}true);
    bound := BinToBase64(@random,SizeOf(Random));
    SetLength(boundaries,boundcount+1);
    boundaries[boundcount] := bound;
    inc(boundcount);
  end;
begin
  result := false;
  len := length(MultiPart);
  if len=0 then
    exit;
  boundcount := 0;
  filescount := 0;
  W := TTextWriter.CreateOwnedStream(temp);
  try
    // header - see https://www.w3.org/Protocols/rfc1341/7_2_Multipart.html
    NewBound;
    MultiPartContentType := 'Content-Type: multipart/form-data; boundary='+bound;
    for i := 0 to len-1 do
    with MultiPart[i] do begin
      if FileName='' then
        W.Add('--%'#13#10'Content-Disposition: form-data; name="%"'#13#10+
          'Content-Type: %'#13#10#13#10'%'#13#10'--%'#13#10,
          [bound,Name,ContentType,Content,bound]) else begin
        // if this is the first file, create the header for files
        if filescount=0 then begin
          if i>0 then
            NewBound;
          W.Add('Content-Disposition: form-data; name="files"'#13#10+
            'Content-Type: multipart/mixed; boundary=%'#13#10#13#10,[bound]);
        end;
        inc(filescount);
        W.Add('--%'#13#10'Content-Disposition: file; filename="%"'#13#10+
          'Content-Type: %'#13#10,[bound,FileName,ContentType]);
        if Encoding<>'' then
          W.Add('Content-Transfer-Encoding: %'#13#10,[Encoding]);
        W.AddCR;
        W.AddString(MultiPart[i].Content);
        W.Add(#13#10'--%'#13#10,[bound]);
      end;
    end;
    // footer multipart
    for i := boundcount-1 downto 0 do
      W.Add('--%--'#13#10, [boundaries[i]]);
    W.SetText(MultiPartContent);
    result := True;
  finally
    W.Free;
  end;
end;

function MultiPartFormDataAddFile(const FileName: TFileName;
  var MultiPart: TMultiPartDynArray; const Name: RawUTF8): boolean;
var part: TMultiPart;
    newlen: integer;
    content: RawByteString;
begin
  result := false;
  content := StringFromFile(FileName);
  if content='' then
    exit;
  newlen := length(MultiPart)+1;
  if Name='' then
    FormatUTF8('File%',[newlen],part.Name) else
    part.Name := Name;
  part.FileName := StringToUTF8(ExtractFileName(FileName));
  part.ContentType := GetMimeContentType(pointer(content),length(content),FileName);
  part.Encoding := 'base64';
  part.Content := BinToBase64(content);
  SetLength(MultiPart,newlen);
  MultiPart[newlen-1] := part;
  result := true;
end;

function MultiPartFormDataAddField(const FieldName, FieldValue: RawUTF8;
  var MultiPart: TMultiPartDynArray): boolean;
var
  part: TMultiPart;
  newlen: integer;
begin
  result := false;
  if FieldName='' then
    exit;
  newlen := length(MultiPart)+1;
  part.Name := FieldName;
  part.ContentType := GetMimeContentTypeFromBuffer(
    pointer(FieldValue),length(FieldValue),'text/plain');
  part.Content := FieldValue;
  SetLength(MultiPart,newlen);
  MultiPart[newlen-1] := part;
  result := true;
end;

function FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt;
begin
  result := FastLocatePUTF8CharSorted(P,R,Value,TUTF8Compare(@StrComp));
end;

function FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char;
  Compare: TUTF8Compare): PtrInt;
var L,i,cmp: PtrInt;
begin // fast O(log(n)) binary search
  if not Assigned(Compare) or (R<0) then
    result := 0 else
    if Compare(P^[R],Value)<0 then // quick return if already sorted
      result := R+1 else begin
      L := 0;
      result := -1; // return -1 if found
      repeat
        i := (L + R) shr 1;
        cmp := Compare(P^[i],Value);
        if cmp=0 then
          exit;
        if cmp<0 then
          L := i + 1 else
          R := i - 1;
      until (L > R);
      while (i>=0) and (Compare(P^[i],Value)>=0) do dec(i);
      result := i+1; // return the index where to insert
    end;
end;

function FastFindPUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char;
  Compare: TUTF8Compare): PtrInt;
var L, cmp: PtrInt;
begin // fast O(log(n)) binary search
  L := 0;
  if Assigned(Compare) and (R>=0) then
    repeat
      result := (L+R) shr 1;
      cmp := Compare(P^[result],Value);
      if cmp=0 then
        exit;
      if cmp<0 then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      R := result-1;
      if L<=R  then
        continue;
      break;
    until false;
  result := -1;
end;

function FastFindPUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt;
{$ifdef CPUX64} // P=rcx/rdi R=rdx/rsi Value=r8/rdx
{$ifdef FPC} assembler; nostackframe; asm {$else} asm .noframe {$endif}
        {$ifdef win64}
        push    rdi
        mov     rdi, P  // P=rdi
        {$endif}
        push    r12
        push    r13
        xor     r9, r9  // L=r9
        test    R, R
        jl      @err
        test    Value, Value
        jz      @void
        mov     cl, byte ptr[Value]  // to check first char (likely diverse)
@s:     lea     rax, qword ptr[r9 + R]
        shr     rax, 1
        lea     r12, qword ptr[rax - 1]  // branchless main loop
        lea     r13, qword ptr[rax + 1]
        mov     r10, qword ptr[rdi + rax * 8]
        test    r10, r10
        jz      @lt
        cmp     cl, byte ptr[r10]
        je      @eq
        cmovc   R, r12
        cmovnc  r9, r13
@nxt:   cmp     r9, R
        jle     @s
@err:   or      rax, -1
@found: pop     r13
        pop     r12
        {$ifdef win64}
        pop     rdi
        {$endif}
        ret
@lt:    mov     r9, r13 // very unlikely P[rax]=nil
        jmp     @nxt
@eq:    mov     r11, Value
@sub:   mov     cl, byte ptr[r10]
        inc     r10
        inc     r11
        test    cl, cl
        jz      @found
        mov     cl, byte ptr[r11]
        cmp     cl, byte ptr[r10]
        je      @sub
        mov     cl, byte ptr[Value]  // reset first char
        cmovc   R, r12
        cmovnc  r9, r13
        cmp     r9, R
        jle     @s
        jmp     @err
@void:  or      rax, -1
        cmp     qword ptr[P], 0
        cmove   rax, Value
        jmp     @found
end;
{$else}
var L: PtrInt;
    c: byte;
    piv,val: PByte;
begin // fast O(log(n)) binary search using inlined StrCompFast()
  if R>=0 then
    if Value<>nil then begin
      L := 0;
      repeat
        result := (L+R) shr 1;
        piv := pointer(P^[result]);
        if piv<>nil then begin
          val := pointer(Value);
          c := piv^;
          if c=val^ then
            repeat
              if c=0 then
                exit;  // StrComp(P^[result],Value)=0
              inc(piv);
              inc(val);
              c := piv^;
            until c<>val^;
          if c>val^ then begin
            R := result-1;  // StrComp(P^[result],Value)>0
            if L<=R then
              continue;
            break;
          end;
        end;
        L := result+1;  // StrComp(P^[result],Value)<0
        if L<=R then
          continue;
        break;
      until false;
    end else
    if P^[0]=nil then begin // '' should be in lowest P[] slot
      result := 0;
      exit;
    end;
  result := -1;
end;
{$endif CPUX64}

function FastFindUpperPUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt;
  Value: PUTF8Char; ValueLen: PtrInt): PtrInt;
var tmp: array[byte] of AnsiChar;
begin
  UpperCopy255Buf(@tmp,Value,ValueLen);
  result := FastFindPUTF8CharSorted(P,R,@tmp);
end;

function FastFindIndexedPUTF8Char(P: PPUTF8CharArray; R: PtrInt;
  var SortedIndexes: TCardinalDynArray; Value: PUTF8Char;
  ItemComp: TUTF8Compare): PtrInt;
var L, cmp: PtrInt;
begin // fast O(log(n)) binary search
  L := 0;
  if 0<=R then
    repeat
      result := (L + R) shr 1;
      cmp := ItemComp(P^[SortedIndexes[result]],Value);
      if cmp=0 then begin
        result := SortedIndexes[result];
        exit;
      end;
      if cmp<0 then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      R := result-1;
      if L<=R  then
        continue;
      break;
    until false;
  result := -1;
end;

function AddSortedRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  const Value: RawUTF8; CoValues: PIntegerDynArray; ForcedIndex: PtrInt;
  Compare: TUTF8Compare): PtrInt;
var n: PtrInt;
begin
  if ForcedIndex>=0 then
    result := ForcedIndex else begin
    if not Assigned(Compare) then
      Compare := @StrComp;
    result := FastLocatePUTF8CharSorted(pointer(Values),ValuesCount-1,pointer(Value),Compare);
    if result<0 then
      exit; // Value exists -> fails
  end;
  n := Length(Values);
  if ValuesCount=n then begin
    n := NextGrow(n);
    SetLength(Values,n);
    if CoValues<>nil then
      SetLength(CoValues^,n);
  end;
  n := ValuesCount;
  if result<n then begin
    n := (n-result)*SizeOf(pointer);
    MoveFast(Pointer(Values[result]),Pointer(Values[result+1]),n);
    PtrInt(Values[result]) := 0; // avoid GPF
    if CoValues<>nil then begin
      {$ifdef CPU64}n := n shr 1;{$endif} // 64-bit pointer size is twice an integer
      MoveFast(CoValues^[result],CoValues^[result+1],n);
    end;
  end else
    result := n;
  Values[result] := Value;
  inc(ValuesCount);
end;


type
  /// used internaly for faster quick sort
  TQuickSortRawUTF8 = object
    Values: PPointerArray;
    Compare: TUTF8Compare;
    CoValues: PIntegerArray;
    pivot: pointer;
    procedure Sort(L,R: PtrInt);
  end;

procedure TQuickSortRawUTF8.Sort(L, R: PtrInt);
var I, J, P: PtrInt;
    Tmp: Pointer;
    TmpInt: integer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := Values^[P];
      while Compare(Values^[I],pivot)<0 do Inc(I);
      while Compare(Values^[J],pivot)>0 do Dec(J);
      if I <= J then begin
        Tmp := Values^[J];
        Values^[J] := Values^[I];
        Values^[I] := Tmp;
        if CoValues<>nil then begin
          TmpInt := CoValues^[J];
          CoValues^[J] := CoValues^[I];
          CoValues^[I] := TmpInt;
        end;
        if P = I then P := J else if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        Sort(L, J);
      L := I;
    end else begin
      if I < R then
        Sort(I, R);
      R := J;
    end; 
  until L >= R;
end;

procedure QuickSortRawUTF8(var Values: TRawUTF8DynArray; ValuesCount: integer;
  CoValues: PIntegerDynArray; Compare: TUTF8Compare);
var QS: TQuickSortRawUTF8;
begin
  QS.Values := pointer(Values);
  if Assigned(Compare) then
    QS.Compare := Compare else
    QS.Compare := @StrComp;
  if CoValues=nil then
    QS.CoValues := nil else
    QS.CoValues := pointer(CoValues^);
  QS.Sort(0,ValuesCount-1);
end;

function DeleteRawUTF8(var Values: TRawUTF8DynArray; Index: integer): boolean;
var n: integer;
begin
  n := length(Values);
  if cardinal(Index)>=cardinal(n) then
    result := false else begin
    dec(n);
    if PRefCnt(PtrUInt(Values)-_DAREFCNT)^>1 then
      DynArrayMakeUnique(@Values,TypeInfo(TRawUTF8DynArray));
    Values[Index] := ''; // avoid GPF
    if n>Index then begin
      MoveFast(pointer(Values[Index+1]),pointer(Values[Index]),(n-Index)*SizeOf(pointer));
      PtrUInt(Values[n]) := 0; // avoid GPF
    end;
    SetLength(Values,n);
    result := true;
  end;
end;

function DeleteRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  Index: integer; CoValues: PIntegerDynArray): boolean;
var n: integer;
begin
  n := ValuesCount;
  if cardinal(Index)>=cardinal(n) then
    result := false else begin
    dec(n);
    ValuesCount := n;
    if PRefCnt(PtrUInt(Values)-_DAREFCNT)^>1 then
      DynArrayMakeUnique(@Values,TypeInfo(TRawUTF8DynArray));
    Values[Index] := ''; // avoid GPF
    dec(n,Index);
    if n>0 then begin
      if CoValues<>nil then
        MoveFast(CoValues^[Index+1],CoValues^[Index],n*SizeOf(Integer));
      MoveFast(pointer(Values[Index+1]),pointer(Values[Index]),n*SizeOf(pointer));
      PtrUInt(Values[ValuesCount]) := 0; // avoid GPF
    end;
    result := true;
  end;
end;

function ToText(const aIntelCPUFeatures: TIntelCpuFeatures; const Sep: RawUTF8): RawUTF8;
var f: TIntelCpuFeature;
    List: PShortString;
    MaxValue: integer;
begin
  result := '';
  List := GetEnumInfo(TypeInfo(TIntelCpuFeature),MaxValue);
  if List<>nil then
    for f := low(f) to high(f) do begin
      if (f in aIntelCPUFeatures) and (List^[3]<>'_') then begin
        if result<>'' then
          result := result+Sep;
        result := result+RawUTF8(copy(List^,3,10));
      end;
      inc(PByte(List),PByte(List)^+1); // next
    end;
end;

{$ifdef MSWINDOWS}

// wrapper around some low-level Windows-specific API

{$ifdef DELPHI6OROLDER}
function GetFileVersion(const FileName: TFileName): cardinal;
var Size, Size2: DWord;
    Pt: Pointer;
    Info: ^TVSFixedFileInfo;
    tmp: TFileName;
begin
  result := cardinal(-1);
  if FileName='' then
    exit;
  // GetFileVersionInfo modifies the filename parameter data while parsing
  // Copy the string const into a local variable to create a writeable copy
  SetString(tmp,PChar(FileName),length(FileName));
  Size := GetFileVersionInfoSize(pointer(tmp), Size2);
  if Size>0 then begin
    GetMem(Pt, Size);
    try
      GetFileVersionInfo(pointer(FileName), 0, Size, Pt);
      if VerQueryValue(Pt, '\', pointer(Info), Size2) then
        result := Info^.dwFileVersionMS;
    finally
      Freemem(Pt);
    end;
  end;
end;
{$endif DELPHI6OROLDER}

function WndProcMethod(Hwnd: HWND; Msg,wParam,lParam: integer): integer; stdcall;
var obj: TObject;
    dsp: TMessage;
begin
  {$ifdef CPU64}
  obj := pointer(GetWindowLongPtr(HWnd,GWLP_USERDATA));
  {$else}
  obj := pointer(GetWindowLong(HWnd,GWL_USERDATA)); // faster than GetProp()
  {$endif CPU64}
  if not Assigned(obj) then
    result := DefWindowProc(HWnd,Msg,wParam,lParam) else begin
    dsp.msg := Msg;
    dsp.wParam := WParam;
    dsp.lParam := lParam;
    dsp.result := 0;
    obj.Dispatch(dsp);
    result := dsp.result;
  end;
end;

function CreateInternalWindow(const aWindowName: string; aObject: TObject): HWND;
var TempClass: TWndClass;
begin
  result := 0;
  if GetClassInfo(HInstance, pointer(aWindowName), TempClass) then
    exit; // class name already registered -> fail
  FillCharFast(TempClass,SizeOf(TempClass),0);
  TempClass.hInstance := HInstance;
  TempClass.lpfnWndProc := @DefWindowProc;
  TempClass.lpszClassName :=  pointer(aWindowName);
  Windows.RegisterClass(TempClass);
  result := CreateWindowEx(WS_EX_TOOLWINDOW, pointer(aWindowName),
    '', WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
  if result=0 then
    exit; // impossible to create window -> fail
  {$ifdef CPU64}
  SetWindowLongPtr(result,GWLP_USERDATA,PtrInt(aObject));
  SetWindowLongPtr(result,GWLP_WNDPROC,PtrInt(@WndProcMethod));
  {$else}
  SetWindowLong(result,GWL_USERDATA,PtrInt(aObject)); // faster than SetProp()
  SetWindowLong(result,GWL_WNDPROC,PtrInt(@WndProcMethod));
  {$endif CPU64}
end;

function ReleaseInternalWindow(var aWindowName: string; var aWindow: HWND): boolean;
begin
  if (aWindow<>0) and (aWindowName<>'') then begin
    {$ifdef CPU64}
    SetWindowLongPtr(aWindow,GWLP_WNDPROC,PtrInt(@DefWindowProc));
    {$else}
    SetWindowLong(aWindow,GWL_WNDPROC,PtrInt(@DefWindowProc));
    {$endif CPU64}
    DestroyWindow(aWindow);
    Windows.UnregisterClass(pointer(aWindowName),HInstance);
    aWindow := 0;
    aWindowName := '';
    result := true;
  end else
    result := false;
end;

var
  LastAppUserModelID: string;

function SetAppUserModelID(const AppUserModelID: string): boolean;
var shell32: THandle;
    id: SynUnicode;
    SetCurrentProcessExplicitAppUserModelID: function(appID: PWidechar): HResult; stdcall;
begin
  if AppUserModelID=LastAppUserModelID then begin
    result := true;
    exit; // nothing to set
  end;
  result := false;
  shell32 := GetModuleHandle('shell32.dll');
  if shell32=0 then
    exit;
  SetCurrentProcessExplicitAppUserModelID := GetProcAddress(
    shell32,'SetCurrentProcessExplicitAppUserModelID');
  if not Assigned(SetCurrentProcessExplicitAppUserModelID) then
    exit; // API available since Windows Seven / Server 2008 R2
  StringToSynUnicode(AppUserModelID,id);
  if Pos('.',AppUserModelID)=0 then
    id := id+'.'+id; // at least CompanyName.ProductName
  if SetCurrentProcessExplicitAppUserModelID(pointer(id))<>S_OK then
    exit;
  result := true;
  LastAppUserModelID := AppUserModelID;
end;

{$endif MSWINDOWS}

{ TFileVersion }

constructor TFileVersion.Create(const aFileName: TFileName;
  aMajor,aMinor,aRelease,aBuild: integer);
var M,D: word;
{$ifdef MSWINDOWS}
    Size, Size2: DWord;
    Pt, StrPt, StrValPt: Pointer;
    LanguageInfo: RawUTF8;
    Info: ^TVSFixedFileInfo;
    FileTime: TFILETIME;
    SystemTime: TSYSTEMTIME;
    tmp: TFileName;
    function ReadResourceByName(const From: RawUTF8): RawUTF8;
    var sz: DWord;
    begin
      VerQueryValueA(Pt,PAnsiChar('\StringFileInfo\'+LanguageInfo+'\'+From),StrValPt,sz);
      if sz>0 then
        FastSetString(Result,StrValPt,sz)
    end;
{$else}
{$ifdef FPCUSEVERSIONINFO}
  VI: TVersionInfo;
  LanguageInfo: String;
  TI, I: Integer;
{$endif}
{$endif MSWINDOWS}
begin
  fFileName := aFileName;
  {$ifdef MSWINDOWS}
  if aFileName<>'' then begin
    // GetFileVersionInfo modifies the filename parameter data while parsing.
    // Copy the string const into a local variable to create a writeable copy.
    SetString(tmp,PChar(aFileName),length(aFileName));
    Size := GetFileVersionInfoSize(pointer(tmp), Size2);
    if Size>0 then begin
      GetMem(Pt, Size);
      try
        GetFileVersionInfo(pointer(aFileName), 0, Size, Pt);
        VerQueryValue(Pt, '\', pointer(Info), Size2);
        with Info^ do begin
          if Version32=0 then begin
            aMajor := dwFileVersionMS shr 16;
            aMinor := word(dwFileVersionMS);
            aRelease := dwFileVersionLS shr 16;
          end;
          aBuild := word(dwFileVersionLS);
          if (dwFileDateLS<>0) and (dwFileDateMS<>0) then begin
            FileTime.dwLowDateTime:= dwFileDateLS; // built date from version info
            FileTime.dwHighDateTime:= dwFileDateMS;
            FileTimeToSystemTime(FileTime, SystemTime);
            fBuildDateTime := EncodeDate(
              SystemTime.wYear,SystemTime.wMonth,SystemTime.wDay);
          end;
        end;
        VerQueryValue(Pt, '\VarFileInfo\Translation', StrPt, Size2);
        if Size2 >= 4 then begin
          LanguageInfo := BinToHexDisplay(PAnsiChar(StrPt), 2) + BinToHexDisplay(PAnsiChar(StrPt)+2, 2);
          CompanyName := ReadResourceByName('CompanyName');
          FileDescription := ReadResourceByName('FileDescription');
          FileVersion := ReadResourceByName('FileVersion');
          InternalName := ReadResourceByName('InternalName');
          LegalCopyright := ReadResourceByName('LegalCopyright');
          OriginalFilename := ReadResourceByName('OriginalFilename');
          ProductName := ReadResourceByName('ProductName');
          ProductVersion := ReadResourceByName('ProductVersion');
          Comments := ReadResourceByName('Comments');
        end
      finally
        Freemem(Pt);
      end;
    end;
  end;
  {$else MSWINDOWS}
  {$ifdef FPCUSEVERSIONINFO} // FPC 3.0+ if enabled in Synopse.inc / project options
  if aFileName<>'' then
  try
    VI := TVersionInfo.Create;
    try
      if (aFileName<>ExeVersion.ProgramFileName) and (aFileName<>ParamStr(0)) then
        VI.Load(aFileName) else
        VI.Load(HInstance); // load info for currently running program
      aMajor := VI.FixedInfo.FileVersion[0];
      aMinor := VI.FixedInfo.FileVersion[1];
      aRelease := VI.FixedInfo.FileVersion[2];
      aBuild := VI.FixedInfo.FileVersion[3];
      //fBuildDateTime := TDateTime(VI.FixedInfo.FileDate); << need to find out how to convert this before uncommenting
      // detect translation.
      if VI.VarFileInfo.Count>0 then
        with VI.VarFileInfo.Items[0] do
          LanguageInfo := Format('%.4x%.4x',[language,codepage]);
      if LanguageInfo='' then begin
        // take first language
        Ti := 0;
        if VI.StringFileInfo.Count>0 then
          LanguageInfo := VI.StringFileInfo.Items[0].Name
      end else begin
        // look for index of language
        TI := VI.StringFileInfo.Count-1;
        while (TI>=0) and (CompareText(VI.StringFileInfo.Items[TI].Name,LanguageInfo)<>0) do
          dec(TI);
        if (TI < 0) then begin
          TI := 0; // revert to first translation
          LanguageInfo := VI.StringFileInfo.Items[TI].Name;
        end;
      end;
      with VI.StringFileInfo.Items[TI] do begin
        CompanyName := Values['CompanyName'];
        FileDescription := Values['FileDescription'];
        FileVersion := Values['FileVersion'];
        InternalName := Values['InternalName'];
        LegalCopyright := Values['LegalCopyright'];
        OriginalFilename := Values['OriginalFilename'];
        ProductName := Values['ProductName'];
        ProductVersion := Values['ProductVersion'];
        Comments := Values['Comments'];
      end;
    finally
      VI.Free;
    end;
  except
    // just ignore if version information resource is missing
  end;
  {$endif FPCUSEVERSIONINFO}
  {$endif MSWINDOWS}
  SetVersion(aMajor,aMinor,aRelease,aBuild);
  if fBuildDateTime=0 then  // get build date from file age
    fBuildDateTime := FileAgeToDateTime(aFileName);
  if fBuildDateTime<>0 then
    DecodeDate(fBuildDateTime,BuildYear,M,D);
end;

function TFileVersion.Version32: integer;
begin
  result := Major shl 16+Minor shl 8+Release;
end;

procedure TFileVersion.SetVersion(aMajor,aMinor,aRelease,aBuild: integer);
begin
  Major := aMajor;
  Minor := aMinor;
  Release := aRelease;
  Build := aBuild;
  Main := IntToString(Major)+'.'+IntToString(Minor);
  fDetailed := Main+ '.'+IntToString(Release)+'.'+IntToString(Build);
end;

function TFileVersion.BuildDateTimeString: string;
begin
  DateTimeToIso8601StringVar(fBuildDateTime,' ',result);
end;

function TFileVersion.DetailedOrVoid: string;
begin
  if (self=nil) or (Major or Minor or Release or Build=0) then
    result := '' else
    result := fDetailed;
end;

function TFileVersion.VersionInfo: RawUTF8;
begin
  FormatUTF8('% % (%)',[ExtractFileName(fFileName),DetailedOrVoid,BuildDateTimeString],result);
end;

function TFileVersion.UserAgent: RawUTF8;
begin
  if self=nil then
    result := '' else
    FormatUTF8('%/%%',[GetFileNameWithoutExt(ExtractFileName(fFileName)),
      DetailedOrVoid,OS_INITIAL[OS_KIND]],result);
  {$ifdef MSWINDOWS}
  if OSVersion in WINDOWS_32 then
    result := result+'32';
  {$endif MSWINDOWS}
end;

class function TFileVersion.GetVersionInfo(const aFileName: TFileName): RawUTF8;
begin
  with Create(aFileName,0,0,0,0) do
  try
    result := VersionInfo;
  finally
    Free;
  end;
end;

procedure SetExecutableVersion(const aVersionText: RawUTF8);
var P: PUTF8Char;
    i: integer;
    ver: array[0..3] of integer;
begin
  P := pointer(aVersionText);
  for i := 0 to 3 do
    ver[i] := GetNextItemCardinal(P,'.');
  SetExecutableVersion(ver[0],ver[1],ver[2],ver[3]);
end;

procedure SetExecutableVersion(aMajor,aMinor,aRelease,aBuild: integer);
var {$ifdef MSWINDOWS}
    tmp: array[byte] of WideChar;
    tmpsize: cardinal;
    {$else}
    tmp: string;
    {$endif}
begin
  with ExeVersion do begin
    if Version=nil then begin
      {$ifdef MSWINDOWS}
      ProgramFileName := paramstr(0);
      {$else}
      ProgramFileName := GetModuleName(HInstance);
      if ProgramFileName='' then
        ProgramFileName := ExpandFileName(paramstr(0));
      {$endif MSWINDOWS}
      ProgramFilePath := ExtractFilePath(ProgramFileName);
      if IsLibrary then
        InstanceFileName := GetModuleName(HInstance) else
        InstanceFileName := ProgramFileName;
      ProgramName := StringToUTF8(GetFileNameWithoutExt(ExtractFileName(ProgramFileName)));
      {$ifdef MSWINDOWS}
      tmpsize := SizeOf(tmp);
      GetComputerNameW(tmp,tmpsize);
      RawUnicodeToUtf8(@tmp,StrLenW(tmp),Host);
      tmpsize := SizeOf(tmp);
      GetUserNameW(tmp,tmpsize);
      RawUnicodeToUtf8(@tmp,StrLenW(tmp),User);
      {$else}
      StringToUTF8(GetHostName,Host);
      if Host='' then
        StringToUTF8(GetEnvironmentVariable('HOSTNAME'),Host);
      tmp := GetEnvironmentVariable('LOGNAME'); // POSIX
      if tmp='' then
        tmp := GetEnvironmentVariable('USER');
      {$ifdef KYLIX3}
      if tmp='' then
        User := LibC.getpwuid(LibC.getuid)^.pw_name else
      {$endif}
        StringToUTF8(tmp,User);
      {$endif MSWINDOWS}
      if Host='' then
        Host := 'unknown';
      if User='' then
        User := 'unknown';
      GarbageCollectorFreeAndNil(Version,
        TFileVersion.Create(InstanceFileName,aMajor,aMinor,aRelease,aBuild));
    end else
      Version.SetVersion(aMajor,aMinor,aRelease,aBuild);
    FormatUTF8('% % (%)',[ProgramFileName,Version.Detailed,
      DateTimeToIso8601(Version.BuildDateTime,True,' ')],ProgramFullSpec);
    Hash.c0 := Version.Version32;
    {$ifdef CPUINTEL}
    Hash.c0 := crc32c(Hash.c0,@CpuFeatures,SizeOf(CpuFeatures));
    {$endif}
    Hash.c0 := crc32c(Hash.c0,pointer(Host),length(Host));
    Hash.c1 := crc32c(Hash.c0,pointer(User),length(User));
    Hash.c2 := crc32c(Hash.c1,pointer(ProgramFullSpec),length(ProgramFullSpec));
    Hash.c3 := crc32c(Hash.c2,pointer(InstanceFileName),length(InstanceFileName));
  end;
end;

{$ifdef MSWINDOWS}
// avoid unneeded reference to ShlObj.pas
function SHGetFolderPath(hwnd: HWND; csidl: Integer; hToken: THandle;
  dwFlags: DWord; pszPath: PChar): HRESULT; stdcall; external 'SHFolder.dll'
  name {$ifdef UNICODE}'SHGetFolderPathW'{$else}'SHGetFolderPathA'{$endif};

var
  _SystemPath: array[TSystemPath] of TFileName;

function GetSystemPath(kind: TSystemPath): TFileName;
const
  CSIDL_PERSONAL = $0005;
  CSIDL_LOCAL_APPDATA = $001C; // local non roaming user folder
  CSIDL_COMMON_APPDATA = $0023;
  CSIDL_COMMON_DOCUMENTS = $002E;
  CSIDL: array[TSystemPath] of integer = (
    // spCommonData,       spUserData,          spCommonDocuments
    CSIDL_COMMON_APPDATA, CSIDL_LOCAL_APPDATA, CSIDL_COMMON_DOCUMENTS,
    // spUserDocuments, spTempFolder, spLog
    CSIDL_PERSONAL, 0, CSIDL_LOCAL_APPDATA);
  ENV: array[TSystemPath] of TFileName = (
    'ALLUSERSAPPDATA', 'LOCALAPPDATA', '', '', 'TEMP', 'LOCALAPPDATA');
var tmp: array[0..MAX_PATH] of char;
begin
  if _SystemPath[kind]='' then
    if (kind=spLog) and IsDirectoryWritable(ExeVersion.ProgramFilePath) then
      _SystemPath[kind] := EnsureDirectoryExists(ExeVersion.ProgramFilePath+'log') else
    if (CSIDL[kind]<>0) and (SHGetFolderPath(0,CSIDL[kind],0,0,@tmp)=S_OK) then
      _SystemPath[kind] := IncludeTrailingPathDelimiter(tmp) else begin
      _SystemPath[kind] := GetEnvironmentVariable(ENV[kind]);
      if _SystemPath[kind]='' then
        _SystemPath[kind] := GetEnvironmentVariable('APPDATA');
      _SystemPath[kind] := IncludeTrailingPathDelimiter(_SystemPath[kind]);
    end;
  result := _SystemPath[kind];
end;
{$else MSWINDOWS}
var
  _HomePath, _TempPath, _UserPath, _LogPath: TFileName;

function GetSystemPath(kind: TSystemPath): TFileName;
begin
  case kind of
  spLog: begin
    if _LogPath='' then
      if IsDirectoryWritable('/var/log') then
        _LogPath := '/var/log/' else // may not be writable by not root on POSIX
        if IsDirectoryWritable(ExeVersion.ProgramFilePath) then
          _LogPath := ExeVersion.ProgramFilePath else
          _LogPath := GetSystemPath(spUserData);
    result := _LogPath;
  end;
  spUserData: begin
    if _UserPath='' then begin //  ~/.cache/appname
      _UserPath := GetEnvironmentVariable('XDG_CACHE_HOME');
      if (_UserPath='') or not IsDirectoryWritable(_UserPath) then
        _UserPath := EnsureDirectoryExists(GetSystemPath(spUserDocuments)+'.cache');
      _UserPath := EnsureDirectoryExists(_UserPath+UTF8ToString(ExeVersion.ProgramName));
    end;
    result := _UserPath;
  end;
  spTempFolder: begin
    if _TempPath='' then begin
      _TempPath := GetEnvironmentVariable('TMPDIR'); // POSIX
      if _TempPath='' then
        _TempPath := GetEnvironmentVariable('TMP');
      if _TempPath='' then
        if DirectoryExists('/tmp') then
          _TempPath := '/tmp' else
          _TempPath := '/var/tmp';
      _TempPath := IncludeTrailingPathDelimiter(_TempPath);
    end;
    result := _TempPath;
  end else begin
    if _HomePath='' then // POSIX requires a value for $HOME
      _HomePath := IncludeTrailingPathDelimiter(GetEnvironmentVariable('HOME'));
    result := _HomePath;
  end;
  end;
end;
{$endif MSWINDOWS}

procedure PatchCode(Old,New: pointer; Size: integer; Backup: pointer;
  LeaveUnprotected: boolean);
{$ifdef MSWINDOWS}
var RestoreProtection, Ignore: DWORD;
    i: integer;
begin
  if VirtualProtect(Old, Size, PAGE_EXECUTE_READWRITE, RestoreProtection) then
  begin
    if Backup<>nil then
      for i := 0 to Size-1 do  // do not use Move() here
        PByteArray(Backup)^[i] := PByteArray(Old)^[i];
    for i := 0 to Size-1 do    // do not use Move() here
      PByteArray(Old)^[i] := PByteArray(New)^[i];
    if not LeaveUnprotected then
      VirtualProtect(Old, Size, RestoreProtection, Ignore);
    FlushInstructionCache(GetCurrentProcess, Old, Size);
    if not CompareMemFixed(Old,New,Size) then
      raise ESynException.Create('PatchCode?');
  end;
end;
{$else}
var PageSize: PtrUInt;
    AlignedAddr: pointer;
    i: PtrInt;
    ProtectedResult: boolean;
    ProtectedMemory: boolean;
begin
  if Backup<>nil then
    for i := 0 to Size-1 do // do not use Move() here
      PByteArray(Backup)^[i] := PByteArray(Old)^[i];
  PageSize := SystemInfo.dwPageSize;
  AlignedAddr := Pointer((PtrUInt(Old) DIV SystemInfo.dwPageSize) * SystemInfo.dwPageSize);
  while PtrUInt(Old)+PtrUInt(Size)>=PtrUInt(AlignedAddr)+PageSize do
    Inc(PageSize,SystemInfo.dwPageSize);
  ProtectedResult := SynMProtect(AlignedAddr,PageSize,PROT_READ or PROT_WRITE or PROT_EXEC) = 0;
  ProtectedMemory := not ProtectedResult; 
  if ProtectedMemory then
    ProtectedResult := SynMProtect(AlignedAddr,PageSize,PROT_READ or PROT_WRITE) = 0;
  if ProtectedResult then
    try
      for i := 0 to Size-1 do // do not use Move() here
        PByteArray(Old)^[i] := PByteArray(New)^[i];
    if not LeaveUnprotected and ProtectedMemory then
      SynMProtect(AlignedAddr,PageSize,PROT_READ or PROT_EXEC);
    except
    end;
end;
{$endif MSWINDOWS}

procedure PatchCodePtrUInt(Code: PPtrUInt; Value: PtrUInt;
  LeaveUnprotected: boolean);
begin
  PatchCode(Code,@Value,SizeOf(Code^),nil,LeaveUnprotected);
end;

{$ifdef CPUINTEL}

procedure RedirectCode(Func, RedirectFunc: Pointer; Backup: PPatchCode);
var NewJump: packed record
    Code: byte;        // $e9 = jmp {relative}
    Distance: integer; // relative jump is 32-bit even on CPU64
  end;
begin
  if (Func=nil) or (RedirectFunc=nil) then
    exit; // nothing to redirect to
  assert(SizeOf(TPatchCode)=SizeOf(NewJump));
  NewJump.Code := $e9;
  NewJump.Distance := integer(PtrUInt(RedirectFunc)-PtrUInt(Func)-SizeOf(NewJump));
  PatchCode(Func,@NewJump,SizeOf(NewJump),Backup);
  {$ifndef LVCL}
  assert(pByte(Func)^=$e9);
  {$endif}
end;

procedure RedirectCodeRestore(Func: pointer; const Backup: TPatchCode);
begin
  PatchCode(Func,@Backup,SizeOf(TPatchCode));
end;

{$endif CPUINTEL}

{$ifndef LVCL}
{$ifndef FPC}
{$ifndef UNICODE}

const
  MemoryDelta = $8000; // 32 KB granularity (must be a power of 2)

function THeapMemoryStream.Realloc(var NewCapacity: longint): Pointer;
// allocates memory from Delphi heap (FastMM4/SynScaleMM) and not windows.Global*()
// and uses bigger growing size -> a lot faster
var i: PtrInt;
begin
  if NewCapacity>0 then begin
    i := Seek(0,soFromCurrent); // no direct access to fSize -> use Seek() trick
    if NewCapacity=Seek(0,soFromEnd) then begin // avoid ReallocMem() if just truncate
      result := Memory;
      Seek(i,soBeginning);
      exit;
    end;
    NewCapacity := (NewCapacity + (MemoryDelta - 1)) and not (MemoryDelta - 1);
    Seek(i,soBeginning);
  end;
  Result := Memory;
  if NewCapacity <> Capacity then begin
    if NewCapacity = 0 then begin
      FreeMem(Memory);
      Result := nil;
    end else begin
      if Capacity = 0 then
        GetMem(Result, NewCapacity) else
        if NewCapacity > Capacity then // only realloc if necessary (grow up)
          ReallocMem(Result, NewCapacity) else
          NewCapacity := Capacity; // same capacity as before
      if Result = nil then
        raise EStreamError.Create('THeapMemoryStream'); // memory allocation bug
    end;
  end;
end;

{$endif UNICODE}
{$endif FPC}
{$endif LVCL}


{ TSortedWordArray }

function FastLocateWordSorted(P: PWordArray; R: integer; Value: word): PtrInt;
var L,cmp: PtrInt;
begin
  if R<0 then
    result := 0 else begin
    L := 0;
    repeat
      result := (L + R) shr 1;
      cmp := P^[result]-Value;
      if cmp=0 then begin
        result := -result-1; // return -(foundindex+1) if already exists
        exit;
      end;
      if cmp<0 then
        L := result + 1 else
        R := result - 1;
    until (L > R);
    while (result>=0) and (P^[result]>=Value) do dec(result);
    result := result+1; // return the index where to insert
  end;
end;

function FastFindWordSorted(P: PWordArray; R: PtrInt; Value: Word): PtrInt;
{$ifdef CPUX64} // P=rcx/rdi R=rdx/rsi Value=r8w/dx
{$ifdef FPC} assembler; nostackframe; asm {$else} asm .noframe {$endif}
        {$ifdef win64}
        push    rdi
        mov     rdi, P  // rdi=P
        {$endif}
        xor     r9, r9  // r9=L rax=result
        test    R, R
        jl      @ko
{$ifdef FPC} align 8 {$else} .align 8 {$endif}
@s:     lea     rax, [r9 + R]
        shr     rax, 1
        lea     r10, qword ptr[rax - 1] // branchless loop
        lea     r11, qword ptr[rax + 1]
        movzx   ecx, word ptr[rdi + rax * 2]
        {$ifdef win64}
        cmp     ecx, r8d
        {$else}
        cmp     ecx, edx // 'cmp cx,Value' is silently rejected by Darwin asm
        {$endif win64}
        je      @ok
        cmovg   R, r10
        cmovl   r9, r11
        cmp     r9, R
        jle     @s
@ko:    or      rax, -1
@ok:    {$ifdef win64}
        pop     rdi
        {$endif}
end;
{$else}
var L: PtrInt;
    cmp: integer;
begin
  L := 0;
  if 0<=R then
    repeat
      result := (L + R) shr 1;
      cmp := P^[result]-Value;
      if cmp=0 then
        exit;
      if cmp<0 then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      R := result-1;
      if L<=R  then
        continue;
      break;
    until false;
  result := -1
end;
{$endif CPUX64}

function TSortedWordArray.Add(aValue: Word): PtrInt;
begin
  result := Count; // optimistic check of perfectly increasing aValue
  if (result>0) and (aValue<=Values[result-1]) then
    result := FastLocateWordSorted(pointer(Values),result-1,aValue);
  if result<0 then // aValue already exists in Values[] -> fails
    exit;
  if Count=length(Values) then
    SetLength(Values,NextGrow(Count));
  if result<Count then
    MoveFast(Values[result],Values[result+1],(Count-result)*SizeOf(word)) else
    result := Count;
  Values[result] := aValue;
  inc(Count);
end;

function TSortedWordArray.IndexOf(aValue: Word): PtrInt;
begin
  result := FastFindWordSorted(pointer(Values),Count-1,aValue);
end;

procedure QuickSortCompare(const OnCompare: TOnValueGreater;
  Index: PIntegerArray; L,R: PtrInt);
var I, J, P: PtrInt;
    pivot, tmp: integer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := Index[P];
      while OnCompare(pivot,Index[I]) do inc(I);
      while OnCompare(Index[J],pivot) do dec(J);
      if I <= J then begin
        tmp := Index[J]; Index[J] := Index[I]; Index[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortCompare(OnCompare, Index, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortCompare(OnCompare, Index, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure Exchg32(var A,B: integer); {$ifdef HASINLINE}inline;{$endif}
var tmp: integer;
begin
  tmp := A;
  A := B;
  B := tmp;
end;

function MedianQuickSelectInteger(Values: PIntegerArray; n: integer): integer;
var low, high, median, middle, ll, hh: PtrInt;
begin
  if n=0 then begin
    result := 0;
    exit;
  end;
  if n=1 then begin
    result := Values[0];
    exit;
  end;
  low := 0;
  high := n-1;
  median := high shr 1;
  repeat
    if high<=low then begin // one item left
      result := Values[median];
      exit;
    end;
    if high=low+1 then begin // two items -> return the smallest (not average)
      if Values[low]>Values[high] then
        Exchg32(Values[low],Values[high]);
      result := Values[median];
      exit;
    end;
    // find median of low, middle and high items; swap into position low
    middle := (low+high) shr 1;
    if Values[middle]>Values[high] then
      Exchg32(Values[middle],Values[high]);
    if Values[low]>Values[high] then
      Exchg32(Values[low],Values[high]);
    if Values[middle]>Values[low] then
      Exchg32(Values[middle],Values[low]);
    // swap low item (now in position middle) into position (low+1)
    Exchg32(Values[middle],Values[low+1]);
    // nibble from each end towards middle, swapping items when stuck
    ll := low+1;
    hh := high;
    repeat
      repeat
        inc(ll);
      until not (Values[low]>Values[ll]);
      repeat
        dec(hh);
      until not (Values[hh]>Values[low]);
      if hh<ll then
        break;
      Exchg32(Values[ll],Values[hh]);
    until false;
    // swap middle item (in position low) back into correct position
    Exchg32(Values[low],Values[hh]);
    // next active partition
    if hh<=median then
      low := ll;
    if hh>=median then
      high := hh-1;
  until false;
end;

function MedianQuickSelect(const OnCompare: TOnValueGreater; n: integer;
  var TempBuffer: TSynTempBuffer): integer;
var low, high, middle, median, ll, hh: PtrInt;
    tmp: integer;
    ndx: PIntegerArray;
begin
  if n<=1 then begin
    TempBuffer.buf := nil; // avoid GPF in TempBuffer.Done
    result := 0;
    exit;
  end;
  low := 0;
  high := n-1;
  ndx := TempBuffer.InitIncreasing(n*4); // no heap alloacation until n>1024
  median := high shr 1;
  repeat
    if high<=low then begin // one item left
      result := ndx[median];
      TempBuffer.Done;
      exit;
    end;
    if high=low+1 then begin // two items -> return the smallest (not average)
      if OnCompare(ndx[low],ndx[high]) then
        Exchg32(ndx[low],ndx[high]);
      result := ndx[median];
      TempBuffer.Done;
      exit;
    end;
    // find median of low, middle and high items; swap into position low
    middle := (low+high) shr 1;
    if OnCompare(ndx[middle],ndx[high]) then
      Exchg32(ndx[middle],ndx[high]);
    if OnCompare(ndx[low],ndx[high]) then
      Exchg32(ndx[low],ndx[high]);
    if OnCompare(ndx[middle],ndx[low]) then
      Exchg32(ndx[middle],ndx[low]);
    // swap low item (now in position middle) into position (low+1)
    Exchg32(ndx[middle],ndx[low+1]);
    // nibble from each end towards middle, swapping items when stuck
    ll := low+1;
    hh := high;
    repeat
      tmp := ndx[low];
      repeat
        inc(ll);
      until not OnCompare(tmp,ndx[ll]);
      repeat
        dec(hh);
      until not OnCompare(ndx[hh],tmp);
      if hh<ll then
        break;
      tmp := ndx[ll]; ndx[ll] := ndx[hh]; ndx[hh] := tmp; // Exchg32(ndx[ll],ndx[hh]);
    until false;
    // swap middle item (in position low) back into correct position
    Exchg32(ndx[low],ndx[hh]);
    // next active partition
    if hh<=median then
      low := ll;
    if hh>=median then
      high := hh-1;
  until false;
end;

function gcd(a, b: cardinal): cardinal;
begin
  while a <> b do
    if a > b then
      dec(a, b) else
      dec(b, a);
  result := a;
end;

function ToVarUInt32Length(Value: PtrUInt): PtrUInt;
begin
  if Value<=$7f then
    result := 1 else
  if Value<$80 shl 7 then
    result := 2 else
  if Value<$80 shl 14 then
    result := 3 else
  if Value <$80 shl 21 then
    result := 4 else
    result := 5;
end;

function ToVarUInt32LengthWithData(Value: PtrUInt): PtrUInt;
begin
  if Value<=$7f then
    result := Value+1 else
  if Value<$80 shl 7 then
    result := Value+2 else
  if Value<$80 shl 14 then
    result := Value+3 else
  if Value<$80 shl 21 then
    result := Value+4 else
    result := Value+5;
end;

{$ifdef HASINLINE}
function FromVarUInt32(var Source: PByte): cardinal;
begin
  result := Source^;
  inc(Source);
  if result>$7f then
    result := (result and $7F) or FromVarUInt32Up128(Source);
end;

function FromVarUInt32Big(var Source: PByte): cardinal;
{$else}
function FromVarUInt32Big(var Source: PByte): cardinal;
asm
     jmp    FromVarUInt32
end;

function FromVarUInt32(var Source: PByte): cardinal;
{$endif}
var c: cardinal;
    p: PByte;
begin
  p := Source;
  result := p^;
  inc(p);
  if result>$7f then begin // Values between 128 and 16256
    c := p^;
    c := c shl 7;
    result := result and $7F or c;
    inc(p);
    if c>$7f shl 7 then begin // Values between 16257 and 2080768
      c := p^;
      c := c shl 14;
      inc(p);
      result := result and $3FFF or c;
      if c>$7f shl 14 then begin // Values between 2080769 and 266338304
        c := p^;
        c := c shl 21;
        inc(p);
        result := result and $1FFFFF or c;
        if c>$7f shl 21 then begin
          c := p^;
          c := c shl 28;
          inc(p);
          result := result and $FFFFFFF or c;
        end;
      end;
    end;
  end;
  Source := p;
end;

function FromVarUInt32Up128(var Source: PByte): cardinal;
var c: cardinal;
    p: PByte;
begin // Values above 128
  p := Source;
  result := p^ shl 7;
  inc(p);
  if result>$7f shl 7 then begin // Values above 16257
    c := p^;
    c := c shl 14;
    inc(p);
    result := result and $3FFF or c;
    if c>$7f shl 14 then begin
      c := p^;
      c := c shl 21;
      inc(p);
      result := result and $1FFFFF or c;
      if c>$7f shl 21 then begin
        c := p^;
        c := c shl 28;
        inc(p);
        result := result and $FFFFFFF or c;
      end;
    end;
  end;
  Source := p;
end;

function FromVarUInt32(var Source: PByte; SourceMax: PByte; out Value: cardinal): boolean;
begin
  if SourceMax=nil then begin
    Value := FromVarUInt32(Source);
    result := true;
  end else begin
    Source := FromVarUInt32Safe(Source,SourceMax,Value);
    result := Source<>nil;
  end;
end;

function FromVarUInt32Safe(Source, SourceMax: PByte; out Value: cardinal): PByte;
var c: cardinal;
begin
  result := nil; // error
  if PAnsiChar(Source)>=PAnsiChar(SourceMax) then exit;
  c := Source^;
  inc(Source);
  Value := c;
  if c>$7f then begin // Values between 128 and 16256
    if PAnsiChar(Source)>=PAnsiChar(SourceMax) then exit;
    c := Source^;
    c := c shl 7;
    Value := Value and $7F or c;
    inc(Source);
    if c>$7f shl 7 then begin // Values between 16257 and 2080768
      if PAnsiChar(Source)>=PAnsiChar(SourceMax) then exit;
      c := Source^;
      c := c shl 14;
      inc(Source);
      Value := Value and $3FFF or c;
      if c>$7f shl 14 then begin // Values between 2080769 and 266338304
        if PAnsiChar(Source)>=PAnsiChar(SourceMax) then exit;
        c := Source^;
        c := c shl 21;
        inc(Source);
        Value := Value and $1FFFFF or c;
        if c>$7f shl 21 then begin
          if PAnsiChar(Source)>=PAnsiChar(SourceMax) then exit;
          c := Source^;
          c := c shl 28;
          inc(Source);
          Value := Value and $FFFFFFF or c;
        end;
      end;
    end;
  end;
  result := Source; // safely decoded
end;

function FromVarInt32(var Source: PByte): integer;
var c: cardinal;
    p: PByte;
begin // fast stand-alone function with no FromVarUInt32 call
  p := Source;
  result := p^;
  inc(p);
  if result>$7f then begin
    c := p^;
    c := c shl 7;
    result := result and $7F or integer(c);
    inc(p);
    if c>$7f shl 7 then begin
      c := p^;
      c := c shl 14;
      inc(p);
      result := result and $3FFF or integer(c);
      if c>$7f shl 14 then begin
        c := p^;
        c := c shl 21;
        inc(p);
        result := result and $1FFFFF or integer(c);
        if c>$7f shl 21 then begin
          c := p^;
          c := c shl 28;
          inc(p);
          result := result and $FFFFFFF or integer(c);
        end;
      end;
    end;
  end;
  Source := p;
  // 0=0,1=1,2=-1,3=2,4=-2...
  if result and 1<>0 then
    // 1->1, 3->2..
    result := result shr 1+1 else
    // 0->0, 2->-1, 4->-2..
    result := -(result shr 1);
end;

function FromVarUInt32High(var Source: PByte): cardinal;
var c: cardinal;
begin
  result := Source^;
  inc(Source);
  c := Source^ shl 7;
  inc(Source);
  result := result and $7F or c;
  if c<=$7f shl 7 then
    exit;
  c := Source^ shl 14;
  inc(Source);
  result := result and $3FFF or c;
  if c<=$7f shl 14 then
    exit;
  c := Source^ shl 21;
  inc(Source);
  result := result and $1FFFFF or c;
  if c<=$7f shl 21 then
    exit;
  c := Source^ shl 28;
  inc(Source);
  result := result and $FFFFFFF or c;
end;

function ToVarInt64(Value: Int64; Dest: PByte): PByte;
begin // 0=0,1=1,2=-1,3=2,4=-2...
  {$ifdef CPU32}
  if Value<=0 then
    // 0->0, -1->2, -2->4..
    result := ToVarUInt64((-Value) shl 1,Dest) else
    // 1->1, 2->3..
    result := ToVarUInt64((Value shl 1)-1,Dest);
  {$else}
  if Value<=0 then
    // 0->0, -1->2, -2->4..
    Value := (-Value) shl 1 else
    // 1->1, 2->3..
    Value := (Value shl 1)-1;
  result := ToVarUInt64(Value,Dest);
  {$endif}
end;

function ToVarUInt64(Value: QWord; Dest: PByte): PByte;
label _1,_2,_4; // ugly but fast
var c: cardinal;
begin
  repeat
    c := Value;
    if {$ifdef CPU32}PInt64Rec(@Value)^.Hi=0{$else}Value shr 32=0{$endif} then begin
      if c>$7f then begin // inlined result := ToVarUInt32(Value,Dest);
        if c<$80 shl 7 then goto _1 else
          if c<$80 shl 14 then goto _2 else
            if c>=$80 shl 21 then goto _4;
        Dest^ := (c and $7F) or $80;
        c := c shr 7;
        inc(Dest);
    _2: Dest^ := (c and $7F) or $80;
        c := c shr 7;
        inc(Dest);
    _1: Dest^ := (c and $7F) or $80;
        c := c shr 7;
        inc(Dest);
      end;
      Dest^ := c;
      inc(Dest);
      result := Dest;
      exit;
    end;
_4: PCardinal(Dest)^ := (c and $7F) or (((c shr 7)and $7F)shl 8) or
      (((c shr 14)and $7F)shl 16) or (((c shr 21)and $7F)shl 24) or $80808080;
    inc(Dest,4);
    Value := Value shr 28;
  until false;
end;

function FromVarUInt64(var Source: PByte): QWord;
var c,n: PtrUInt;
    p: PByte;
begin
  p := Source;
  {$ifdef CPU64}
  result := p^;
  if result>$7f then begin
    result := result and $7F;
  {$else}
  if p^>$7f then begin
    result := PtrUInt(p^) and $7F;
  {$endif}
    n := 0;
    inc(p);
    repeat
      c := p^;
      inc(n,7);
      if c<=$7f then
        break;
      result := result or (QWord(c and $7f) shl n);
      inc(p);
    until false;
    result := result or (QWord(c) shl n);
  end{$ifndef CPU64} else
    result := p^{$endif};
  inc(p);
  Source := p;
end;

function FromVarUInt64Safe(Source, SourceMax: PByte; out Value: QWord): PByte;
var c,n: PtrUInt;
begin
  result := nil; // error
  if PAnsiChar(Source)>=PAnsiChar(SourceMax) then exit;
  c := Source^;
  inc(Source);
  if c>$7f then begin
    Value := c and $7F;
    n := 7;
    repeat
      if PAnsiChar(Source)>=PAnsiChar(SourceMax) then
        exit;
      c := Source^;
      inc(Source);
      if c<=$7f then
        break;
      c := c and $7f;
      Value := Value or (QWord(c) shl n);
      inc(n,7);
    until false;
    Value := Value or (QWord(c) shl n);
  end else
    Value := c;
  result := Source; // safely decoded
end;

function FromVarUInt64(var Source: PByte; SourceMax: PByte; out Value: QWord): boolean;
begin
  if SourceMax=nil then begin
    Value := FromVarUInt64(Source);
    result := true;
  end else begin
    Source := FromVarUInt64Safe(Source,SourceMax,Value);
    result := Source<>nil;
  end;
end;

function FromVarInt64(var Source: PByte): Int64;
var c,n: PtrUInt;
begin // 0=0,1=1,2=-1,3=2,4=-2...
  {$ifdef CPU64}
  result := Source^;
  if result>$7f then begin
    result := result and $7F;
    n := 0;
    inc(Source);
    repeat
      c := Source^;
      inc(n,7);
      if c<=$7f then
        break;
      result := result or (Int64(c and $7f) shl n);
      inc(Source);
    until false;
    result := result or (Int64(c) shl n);
  end;
  if result and 1<>0 then
    // 1->1, 3->2..
    result := result shr 1+1 else
    // 0->0, 2->-1, 4->-2..
    result := -(result shr 1);
  {$else}
  c := Source^;
  if c>$7f then begin
    result := c and $7F;
    n := 0;
    inc(Source);
    repeat
      c := Source^;
      inc(n,7);
      if c<=$7f then
        break;
      result := result or (Int64(c and $7f) shl n);
      inc(Source);
    until false;
    result := result or (Int64(c) shl n);
    if PCardinal(@result)^ and 1<>0 then
      // 1->1, 3->2..
      result := result shr 1+1 else
      // 0->0, 2->-1, 4->-2..
      result := -(result shr 1);
  end else begin
    if c=0 then
      result := 0 else
    if c and 1=0 then
      // 0->0, 2->-1, 4->-2..
      result := -Int64(c shr 1) else
      // 1->1, 3->2..
      result := (c shr 1)+1;
  end;
  {$endif}
  inc(Source);
end;

function FromVarInt64Value(Source: PByte): Int64;
{$ifdef DELPHI5OROLDER}
begin // try to circumvent Internal Error C1093 on Delphi 5 :(
  result := FromVarInt64(Source);
end;
{$else}
var c,n: PtrUInt;
begin // 0=0,1=1,2=-1,3=2,4=-2...
  c := Source^;
  if c>$7f then begin
    result := c and $7F;
    n := 0;
    inc(Source);
    repeat
      c := Source^;
      inc(n,7);
      if c<=$7f then
        break;
      result := result or (Int64(c and $7f) shl n);
      inc(Source);
    until false;
    result := result or (Int64(c) shl n);
    if {$ifdef CPU64}result{$else}PCardinal(@result)^{$endif} and 1<>0 then
      // 1->1, 3->2..
      result := result shr 1+1 else
      // 0->0, 2->-1, 4->-2..
      result := -Int64(result shr 1);
  end else
    if c=0 then
      result := 0 else
      if c and 1=0 then
        // 0->0, 2->-1, 4->-2..
        result := -Int64(c shr 1) else
        // 1->1, 3->2..
        result := (c shr 1)+1;
end;
{$endif DELPHI5OROLDER}

function GotoNextVarInt(Source: PByte): pointer;
begin
  if Source<>nil then begin
    if Source^>$7f then
      repeat
        inc(Source)
      until Source^<=$7f;
    inc(Source);
  end;
  result := Source;
end;

function ToVarString(const Value: RawUTF8; Dest: PByte): PByte;
var Len: integer;
begin
  Len := Length(Value);
  Dest := ToVarUInt32(Len,Dest);
  if Len>0 then begin
    MoveFast(pointer(Value)^,Dest^,Len);
    result := pointer(PAnsiChar(Dest)+Len);
  end else
    result := Dest;
end;

function GotoNextVarString(Source: PByte): pointer;
begin
  result := Pointer(PtrUInt(Source)+FromVarUInt32(Source));
end;

function FromVarString(var Source: PByte): RawUTF8;
var len: PtrUInt;
begin
  len := FromVarUInt32(Source);
  FastSetStringCP(Result,Source,len,CP_UTF8);
  inc(Source,len);
end;

function FromVarString(var Source: PByte; SourceMax: PByte): RawUTF8;
var len: cardinal;
begin
  Source := FromVarUInt32Safe(Source,SourceMax,len);
  if (Source=nil) or (PAnsiChar(Source)+len>PAnsiChar(SourceMax)) then
    len := 0;
  FastSetStringCP(Result,Source,len,CP_UTF8);
  inc(Source,len);
end;

procedure FromVarString(var Source: PByte; var Value: TSynTempBuffer);
var len: integer;
begin
  len := FromVarUInt32(Source);
  Value.Init(Source,len);
  PByteArray(Value.buf)[len] := 0; // include trailing #0
  inc(Source,len);
end;

function FromVarString(var Source: PByte; SourceMax: PByte;
  var Value: TSynTempBuffer): boolean;
var len: cardinal;
begin
  if SourceMax=nil then
    len := FromVarUInt32(Source) else begin
    Source := FromVarUInt32Safe(Source,SourceMax,len);
    if (Source=nil) or (PAnsiChar(Source)+len>PAnsiChar(SourceMax)) then begin
      result := false;
      exit;
    end;
  end;
  Value.Init(Source,len);
  PByteArray(Value.buf)[len] := 0; // include trailing #0
  inc(Source,len);
  result := true;
end;

procedure FromVarString(var Source: PByte; var Value: RawByteString;
  CodePage: integer);
var Len: PtrUInt;
begin
  Len := FromVarUInt32(Source);
  FastSetStringCP(Value,Source,Len,CodePage);
  inc(Source,Len);
end;

function FromVarString(var Source: PByte; SourceMax: PByte;
  var Value: RawByteString; CodePage: integer): boolean;
var len: cardinal;
begin
  if SourceMax=nil then
    len := FromVarUInt32(Source) else begin
    Source := FromVarUInt32Safe(Source,SourceMax,len);
    if (Source=nil) or (PAnsiChar(Source)+len>PAnsiChar(SourceMax)) then begin
      result := false;
      exit;
    end;
  end;
  FastSetStringCP(Value,Source,len,CodePage);
  inc(Source,len);
  result := true;
end;

function FromVarBlob(Data: PByte): TValueResult;
begin
  Result.Len := FromVarUInt32(Data);
  Result.Ptr := pointer(Data);
end;


{ ************ low-level RTTI types and conversion routines }

{$ifdef FPC}

{$ifdef FPC_OLDRTTI}
function OldRTTIFirstManagedField(info: PTypeInfo): PFieldInfo;
var fieldtype: PTypeInfo;
    i: integer;
begin
  result := @info^.ManagedFields[0];
  for i := 1 to info^.ManagedCount do begin
    fieldtype := DeRef(result^.TypeInfo);
    if (fieldtype<>nil) and (fieldtype^.Kind in tkManagedTypes) then
      exit;
    inc(result);
  end;
  result := nil;
end;

function OldRTTIManagedSize(typeInfo: Pointer): SizeInt; inline;
begin
  case PTypeKind(typeInfo)^ of // match tkManagedTypes
    tkLString,tkLStringOld,tkWString,tkUString, tkInterface,tkDynarray:
      result := SizeOf(Pointer);
    {$ifndef NOVARIANTS}
    tkVariant: result := SizeOf(TVarData);
    {$endif}
    tkArray: with GetTypeInfo(typeInfo)^ do
      result := arraySize{$ifdef VER2_6}*elCount{$endif};
    tkObject,tkRecord: result := GetTypeInfo(typeInfo)^.recSize;
    else raise ESynException.CreateUTF8('OldRTTIManagedSize unhandled % (%)',
        [ToText(PTypeKind(typeInfo)^)^,PByte(typeInfo)^]);
  end;
end;

procedure RecordCopy(var Dest; const Source; TypeInfo: pointer);
begin // external name 'FPC_COPY' does not work as we need
  FPCFinalize(@Dest,TypeInfo);
  Move(Source,Dest,OldRTTIManagedSize(TypeInfo));
  FPCRecordAddRef(Dest,TypeInfo);
end;
{$else}
procedure RecordCopy(var Dest; const Source; TypeInfo: pointer);
begin
  FPCRecordCopy(Source,Dest,TypeInfo);
end;
{$endif FPC_OLDRTTI}

procedure RecordClear(var Dest; TypeInfo: pointer);
begin
  FPCFinalize(@Dest,TypeInfo);
end;

{$else FPC}

procedure CopyArray(dest, source, typeInfo: Pointer; cnt: PtrUInt);
asm
{$ifdef CPU64}
        .noframe
        jmp     System.@CopyArray
{$else} push    dword ptr[EBP + 8]
        call    System.@CopyArray // RTL is fast enough for this
{$endif}
end;

procedure _DynArrayClear(var a: Pointer; typeInfo: Pointer);
asm
  {$ifdef CPU64}
  .noframe
  {$endif}
  jmp System.@DynArrayClear
end;

procedure _FinalizeArray(p: Pointer; typeInfo: Pointer; elemCount: PtrUInt);
asm
  {$ifdef CPU64}
  .noframe
  {$endif}
  jmp System.@FinalizeArray
end;

procedure _Finalize(Data: Pointer; TypeInfo: Pointer);
asm
{$ifdef CPU64}
        .noframe
        mov     r8, 1 // rcx=p rdx=typeInfo r8=ElemCount
        jmp     System.@FinalizeArray
{$else} // much faster than FinalizeArray(Data,TypeInfo,1)
        movzx   ecx, byte ptr[edx]  // eax=ptr edx=typeinfo ecx=datatype
        sub     cl, tkLString
        {$ifdef UNICODE}
        cmp     cl, tkUString - tkLString + 1
        {$else}
        cmp     cl, tkDynArray - tkLString + 1
        {$endif}
        jnb     @@err
        jmp     dword ptr[@@Tab + ecx * 4]
        nop
        nop // for @@Tab alignment
@@Tab:  dd      System.@LStrClr
{$IFDEF LINUX} // under Linux, WideString are refcounted as AnsiString
        dd      System.@LStrClr
{$else} dd      System.@WStrClr
{$endif LINUX}
{$ifdef LVCL}
        dd      @@err
{$else} dd      System.@VarClr
{$endif LVCL}
        dd      @@ARRAY
        dd      RecordClear
        dd      System.@IntfClear
        dd      @@err
        dd      System.@DynArrayClear
        {$ifdef UNICODE}
        dd      System.@UStrClr
        {$endif}
@@err:  mov     al, reInvalidPtr
        {$ifdef DELPHI5OROLDER}
        jmp     System.@RunError
        {$else}
        jmp     System.Error
        {$endif}
@@array:movzx   ecx, [edx].TTypeInfo.NameLen
        add     ecx, edx
        mov     edx, dword ptr[ecx].TTypeInfo.ManagedFields[0] // Fields[0].TypeInfo^
        mov     ecx, [ecx].TTypeInfo.ManagedCount
        mov     edx, [edx]
        jmp     System.@FinalizeArray
{$endif CPU64}
end;
{$endif FPC}

procedure RecordZero(var Dest; TypeInfo: pointer);
var info: PTypeInfo;
begin
  info := GetTypeInfo(TypeInfo,tkRecordKinds);
  if info<>nil then begin // record/object only
    RecordClear(Dest,TypeInfo);
    FillCharFast(Dest,info^.recSize,0);
  end;
end;

procedure RawUTF8DynArrayClear(var Value: TRawUTF8DynArray);
begin
  FastDynArrayClear(@Value,TypeInfo(RawUTF8));
end;

function ArrayItemType(var info: PTypeInfo; out len: integer): PTypeInfo;
  {$ifdef HASINLINE}inline;{$endif}
begin
  {$ifdef HASALIGNTYPEDATA} // inlined info := GetTypeInfo(info)
  info := FPCTypeInfoOverName(info);
  {$else}
  info := @PAnsiChar(info)[info^.NameLen];
  {$endif}
  result := nil;
  if (info=nil) or (info^.dimCount<>1) then begin
    len := 0;
    info := nil; // supports single dimension static array only
  end else begin
    len := info^.arraySize{$ifdef VER2_6}*info^.elCount{$endif};
    {$ifdef HASDIRECTTYPEINFO} // inlined result := DeRef(info^.arrayType)
    result := info^.arrayType;
    {$else}
    if info^.arrayType=nil then
      exit;
    result := info^.arrayType^;
    {$endif}
    {$ifdef FPC}
    if (result<>nil) and not(result^.Kind in tkManagedTypes) then
      result := nil; // as with Delphi
    {$endif}
  end;
end;

function ManagedTypeCompare(A,B: PAnsiChar; info: PTypeInfo): integer;
// returns -1 if info was not handled, 0 if A^<>B^, or SizeOf(A^) if A^=B^
var i,arraysize: integer;
    itemtype: PTypeInfo;
    {$ifndef DELPHI5OROLDER} // do not know why this compiler does not like it
    DynA, DynB: TDynArray;
    {$endif}
begin // info is expected to come from a DeRef() if retrieved from RTTI
  result := 0; // A^<>B^
  case info^.Kind of // should match tkManagedTypes
  tkLString{$ifdef FPC},tkLStringOld{$endif}:
    if PRawByteString(A)^=PRawByteString(B)^ then
      result := SizeOf(pointer);
  tkWString:
    if PWideString(A)^=PWideString(B)^ then
      result := SizeOf(pointer);
  {$ifdef HASVARUSTRING}
  tkUString:
    if PUnicodeString(A)^=PUnicodeString(B)^ then
      result := SizeOf(pointer);
  {$endif}
  tkRecord{$ifdef FPC},tkObject{$endif}:
    if not RecordEquals(A^,B^,info,@result) then
      result := 0; // A^<>B^
  {$ifndef NOVARIANTS}
  tkVariant: // slightly more optimized than PVariant(A)^=PVariant(B)^
    if SortDynArrayVariantComp(PVarData(A)^,PVarData(B)^,false)=0 then
      result := SizeOf(variant);
  {$endif}
  {$ifndef DELPHI5OROLDER}
  tkDynArray: begin
    DynA.Init(info,A^);
    DynB.Init(info,B^);
    if DynA.Equals(DynB) then
      result := SizeOf(pointer);
  end;
  {$endif}
  tkInterface:
    if PPointer(A)^=PPointer(B)^ then
      result := SizeOf(pointer);
  tkArray: begin
    itemtype := ArrayItemType(info,arraysize);
    if info=nil then
      result := -1 else
      if itemtype=nil then
        if CompareMemFixed(A,B,arraysize) then
          result := arraysize else
          result := 0 else begin
        for i := 1 to info^.elCount do begin // only compare managed fields
          result := ManagedTypeCompare(A,B,itemtype);
          if result<=0 then
            exit; // invalid (-1) or not equals (0)
          inc(A,result);
          inc(B,result);
        end;
        result := arraysize;
      end;
  end;
  else
    result := -1; // Unhandled field
  end;
end;

function ManagedTypeSaveLength(data: PAnsiChar; info: PTypeInfo;
  out len: integer): integer;
// returns 0 on error, or saved bytes + len=data^ length
var DynArray: TDynArray;
    itemtype: PTypeInfo;
    itemsize,size,i: integer;
    P: PPtrUInt absolute data;
begin // info is expected to come from a DeRef() if retrieved from RTTI
  case info^.Kind of // should match tkManagedTypes
  tkLString{$ifdef FPC},tkLStringOld{$endif}: begin
    len := SizeOf(pointer);
    if P^=0 then
      result := 1 else
      result := ToVarUInt32LengthWithData(PStrLen(P^-_STRLEN)^);
  end;
  tkWString: begin // PStrRec doesn't match on Widestring for FPC
    len := SizeOf(pointer);
    result := ToVarUInt32LengthWithData(length(PWideString(P)^)*2);
  end;
  {$ifdef HASVARUSTRING}
  tkUString: begin
    len := SizeOf(pointer);
    if P^=0 then
      result := 1 else
      result := ToVarUInt32LengthWithData(PStrLen(P^-_STRLEN)^*2);
  end;
  {$endif}
  tkRecord{$ifdef FPC},tkObject{$endif}:
    result := RecordSaveLength(data^,info,@len);
  tkArray: begin
    itemtype := ArrayItemType(info,len);
    result := 0;
    if info<>nil then
      if itemtype=nil then
        result := len else
        for i := 1 to info^.elCount do begin
          size := ManagedTypeSaveLength(data,itemtype,itemsize);
          if size=0 then begin
            result := 0;
            exit;
          end;
          inc(result,size);
          inc(data,itemsize);
        end;
  end;
  {$ifndef NOVARIANTS}
  tkVariant: begin
    len := SizeOf(variant);
    result := VariantSaveLength(PVariant(data)^);
  end;
  {$endif}
  tkDynArray: begin
    DynArray.Init(info,data^);
    len := SizeOf(pointer);
    result := DynArray.SaveToLength;
  end;
  tkInterface: begin
    len := SizeOf(Int64); // consume 64-bit even on CPU32
    result := SizeOf(PtrUInt);
  end;
  else
    result := 0; // invalid/unhandled record content
  end;
end;

function ManagedTypeSave(data, dest: PAnsiChar; info: PTypeInfo;
  out len: integer): PAnsiChar;
// returns nil on error, or final dest + len=data^ length
var DynArray: TDynArray;
    itemtype: PTypeInfo;
    itemsize,i: integer;
    P: PPtrUInt absolute data;
begin // info is expected to come from a DeRef() if retrieved from RTTI
  case info^.Kind of
  tkLString {$ifdef HASVARUSTRING},tkUString{$endif} {$ifdef FPC},tkLStringOld{$endif}: begin
    if P^=0 then begin
      dest^ := #0;
      result := dest+1;
    end else begin
      itemsize := PStrLen(P^-_STRLEN)^;
      {$ifdef HASVARUSTRING} // UnicodeString length in WideChars
      if info^.Kind=tkUString then
        itemsize := itemsize*2;
      {$endif}
      result := pointer(ToVarUInt32(itemsize,pointer(dest)));
      MoveFast(pointer(P^)^,result^,itemsize);
      inc(result,itemsize);
    end;
    len := SizeOf(PtrUInt); // size of tkLString/tkUString in record
  end;
  tkWString: begin
    itemsize := length(PWideString(P)^)*2; // PStrRec doesn't match on FPC
    result := pointer(ToVarUInt32(itemsize,pointer(dest)));
    MoveFast(pointer(P^)^,result^,itemsize);
    inc(result,itemsize);
    len := SizeOf(PtrUInt);
  end;
  tkRecord{$ifdef FPC},tkObject{$endif}:
    result := RecordSave(data^,dest,info,len);
  tkArray: begin
    itemtype := ArrayItemType(info,len);
    if info=nil then
      result := nil else
      if itemtype=nil then begin
        MoveSmall(data,dest,len);
        result := dest+len;
      end else begin
        for i := 1 to info^.elCount do begin
          dest := ManagedTypeSave(data,dest,itemtype,itemsize);
          if dest=nil then
            break; // invalid/unhandled content
          inc(data,itemsize)
        end;
        result := dest;
      end;
  end;
  {$ifndef NOVARIANTS}
  tkVariant: begin
    result := VariantSave(PVariant(data)^,dest);
    len := SizeOf(Variant); // size of tkVariant in record
  end;
  {$endif}
  tkDynArray: begin
    DynArray.Init(info,data^);
    result := DynArray.SaveTo(dest);
    len := SizeOf(PtrUInt); // size of tkDynArray in record
  end;
  {$ifndef DELPHI5OROLDER}
  tkInterface: begin
    PIInterface(dest)^ := PIInterface(data)^; // with proper refcount
    result := dest+SizeOf(Int64); // consume 64-bit even on CPU32
    len := SizeOf(PtrUInt);
  end;
  {$endif}
  else
    result := nil; // invalid/unhandled record content
  end;
end;

function ManagedTypeLoad(data: PAnsiChar; var source: PAnsiChar;
  info: PTypeInfo; sourceMax: PAnsiChar): integer;
// returns source=nil on error, or final source + result=data^ length
var DynArray: TDynArray;
    itemtype: PTypeInfo;
    itemsize: cardinal;
    i: PtrInt;
begin // info is expected to come from a DeRef() if retrieved from RTTI
  result := SizeOf(PtrUInt); // size of most items
  if info^.Kind in [tkLString{$ifdef FPC},tkLStringOld{$endif},tkWString
      {$ifdef HASVARUSTRING},tkUString{$endif}] then
    if sourceMax<>nil then begin
      source := pointer(FromVarUInt32Safe(PByte(source),PByte(sourceMax),itemsize));
      if source=nil then
        exit;
      if source+itemsize>sourceMax then begin
        source := nil;
        exit; // avoid buffer overflow
      end;
    end else
      itemsize := FromVarUInt32(PByte(source)); // in source buffer bytes
  case info^.Kind of
  tkLString{$ifdef FPC}, tkLStringOld{$endif}: begin
    {$ifdef HASCODEPAGE}
    FastSetStringCP(data^,source,itemsize,LStringCodePage(info));
    {$else}
    SetString(PRawUTF8(data)^,source,itemsize);
    {$endif HASCODEPAGE}
    inc(source,itemsize);
  end;
  tkWString: begin
    SetString(PWideString(data)^,PWideChar(source),itemsize shr 1);
    inc(source,itemsize);
  end;
  {$ifdef HASVARUSTRING}
  tkUString: begin
    SetString(PUnicodeString(data)^,PWideChar(source),itemsize shr 1);
    inc(source,itemsize);
  end;
  {$endif}
  tkRecord{$ifdef FPC},tkObject{$endif}:
    source := RecordLoad(data^,source,info,@result,sourceMax);
  tkArray: begin
    itemtype := ArrayItemType(info,result);
    if info=nil then
      source := nil else
      if itemtype=nil then
        if (sourceMax<>nil) and (source+result>sourceMax) then
          source := nil else begin
          MoveSmall(source,data,result);
          inc(source,result);
        end else
        for i := 1 to info^.elCount do begin
          inc(data,ManagedTypeLoad(data,source,itemtype,sourceMax));
          if source=nil then
            exit;
        end;
  end;
  {$ifndef NOVARIANTS}
  tkVariant: begin
    source := VariantLoad(PVariant(data)^,source,@JSON_OPTIONS[true]);
    result := SizeOf(Variant); // size of tkVariant in record
  end;
  {$endif NOVARIANTS}
  tkDynArray: begin
    DynArray.Init(info,data^);
    source := DynArray.LoadFrom(source,nil,{nohash=}true,sourceMax);
  end;
  {$ifndef DELPHI5OROLDER}
  tkInterface: begin
    if (sourceMax<>nil) and (source+SizeOf(Int64)>sourceMax) then begin
      source := nil;
      exit;
    end;
    PIInterface(data)^ := PIInterface(source)^; // with proper refcount
    inc(source,SizeOf(Int64)); // consume 64-bit even on CPU32
  end;
  {$endif DELPHI5OROLDER}
  else
    source := nil; // notify error for unexpected input type
  end;
end;

function GetManagedFields(info: PTypeInfo; out firstfield: PFieldInfo): integer;
{$ifdef HASINLINE}inline;{$endif}
{$ifdef FPC_NEWRTTI}
var
  recInitData: PFPCRecInitData; // low-level type redirected from SynFPCTypInfo
  aPointer:pointer;
begin
  if Assigned(info^.RecInitInfo) then
    recInitData := PFPCRecInitData(AlignTypeDataClean(PTypeInfo(info^.RecInitInfo+2+PByte(info^.RecInitInfo+1)^)))
  else begin
    aPointer:=@info^.RecInitInfo;
    {$ifdef FPC_PROVIDE_ATTR_TABLE}
    dec(PByte(aPointer),SizeOf(Pointer));
    {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
    {$ifdef CPUARM}
    dec(PByte(aPointer),SizeOf(Pointer));
    {$endif CPUARM}
    {$endif}
    {$endif}
    recInitData := PFPCRecInitData(aPointer);
  end;
  firstfield := PFieldInfo(PtrUInt(@recInitData^.ManagedFieldCount));
  inc(PByte(firstfield),SizeOf(recInitData^.ManagedFieldCount));
  firstfield := AlignPTypeInfo(firstfield);
  result := recInitData^.ManagedFieldCount;
{$else}
begin
  firstfield := @info^.ManagedFields[0];
  result := info^.ManagedCount;
{$endif FPC_NEWRTTI}
end;

function RecordEquals(const RecA, RecB; TypeInfo: pointer;
  PRecSize: PInteger): boolean;
var info,fieldinfo: PTypeInfo;
    F, offset: PtrInt;
    field: PFieldInfo;
    A, B: PAnsiChar;
begin
  A := @RecA;
  B := @RecB;
  result := false;
  info := GetTypeInfo(TypeInfo,tkRecordKinds);
  if info=nil then
    exit; // raise Exception.CreateUTF8('% is not a record',[Typ^.Name]);
  if PRecSize<>nil then
    PRecSize^ := info^.recSize;
  if A=B then begin // both nil or same pointer
    result := true;
    exit;
  end;
  offset := 0;
  for F := 1 to GetManagedFields(info,field) do begin
    fieldinfo := DeRef(field^.TypeInfo);
    {$ifdef FPC_OLDRTTI} // old FPC did include RTTI for unmanaged fields
    if not (fieldinfo^.Kind in tkManagedTypes) then begin
      inc(field);
      continue; // as with Delphi
    end;
    {$endif}
    offset := integer(field^.Offset)-offset;
    if offset<>0 then begin
      if not CompareMemFixed(A,B,offset) then
        exit; // binary block not equal
      inc(A,offset);
      inc(B,offset);
    end;
    offset := ManagedTypeCompare(A,B,fieldinfo);
    if offset<=0 then
      if offset=0 then // A^<>B^
        exit else    // Diff=-1 for unexpected type
        raise ESynException.CreateUTF8('RecordEquals: unexpected %',
          [ToText(fieldinfo^.Kind)^]);
    inc(A,offset);
    inc(B,offset);
    inc(offset,field^.Offset);
    inc(field);
  end;
  if CompareMemFixed(A,B,integer(info^.recSize)-offset) then
    result := true;
end;

function RecordSaveLength(const Rec; TypeInfo: pointer; Len: PInteger): integer;
var info,fieldinfo: PTypeInfo;
    F, recsize,saved: integer;
    field: PFieldInfo;
    R: PAnsiChar;
begin
  R := @Rec;
  info := GetTypeInfo(TypeInfo,tkRecordKinds);
  if (R=nil) or (info=nil) then begin
    result := 0; // should have been checked before
    exit;
  end;
  result := info^.recSize;
  if Len<>nil then
    Len^ := result;
  for F := 1 to GetManagedFields(info,field) do begin
    fieldinfo := DeRef(field^.TypeInfo);
    {$ifdef FPC_OLDRTTI} // old FPC did include RTTI for unmanaged fields! :)
    if not (fieldinfo^.Kind in tkManagedTypes) then begin
      inc(field);
      continue; // as with Delphi
    end;
    {$endif};
    saved := ManagedTypeSaveLength(R+field^.Offset,fieldinfo,recsize);
    if saved=0 then begin
      result := 0; // invalid type
      exit;
    end;
    inc(result,saved-recsize); // extract recsize from info^.recSize
    inc(field);
  end;
end;

function RecordSave(const Rec; Dest: PAnsiChar; TypeInfo: pointer;
  out Len: integer): PAnsiChar;
var info,fieldinfo: PTypeInfo;
    F, offset: integer;
    field: PFieldInfo;
    R: PAnsiChar;
begin
  R := @Rec;
  info := GetTypeInfo(TypeInfo,tkRecordKinds);
  if (R=nil) or (info=nil) then begin
    result := nil; // should have been checked before
    exit;
  end;
  Len := info^.recSize;
  offset := 0;
  for F := 1 to GetManagedFields(info,field) do begin
    {$ifdef HASDIRECTTYPEINFO} // inlined DeRef()
    fieldinfo := field^.TypeInfo;
    {$else}
    {$ifdef CPUINTEL}
    fieldinfo := PPointer(field^.TypeInfo)^;
    {$else}
    fieldinfo := DeRef(field^.TypeInfo);
    {$endif}
    {$endif}
    {$ifdef FPC_OLDRTTI} // old FPC did include RTTI for unmanaged fields! :)
    if not (fieldinfo^.Kind in tkManagedTypes) then begin
      inc(field);
      continue; // as with Delphi
    end;
    {$endif};
    offset := integer(field^.Offset)-offset;
    if offset>0 then begin
      MoveFast(R^,Dest^,offset);
      inc(R,offset);
      inc(Dest,offset);
    end;
    Dest := ManagedTypeSave(R,Dest,fieldinfo,offset);
    if Dest=nil then begin
      result := nil; // invalid/unhandled record content
      exit;
    end;
    inc(R,offset);
    inc(offset,field.Offset);
    inc(field);
  end;
  offset := integer(info^.recSize)-offset;
  if offset<0 then
    raise ESynException.Create('RecordSave offset<0') else
  if offset<>0 then begin
    MoveFast(R^,Dest^,offset);
    result := Dest+offset;
  end else
    result := Dest;
end;

function RecordSave(const Rec; Dest: PAnsiChar; TypeInfo: pointer): PAnsiChar;
var dummylen: integer;
begin
  result := RecordSave(Rec,Dest,TypeInfo,dummylen);
end;

function RecordSave(const Rec; TypeInfo: pointer): RawByteString;
var destlen,dummylen: integer;
    dest: PAnsiChar;
begin
  destlen := RecordSaveLength(Rec,TypeInfo);
  SetString(result,nil,destlen);
  if destlen<>0 then begin
    dest := RecordSave(Rec,pointer(result),TypeInfo,dummylen);
    if (dest=nil) or (dest-pointer(result)<>destlen) then // paranoid check
      raise ESynException.CreateUTF8('RecordSave % len=%<>%',
        [TypeInfoToShortString(TypeInfo)^,dest-pointer(result),destlen]);
  end;
end;

function RecordSaveBytes(const Rec; TypeInfo: pointer): TBytes;
var destlen,dummylen: integer;
    dest: PAnsiChar;
begin
  destlen := RecordSaveLength(Rec,TypeInfo);
  result := nil; // don't reallocate TBytes data from a previous call
  SetLength(result,destlen);
  if destlen<>0 then begin
    dest := RecordSave(Rec,pointer(result),TypeInfo,dummylen);
    if (dest=nil) or (dest-pointer(result)<>destlen) then // paranoid check
      raise ESynException.CreateUTF8('RecordSave % len=%<>%',
        [TypeInfoToShortString(TypeInfo)^,dest-pointer(result),destlen]);
  end;
end;

procedure RecordSave(const Rec; var Dest: TSynTempBuffer; TypeInfo: pointer);
var dummylen: integer;
    P: PAnsiChar;
begin
  Dest.Init(RecordSaveLength(Rec,TypeInfo));
  P := RecordSave(Rec,Dest.buf,TypeInfo,dummylen);
  if (P=nil) or (P-Dest.buf<>Dest.len) then begin // paranoid check
    Dest.Done;
    raise ESynException.CreateUTF8('RecordSave TSynTempBuffer %',[TypeInfoToShortString(TypeInfo)^]);
  end;
end;

function RecordSaveBase64(const Rec; TypeInfo: pointer; UriCompatible: boolean): RawUTF8;
var len,dummy: integer;
    temp: TSynTempBuffer;
begin
  result := '';
  len := RecordSaveLength(Rec,TypeInfo);
  if len=0 then
    exit;
  temp.Init(len+4); 
  RecordSave(Rec,PAnsiChar(temp.buf)+4,TypeInfo,dummy);
  PCardinal(temp.buf)^ := crc32c(0,PAnsiChar(temp.buf)+4,len);
  if UriCompatible then
    result := BinToBase64uri(temp.buf,temp.len) else
    result := BinToBase64(temp.buf,temp.len);
  temp.Done;
end;

function RecordLoadBase64(Source: PAnsiChar; Len: PtrInt; var Rec;
  TypeInfo: pointer; UriCompatible: boolean): boolean;
var temp: TSynTempBuffer;
begin
  result := false;
  if Len<=6 then
    exit;
  if UriCompatible then
    result := Base64uriToBin(Source,Len,temp) else
    result := Base64ToBin(Source,Len,temp);
  result := result and (temp.len>=4) and
    (crc32c(0,PAnsiChar(temp.buf)+4,temp.len-4)=PCardinal(temp.buf)^) and
    (RecordLoad(Rec,PAnsiChar(temp.buf)+4,TypeInfo,nil,PAnsiChar(temp.buf)+temp.len)<>nil);
  temp.Done;
end;

function RecordLoad(var Rec; Source: PAnsiChar; TypeInfo: pointer;
  Len: PInteger; SourceMax: PAnsiChar): PAnsiChar;
var info,fieldinfo: PTypeInfo;
    n, F: integer;
    offset: PtrInt;
    field: PFieldInfo;
    R: PAnsiChar;
begin
  result := nil; // indicates error
  R := @Rec;
  info := GetTypeInfo(TypeInfo,tkRecordKinds);
  if (R=nil) or (info=nil) then // should have been checked before
    exit;
  if Len<>nil then
    Len^ := info^.recSize;
  n := GetManagedFields(info,field);
  if Source=nil then begin  // inline RecordClear() function
    for F := 1 to n do begin
      {$ifdef FPC}FPCFinalize{$else}_Finalize{$endif}(R+field^.Offset,Deref(field^.TypeInfo));
      inc(field);
    end;
    exit;
  end;
  offset := 0;
  for F := 1 to n do begin
    {$ifdef HASDIRECTTYPEINFO} // inlined DeRef()
    fieldinfo := field^.TypeInfo;
    {$else}
    {$ifdef CPUINTEL}
    fieldinfo := PPointer(field^.TypeInfo)^;
    {$else}
    fieldinfo := DeRef(field^.TypeInfo);
    {$endif}
    {$endif}
    {$ifdef FPC_OLDRTTI} // old FPC did include RTTI for unmanaged fields! :)
    if not (fieldinfo^.Kind in tkManagedTypes) then begin
      inc(field);
      continue; // as with Delphi
    end;
    {$endif};
    offset := integer(field^.Offset)-offset;
    if offset<>0 then begin
      if (SourceMax<>nil) and (Source+offset>SourceMax) then
        exit;
      MoveFast(Source^,R^,offset);
      inc(Source,offset);
      inc(R,offset);
    end;
    offset := ManagedTypeLoad(R,Source,fieldinfo,SourceMax);
    if Source=nil then
      exit; // error at loading
    inc(R,offset);
    inc(offset,field^.Offset);
    inc(field);
  end;
  offset := integer(info^.recSize)-offset;
  if offset<0 then
    raise ESynException.Create('RecordLoad offset<0') else
  if offset<>0 then begin
    if (SourceMax<>nil) and (Source+offset>SourceMax) then
      exit;
    MoveFast(Source^,R^,offset);
    result := Source+offset;
  end else
    result := Source;
end;

function RecordLoad(var Res; const Source: RawByteString; TypeInfo: pointer): boolean;
var P: PAnsiChar;
begin
  P := pointer(Source);
  P := RecordLoad(Res,P,TypeInfo,nil,P+length(Source));
  result := (P<>nil) and (P-pointer(Source)=length(Source));
end;

{$ifndef FPC}

  {$ifdef USEPACKAGES}
    {$define EXPECTSDELPHIRTLRECORDCOPYCLEAR}
  {$endif}
  {$ifdef DELPHI5OROLDER}
    {$define EXPECTSDELPHIRTLRECORDCOPYCLEAR}
  {$endif}
  {$ifdef PUREPASCAL}
    {$define EXPECTSDELPHIRTLRECORDCOPYCLEAR}
  {$endif}
  {$ifndef DOPATCHTRTL}
    {$define EXPECTSDELPHIRTLRECORDCOPYCLEAR}
  {$endif}

{$ifdef EXPECTSDELPHIRTLRECORDCOPYCLEAR}
procedure RecordCopy(var Dest; const Source; TypeInfo: pointer);
asm // same params than _CopyRecord{ dest, source, typeInfo: Pointer }
  {$ifdef CPU64}
  .noframe
  {$endif}
  jmp System.@CopyRecord
end;

procedure RecordClear(var Dest; TypeInfo: pointer);
asm
  {$ifdef CPU64}
  .noframe
  {$endif}
  jmp System.@FinalizeRecord
end;
{$endif EXPECTSDELPHIRTLRECORDCOPYCLEAR}


{$ifdef DOPATCHTRTL}

function SystemRecordCopyAddress: Pointer;
asm
  {$ifdef CPU64}
  mov rax,offset System.@CopyRecord
  {$else}
  mov eax,offset System.@CopyRecord
  {$endif}
end;

function SystemFinalizeRecordAddress: Pointer;
asm
  {$ifdef CPU64}
  mov rax,offset System.@FinalizeRecord
  {$else}
  mov eax,offset System.@FinalizeRecord
  {$endif}
end;

function SystemInitializeRecordAddress: Pointer;
asm
  {$ifdef CPU64}
  mov rax,offset System.@InitializeRecord
  {$else}
  mov eax,offset System.@InitializeRecord
  {$endif}
end;

{$ifdef CPUX86}
procedure _InitializeRecord(P: Pointer; TypeInfo: Pointer);
asm // faster version by AB
        { ->    EAX pointer to record to be finalized   }
        {       EDX pointer to type info                }
(* // this TObject.Create-like initialization sounds slower
  movzx ecx,byte ptr [edx].TTypeInfo.NameLen
  mov edx,[edx+ecx].TTypeInfo.Size
  xor ecx,ecx
  jmp dword ptr [FillCharFast] *)
        movzx   ecx, byte ptr[edx].TTypeInfo.NameLen
        push    ebx
        mov     ebx, eax
        push    esi
        push    edi
        mov     edi, [edx + ecx].TTypeInfo.ManagedCount
        lea     esi, [edx + ecx].TTypeInfo.ManagedFields
        test    edi, edi
        jz      @end
@loop:  mov     edx, [esi].TFieldInfo.TypeInfo
        mov     eax, [esi].TFieldInfo.&Offset
        mov     edx, [edx]
        add     esi, 8
        movzx   ecx, [edx].TTypeInfo.Kind
        add     eax, ebx // eax=data to be initialized
        jmp     dword ptr[@tab + ecx * 4 - tkLString * 4]
@tab:   dd      @ptr, @ptr, @varrec, @array, @array, @ptr, @ptr, @ptr, @ptr
@ptr:   mov     dword ptr[eax], 0 // pointer initialization
        dec     edi
        jg      @loop
@end:   pop     edi
        pop     esi
        pop     ebx
        ret
@varrec:xor     ecx, ecx
        mov     dword ptr[eax], ecx
        mov     dword ptr[eax + 4], ecx
        mov     dword ptr[eax + 8], ecx
        mov     dword ptr[eax + 12], ecx
        dec     edi
        jg      @loop
        pop     edi
        pop     esi
        pop     ebx
        ret
@array: mov     ecx, 1 // here eax=data edx=typeinfo
        call    System.@InitializeArray
        dec     edi
        jg      @loop
        pop     edi
        pop     esi
        pop     ebx
end;

{$ifndef UNICODE} // TMonitor.Destroy is not available ! -> apply to D2007 only
procedure TObjectCleanupInstance;
asm // faster version by AB
        push    ebx
        mov     ebx, eax
@loop:  mov     ebx, [ebx] // handle three VMT levels per iteration
        mov     edx, [ebx].vmtInitTable
        mov     ebx, [ebx].vmtParent
        test    edx, edx
        jnz     @clr
        test    ebx, ebx
        jz      @end
        mov     ebx, [ebx]
        mov     edx, [ebx].vmtInitTable
        mov     ebx, [ebx].vmtParent
        test    edx, edx
        jnz     @clr
        test    ebx, ebx
        jz      @end
        mov     ebx, [ebx]
        mov     edx, [ebx].vmtInitTable
        mov     ebx, [ebx].vmtParent
        test    edx, edx
        jnz     @clr
        test    ebx, ebx
        jnz     @loop
@end:   pop     ebx
        ret
@clr:   push    offset @loop // TObject has no vmtInitTable -> safe
        jmp     RecordClear // eax=self edx=typeinfo
end;
{$endif}

procedure RecordClear(var Dest; TypeInfo: pointer);
asm // faster version by AB (direct call to finalization procedures)
        { ->    EAX pointer to record to be finalized   }
        {       EDX pointer to type info                }
        { <-    EAX pointer to record to be finalized   }
        movzx   ecx, byte ptr[edx].TTypeInfo.NameLen
        push    ebx
        mov     ebx, eax
        push    esi
        push    edi
        mov     edi, [edx + ecx].TTypeInfo.ManagedCount
        lea     esi, [edx + ecx].TTypeInfo.ManagedFields
        test    edi, edi
        jz      @end
@loop:  mov     edx, [esi].TFieldInfo.TypeInfo
        mov     eax, [esi].TFieldInfo.&Offset
        mov     edx, [edx]
        add     esi, 8
        movzx   ecx, [edx].TTypeInfo.Kind
        add     eax, ebx // eax=data to be initialized
        sub     cl, tkLString
{$ifdef UNICODE}
        cmp     cl, tkUString - tkLString + 1
{$else} cmp     cl, tkDynArray - tkLString + 1
{$endif}
        jnb     @err
        call    dword ptr[@Tab + ecx * 4]
        dec     edi
        jg      @loop
@end:   mov     eax, ebx // keep eax at return (see e.g. TObject.CleanupInstance)
        pop     edi
        pop     esi
        pop     ebx
        ret
        nop
        nop
        nop // align @Tab
@Tab:   dd      System.@LStrClr
{$IFDEF LINUX} // under Linux, WideString are refcounted as AnsiString
        dd      System.@LStrClr
{$else} dd      System.@WStrClr
{$endif}
{$ifdef LVCL}
        dd      @err
{$else} dd      System.@VarClr
{$endif}
        dd      @array
        dd      RecordClear
        dd      System.@IntfClear
        dd      @err
        dd      System.@DynArrayClear
        {$ifdef UNICODE}
        dd      System.@UStrClr
        {$endif}
@err:   mov     al, reInvalidPtr
        pop     edi
        pop     esi
        pop     ebx
        jmp     System.Error
@array: movzx   ecx, [edx].TTypeInfo.NameLen
        add     ecx, edx
        mov     edx, dword ptr[ecx].TTypeInfo.ManagedFields[0] // Fields[0].TypeInfo^
        mov     ecx, [ecx].TTypeInfo.ManagedCount
        mov     edx, [edx]
        call    System.@FinalizeArray
        // we made Call @Array -> ret to continue
end;

procedure RecordCopy(var Dest; const Source; TypeInfo: pointer);
asm  // faster version of _CopyRecord{dest, source, typeInfo: Pointer} by AB
        { ->    EAX pointer to dest             }
        {       EDX pointer to source           }
        {       ECX pointer to typeInfo         }
        push    ebp
        push    ebx
        push    esi
        push    edi
        movzx   ebx, byte ptr[ecx].TTypeInfo.NameLen
        mov     esi, edx                     // esi = source
        mov     edi, eax                     // edi = dest
        add     ebx, ecx                     // ebx = TFieldTable
        xor     eax, eax                     // eax = current offset
        mov     ebp, [ebx].TTypeInfo.ManagedCount // ebp = TFieldInfo count
        mov     ecx, [ebx].TTypeInfo.recSize
        test    ebp, ebp
        jz      @fullcopy
        push    ecx                          // SizeOf(record) on stack
        add     ebx, offset TTypeInfo.ManagedFields[0] // ebx = first TFieldInfo
@next:  mov     ecx, [ebx].TFieldInfo.&Offset
        mov     edx, [ebx].TFieldInfo.TypeInfo
        sub     ecx, eax
        mov     edx, [edx]
        jle     @nomov
        add     esi, ecx
        add     edi, ecx
        neg     ecx
@mov1:  mov     al, [esi + ecx] // fast copy not destructable data
        mov     [edi + ecx], al
        inc     ecx
        jnz     @mov1
@nomov: mov     eax, edi
        movzx   ecx, [edx].TTypeInfo.Kind
        cmp     ecx, tkLString
        je      @LString
        jb      @err
{$ifdef UNICODE}
        cmp     ecx, tkUString
        je      @UString
{$else} cmp     ecx, tkDynArray
        je      @dynaray
{$endif}        ja      @err
        jmp     dword ptr[ecx * 4 + @tab - tkWString * 4]

@Tab:   dd      @WString, @variant, @array, @record, @interface, @err
{$ifdef UNICODE}
        dd      @dynaray
{$endif}
@errv:  mov     al, reVarInvalidOp
        jmp     @err2
@err:   mov     al, reInvalidPtr
@err2:  pop     edi
        pop     esi
        pop     ebx
        pop     ebp
        jmp     System.Error
        nop // all functions below have esi=source edi=dest
@array: movzx   ecx, byte ptr[edx].TTypeInfo.NameLen
        push    dword ptr[edx + ecx].TTypeInfo.recSize
        push    dword ptr[edx + ecx].TTypeInfo.ManagedCount
        mov     ecx, dword ptr[edx + ecx].TTypeInfo.ManagedFields[0] // Fields[0].TypeInfo^
        mov     ecx, [ecx]
        mov     edx, esi
        call    System.@CopyArray
        pop     eax // restore SizeOf(Array)
        jmp     @finish
@record:movzx   ecx, byte ptr[edx].TTypeInfo.NameLen
        mov     ecx, [edx + ecx].TTypeInfo.recSize
        push    ecx
        mov     ecx, edx
        mov     edx, esi
        call    RecordCopy
        pop     eax // restore SizeOf(Record)
        jmp     @finish
        nop
        nop
        nop
@variant:
{$ifdef NOVARCOPYPROC}
        mov     edx, esi
        call    System.@VarCopy
{$else} mov     edx, esi
        cmp     dword ptr[VarCopyProc], 0
        jz      @errv
        call    [VarCopyProc]
{$endif}
        mov     eax, 16
        jmp     @finish
{$ifdef DELPHI6OROLDER}
        nop
        nop
{$endif}
@interface:
        mov     edx, [esi]
        call    System.@IntfCopy
        jmp     @fin4
        nop
        nop
        nop
@dynaray:
        mov     ecx, edx // ecx=TypeInfo
        mov     edx, [esi]
        call    System.@DynArrayAsg
        jmp     @fin4
@WString:
{$ifndef LINUX}
        mov     edx, [esi]
        call    System.@WStrAsg
        jmp     @fin4
{$endif}
@LString:
        mov     edx, [esi]
        call    System.@LStrAsg
{$ifdef UNICODE}
        jmp     @fin4
        nop
        nop
@UString:
        mov     edx, [esi]
        call    System.@UStrAsg
{$endif}
@fin4: mov     eax, 4
@finish:
        add     esi, eax
        add     edi, eax
        add     eax, [ebx].TFieldInfo.&Offset
        add     ebx, 8
        dec     ebp    // any other TFieldInfo?
        jnz     @next
        pop     ecx // ecx= SizeOf(record)
@fullcopy:
        mov     edx, edi
        sub     ecx, eax
        mov     eax, esi
        jle     @nomov2
        call    dword ptr[MoveFast]
@nomov2:        pop     edi
        pop     esi
        pop     ebx
        pop     ebp
end;

{$endif CPUX86}
{$endif DOPATCHTRTL}

{$ifndef CPUARM}

function SystemFillCharAddress: Pointer;
asm
  {$ifdef CPU64}
  mov rax,offset System.@FillChar
  {$else}
  mov eax,offset System.@FillChar
  {$endif}
end;

{$ifndef CPU64}

{$ifndef PUREPASCAL}

procedure FillCharX87;
asm // eax=Dest edx=Count cl=Value
        // faster version by John O'Harrow  (Code Size = 153 Bytes)
        mov     ch, cl                 // copy value into both bytes of cx
        cmp     edx, 32
        jl      @small
        mov     [eax], cx              // fill first 8 bytes
        mov     [eax + 2], cx
        mov     [eax + 4], cx
        mov     [eax + 6], cx
        sub     edx, 16
        fld     qword ptr[eax]
        fst     qword ptr[eax + edx]    // fill last 16 bytes
        fst     qword ptr[eax + edx + 8]
        mov     ecx, eax
        and     ecx, 7                 // 8-byte align writes
        sub     ecx, 8
        sub     eax, ecx
        add     edx, ecx
        add     eax, edx
        neg     edx
@loop:  fst     qword ptr[eax + edx]    // fill 16 bytes per loop
        fst     qword ptr[eax + edx + 8]
        add     edx, 16
        jl      @loop
        ffree   st(0)
        fincstp
        ret
        nop
@small: test    edx, edx
        jle     @done
        mov     [eax + edx - 1], cl      // fill last byte
        and     edx, -2                  // no. of words to fill
        neg     edx
        lea     edx, [@fill + 60 + edx * 2]
        jmp     edx
        nop                              // align jump destinations
        nop
@fill:  mov     [eax + 28], cx
        mov     [eax + 26], cx
        mov     [eax + 24], cx
        mov     [eax + 22], cx
        mov     [eax + 20], cx
        mov     [eax + 18], cx
        mov     [eax + 16], cx
        mov     [eax + 14], cx
        mov     [eax + 12], cx
        mov     [eax + 10], cx
        mov     [eax + 8], cx
        mov     [eax + 6], cx
        mov     [eax + 4], cx
        mov     [eax + 2], cx
        mov     [eax], cx
        ret                         // for 4-bytes @fill alignment
@done:  db      $f3 // rep ret AMD trick here
end;

/// faster implementation of Move() for Delphi versions with no FastCode inside
procedure MoveX87;
asm // eax=source edx=dest ecx=count
         // original code by John O'Harrow - included since delphi 2007
        cmp     eax, edx
        jz      @exit                  // exit if source=dest
        cmp     ecx, 32
        ja      @lrg                   // count > 32 or count < 0
        sub     ecx, 8
        jg      @sml                   // 9..32 byte move
        jmp     dword ptr[@table + 32 + ecx * 4]   // 0..8 byte move
@sml:   fild    qword ptr[eax + ecx]   // load last 8
        fild    qword ptr[eax]         // load first 8
        cmp     ecx, 8
        jle     @sml16
        fild    qword ptr[eax + 8]     // load second 8
        cmp     ecx, 16
        jle     @sml24
        fild    qword ptr[eax + 16]    // load third 8
        fistp   qword ptr[edx + 16]    // save third 8
@sml24: fistp   qword ptr[edx + 8]     // save second 8
@sml16: fistp   qword ptr[edx]         // save first 8
        fistp   qword ptr[edx + ecx]   // save last 8
        ret
@exit:  rep     ret
@table: dd      @exit, @m01, @m02, @m03, @m04, @m05, @m06, @m07, @m08
@lrgfwd:push    edx
        fild    qword ptr[eax]       // first 8
        lea     eax, [eax + ecx - 8]
        lea     ecx, [ecx + edx - 8]
        fild    qword ptr[eax]       // last 8
        push    ecx
        neg     ecx
        and     edx,  -8             // 8-byte align writes
        lea     ecx, [ecx + edx + 8]
        pop     edx
@fwd:   fild    qword ptr[eax + ecx]
        fistp   qword ptr[edx + ecx]
        add     ecx, 8
        jl      @fwd
        fistp   qword ptr[edx]       // last 8
        pop     edx
        fistp   qword ptr[edx]       // first 8
        ret
@lrg:   jng     @exit                // count < 0
        cmp     eax, edx
        ja      @lrgfwd
        sub     edx, ecx
        cmp     eax, edx
        lea     edx, [edx + ecx]
        jna     @lrgfwd
        sub     ecx, 8               // backward move
        push    ecx
        fild    qword ptr[eax + ecx] // last 8
        fild    qword ptr[eax]       // first 8
        add     ecx, edx
        and     ecx, -8              // 8-byte align writes
        sub     ecx, edx
@bwd:   fild    qword ptr[eax + ecx]
        fistp   qword ptr[edx + ecx]
        sub     ecx, 8
        jg      @bwd
        pop     ecx
        fistp   qword ptr[edx]       // first 8
        fistp   qword ptr[edx + ecx] // last 8
        ret
@m01:   movzx   ecx, byte ptr[eax]
        mov     [edx], cl
        ret
@m02:   movzx   ecx, word ptr[eax]
        mov     [edx], cx
        ret
@m03:   mov     cx, [eax]
        mov     al, [eax + 2]
        mov     [edx], cx
        mov     [edx + 2], al
        ret
@m04:   mov     ecx, [eax]
        mov     [edx], ecx
        ret
@m05:   mov     ecx, [eax]
        mov     al, [eax + 4]
        mov     [edx], ecx
        mov     [edx + 4], al
        ret
@m06:   mov     ecx, [eax]
        mov     ax, [eax + 4]
        mov     [edx], ecx
        mov     [edx + 4], ax
        ret
@m07:   mov     ecx, [eax]
        mov     eax, [eax + 3]
        mov     [edx], ecx
        mov     [edx + 3], eax
        ret
@m08:   mov     ecx, [eax]
        mov     eax, [eax + 4]
        mov     [edx], ecx
        mov     [edx + 4], eax
end;

{$ifdef WITH_ERMS}
procedure FillCharERMSB; // Ivy Bridge+ Enhanced REP MOVSB/STOSB CPUs
asm // eax=Dest edx=Count cl=Value
      test    edx, edx
      jle     @none
      cld
      push    edi
      mov     edi, eax
      mov     al, cl
      mov     ecx, edx
      rep     stosb
      pop     edi
@none:
end;

procedure MoveERMSB; // Ivy Bridge+ Enhanced REP MOVSB/STOSB CPUs
asm // eax=source edx=dest ecx=count
      test    ecx, ecx
      jle     @none
      push    esi
      push    edi
      cmp     edx, eax
      ja      @down
      mov     esi, eax
      mov     edi, edx
      cld
      rep movsb
      pop     edi
      pop     esi
@none:ret
@down:lea     esi, [eax + ecx - 1]
      lea     edi, [edx + ecx - 1]
      std
      rep     movsb
      pop     edi
      pop     esi
      cld
end;
{$endif WITH_ERMS}

function StrLenX86(S: pointer): PtrInt;
// pure x86 function (if SSE2 not available) - faster than SysUtils' version
asm
        test    eax, eax
        jz      @0
        cmp     byte ptr[eax + 0], 0
        je      @0
        cmp     byte ptr[eax + 1], 0
        je      @1
        cmp     byte ptr[eax + 2], 0
        je      @2
        cmp     byte ptr[eax + 3], 0
        je      @3
        push    eax
        and     eax, -4              { DWORD Align Reads }
@Loop:  add     eax, 4
        mov     edx, [eax]           { 4 Chars per Loop }
        lea     ecx, [edx - $01010101]
        not     edx
        and     edx, ecx
        and     edx, $80808080       { Set Byte to $80 at each #0 Position }
        jz      @Loop                { Loop until any #0 Found }
        pop     ecx
        bsf     edx, edx             { Find First #0 Position }
        shr     edx, 3               { Byte Offset of First #0 }
        add     eax, edx             { Address of First #0 }
        sub     eax, ecx             { Returns Length }
        ret
@0:     xor     eax, eax
        ret
@1:     mov     eax, 1
        ret
@2:     mov     eax, 2
        ret
@3:     mov     eax, 3
end;

{$ifndef DELPHI5OROLDER} // need SSE2 asm instruction set

procedure FillCharSSE2;
asm // Dest=eax Count=edx Value=cl
        mov     ch, cl                {copy value into both bytes of cx}
        cmp     edx, 32
        jl      @small
        sub     edx, 16
        movd    xmm0, ecx
        pshuflw xmm0, xmm0, 0
        pshufd  xmm0, xmm0, 0
        movups  [eax], xmm0           {fill first 16 bytes}
        movups  [eax + edx], xmm0     {fill last 16 bytes}
        mov     ecx, eax              {16-byte align writes}
        and     ecx, 15
        sub     ecx, 16
        sub     eax, ecx
        add     edx, ecx
        add     eax, edx
        neg     edx
        cmp     edx,  - 512 * 1024
        jb      @large
@loop:  movaps  [eax + edx], xmm0     {fill 16 bytes per loop}
        add     edx, 16
        jl      @loop
        ret
@large: movntdq [eax + edx], xmm0     {fill 16 bytes per loop}
        add     edx, 16
        jl      @large
        ret
@small: test    edx, edx
        jle     @done
        mov     [eax + edx - 1], cl   {fill last byte}
        and     edx,  -2              {no. of words to fill}
        neg     edx
        lea     edx, [@smallfill + 60 + edx * 2]
        jmp     edx
        nop                           {align jump destinations}
        nop
@smallfill:
        mov     [eax + 28], cx
        mov     [eax + 26], cx
        mov     [eax + 24], cx
        mov     [eax + 22], cx
        mov     [eax + 20], cx
        mov     [eax + 18], cx
        mov     [eax + 16], cx
        mov     [eax + 14], cx
        mov     [eax + 12], cx
        mov     [eax + 10], cx
        mov     [eax + 8], cx
        mov     [eax + 6], cx
        mov     [eax + 4], cx
        mov     [eax + 2], cx
        mov     [eax], cx
        ret {do not remove - this is for alignment}
@done:
end;

{$endif DELPHI5OROLDER}

{$endif PUREPASCAL}
{$endif CPU64}
{$endif CPUARM}

{$endif FPC}


{ ************  Custom record / dynamic array JSON serialization }

procedure SaveJSON(const Value; TypeInfo: pointer;
  Options: TTextWriterOptions; var result: RawUTF8);
var temp: TTextWriterStackBuffer;
begin
  with DefaultTextWriterSerializer.CreateOwnedStream(temp) do
  try
    fCustomOptions := fCustomOptions+Options;
    AddTypedJSON(TypeInfo,Value);
    SetText(result);
  finally
    Free;
  end;
end;

function SaveJSON(const Value; TypeInfo: pointer; EnumSetsAsText: boolean): RawUTF8;
var options: TTextWriterOptions;
begin
  if EnumSetsAsText then
    options := [twoEnumSetsAsTextInRecord,twoFullSetsAsStar] else
    options := [twoFullSetsAsStar];
  SaveJSON(Value,TypeInfo,options,result);
end;

type
  /// information about one customized JSON serialization
  TJSONCustomParserRegistration = record
    RecordTypeName: RawUTF8;
    RecordTextDefinition: RawUTF8;
    DynArrayTypeInfo: pointer;
    RecordTypeInfo: pointer;
    Reader: TDynArrayJSONCustomReader;
    Writer: TDynArrayJSONCustomWriter;
    RecordCustomParser: TJSONRecordAbstract;
  end;
  PJSONCustomParserRegistration = ^TJSONCustomParserRegistration;
  TJSONCustomParserRegistrations = array of TJSONCustomParserRegistration;

  PTJSONCustomParserAbstract = ^TJSONRecordAbstract;

  /// used internally to manage custom record / dynamic array JSON serialization
  // - e.g. used by TTextWriter.RegisterCustomJSONSerializer*()
  TJSONCustomParsers = class
  protected
    fLastDynArrayIndex: integer;
    fLastRecordIndex: integer;
    fParser: TJSONCustomParserRegistrations;
    fParsersCount: Integer;
    fParsers: TDynArrayHashed;
    {$ifndef NOVARIANTS}
    fVariants: array of record
      TypeClass: TCustomVariantType;
      Reader: TDynArrayJSONCustomReader;
      Writer: TDynArrayJSONCustomWriter;
    end;
    function VariantSearch(aClass: TCustomVariantType): PtrInt;
    procedure VariantWrite(aClass: TCustomVariantType;
      aWriter: TTextWriter; const aValue: variant; Escape: TTextWriterKind);
    {$endif}
    function TryToGetFromRTTI(aDynArrayTypeInfo, aRecordTypeInfo: pointer): integer;
    function Search(aTypeInfo: pointer; var Reg: TJSONCustomParserRegistration;
      AddIfNotExisting: boolean): integer;
    function DynArraySearch(aDynArrayTypeInfo, aRecordTypeInfo: pointer;
      AddIfNotExisting: boolean=true): integer; overload;
    function RecordSearch(aRecordTypeInfo: pointer;
      AddIfNotExisting: boolean=true): integer; overload;
    function RecordSearch(aRecordTypeInfo: pointer;
      out Reader: TDynArrayJSONCustomReader): boolean; overload;
    function RecordSearch(aRecordTypeInfo: pointer;
      out Writer: TDynArrayJSONCustomWriter; PParser: PTJSONCustomParserAbstract): boolean; overload;
    function RecordSearch(const aTypeName: RawUTF8): integer; overload;
    function RecordRTTITextHash(aRecordTypeInfo: pointer; var crc: cardinal;
      out recsize: integer): boolean;
  public
    constructor Create;
    procedure RegisterCallbacks(aTypeInfo: pointer;
      aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
    function RegisterFromText(aTypeInfo: pointer;
      const aRTTIDefinition: RawUTF8): TJSONRecordAbstract;
    {$ifndef NOVARIANTS}
    procedure RegisterCallbacksVariant(aClass: TCustomVariantType;
      aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
    {$endif}
    property Parser: TJSONCustomParserRegistrations read fParser;
    property ParsersCount: Integer read fParsersCount;
  end;

var
  GlobalJSONCustomParsers: TJSONCustomParsers;

constructor TJSONCustomParsers.Create;
begin
  fParsers.InitSpecific(TypeInfo(TJSONCustomParserRegistrations),
    fParser,djRawUTF8,@fParsersCount,true);
  GarbageCollectorFreeAndNil(GlobalJSONCustomParsers,self);
end;

function TJSONCustomParsers.TryToGetFromRTTI(aDynArrayTypeInfo,
  aRecordTypeInfo: pointer): integer;
var Reg: TJSONCustomParserRegistration;
    RegRoot: TJSONCustomParserRTTI;
    {$ifdef ISDELPHI2010}
    info: PTypeInfo;
    {$endif}
    added: boolean;
    ndx, len: integer;
    name: PShortString;
begin
  result := -1;
  Reg.RecordTypeInfo := aRecordTypeInfo;
  Reg.DynArrayTypeInfo := aDynArrayTypeInfo;
  TypeInfoToName(Reg.RecordTypeInfo,Reg.RecordTypeName);
  if Reg.RecordTypeName='' then begin
    name := TypeInfoToShortString(Reg.DynArrayTypeInfo);
    if name=nil then
      exit; // we need a type name!
    len := length(name^); // try to guess from T*DynArray or T*s names
    if (len>12) and (IdemPropName('DynArray',@name^[len-7],8)) then
      FastSetString(Reg.RecordTypeName,@name^[1],len-8) else
    if (len>3) and (name^[len]='s') then
      FastSetString(Reg.RecordTypeName,@name^[1],len-1) else
      exit;
  end;
  RegRoot := TJSONCustomParserRTTI.CreateFromTypeName('',Reg.RecordTypeName);
  {$ifdef ISDELPHI2010}
  if RegRoot=nil then begin
    info := GetTypeInfo(aRecordTypeInfo,tkRecordKinds);
    if info=nil then
      exit; // not enough RTTI
    inc(PByte(info),info^.ManagedCount*SizeOf(TFieldInfo)-SizeOf(TFieldInfo));
    inc(PByte(info),info^.NumOps*SizeOf(pointer)); // jump RecOps[]
    if info^.AllCount=0 then
      exit; // not enough RTTI -> avoid exception in constructor below
  end;
  {$else}
  if RegRoot=nil then
    exit; // not enough RTTI for older versions of Delphi
  {$endif}
  Reg.RecordCustomParser := TJSONRecordRTTI.Create(Reg.RecordTypeInfo,RegRoot);
  Reg.Reader := Reg.RecordCustomParser.CustomReader;
  Reg.Writer := Reg.RecordCustomParser.CustomWriter;
  if self=nil then
    if GlobalJSONCustomParsers<>nil then // may have been set just above
      self := GlobalJSONCustomParsers else
      self := TJSONCustomParsers.Create;
  ndx := fParsers.FindHashedForAdding(Reg.RecordTypeName,added);
  if not added then
    exit; // name should be unique
  fParser[ndx] := Reg;
  result := ndx;
end;

function TJSONCustomParsers.DynArraySearch(aDynArrayTypeInfo,aRecordTypeInfo: pointer;
  AddIfNotExisting: boolean): Integer;
var threadsafe: integer;
    parser: PJSONCustomParserRegistration;
begin // O(n) brute force is fast enough, since n remains small (mostly<64)
  if self<>nil then
  if (aDynArrayTypeInfo<>nil) and (fParsersCount<>0) then begin
    threadsafe := fLastDynArrayIndex;
    if (cardinal(threadsafe)<cardinal(fParsersCount)) and
       (fParser[threadsafe].DynArrayTypeInfo=aDynArrayTypeInfo) then begin
      result := threadsafe;
      exit;
    end else begin
      if aRecordTypeInfo=nil then // record RTTI not specified: guess now
        aRecordTypeInfo := DynArrayTypeInfoToRecordInfo(aDynArrayTypeInfo);
      if aRecordTypeInfo=nil then begin
        parser := pointer(fParser);
        for result := 0 to fParsersCount-1 do
          if parser^.DynArrayTypeInfo=aDynArrayTypeInfo then begin
            fLastDynArrayIndex := result;
            exit;
          end else
          inc(parser);
      end else begin
        threadsafe := fLastRecordIndex;
        if (cardinal(threadsafe)<cardinal(fParsersCount)) and
           (fParser[threadsafe].RecordTypeInfo=aRecordTypeInfo) then begin
          result := threadsafe;
          exit;
        end else begin
          parser := pointer(fParser);
          for result := 0 to fParsersCount-1 do
            if (parser^.DynArrayTypeInfo=aDynArrayTypeInfo) or
               (parser^.RecordTypeInfo=aRecordTypeInfo) then begin
              fLastDynArrayIndex := result;
              fLastRecordIndex := result;
              exit;
            end else
            inc(parser);
        end;
      end;
    end;
  end;
  if AddIfNotExisting then begin
    result := TryToGetFromRTTI(aDynArrayTypeInfo,aRecordTypeInfo);
    if result>=0 then
      fLastRecordIndex := result;
  end else
    result := -1;
end;

function TJSONCustomParsers.RecordSearch(aRecordTypeInfo: pointer;
  AddIfNotExisting: boolean): integer;
begin
  if aRecordTypeInfo=nil then begin
    result := -1;
    exit;
  end;
  if self<>nil then
    if (cardinal(fLastRecordIndex)<cardinal(fParsersCount)) and
       (fParser[fLastRecordIndex].RecordTypeInfo=aRecordTypeInfo) then begin
      result := fLastRecordIndex;
      exit;
    end else
    for result := 0 to fParsersCount-1 do
      if fParser[result].RecordTypeInfo=aRecordTypeInfo then begin
        fLastRecordIndex := result;
        exit;
      end;
  if AddIfNotExisting then begin
    result := TryToGetFromRTTI(nil,aRecordTypeInfo);
    if result>=0 then
      fLastRecordIndex := result;
  end else
    result := -1;
end;

function TJSONCustomParsers.RecordSearch(const aTypeName: RawUTF8): integer;
begin
  if self=nil then
    result := -1 else
    if (cardinal(fLastRecordIndex)<cardinal(fParsersCount)) and
       IdemPropNameU(fParser[fLastRecordIndex].RecordTypeName,aTypeName) then
      result := fLastRecordIndex else begin
      result := fParsers.FindHashed(aTypeName);
      if result>=0 then
        fLastRecordIndex := result;
    end;
end;

function TJSONCustomParsers.RecordSearch(aRecordTypeInfo: pointer;
  out Reader: TDynArrayJSONCustomReader): boolean;
var ndx: integer;
begin
  ndx := RecordSearch(aRecordTypeInfo);
  if (ndx>=0) and Assigned(fParser[ndx].Reader) then begin
    Reader := fParser[ndx].Reader;
    result := true;
  end else
    result := false;
end;

function TJSONCustomParsers.RecordRTTITextHash(aRecordTypeInfo: pointer;
  var crc: cardinal; out recsize: integer): boolean;
var ndx: integer;
begin
  if (self<>nil) and (aRecordTypeInfo<>nil) then
  for ndx := 0 to fParsersCount-1 do
    with fParser[ndx] do
    if RecordTypeInfo=aRecordTypeInfo then begin
      if RecordTextDefinition='' then
        break;
      crc := crc32c(crc,pointer(RecordTextDefinition),length(RecordTextDefinition));
      recsize := RecordTypeInfoSize(aRecordTypeInfo);
      result := true;
      exit;
    end;
  result := false;
end;

function TJSONCustomParsers.RecordSearch(aRecordTypeInfo: pointer;
  out Writer: TDynArrayJSONCustomWriter; PParser: PTJSONCustomParserAbstract): boolean;
var ndx: integer;
begin
  result := false;
  ndx := RecordSearch(aRecordTypeInfo);
  if (ndx>=0) and Assigned(fParser[ndx].Writer) then begin
    Writer := fParser[ndx].Writer;
    if PParser<>nil then
      PParser^ := fParser[ndx].RecordCustomParser;
    result := true;
  end;
end;

function TJSONCustomParsers.Search(aTypeInfo: pointer;
  var Reg: TJSONCustomParserRegistration; AddIfNotExisting: boolean): integer;
var added: boolean;
begin
  if (aTypeInfo=nil) or (self=nil) then
    raise ESynException.CreateUTF8('%.Search(%)',[self,aTypeInfo]);
  FillCharFast(Reg,SizeOf(Reg),0);
  case PTypeKind(aTypeInfo)^ of
  tkDynArray: begin
    Reg.DynArrayTypeInfo := aTypeInfo;
    Reg.RecordTypeInfo := DynArrayTypeInfoToRecordInfo(aTypeInfo);
    result := DynArraySearch(Reg.DynArrayTypeInfo,Reg.RecordTypeInfo,false);
  end;
  tkRecord{$ifdef FPC},tkObject{$endif}: begin
    Reg.DynArrayTypeInfo := nil;
    Reg.RecordTypeInfo := aTypeInfo;
    result := RecordSearch(Reg.RecordTypeInfo,false);
  end;
  else raise ESynException.CreateUTF8('%.Search: % not a tkDynArray/tkRecord',
    [self,ToText(PTypeKind(aTypeInfo)^)^]);
  end;
  if not AddIfNotExisting then
    exit;
  TypeInfoToName(Reg.RecordTypeInfo,Reg.RecordTypeName);
  if Reg.RecordTypeName='' then
    TypeInfoToName(Reg.DynArrayTypeInfo,Reg.RecordTypeName);
  if Reg.RecordTypeName='' then
    raise ESynException.CreateUTF8('%.Search(%) has no type name',[self,aTypeInfo]);
  if result<0 then
    result := fParsers.FindHashedForAdding(Reg.RecordTypeName,added);
end;

{$ifndef NOVARIANTS}
function TJSONCustomParsers.VariantSearch(aClass: TCustomVariantType): PtrInt;
begin
  if self<>nil then
    for result := 0 to length(fVariants)-1 do
      if fVariants[result].TypeClass=aClass then
        exit;
  result := -1;
end;

procedure TJSONCustomParsers.VariantWrite(aClass: TCustomVariantType;
  aWriter: TTextWriter; const aValue: variant; Escape: TTextWriterKind);
var ndx: PtrInt;
    temp: string;
begin
  ndx := VariantSearch(aClass);
  if (ndx>=0) and Assigned(fVariants[ndx].Writer) then
    fVariants[ndx].Writer(aWriter,aValue) else begin
    temp := aValue; // fallback to JSON string from variant-to-string conversion
    if Escape=twJSONEscape then
      aWriter.Add('"');
    {$ifdef UNICODE}
    aWriter.AddW(pointer(temp),length(temp),Escape);
    {$else}
    aWriter.AddAnsiString(temp,Escape);
    {$endif}
    if Escape=twJSONEscape then
      aWriter.Add('"');
  end;
end;

procedure TJSONCustomParsers.RegisterCallbacksVariant(aClass: TCustomVariantType;
  aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
var ndx: PtrInt;
begin
  if self=nil then
    self := TJSONCustomParsers.Create;
  ndx := VariantSearch(aClass);
  if ndx<0 then begin
    ndx := length(fVariants);
    SetLength(fVariants,ndx+1);
    fVariants[ndx].TypeClass := aClass;
  end;
  fVariants[ndx].Writer := aWriter;
  fVariants[ndx].Reader := aReader;
end;
{$endif}

procedure TJSONCustomParsers.RegisterCallbacks(aTypeInfo: pointer;
  aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
var Reg: TJSONCustomParserRegistration;
    ForAdding: boolean;
    ndx: integer;
begin
  if self=nil then
    self := TJSONCustomParsers.Create;
  ForAdding := Assigned(aReader) or Assigned(aWriter);
  ndx := Search(aTypeInfo,Reg,ForAdding);
  if ForAdding then begin
    Reg.Writer := aWriter;
    Reg.Reader := aReader;
    fParser[ndx] := Reg;
  end else
    if ndx>=0 then begin
      fParsers.Delete(ndx);
      fParsers.ReHash;
    end;
end;

function TJSONCustomParsers.RegisterFromText(aTypeInfo: pointer;
  const aRTTIDefinition: RawUTF8): TJSONRecordAbstract;
var Reg: TJSONCustomParserRegistration;
    ForAdding: boolean;
    ndx: integer;
begin
  if self=nil then
    self := TJSONCustomParsers.Create;
  ForAdding := aRTTIDefinition<>'';
  ndx := Search(aTypeInfo,Reg,ForAdding);
  if ForAdding then begin
    result := TJSONRecordTextDefinition.FromCache(Reg.RecordTypeInfo,aRTTIDefinition);
    Reg.RecordTextDefinition := aRTTIDefinition;
    Reg.Reader := result.CustomReader;
    Reg.Writer := result.CustomWriter;
    Reg.RecordCustomParser := result;
    fParser[ndx] := Reg;
  end else begin
    result := nil;
    if ndx>=0 then begin
      fParsers.Delete(ndx);
      fParsers.ReHash;
    end;
  end;
end;

function ManagedTypeSaveRTTIHash(info: PTypeInfo; var crc: cardinal): integer;
var itemtype: PTypeInfo;
    i, unmanagedsize: integer;
    field: PFieldInfo;
    dynarray: TDynArray;
begin // info is expected to come from a DeRef() if retrieved from RTTI
  result := 0;
  if info=nil then
    exit;
  {$ifdef FPC} // storage binary layout as Delphi's ordinal value
  crc := crc32c(crc,@FPCTODELPHI[info^.Kind],1);
  {$else}
  crc := crc32c(crc,@info^.Kind,1); // hash RTTI kind, but not name
  {$endif}
  case info^.Kind of // handle nested RTTI
  tkLString,{$ifdef FPC}tkLStringOld,{$endif}{$ifdef HASVARUSTRING}tkUString,{$endif}
  tkWString,tkInterface:
    result := SizeOf(pointer);
  {$ifndef NOVARIANTS}
  tkVariant:
    result := SizeOf(variant);
  {$endif}
  tkRecord{$ifdef FPC},tkObject{$endif}: // first search from custom RTTI text
    if not GlobalJSONCustomParsers.RecordRTTITextHash(info,crc,result) then begin
      itemtype := GetTypeInfo(info,tkRecordKinds);
      if itemtype<>nil then begin
        unmanagedsize := itemtype^.recsize;
        for i := 1 to GetManagedFields(itemtype,field) do begin
          info := DeRef(field^.TypeInfo);
          {$ifdef FPC_OLDRTTI} // old FPC did include RTTI for unmanaged fields
          if info^.Kind in tkManagedTypes then // as with Delphi
          {$endif}
            dec(unmanagedsize,ManagedTypeSaveRTTIHash(info,crc));
          inc(field);
        end;
        crc := crc32c(crc,@unmanagedsize,4);
        result := itemtype^.recSize;
      end;
  end;
  tkArray: begin
    itemtype := ArrayItemType(info,result);
    if info=nil then
      exit;
    unmanagedsize := result;
    if itemtype<>nil then
      for i := 1 to info^.elCount do
        dec(unmanagedsize,ManagedTypeSaveRTTIHash(itemtype,crc));
    crc := crc32c(crc,@unmanagedsize,4);
  end;
  tkDynArray: begin
    dynarray.Init(info,field); // fake void array pointer
    crc := dynarray.SaveToTypeInfoHash(crc);
    result := SizeOf(pointer);
  end;
  end;
end;

function TypeInfoToHash(aTypeInfo: pointer): cardinal;
begin
  result := 0;
  ManagedTypeSaveRTTIHash(aTypeInfo,result);
end;

function RecordSaveJSON(const Rec; TypeInfo: pointer; EnumSetsAsText: boolean): RawUTF8;
begin
  result := SaveJSON(Rec,TypeInfo,EnumSetsAsText);
end;

const
  NULCHAR: AnsiChar = #0;

function RecordLoadJSON(var Rec; JSON: PUTF8Char; TypeInfo: pointer; EndOfObject: PUTF8Char
  {$ifndef NOVARIANTS}; CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char;
var wasString, wasValid: boolean;
    Reader: TDynArrayJSONCustomReader;
    FirstChar,EndOfObj: AnsiChar;
    Val: PUTF8Char;
    ValLen: integer;
begin // code below must match TTextWriter.AddRecordJSON
  result := nil; // indicates error
  if JSON=nil then
    exit;
  if (@Rec=nil) or (TypeInfo=nil) then
    raise ESynException.CreateUTF8('Invalid RecordLoadJSON(%) call',[TypeInfo]);
  if JSON^=' ' then repeat inc(JSON); if JSON^=#0 then exit; until JSON^<>' ';
  if PCardinal(JSON)^=JSON_BASE64_MAGIC_QUOTE then begin
    if not (PTypeKind(TypeInfo)^ in tkRecordTypes) then
      raise ESynException.CreateUTF8('RecordLoadJSON(%/%)',
        [PShortString(@PTypeInfo(TypeInfo).NameLen)^,ToText(PTypeKind(TypeInfo)^)^]);
    Val := GetJSONField(JSON,JSON,@wasString,@EndOfObj,@ValLen);
    if (Val=nil) or not wasString or (ValLen<3) or
       (PInteger(Val)^ and $00ffffff<>JSON_BASE64_MAGIC) or
       not RecordLoad(Rec,Base64ToBin(PAnsiChar(Val)+3,ValLen-3),TypeInfo) then
      exit; // invalid content
  end else begin
    if not GlobalJSONCustomParsers.RecordSearch(TypeInfo,Reader) then
      exit;
    FirstChar := JSON^;
    JSON := Reader(JSON,Rec,wasValid{$ifndef NOVARIANTS},CustomVariantOptions{$endif});
    if not wasValid then
      exit;
    if JSON<>nil then
      JSON := GotoNextNotSpace(JSON);
    if (JSON<>nil) and (JSON^<>#0) then
      if FirstChar='"' then // special case e.g. for TGUID string
        EndOfObj := FirstChar else begin
        EndOfObj := JSON^;
        inc(JSON);
      end else
      EndOfObj := #0;
  end;
  if JSON=nil then // end reached, but valid content decoded
    result := @NULCHAR else
    result := JSON;
  if EndOfObject<>nil then
    EndOfObject^ := EndOfObj;
end;

function RecordLoadJSON(var Rec; const JSON: RawUTF8; TypeInfo: pointer{$ifndef NOVARIANTS};
  CustomVariantOptions: PDocVariantOptions{$endif}): boolean;
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON); // make private copy before in-place decoding
  try
    result := RecordLoadJSON(Rec,tmp.buf,TypeInfo,nil
      {$ifndef NOVARIANTS},CustomVariantOptions{$endif})<>nil;
  finally
    tmp.Done;
  end;
end;


{ TJSONCustomParserCustom }

constructor TJSONCustomParserCustom.Create(const aPropertyName, aCustomTypeName: RawUTF8);
begin
  inherited Create(aPropertyName,ptCustom);
  fCustomTypeName := aCustomTypeName;
end;

procedure TJSONCustomParserCustom.FinalizeItem(Data: Pointer);
begin // nothing to be done by default
end;


{ TJSONCustomParserCustomSimple }

constructor TJSONCustomParserCustomSimple.Create(
  const aPropertyName, aCustomTypeName: RawUTF8; aCustomType: pointer);
var info: PTypeInfo;
    kind: TTypeKind;
begin
  inherited Create(aPropertyName,aCustomTypeName);
  fCustomTypeInfo := aCustomType;
  if IdemPropNameU(aCustomTypeName,'TGUID') then begin
    fKnownType := ktGUID;
    fDataSize := SizeOf(TGUID);
  end else
  if fCustomTypeInfo<>nil then begin
    TypeInfoToName(fCustomTypeInfo,fCustomTypeName,aCustomTypeName);
    kind := PTypeKind(fCustomTypeInfo)^;
    info := GetTypeInfo(fCustomTypeInfo,[tkEnumeration,tkSet,tkArray,tkDynArray]);
    fTypeData := info;
    if info<>nil then
    case kind of
    tkEnumeration, tkSet: begin
      fDataSize := ORDTYPE_SIZE[info^.EnumType];
      if kind=tkEnumeration then
        fKnownType := ktEnumeration else
        fKnownType := ktSet;
      exit; // success
    end;
    tkArray: begin
      if info^.dimCount<>1 then
        raise ESynException.CreateUTF8('%.Create("%") supports only single '+
          'dimension static array)',[self,fCustomTypeName]);
      fKnownType := ktStaticArray;
      {$ifdef VER2_6}
      fFixedSize := info^.arraySize; // is elSize in fact
      fDataSize := fFixedSize*info^.elCount;
      {$else}
      fDataSize := info^.arraySize;
      fFixedSize := fDataSize div info^.elCount;
      {$endif}
      fNestedArray := TJSONCustomParserRTTI.CreateFromRTTI(
        '',Deref(info^.arrayType),fFixedSize);
      exit; // success
    end;
    tkDynArray: begin
      fKnownType := ktDynamicArray;
      exit; // success
    end;
    end;
    raise ESynException.CreateUTF8('%.Create("%") unsupported type: % (%)',
      [self,fCustomTypeName,ToText(kind)^,ord(kind)]);
  end;
end;

constructor TJSONCustomParserCustomSimple.CreateFixedArray(
  const aPropertyName: RawUTF8; aFixedSize: cardinal);
begin
  inherited Create(aPropertyName,FormatUTF8('Fixed%Byte',[aFixedSize]));
  fKnownType := ktFixedArray;
  fFixedSize := aFixedSize;
  fDataSize := aFixedSize;
end;

constructor TJSONCustomParserCustomSimple.CreateBinary(
  const aPropertyName: RawUTF8; aDataSize, aFixedSize: cardinal);
begin
  inherited Create(aPropertyName,FormatUTF8('BinHex%Byte',[aFixedSize]));
  fKnownType := ktBinary;
  fFixedSize := aFixedSize;
  fDataSize := aDataSize;
end;

destructor TJSONCustomParserCustomSimple.Destroy;
begin
  inherited;
  fNestedArray.Free;
end;

procedure TJSONCustomParserCustomSimple.CustomWriter(
  const aWriter: TTextWriter; const aValue);
var i: integer;
    V: PByte;
begin
  case fKnownType of
  ktStaticArray: begin
    aWriter.Add('[');
    V := @aValue;
    for i := 1 to PTypeInfo(fTypeData)^.elCount do begin
      fNestedArray.WriteOneLevel(aWriter,V,[]);
      aWriter.Add(',');
    end;
    aWriter.CancelLastComma;
    aWriter.Add(']');
  end;
  ktEnumeration, ktSet:
    aWriter.AddTypedJSON(fCustomTypeInfo,aValue);
  ktDynamicArray:
    raise ESynException.CreateUTF8('%.CustomWriter("%"): unsupported',
        [self,fCustomTypeName]);
  ktBinary:
    if (fFixedSize<=SizeOf(QWord)) and IsZero(@aValue,fFixedSize) then
      aWriter.AddShort('""') else // 0 -> ""
      aWriter.AddBinToHexDisplayQuoted(@aValue,fFixedSize);
  else begin // encoded as JSON strings
    aWriter.Add('"');
    case fKnownType of
    ktGUID:
      aWriter.Add(TGUID(aValue));
    ktFixedArray:
      aWriter.AddBinToHex(@aValue,fFixedSize);
    end;
    aWriter.Add('"');
  end;
  end;
end;

function TJSONCustomParserCustomSimple.CustomReader(P: PUTF8Char; var aValue;
  out EndOfObject: AnsiChar{$ifndef NOVARIANTS}; CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char;
var PropValue: PUTF8Char;
    i, PropValueLen, i32: integer;
    u64: QWord;
    wasString: boolean;
    Val: PByte;
begin
  result := nil; // indicates error
  case fKnownType of
  ktStaticArray: begin
    if P^<>'[' then
      exit; // we expect a true array here
    P := GotoNextNotSpace(P+1);
    if JSONArrayCount(P)<>PTypeInfo(fTypeData)^.elCount then
      exit; // invalid number of items
    Val := @aValue;
    for i := 1 to PTypeInfo(fTypeData)^.elCount do
      if not fNestedArray.ReadOneLevel(
          P,Val,[]{$ifndef NOVARIANTS},CustomVariantOptions{$endif}) then
        exit else
      if P=nil then
        exit;
    P := GotoNextNotSpace(P);
    EndOfObject := P^;
    if P^ in [',','}'] then
      inc(P);
    result := P;
  end;
  ktDynamicArray:
    raise ESynException.CreateUTF8('%.CustomReader("%"): unsupported',
        [self,fCustomTypeName]);
  ktSet: begin
    i32 := GetSetNameValue(fCustomTypeInfo,P,EndOfObject);
    MoveSmall(@i32,@aValue,fDataSize);
    result := P;
  end;
  else begin // encoded as JSON strings or number
    PropValue := GetJSONField(P,P,@wasString,@EndOfObject,@PropValueLen);
    if PropValue=nil then
      exit; // not a JSON string or number
    if P=nil then // result=nil=error + caller may dec(P); P^:=EndOfObject;
      P := PropValue+PropValueLen;
    case fKnownType of
    ktGUID:
      if wasString and (TextToGUID(PropValue,@aValue)<>nil) then
        result := P;
    ktEnumeration: begin
      if wasString then
        i32 := GetEnumNameValue(fCustomTypeInfo,PropValue,PropValueLen,true) else
        i32 := GetCardinal(PropValue);
      if i32<0 then
        exit;
      MoveSmall(@i32,@aValue,fDataSize);
      result := P;
    end;
    ktFixedArray:
      if wasString and (PropValueLen=fFixedSize*2) and
         SynCommons.HexToBin(PAnsiChar(PropValue),@aValue,fFixedSize) then
        result := P;
    ktBinary:
      if wasString then begin // default hexa serialization
        FillCharFast(aValue,fDataSize,0);
        if (PropValueLen=0) or ((PropValueLen=fFixedSize*2) and
           HexDisplayToBin(PAnsiChar(PropValue),@aValue,fFixedSize)) then
          result := P;
      end else
        if fFixedSize<=SizeOf(u64) then begin // allow integer serialization
          SetQWord(PropValue,u64);
          MoveSmall(@u64,@aValue,fDataSize);
          result := P;
        end;
    end;
  end;
  end;
end;


{ TJSONCustomParserCustomRecord }

constructor TJSONCustomParserCustomRecord.Create(
  const aPropertyName: RawUTF8; aCustomTypeIndex: integer);
begin
  fCustomTypeIndex := aCustomTypeIndex;
  with GlobalJSONCustomParsers.fParser[fCustomTypeIndex] do begin
    inherited Create(aPropertyName,RecordTypeName);
    fCustomTypeInfo := RecordTypeInfo;
    fCustomTypeName := RecordTypeName;
  end;
  fDataSize := RecordTypeInfoSize(fCustomTypeInfo);
end;

function TJSONCustomParserCustomRecord.GetJSONCustomParserRegistration: pointer;
begin
  result := nil;
  if GlobalJSONCustomParsers<>nil then begin
    if (Cardinal(fCustomTypeIndex)>=Cardinal(GlobalJSONCustomParsers.fParsersCount)) or
       not IdemPropNameU(fCustomTypeName,
         GlobalJSONCustomParsers.fParser[fCustomTypeIndex].RecordTypeName) then
      fCustomTypeIndex := GlobalJSONCustomParsers.RecordSearch(fCustomTypeInfo);
    if fCustomTypeIndex>=0 then
      result := @GlobalJSONCustomParsers.fParser[fCustomTypeIndex];
  end;
  if result=nil then
    raise ESynException.CreateUTF8(
      '%: [%] type should not have been un-registered',[self,fCustomTypeName]);
end;

procedure TJSONCustomParserCustomRecord.CustomWriter(
  const aWriter: TTextWriter; const aValue);
var parser: PJSONCustomParserRegistration;
begin
  parser := GetJSONCustomParserRegistration;
  parser^.Writer(aWriter,aValue);
end;

function TJSONCustomParserCustomRecord.CustomReader(P: PUTF8Char; var aValue;
  out EndOfObject: AnsiChar{$ifndef NOVARIANTS}; CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char;
var valid: boolean;
    callback: PJSONCustomParserRegistration; // D5/D6 Internal error: C3890
begin
  callback := GetJSONCustomParserRegistration;
  result := callback^.Reader(P,aValue,valid{$ifndef NOVARIANTS},CustomVariantOptions{$endif});
  if not valid then
    result := nil;
  if result=nil then
    exit;
  EndOfObject := result^;
  if result^ in [',','}',']'] then
    inc(result);
end;

procedure TJSONCustomParserCustomRecord.FinalizeItem(Data: Pointer);
begin
  RecordClear(Data^,fCustomTypeInfo);
end;


{ TJSONCustomParserRTTI }

type
  TJSONSerializerFromTextSimple = record
    TypeInfo: pointer;
    BinaryDataSize, BinaryFieldSize: integer;
  end;
  TJSONSerializerFromTextSimpleDynArray = array of TJSONSerializerFromTextSimple;
var // RawUTF8/TJSONSerializerFromTextSimpleDynArray
  GlobalCustomJSONSerializerFromTextSimpleType: TSynDictionary;

procedure JSONSerializerFromTextSimpleTypeAdd(aTypeName: RawUTF8;
  aTypeInfo: pointer; aDataSize, aFieldSize: integer);
var simple: TJSONSerializerFromTextSimple;
begin
  if aTypeName='' then
    TypeInfoToName(aTypeInfo,aTypeName);
  if aDataSize<>0 then
    if aFieldSize>aDataSize then
      raise ESynException.CreateUTF8('JSONSerializerFromTextSimpleTypeAdd(%) fieldsize=%>%',
        [aTypeName,aFieldSize,aDataSize]) else
    if aFieldSize=0 then
      aFieldSize := aDataSize; // not truncated
  simple.TypeInfo := aTypeInfo;
  simple.BinaryDataSize := aDataSize;
  simple.BinaryFieldSize := aFieldSize;
  UpperCaseSelf(aTypeName);
  if GlobalCustomJSONSerializerFromTextSimpleType.Add(aTypeName,simple)<0 then
    raise ESynException.CreateUTF8('JSONSerializerFromTextSimpleTypeAdd(%) duplicated', [aTypeName]);
end;

/// if defined, will try to mimic the default record alignment
// -> is buggy, and compiler revision specific -> we would rather use packed records
{.$define ALIGNCUSTOMREC}

constructor TJSONCustomParserRTTI.Create(const aPropertyName: RawUTF8;
  aPropertyType: TJSONCustomParserRTTIType);
begin
  fPropertyName := aPropertyName;
  fPropertyType := aPropertyType;
end;

class function TJSONCustomParserRTTI.TypeNameToSimpleRTTIType(TypeName: PUTF8Char;
  TypeNameLen: PtrInt; ItemTypeName: PRawUTF8): TJSONCustomParserRTTIType;
const
  SORTEDMAX = {$ifdef NOVARIANTS}32{$else}33{$endif}{$ifdef HASVARUSTRING}+1{$endif};
  SORTEDNAMES: array[0..SORTEDMAX] of PUTF8Char =
    ('ARRAY','BOOLEAN','BYTE','CARDINAL','CURRENCY',
     'DOUBLE','EXTENDED','INT64','INTEGER','PTRINT','PTRUINT','QWORD',
     'RAWBYTESTRING','RAWJSON','RAWUTF8','RECORD','SINGLE',
     'STRING','SYNUNICODE','TCREATETIME','TDATETIME','TDATETIMEMS','TGUID',
     'TID','TMODTIME','TRECORDREFERENCE','TRECORDREFERENCETOBEDELETED',
     'TRECORDVERSION','TSQLRAWBLOB','TTIMELOG',{$ifdef HASVARUSTRING}'UNICODESTRING',{$endif}
     'UTF8STRING',{$ifndef NOVARIANTS}'VARIANT',{$endif}
     'WIDESTRING','WORD');
   // warning: recognized types should match at binary storage level!
   SORTEDTYPES: array[0..SORTEDMAX] of TJSONCustomParserRTTIType =
     (ptArray,ptBoolean,ptByte,ptCardinal,ptCurrency,
      ptDouble,ptExtended,ptInt64,ptInteger,ptPtrInt,ptPtrUInt,ptQWord,
      ptRawByteString,ptRawJSON,ptRawUTF8,ptRecord,ptSingle,
      ptString,ptSynUnicode,ptTimeLog,ptDateTime,ptDateTimeMS,ptGUID,
      ptID,ptTimeLog,ptInt64,ptInt64,ptInt64,ptRawByteString,ptTimeLog,
      {$ifdef HASVARUSTRING}ptUnicodeString,{$endif}ptRawUTF8,
      {$ifndef NOVARIANTS}ptVariant,{$endif}
      ptWideString,ptWord);
var ndx: integer;
    up: PUTF8Char;
    tmp: array[byte] of AnsiChar; // avoid unneeded memory allocation
begin
  if ItemTypeName<>nil then begin
    UpperCaseCopy(TypeName,TypeNameLen,ItemTypeName^);
    up := pointer(ItemTypeName^);
  end else begin
    UpperCopy255Buf(@tmp,TypeName,TypeNameLen);
    up := @tmp;
  end;
//for ndx := 1 to SORTEDMAX do assert(StrComp(SORTEDNAMES[ndx],SORTEDNAMES[ndx-1])>0,SORTEDNAMES[ndx]);
  ndx := FastFindPUTF8CharSorted(@SORTEDNAMES,SORTEDMAX,up);
  if ndx>=0 then
    result := SORTEDTYPES[ndx] else
    result := ptCustom;
end;

class function TJSONCustomParserRTTI.TypeNameToSimpleRTTIType(
  const TypeName: RawUTF8): TJSONCustomParserRTTIType;
begin
  if TypeName='' then
    result := ptCustom else
    result := TypeNameToSimpleRTTIType(Pointer(TypeName),length(TypeName),nil);
end;

class function TJSONCustomParserRTTI.TypeNameToSimpleRTTIType(
  TypeName: PShortString): TJSONCustomParserRTTIType;
begin
  if TypeName=nil then
    result := ptCustom else
    result := TypeNameToSimpleRTTIType(@TypeName^[1],ord(TypeName^[0]),nil);
end;

class function TJSONCustomParserRTTI.TypeInfoToSimpleRTTIType(Info: pointer): TJSONCustomParserRTTIType;
begin
  result := ptCustom; // e.g. for tkRecord
  if Info=nil then
    exit;
  case PTypeKind(Info)^ of // FPC and Delphi will use a fast jmp table
  tkLString{$ifdef FPC},tkLStringOld{$endif}: result := ptRawUTF8;
  tkWString: result := ptWideString;
  {$ifdef HASVARUSTRING}tkUString: result := ptUnicodeString;{$endif}
  {$ifdef FPC_OR_UNICODE}
  tkClassRef,tkPointer{$ifdef UNICODE},tkProcedure{$endif}: result := ptPtrInt;
  {$endif}
  {$ifndef NOVARIANTS}
  tkVariant: result := ptVariant;
  {$endif}
  tkDynArray: result := ptArray;
  tkChar: result := ptByte;
  tkWChar: result := ptWord;
  tkClass, tkMethod, tkInterface: result := ptPtrInt;
  tkInteger:
    case GetTypeInfo(Info)^.IntegerType of
    otSByte,otUByte: result := ptByte;
    otSWord,otUWord: result := ptWord;
    otSLong: result := ptInteger;
    otULong: result := ptCardinal;
    {$ifdef FPC_NEWRTTI}
    otSQWord: result := ptInt64;
    otUQWord: result := ptQWord;
    {$endif}
    end;
  tkInt64:
    {$ifndef FPC} if Info=TypeInfo(QWord) then result := ptQWord else
      {$ifdef UNICODE}with GetTypeInfo(Info)^ do // detect QWord/UInt64
      if MinInt64Value>MaxInt64Value then result := ptQWord else{$endif}{$endif}
      result := ptInt64;
  {$ifdef FPC}
  tkQWord: result := ptQWord;
  tkBool:  result := ptBoolean;
  {$else}
  tkEnumeration: // other enumerates (or tkSet) use TJSONCustomParserCustomSimple
    if Info=TypeInfo(boolean) then
      result := ptBoolean;
  {$endif}
  tkFloat:
    case GetTypeInfo(Info)^.FloatType of
    ftSingle:   result := ptSingle;
    ftDoub:     result := ptDouble;
    ftCurr:     result := ptCurrency;
    ftExtended: result := ptExtended;
    // ftComp: not implemented yet
    end;
  end;
end;

function TypeInfoToRttiType(aTypeInfo: pointer): TJSONCustomParserRTTIType;
begin // first by known name, then from RTTI
  result := TJSONCustomParserRTTI.TypeNameToSimpleRTTIType(
    PUTF8Char(@PTypeInfo(aTypeInfo)^.NameLen)+1,PTypeInfo(aTypeInfo)^.NameLen,nil);
  if result=ptCustom then
    result := TJSONCustomParserRTTI.TypeInfoToSimpleRTTIType(aTypeInfo);
end;

class function TJSONCustomParserRTTI.TypeNameToSimpleBinary(const aTypeName: RawUTF8;
  out aDataSize, aFieldSize: integer): boolean;
var simple: ^TJSONSerializerFromTextSimple;
begin
  simple := GlobalCustomJSONSerializerFromTextSimpleType.FindValue(aTypeName);
  if (simple<>nil) and (simple^.BinaryFieldSize<>0) then begin
    aDataSize := simple^.BinaryDataSize;
    aFieldSize := simple^.BinaryFieldSize;
    result := true;
  end else
    result := false;
end;

class function TJSONCustomParserRTTI.CreateFromRTTI(
  const PropertyName: RawUTF8; Info: pointer; ItemSize: integer): TJSONCustomParserRTTI;
var Item: PTypeInfo absolute Info;
    ItemType: TJSONCustomParserRTTIType;
    ItemTypeName: RawUTF8;
    ndx: integer;
begin
  if Item=nil then // no RTTI -> stored as hexa string
    result := TJSONCustomParserCustomSimple.CreateFixedArray(PropertyName,ItemSize) else begin
    ItemType := TypeNameToSimpleRTTIType(PUTF8Char(@Item.NameLen)+1,Item.NameLen,@ItemTypeName);
    if ItemType=ptCustom then
      ItemType := TypeInfoToSimpleRTTIType(Info);
    if ItemType=ptCustom then
      if Item^.kind in [tkEnumeration,tkArray,tkDynArray,tkSet] then
        result := TJSONCustomParserCustomSimple.Create(
          PropertyName,ItemTypeName,Item) else begin
        ndx := GlobalJSONCustomParsers.RecordSearch(Item);
        if ndx<0 then
          ndx := GlobalJSONCustomParsers.RecordSearch(ItemTypeName);
        if ndx<0 then
          raise ESynException.CreateUTF8('%.CreateFromRTTI("%") unsupported %',
            [self,ItemTypeName,ToText(Item^.kind)^]);
        result := TJSONCustomParserCustomRecord.Create(PropertyName,ndx);
      end else
      result := TJSONCustomParserRTTI.Create(PropertyName,ItemType);
  end;
  if ItemSize<>0 then
    result.fDataSize := ItemSize;
end;

class function TJSONCustomParserRTTI.CreateFromTypeName(
  const aPropertyName, aCustomRecordTypeName: RawUTF8): TJSONCustomParserRTTI;
var ndx: integer;
    simple: ^TJSONSerializerFromTextSimple;
begin
  simple := GlobalCustomJSONSerializerFromTextSimpleType.FindValue(aCustomRecordTypeName);
  if simple<>nil then
    if simple^.BinaryFieldSize<>0 then
      result := TJSONCustomParserCustomSimple.CreateBinary(
        aPropertyName,simple^.BinaryDataSize,simple^.BinaryFieldSize) else
      result := TJSONCustomParserCustomSimple.Create(
        aPropertyName,aCustomRecordTypeName,simple^.TypeInfo) else begin
    ndx := GlobalJSONCustomParsers.RecordSearch(aCustomRecordTypeName);
    if ndx<0 then
      result := nil else
      result := TJSONCustomParserCustomRecord.Create(aPropertyName,ndx);
  end;
end;

procedure TJSONCustomParserRTTI.ComputeFullPropertyName;
var i: PtrInt;
begin
  for i := 0 to length(NestedProperty)-1 do begin
    NestedProperty[i].ComputeFullPropertyName;
    if fFullPropertyName<>'' then
      NestedProperty[i].fFullPropertyName :=
        fFullPropertyName+'.'+NestedProperty[i].fPropertyName;
  end;
end;

procedure TJSONCustomParserRTTI.ComputeNestedDataSize;
var i: PtrInt;
begin
  assert(fNestedDataSize=0);
  fNestedDataSize := 0;
  for i := 0 to length(NestedProperty)-1 do begin
    NestedProperty[i].ComputeDataSizeAfterAdd;
    inc(fNestedDataSize,NestedProperty[i].fDataSize);
    if fFullPropertyName<>'' then
      NestedProperty[i].fFullPropertyName :=
        fFullPropertyName+'.'+NestedProperty[i].fPropertyName;
  end;
end;

procedure TJSONCustomParserRTTI.ComputeDataSizeAfterAdd;
const // binary size (in bytes) of each kind of property - 0 for ptRecord/ptCustom
  JSONRTTI_SIZE: array[TJSONCustomParserRTTIType] of byte = (
    SizeOf(PtrUInt),SizeOf(Boolean),SizeOf(Byte),SizeOf(Cardinal),SizeOf(Currency),
    SizeOf(Double),SizeOf(Extended),SizeOf(Int64),SizeOf(Integer),SizeOf(QWord),
    SizeOf(RawByteString),SizeOf(RawJSON),SizeOf(RawUTF8),0,SizeOf(Single),
    SizeOf(String),SizeOf(SynUnicode),SizeOf(TDateTime),SizeOf(TDateTimeMS),
    SizeOf(TGUID),SizeOf(Int64),SizeOf(TTimeLog),
    {$ifdef HASVARUSTRING}SizeOf(UnicodeString),{$endif}
    {$ifndef NOVARIANTS}SizeOf(Variant),{$endif}
    SizeOf(WideString),SizeOf(Word),0);
var i: PtrInt;
begin
  if fFullPropertyName='' then begin
    fFullPropertyName := fPropertyName;
    ComputeFullPropertyName;
  end;
  if fDataSize=0 then begin
    ComputeNestedDataSize;
    case PropertyType of
    ptRecord:
      for i := 0 to length(NestedProperty)-1 do
        inc(fDataSize,NestedProperty[i].fDataSize);
    //ptCustom: fDataSize already set in TJSONCustomParserCustom.Create()
    else
      fDataSize := JSONRTTI_SIZE[PropertyType];
    end;
    {$ifdef ALIGNCUSTOMREC}
    inc(fDataSize,fDataSize and 7);
    {$endif}
  end;
end;

procedure TJSONCustomParserRTTI.FinalizeNestedRecord(var Data: PByte);
var j: PtrInt;
begin
  for j := 0 to length(NestedProperty)-1 do begin
    case NestedProperty[j].PropertyType of
    ptRawByteString,
    ptRawJSON,
    ptRawUTF8: {$ifdef FPC}Finalize(PRawByteString(Data)^){$else}PRawByteString(Data)^ := ''{$endif};
    ptString:     PString(Data)^ := '';
    ptSynUnicode: PSynUnicode(Data)^ := '';
    {$ifdef HASVARUSTRING}
    ptUnicodeString: PUnicodeString(Data)^ := '';
    {$endif}
    ptWideString: PWideString(Data)^ := '';
    ptArray:      NestedProperty[j].FinalizeNestedArray(PPtrUInt(Data)^);
    {$ifndef NOVARIANTS}
    ptVariant:    VarClear(PVariant(Data)^);
    {$endif}
    ptRecord: begin
      NestedProperty[j].FinalizeNestedRecord(Data);
      continue;
    end;
    ptCustom:
      TJSONCustomParserCustom(NestedProperty[j]).FinalizeItem(Data);
    end;
    inc(Data,NestedProperty[j].fDataSize);
  end;
end;

procedure TJSONCustomParserRTTI.FinalizeNestedArray(var Data: PtrUInt);
var i: integer;
    p: PDynArrayRec;
    ItemData: PByte;
begin
  if Data=0 then
    exit;
  ItemData := pointer(Data);
  p := pointer(Data);
  dec(p);
  Data := 0;
  if (p^.refCnt>=0) and RefCntDecFree(p^.refCnt) then begin
    for i := 1 to p^.length do
      FinalizeNestedRecord(ItemData);
    FreeMem(p);
  end;
end;

procedure TJSONCustomParserRTTI.AllocateNestedArray(var Data: PtrUInt;
  NewLength: integer);
begin
  FinalizeNestedArray(Data);
  if NewLength<=0 then
    exit;
  pointer(Data) := AllocMem(SizeOf(TDynArrayRec)+fNestedDataSize*NewLength);
  PDynArrayRec(Data)^.refCnt := 1;
  PDynArrayRec(Data)^.length := NewLength;
  inc(Data,SizeOf(TDynArrayRec));
end;

procedure TJSONCustomParserRTTI.ReAllocateNestedArray(var Data: PtrUInt;
  NewLength: integer);
var OldLength: integer;
    p: PDynArrayRec;
begin
  p := pointer(Data);
  if p=nil then
    raise ESynException.CreateUTF8('%.ReAllocateNestedArray(nil)',[self]);
  dec(p);
  ReAllocMem(p,SizeOf(p^)+fNestedDataSize*NewLength);
  OldLength := p^.length;
  if NewLength>OldLength then
    FillCharFast(PByteArray(p)[SizeOf(p^)+fNestedDataSize*OldLength],
      fNestedDataSize*(NewLength-OldLength),0);
  p^.length := NewLength;
  inc(p);
  Data := PtrUInt(p);
end;

function TJSONCustomParserRTTI.ReadOneLevel(var P: PUTF8Char; var Data: PByte;
  Options: TJSONCustomParserSerializationOptions{$ifndef NOVARIANTS};
  CustomVariantOptions: PDocVariantOptions{$endif}): boolean;
var EndOfObject: AnsiChar;
  function ProcessValue(const Prop: TJSONCustomParserRTTI; var P: PUTF8Char;
    var Data: PByte): boolean;
  var DynArray: PByte;
      ArrayLen, ArrayCapacity, n, PropValueLen: integer;
      wasString: boolean;
      PropValue, ptr: PUTF8Char;
  label Error;
  begin
    result := false;
    P := GotoNextNotSpace(P);
    case Prop.PropertyType of
    ptRecord: begin
      if not Prop.ReadOneLevel(
          P,Data,Options{$ifndef NOVARIANTS},CustomVariantOptions{$endif}) then
        exit;
      EndOfObject := P^;
      if P^ in [',','}'] then
        inc(P);
      result := true;
      exit;
    end;
    ptArray:
    if (PInteger(P)^=NULL_LOW) and (jcEndOfJSONValueField in JSON_CHARS[P[4]]) then begin
      P := GotoNextNotSpace(P+4);
      EndOfObject := P^;
      if P^<>#0 then //if P^=',' then
        inc(P);
      Prop.FinalizeNestedArray(PPtrUInt(Data)^); // null -> void array
    end else begin
      if P^<>'[' then
        exit; // we expect a true array here
      repeat inc(P) until P^<>' ';
      // try to allocate nested array at once (if not too slow)
      ArrayLen := JSONArrayCount(P,P+131072); // parse up to 128 KB here
      if ArrayLen<0 then // mostly JSONArrayCount()=nil due to PMax
        ArrayCapacity := 512 else
        ArrayCapacity := ArrayLen;
      Prop.AllocateNestedArray(PPtrUInt(Data)^,ArrayCapacity);
      // read array content
      if ArrayLen=0 then begin
        if not NextNotSpaceCharIs(P,']') then
          exit;
      end else begin
        n := 0;
        DynArray := PPointer(Data)^;
        repeat
          inc(n);
          if (ArrayLen<0) and (n>ArrayCapacity) then begin
            ArrayCapacity := NextGrow(ArrayCapacity);
            Prop.ReAllocateNestedArray(PPtrUInt(Data)^,ArrayCapacity);
            DynArray := PPointer(Data)^;
            inc(DynArray,pred(n)*Prop.fNestedDataSize);
          end;
          if Prop.NestedProperty[0].PropertyName='' then begin
            // array of simple type
            ptr := P;
            if not ProcessValue(Prop.NestedProperty[0],ptr,DynArray) or (ptr=nil) then
              goto Error;
            P := ptr;
          end else begin
            // array of record
            ptr := P;
            if not Prop.ReadOneLevel(ptr,DynArray,Options{$ifndef NOVARIANTS},
                 CustomVariantOptions{$endif}) or (ptr=nil) then
              goto Error;
            P := GotoNextNotSpace(ptr);
            EndOfObject := P^;
            if not(P^ in [',',']']) then
              goto Error;
            inc(P);
          end;
          case EndOfObject of
          ',': continue;
          ']': begin
            if ArrayLen<0 then
              Prop.ReAllocateNestedArray(PPtrUInt(Data)^,n) else
              if n<>ArrayLen then
                goto Error;
            break; // we reached end of array
          end;
          else begin
Error:      Prop.FinalizeNestedArray(PPtrUInt(Data)^);
            exit;
           end;
          end;
        until false;
      end;
      if P=nil then
        exit;
      P := GotoNextNotSpace(P);
      EndOfObject := P^;
      if P^<>#0 then //if P^=',' then
        inc(P);
    end;
    ptCustom: begin
      ptr := TJSONCustomParserCustom(Prop).CustomReader(P,Data^,EndOfObject
        {$ifndef NOVARIANTS},CustomVariantOptions{$endif});
      if ptr=nil then
        exit;
      P := ptr;
    end;
    {$ifndef NOVARIANTS}
    ptVariant:
      P := VariantLoadJSON(PVariant(Data)^,P,@EndOfObject,
        @JSON_OPTIONS[soCustomVariantCopiedByReference in Options]);
    {$endif}
    ptRawByteString: begin
      PropValue := GetJSONField(P,ptr,@wasString,@EndOfObject,@PropValueLen);
      if PropValue=nil then // null -> Blob=''
        PRawByteString(Data)^ := '' else
        if not Base64MagicCheckAndDecode(PropValue,PropValueLen,PRawByteString(Data)^) then
          exit;
      P := ptr;
    end;
    ptRawJSON:
      GetJSONItemAsRawJSON(P,PRawJSON(Data)^,@EndOfObject);
    else begin
      PropValue := GetJSONField(P,ptr,@wasString,@EndOfObject,@PropValueLen);
      if (PropValue<>nil) and // PropValue=nil for null
         (wasString<>(Prop.PropertyType in [ptRawUTF8,ptString,ptSynUnicode,
           {$ifdef HASVARUSTRING}ptUnicodeString,{$endif}
           ptDateTime,ptDateTimeMS,ptGUID,ptWideString])) then
         exit;
      P := ptr;
      case Prop.PropertyType of
      ptBoolean:   PBoolean(Data)^ := GetBoolean(PropValue);
      ptByte:      PByte(Data)^ := GetCardinal(PropValue);
      ptCardinal:  PCardinal(Data)^ := GetCardinal(PropValue);
      ptCurrency:  PInt64(Data)^ := StrToCurr64(PropValue);
      ptDouble:    unaligned(PDouble(Data)^) := GetExtended(PropValue);
      ptExtended:  PExtended(Data)^ := GetExtended(PropValue);
      ptInt64,ptID,ptTimeLog: SetInt64(PropValue,PInt64(Data)^);
      ptQWord:     SetQWord(PropValue,PQWord(Data)^);
      ptInteger:   PInteger(Data)^ := GetInteger(PropValue);
      ptSingle:    PSingle(Data)^ := GetExtended(PropValue);
      ptRawUTF8:   FastSetString(PRawUTF8(Data)^,PropValue,PropValueLen);
      ptString:    UTF8DecodeToString(PropValue,PropValueLen,PString(Data)^);
      ptSynUnicode:UTF8ToSynUnicode(PropValue,PropValueLen,PSynUnicode(Data)^);
      {$ifdef HASVARUSTRING}
      ptUnicodeString:UTF8DecodeToUnicodeString(PropValue,PropValueLen,PUnicodeString(Data)^);
      {$endif}
      ptDateTime, ptDateTimeMS:  Iso8601ToDateTimePUTF8CharVar(
                    PropValue,PropValueLen,PDateTime(Data)^);
      ptWideString:UTF8ToWideString(PropValue,PropValueLen,PWideString(Data)^);
      ptWord:      PWord(Data)^ := GetCardinal(PropValue);
      ptGUID:      TextToGUID(PropValue,pointer(Data));
      end;
    end;
    end;
    inc(Data,Prop.fDataSize);
    result := true;
  end;
var i,j: integer;
    PropName: shortstring;
    ptr: PUTF8Char;
    Values: array of PUTF8Char;
begin
  result := false;
  if P=nil then
    exit;
  P := GotoNextNotSpace(P);
  if (PInteger(P)^=NULL_LOW) and (jcEndOfJSONValueField in JSON_CHARS[P[4]]) then begin
    P := GotoNextNotSpace(P+4); // a record stored as null
    inc(Data,fDataSize);
    result := true;
    exit;
  end;
  EndOfObject := #0;
  if not (PropertyType in [ptRecord,ptArray]) then begin
    ptr := P;
    result := ProcessValue(Self,P,Data);
    exit;
  end;
  if P^<>'{' then
    exit; // we expect a true object here
  repeat inc(P) until (P^>' ') or (P^=#0);
  if P^='}' then begin
    inc(Data,fDataSize);
    EndOfObject := '}';
    inc(P);
  end else
  for i := 0 to length(NestedProperty)-1 do begin
    ptr := P;
    GetJSONPropName(ptr,PropName);
    if PropName='' then
      exit;  // invalid JSON content
    P := ptr;
    if IdemPropNameU(NestedProperty[i].PropertyName,@PropName[1],ord(PropName[0])) then begin
      // O(1) optimistic search
      if not ProcessValue(NestedProperty[i],P,Data) then
        exit;
      if EndOfObject='}' then begin // ignore missing properties
        for j := i+1 to length(NestedProperty)-1 do
          inc(Data,NestedProperty[j].fDataSize);
        break;
      end;
    end else begin
      SetLength(Values,length(NestedProperty)); // pessimistic check through all properties
      repeat
        for j := i to length(NestedProperty)-1 do
          if (Values[j]=nil) and
             IdemPropNameU(NestedProperty[j].PropertyName,@PropName[1],ord(PropName[0])) then begin
            Values[j] := P;
            PropName := '';
            break;
          end;
        if (PropName<>'') and not(soReadIgnoreUnknownFields in Options) then
          exit; // unexpected property
        ptr := GotoNextJSONItem(P,1,@EndOfObject);
        if ptr=nil then
          exit;
        P := ptr;
        if EndOfObject='}' then
          break;
        GetJSONPropName(ptr,PropName); // next name
        if PropName='' then
          exit;  // invalid JSON content
        P := ptr;
      until false;
      for j := i to length(NestedProperty)-1 do
        if Values[j]=nil then // ignore missing properties
          inc(Data,NestedProperty[j].fDataSize) else
          if not ProcessValue(NestedProperty[j],Values[j],Data) then
            exit;
      EndOfObject := '}'; // ProcessValue() did update EndOfObject
      break;
    end;
  end;
  if (P<>nil) and (EndOfObject=',') and (soReadIgnoreUnknownFields in Options) then begin
    ptr := GotoNextJSONObjectOrArray(P,'}');
    if ptr=nil then
      exit;
    P := ptr;
  end else
    if EndOfObject<>'}' then
      exit;
  if P<>nil then
    P := GotoNextNotSpace(P);
  result := true;
end;

function Plural(const itemname: shortstring; itemcount: cardinal): shortstring;
var len,L: PtrInt;
begin
  len := (AppendUInt32ToBuffer(@result[1],itemcount)-PUTF8Char(@result[1]))+1;
  result[len] := ' ';
  L := ord(itemname[0]);
  if L in [1..240] then begin // avoid buffer overflow
    MoveSmall(@itemname[1],@result[len+1],L);
    inc(len,L);
    if itemcount>1 then begin
      inc(len);
      result[len] := 's';
    end;
  end;
  result[0] := AnsiChar(len);
end;

function TJSONCustomParserRTTI.IfDefaultSkipped(var Value: PByte): boolean;
begin
  case PropertyType of
    ptBoolean:   result := not PBoolean(Value)^;
    ptByte:      result := PByte(Value)^=0;
    ptWord:      result := PWord(Value)^=0;
    ptInteger,ptCardinal,ptSingle:
                 result := PInteger(Value)^=0;
    ptCurrency,ptDouble,ptInt64,ptQWord,ptID,ptTimeLog,ptDateTime,ptDateTimeMS:
                 result := PInt64(Value)^=0;
    ptExtended:  result := PExtended(Value)^=0;
    {$ifndef NOVARIANTS}
    ptVariant:   result := integer(PVarData(Value)^.VType)<=varNull;
    {$endif}
    ptRawJSON,ptRawByteString,ptRawUTF8,ptString,ptSynUnicode,ptWideString,
    {$ifdef HASVARUSTRING}ptUnicodeString,{$endif}ptArray:
                 result := PPointer(Value)^=nil;
    ptGUID:      result := IsNullGUID(PGUID(Value)^);
    ptRecord:    result := IsZero(Value,fDataSize);
    else         result := false;
  end;
  if result then
    inc(Value,fDataSize);
end;

procedure TJSONCustomParserRTTI.WriteOneSimpleValue(aWriter: TTextWriter; var Value: PByte;
  Options: TJSONCustomParserSerializationOptions);
var DynArray: PByte;
    j: integer;
begin
  case PropertyType of
  ptBoolean:   aWriter.Add(PBoolean(Value)^);
  ptByte:      aWriter.AddU(PByte(Value)^);
  ptCardinal:  aWriter.AddU(PCardinal(Value)^);
  ptCurrency:  aWriter.AddCurr64(PInt64(Value)^);
  ptDouble:    aWriter.AddDouble(unaligned(PDouble(Value)^));
  ptExtended:  aWriter.Add(PExtended(Value)^,EXTENDED_PRECISION);
  ptInt64,ptID,ptTimeLog:
               aWriter.Add(PInt64(Value)^);
  ptQWord:     aWriter.AddQ(PQWord(Value)^);
  ptInteger:   aWriter.Add(PInteger(Value)^);
  ptSingle:    aWriter.AddSingle(PSingle(Value)^);
  ptWord:      aWriter.AddU(PWord(Value)^);
  {$ifndef NOVARIANTS}
  ptVariant:   aWriter.AddVariant(PVariant(Value)^,twJSONEscape);
  {$endif}
  ptRawJSON:   aWriter.AddRawJSON(PRawJSON(Value)^);
  ptRawByteString:
    aWriter.WrBase64(PPointer(Value)^,length(PRawByteString(Value)^),{withMagic=}true);
  ptRawUTF8, ptString, ptSynUnicode,{$ifdef HASVARUSTRING}ptUnicodeString,{$endif}
  ptDateTime, ptDateTimeMS, ptGUID, ptWideString: begin
    aWriter.Add('"');
    case PropertyType of
    ptRawUTF8:       aWriter.AddJSONEscape(PPointer(Value)^);
    ptString:        aWriter.AddJSONEscapeString(PString(Value)^);
    ptSynUnicode,{$ifdef HASVARUSTRING}ptUnicodeString,{$endif}
    ptWideString:    aWriter.AddJSONEscapeW(PPointer(Value)^);
    ptDateTime:      aWriter.AddDateTime(unaligned(PDateTime(Value)^),{withms=}false);
    ptDateTimeMS:    aWriter.AddDateTime(unaligned(PDateTime(Value)^),true);
    ptGUID:          aWriter.Add(PGUID(Value)^);
    end;
    aWriter.Add('"');
  end;
  ptArray: begin
    aWriter.Add('[');
    inc(aWriter.fHumanReadableLevel);
    DynArray := PPointer(Value)^;
    if DynArray<>nil then
      for j := 1 to DynArrayLength(DynArray) do begin
        if soWriteHumanReadable in Options then
          aWriter.AddCRAndIndent;
        if NestedProperty[0].PropertyName='' then  // array of simple
          NestedProperty[0].WriteOneSimpleValue(aWriter,DynArray,Options) else
          WriteOneLevel(aWriter,DynArray,Options); // array of record
        aWriter.Add(',');
        {$ifdef ALIGNCUSTOMREC}
        if PtrUInt(DynArray)and 7<>0 then
          inc(DynArray,8-(PtrUInt(DynArray)and 7));
        {$endif}
      end;
    aWriter.CancelLastComma;
    aWriter.Add(']');
    dec(aWriter.fHumanReadableLevel);
  end;
  ptRecord: begin
    WriteOneLevel(aWriter,Value,Options);
    exit;
  end;
  ptCustom:
    TJSONCustomParserCustom(self).CustomWriter(aWriter,Value^);
  end;
  inc(Value,fDataSize);
end;

procedure TJSONCustomParserRTTI.WriteOneLevel(aWriter: TTextWriter; var P: PByte;
  Options: TJSONCustomParserSerializationOptions);
var i: integer;
    SubProp: TJSONCustomParserRTTI;
begin
  if P=nil then begin
    aWriter.AddShort('null');
    exit;
  end;
  if not (PropertyType in [ptRecord,ptArray]) then begin
    WriteOneSimpleValue(aWriter,P,Options);
    exit;
  end;
  aWriter.Add('{');
  Inc(aWriter.fHumanReadableLevel);
  for i := 0 to length(NestedProperty)-1 do begin
    SubProp := NestedProperty[i];
    if soWriteIgnoreDefault in Options then
      if SubProp.IfDefaultSkipped(P) then
        continue;
    if soWriteHumanReadable in Options then
      aWriter.AddCRAndIndent;
    aWriter.AddFieldName(SubProp.PropertyName);
    if soWriteHumanReadable in Options then
      aWriter.Add(' ');
    SubProp.WriteOneSimpleValue(aWriter,P,Options);
    aWriter.Add(',');
  end;
  aWriter.CancelLastComma;
  dec(aWriter.fHumanReadableLevel);
  if soWriteHumanReadable in Options then
    aWriter.AddCRAndIndent;
  aWriter.Add('}');
end;


{ TJSONRecordAbstract }

constructor TJSONRecordAbstract.Create;
begin
  fItems := TSynObjectList.Create;
end;

function TJSONRecordAbstract.AddItem(const aPropertyName: RawUTF8;
  aPropertyType: TJSONCustomParserRTTIType;
  const aCustomRecordTypeName: RawUTF8): TJSONCustomParserRTTI;
begin
  if aPropertyType=ptCustom then begin
    result := TJSONCustomParserRTTI.CreateFromTypeName(
      aPropertyName,aCustomRecordTypeName);
    if result=nil then
      raise ESynException.CreateUTF8('Unregistered ptCustom for %.AddItem(%: %)',
        [self,aPropertyName,aCustomRecordTypeName]);
  end else
    result := TJSONCustomParserRTTI.Create(aPropertyName,aPropertyType);
  fItems.Add(result);
end;

function TJSONRecordAbstract.CustomReader(P: PUTF8Char; var aValue;
  out aValid: Boolean{$ifndef NOVARIANTS}; CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char;
var Data: PByte;
    EndOfObject: AnsiChar;
begin
  if Root.PropertyType=ptCustom then begin
    result := TJSONCustomParserCustom(Root).CustomReader(P,aValue,EndOfObject
      {$ifndef NOVARIANTS},CustomVariantOptions{$endif});
    aValid := result<>nil;
    if (EndOfObject<>#0) and aValid then begin
       dec(result);
       result^ := EndOfObject; // emulates simple read
     end;
    exit;
  end;
  Data := @aValue;
  aValid := Root.ReadOneLevel(P,Data,Options{$ifndef NOVARIANTS},CustomVariantOptions{$endif});
  result := P;
end;

procedure TJSONRecordAbstract.CustomWriter(const aWriter: TTextWriter; const aValue);
var P: PByte;
    o: TJSONCustomParserSerializationOptions;
begin
  P := @aValue;
  o := Options;
  if twoIgnoreDefaultInRecord in aWriter.CustomOptions then
    include(o,soWriteIgnoreDefault);
  Root.WriteOneLevel(aWriter,P,o);
end;

destructor TJSONRecordAbstract.Destroy;
begin
  FreeAndNil(fItems);
  inherited;
end;


{ TJSONRecordTextDefinition }

var
  JSONCustomParserCache: TRawUTF8List;

class function TJSONRecordTextDefinition.FromCache(aTypeInfo: pointer;
  const aDefinition: RawUTF8): TJSONRecordTextDefinition;
begin
  if JSONCustomParserCache=nil then
    GarbageCollectorFreeAndNil(JSONCustomParserCache,
      TRawUTF8List.Create([fObjectsOwned,fNoDuplicate,fCaseSensitive]));
  result := JSONCustomParserCache.GetObjectFrom(aDefinition);
  if result<>nil then
    exit;
  result := TJSONRecordTextDefinition.Create(aTypeInfo,aDefinition);
  JSONCustomParserCache.AddObjectUnique(aDefinition,@result);
end;

constructor TJSONRecordTextDefinition.Create(aRecordTypeInfo: pointer;
  const aDefinition: RawUTF8);
var P: PUTF8Char;
    recordInfoSize: integer;
begin
  inherited Create;
  fDefinition := aDefinition;
  fRoot := TJSONCustomParserRTTI.Create('',ptRecord);
  TypeInfoToName(aRecordTypeInfo,fRoot.fCustomTypeName);
  fItems.Add(fRoot);
  P := pointer(aDefinition);
  Parse(fRoot,P,eeNothing);
  fRoot.ComputeDataSizeAfterAdd;
  recordInfoSize := RecordTypeInfoSize(aRecordTypeInfo);
  if (recordInfoSize<>0) and (fRoot.fDataSize<>recordInfoSize) then
    raise ESynException.CreateUTF8('%.Create: % text definition is not accurate,'+
      ' or the type has not been defined as PACKED record: RTTI size is %'+
      ' bytes but text definition covers % bytes',
      [self,fRoot.fCustomTypeName,recordInfoSize,fRoot.fDataSize]);
end;

function DynArrayItemTypeLen(const aDynArrayTypeName: RawUTF8): PtrInt;
begin
  result := length(aDynArrayTypeName);
  if (result>12) and IdemPropName('DynArray',@PByteArray(aDynArrayTypeName)[result-8],8) then
    dec(result,8) else
  if (result>3) and (aDynArrayTypeName[result] in ['s','S']) then
    dec(result) else
    result := 0;
end;

function DynArrayItemTypeIsSimpleBinary(const aDynArrayTypeName: RawUTF8): boolean;
var itemLen,dataSize,fieldSize: integer;
begin
  itemLen := DynArrayItemTypeLen(aDynArrayTypeName);
  result := (itemLen>0) and TJSONCustomParserRTTI.TypeNameToSimpleBinary(
    copy(aDynArrayTypeName,1,itemLen),dataSize,fieldSize);
end;

procedure TJSONRecordTextDefinition.Parse(Props: TJSONCustomParserRTTI;
  var P: PUTF8Char; PEnd: TJSONCustomParserRTTIExpectedEnd);
  function GetNextFieldType(var P: PUTF8Char;
    var TypIdent: RawUTF8): TJSONCustomParserRTTIType;
  begin
    if GetNextFieldProp(P,TypIdent) then
      result := TJSONCustomParserRTTI.TypeNameToSimpleRTTIType(
        pointer(TypIdent),length(TypIdent),@TypIdent) else
      raise ESynException.CreateUTF8('%.Parse: missing field type',[self]);
  end;
var PropsName: TRawUTF8DynArray;
    PropsMax, ndx, len, firstNdx: cardinal;
    Typ, ArrayTyp: TJSONCustomParserRTTIType;
    TypIdent, ArrayTypIdent: RawUTF8;
    Item: TJSONCustomParserRTTI;
    ExpectedEnd: TJSONCustomParserRTTIExpectedEnd;
begin
  SetLength(PropsName,16);
  PropsMax := 0;
  while (P<>nil) and (P^<>#0) do begin
    // fill Props[]
    if P^ in ['''','"'] then begin // parse identifier as SQL string (e.g. "@field0")
      P := UnQuoteSQLStringVar(P,PropsName[PropsMax]);
      if P=nil then
        break;
    end else // regular object pascal identifier (i.e. 0..9,a..z,A..Z,_)
      if not GetNextFieldProp(P,PropsName[PropsMax]) then
        break;
    case P^ of
    ',': begin
      inc(P);
      inc(PropsMax);
      if PropsMax=cardinal(length(PropsName)) then
        SetLength(PropsName,PropsMax+16);
      continue; // several properties defined with the same type
    end;
    ':': P := GotoNextNotSpace(P+1);
    end;
    // identify type
    ArrayTyp := ptRecord;
    if P^='{' then begin
      Typ := ptRecord;
      ExpectedEnd := eeCurly;
      repeat inc(P) until (P^>' ') or (P^=#0);
    end else
    if P^='[' then begin
      Typ := ptArray;
      ExpectedEnd := eeSquare;
      repeat inc(P) until (P^>' ') or (P^=#0);
    end else begin
      Typ := GetNextFieldType(P,TypIdent);
      case Typ of
        ptArray: begin
          if IdemPChar(P,'OF') then begin
            P := GotoNextNotSpace(P+2);
            ArrayTyp := GetNextFieldType(P,ArrayTypIdent);
            if ArrayTyp=ptArray then
              P := nil;
          end else
            P := nil;
          if P=nil then
            raise ESynException.CreateUTF8('%.Parse: expected syntax is '+
              '"array of record" or "array of SimpleType"',[self]);
          if ArrayTyp=ptRecord then
            ExpectedEnd := eeEndKeyWord else
            ExpectedEnd := eeNothing;
        end;
        ptRecord:
          ExpectedEnd := eeEndKeyWord;
        ptCustom: begin
          len := DynArrayItemTypeLen(TypIdent);
          if len>0 then begin
            ArrayTyp := TJSONCustomParserRTTI.TypeNameToSimpleRTTIType(
              @PByteArray(TypIdent)[1],len-1,@ArrayTypIdent); // TByteDynArray -> byte
            if ArrayTyp=ptCustom then begin // TMyTypeDynArray/TMyTypes -> TMyType
              FastSetString(ArrayTypIdent,pointer(TypIdent),len);
              if GlobalCustomJSONSerializerFromTextSimpleType.Find(ArrayTypIdent)>=0 then
                Typ := ptArray;
            end else
              Typ := ptArray;
          end;
          ExpectedEnd := eeNothing;
        end;
        else ExpectedEnd := eeNothing;
      end;
    end;
    // add elements
    firstNdx := length(Props.fNestedProperty);
    SetLength(Props.fNestedProperty,firstNdx+PropsMax+1);
    for ndx := 0 to PropsMax do begin
      Item := AddItem(PropsName[ndx],Typ,TypIdent);
      Props.fNestedProperty[firstNdx+ndx] := Item;
      if (Typ=ptArray) and (ArrayTyp<>ptRecord) then begin
        SetLength(Item.fNestedProperty,1);
        Item.fNestedProperty[0] := AddItem('',ArrayTyp,ArrayTypIdent);
      end else
      if Typ in [ptArray,ptRecord] then
        if ndx=0 then // only parse once multiple fields nested type
          Parse(Item,P,ExpectedEnd) else
          Item.fNestedProperty := Props.fNestedProperty[firstNdx].fNestedProperty;
      Item.ComputeDataSizeAfterAdd;
    end;
    // validate expected end
    while P^ in [#1..' ',';'] do inc(P);
    case PEnd of
    eeEndKeyWord:
      if IdemPChar(P,'END') then begin
        inc(P,3);
        while P^ in [#1..' ',';'] do inc(P);
        break;
      end;
    eeSquare:
      if P^=']' then begin
        inc(P);
        break;
      end;
    eeCurly:
      if P^='}' then begin
        inc(P);
        break;
      end;
    end;
    PropsMax := 0;
  end;
end;


{ TJSONRecordRTTI }

constructor TJSONRecordRTTI.Create(aRecordTypeInfo: pointer;
  aRoot: TJSONCustomParserRTTI);
begin
  inherited Create;
  fRecordTypeInfo := aRecordTypeInfo;
  fRoot := aRoot;
  if fRoot=nil then begin
    {$ifdef ISDELPHI2010}
    fRoot := TJSONCustomParserRTTI.Create('',ptRecord);
    FromEnhancedRTTI(fRoot,aRecordTypeInfo);
    if fRoot.fNestedDataSize<>RecordTypeInfoSize(aRecordTypeInfo) then
      raise ESynException.CreateUTF8(
        '%.Create: error when retrieving enhanced RTTI for %',
          [self,fRoot.CustomTypeName]);
    {$else}
    raise ESynException.CreateUTF8('%.Create with no enhanced RTTI for %',
      [self,PShortString(@PTypeInfo(aRecordTypeInfo).NameLen)^]);
    {$endif}
  end;
  fItems.Add(fRoot);
  GarbageCollector.Add(self);
end;

function TJSONRecordRTTI.AddItemFromRTTI(
  const PropertyName: RawUTF8; Info: pointer; ItemSize: integer): TJSONCustomParserRTTI;
begin
  result := TJSONCustomParserRTTI.CreateFromRTTI(PropertyName,Info,ItemSize);
  fItems.Add(result);
end;

{$ifdef ISDELPHI2010}

procedure TJSONRecordRTTI.FromEnhancedRTTI(
  Props: TJSONCustomParserRTTI; Info: pointer);
var FieldTable: PTypeInfo;
    i: integer;
    FieldSize: cardinal;
    RecField: PEnhancedFieldInfo;
    ItemFields: array of PEnhancedFieldInfo;
    ItemField: PTypeInfo;
    ItemFieldName: RawUTF8;
    ItemFieldSize: cardinal;
    Item, ItemArray: TJSONCustomParserRTTI;
begin // only tkRecord is needed here
  FieldTable := GetTypeInfo(Info,tkRecord);
  if FieldTable=nil then
    raise ESynException.CreateUTF8('%.FromEnhancedRTTI(%=record?)',[self,Info]);
  FieldSize := FieldTable^.recSize;
  inc(PByte(FieldTable),FieldTable^.ManagedCount*SizeOf(TFieldInfo)-SizeOf(TFieldInfo));
  inc(PByte(FieldTable),FieldTable^.NumOps*SizeOf(pointer)); // jump RecOps[]
  if FieldTable^.AllCount=0 then
    exit; // not enough RTTI -> will raise an error in Create()
  TypeInfoToName(Info,Props.fCustomTypeName);
  RecField := @FieldTable^.AllFields[0];
  SetLength(ItemFields,FieldTable^.AllCount);
  for i := 0 to FieldTable^.AllCount-1 do begin
    ItemFields[i] := RecField;
    inc(PByte(RecField),RecField^.NameLen); // Delphi: no AlignPtr() needed
    inc(RecField);
    inc(PByte(RecField),PWord(RecField)^);
  end;
  SetLength(Props.fNestedProperty,FieldTable^.AllCount);
  for i := 0 to FieldTable^.AllCount-1 do begin
    if i=FieldTable^.AllCount-1 then
      ItemFieldSize := FieldSize-ItemFields[i].Offset else
      ItemFieldSize := ItemFields[i+1].Offset-ItemFields[i].Offset;
    ItemField := Deref(ItemFields[i]^.TypeInfo);
    FastSetString(ItemFieldName,PAnsiChar(@ItemFields[i]^.NameLen)+1,ItemFields[i]^.NameLen);
    Item := AddItemFromRTTI(ItemFieldName,ItemField,ItemFieldSize);
    Props.fNestedProperty[i] := Item;
    case Item.PropertyType of
    ptArray: begin
      inc(PByte(ItemField),ItemField^.NameLen);
      ItemArray := AddItemFromRTTI('',Deref(ItemField^.elType2),
        ItemField^.elSize {$ifdef FPC}and $7FFFFFFF{$endif});
      if (ItemArray.PropertyType=ptCustom) and
         (ItemArray.ClassType=TJSONCustomParserRTTI) then
        FromEnhancedRTTI(Item,Deref(ItemField^.elType2)) else begin
        SetLength(Item.fNestedProperty,1);
        Item.fNestedProperty[0] := ItemArray;
        Item.ComputeNestedDataSize;
      end;
    end;
    ptCustom:
      if (ItemField<>nil) and (Item.ClassType=TJSONCustomParserRTTI) then
        FromEnhancedRTTI(Item,ItemField);
    end;
  end;
  Props.ComputeNestedDataSize;
end;

{$endif ISDELPHI2010}


{ ************ variant-based process, including JSON/BSON document content }

{$ifndef LVCL}

procedure RawByteStringToVariant(Data: PByte; DataLen: Integer; var Value: variant);
begin
  ClearVariantForString(Value);
  if (Data=nil) or (DataLen<=0) then
    TVarData(Value).VType := varNull else
    SetString(RawByteString(TVarData(Value).VAny),PAnsiChar(Data),DataLen);
end;

procedure RawByteStringToVariant(const Data: RawByteString; var Value: variant);
begin
  ClearVariantForString(Value);
  if Data='' then
    TVarData(Value).VType := varNull else
    RawByteString(TVarData(Value).VAny) := Data;
end;

procedure VariantToRawByteString(const Value: variant; var Dest: RawByteString);
begin
  case integer(TVarData(Value).VType) of
  varEmpty, varNull:
    Dest := '';
  varString:
    Dest := RawByteString(TVarData(Value).VAny);
  else // not from RawByteStringToVariant() -> conversion to string
    Dest := {$ifdef UNICODE}RawByteString{$else}string{$endif}(Value);
  end;
end;

procedure SetVariantNull(var Value: variant);
begin // slightly faster than Value := Null
  VarClear(Value);
  TVarData(Value).VType := varNull;
end;

{$endif LVCL}

function VarDataIsEmptyOrNull(VarData: pointer): Boolean;
var vt: cardinal;
begin
  repeat
    vt := PVarData(VarData)^.VType;
    if vt<>varVariant or varByRef then
      break;
    VarData := PVarData(VarData)^.VPointer;
    if VarData=nil then begin
      result := true;
      exit;
    end;
  until false;
  result := (vt<=varNull) or (vt=varNull or varByRef);
end;

function VarIsEmptyOrNull(const V: Variant): Boolean;
begin
  result := VarDataIsEmptyOrNull(@V);
end;

function VarIs(const V: Variant; const VTypes: TVarDataTypes): Boolean;
var VD: PVarData;
    vt: cardinal;
begin
  VD := @V;
  repeat
    vt := VD^.VType;
    if vt<>varVariant or varByRef then
      break;
    VD := VD^.VPointer;
    if VD=nil then begin
      result := false;
      exit;
    end;
  until false;
  result := vt in VTypes;
end;

function VarIsVoid(const V: Variant): boolean;
var vt: cardinal;
begin
  vt := TVarData(V).VType;
  with TVarData(V) do
    case vt of
    varEmpty,varNull:
      result := true;
    varBoolean:
      result := not VBoolean;
    varString,varOleStr{$ifdef HASVARUSTRING},varUString{$endif}:
      result := VAny=nil;
    varDate:
      result := VInt64=0;
    else
      if vt=varVariant or varByRef then
        result := VarIsVoid(PVariant(VPointer)^) else
      if (vt=varByRef or varString) or (vt=varByRef or varOleStr)
         {$ifdef HASVARUSTRING} or (vt=varByRef or varUString) {$endif} then
        result := PPointer(VAny)^=nil else
      {$ifndef NOVARIANTS}
      if vt=cardinal(DocVariantVType) then
        result := TDocVariantData(V).Count=0 else
      {$endif}
        result := false;
    end;
end;

function VarStringOrNull(const v: RawUTF8): variant;
begin
  if v='' then
    SetVariantNull(result) else
    {$ifdef NOVARIANTS} result := v {$else} RawUTF8ToVariant(v,result) {$endif};
end;

{$ifndef NOVARIANTS}

/// internal method used by VariantLoadJSON(), GetVariantFromJSON() and
// TDocVariantData.InitJSONInPlace()
procedure GetJSONToAnyVariant(var Value: variant; var JSON: PUTF8Char;
  EndOfObject: PUTF8Char; Options: PDocVariantOptions; AllowDouble: boolean); forward;

procedure SetVariantByRef(const Source: Variant; var Dest: Variant);
var vt: cardinal;
begin
  VarClear(Dest);
  vt := TVarData(Source).VType;
  if ((vt and varByRef)<>0) or (vt in [varEmpty..varDate,varBoolean,varShortInt..varWord64]) then
    TVarData(Dest) := TVarData(Source) else
  if not SetVariantUnRefSimpleValue(Source,TVarData(Dest)) then begin
    TVarData(Dest).VType := varVariant or varByRef;
    TVarData(Dest).VPointer := @Source;
  end;
end;

procedure SetVariantByValue(const Source: Variant; var Dest: Variant);
var s: PVarData;
    d: TVarData absolute Dest;
    vt: cardinal;
begin
  s := @Source;
  VarClear(Dest);
  vt := s^.VType;
  if vt=varVariant or varByRef then begin
    s := s^.VPointer;
    vt := s^.VType;
  end;
  case vt of
  varEmpty..varDate,varBoolean,varShortInt..varWord64: begin
    d.VType := vt;
    d.VInt64 := s^.VInt64;
  end;
  varString: begin
    d.VType := varString;
    d.VAny := nil;
    RawByteString(d.VAny) := RawByteString(s^.VAny);
  end;
  varByRef or varString: begin
    d.VType := varString;
    d.VAny := nil;
    RawByteString(d.VAny) := PRawByteString(s^.VAny)^;
  end;
  {$ifdef HASVARUSTRING} varUString, varByRef or varUString, {$endif}
  varOleStr, varByRef or varOleStr: begin
    d.VType := varString;
    d.VAny := nil;
    VariantToUTF8(PVariant(s)^,RawUTF8(d.VAny)); // store a RawUTF8 instance
  end;
  else
    if not SetVariantUnRefSimpleValue(PVariant(s)^,d) then
      if vt=cardinal(DocVariantVType) then
        DocVariantType.CopyByValue(d,s^) else
        Dest := PVariant(s)^;
  end;
end;

procedure ZeroFill(Value: PVarData);
begin // slightly faster than FillChar(Value,SizeOf(Value),0);
  PInt64Array(Value)^[0] := 0;
  PInt64Array(Value)^[1] := 0;
  {$ifdef CPU64}
  //assert(SizeOf(TVarData)=24);
  PInt64Array(Value)^[2] := 0;
  {$endif}
end;

procedure FillZero(var value: variant);
begin
  with TVarData(Value) do
    if cardinal(VType)=varString then
      FillZero(RawByteString(VString));
  VarClear(Value);
end;

procedure RawUTF8ToVariant(Txt: PUTF8Char; TxtLen: integer; var Value: variant);
begin
  ClearVariantForString(Value);
  FastSetString(RawUTF8(TVarData(Value).VString), Txt, TxtLen);
end;

procedure RawUTF8ToVariant(const Txt: RawUTF8; var Value: variant);
begin
  ClearVariantForString(Value);
  if Txt='' then
    exit;
  RawByteString(TVarData(Value).VString) := Txt;
  {$ifdef HASCODEPAGE} // force explicit UTF-8
  SetCodePage(RawByteString(TVarData(Value).VAny),CP_UTF8,false);
  {$endif HASCODEPAGE}
end;

procedure FormatUTF8ToVariant(const Fmt: RawUTF8; const Args: array of const;
  var Value: variant);
begin
  RawUTF8ToVariant(FormatUTF8(Fmt,Args),Value);
end;

function RawUTF8ToVariant(const Txt: RawUTF8): variant;
begin
  RawUTF8ToVariant(Txt,result);
end;

procedure RawUTF8ToVariant(const Txt: RawUTF8; var Value: TVarData;
  ExpectedValueType: cardinal);
begin
  if ExpectedValueType=varString then begin
    RawUTF8ToVariant(Txt,variant(Value));
    exit;
  end;
  VarClear(variant(Value));
  Value.VType := ExpectedValueType;
  Value.VAny := nil; // avoid GPF below
  if Txt<>'' then
  case ExpectedValueType of
    varOleStr:
      UTF8ToWideString(Txt,WideString(Value.VAny));
    {$ifdef HASVARUSTRING}
    varUString:
      UTF8DecodeToUnicodeString(pointer(Txt),length(Txt),UnicodeString(Value.VAny));
    {$endif}
    else raise ESynException.CreateUTF8('RawUTF8ToVariant(ExpectedValueType=%)',
      [ExpectedValueType]);
  end;
end;

function VariantSave(const Value: variant; Dest: PAnsiChar): PAnsiChar;
  procedure ComplexType;
  begin
    try
      Dest := pointer(ToVarString(VariantSaveJSON(Value),PByte(Dest)));
    except
      on Exception do
        Dest := nil; // notify invalid/unhandled variant content
    end;
  end;
var LenBytes: integer;
    tmp: TVarData;
begin
  with TVarData(Value) do
    if VType and varByRef<>0 then
      if VType=varVariant or varByRef then begin
        result := VariantSave(PVariant(VPointer)^,Dest);
        exit;
      end else
      if SetVariantUnRefSimpleValue(Value,tmp) then begin
        result := VariantSave(variant(tmp),Dest-SizeOf(VType));
        exit;
      end;
  with TVarData(Value) do begin
    PWord(Dest)^ := VType;
    inc(Dest,SizeOf(VType));
    case VType of
    varNull, varEmpty: ;
    varShortInt, varByte: begin
      Dest^ := AnsiChar(VByte);
      inc(Dest);
    end;
    varSmallint, varWord, varBoolean: begin
      PWord(Dest)^ := VWord;
      inc(Dest,SizeOf(VWord));
    end;
    varSingle, varLongWord, varInteger: begin
      PInteger(Dest)^ := VInteger;
      inc(Dest,SizeOf(VInteger));
    end;
    varInt64, varWord64, varDouble, varDate, varCurrency:begin
      PInt64(Dest)^ := VInt64;
      inc(Dest,SizeOf(VInt64));
    end;
    varString, varOleStr {$ifdef HASVARUSTRING}, varUString{$endif}: begin
      if PtrUInt(VAny)=0 then
        LenBytes := 0 else begin
        LenBytes := PStrLen(PtrUInt(VAny)-_STRLEN)^;
        {$ifdef HASVARUSTRING}
        if VType=varUString then
          LenBytes := LenBytes*2; // stored length is in bytes, not (wide)chars
        {$endif}
      end;
      Dest := pointer(ToVarUInt32(LenBytes,pointer(Dest)));
      if LenBytes>0 then begin // direct raw copy
        MoveFast(PPtrUInt(VAny)^,Dest^,LenBytes);
        inc(Dest,LenBytes);
      end;
    end;
    else ComplexType; // complex types are stored as JSON
    end;
  end;
  result := Dest;
end;

function VariantSaveLength(const Value: variant): integer;
var tmp: TVarData;
    v: TVarData absolute Value;
begin // match VariantSave() storage
  if v.VType and varByRef<>0 then
    if v.VType=varVariant or varByRef then begin
      result := VariantSaveLength(PVariant(v.VPointer)^);
      exit;
    end else
    if SetVariantUnRefSimpleValue(Value,tmp) then begin
      result := VariantSaveLength(variant(tmp));
      exit;
    end;
  case v.VType of
  varEmpty, varNull:
    result := SizeOf(tmp.VType);
  varShortInt, varByte:
    result := SizeOf(tmp.VByte)+SizeOf(tmp.VType);
  varSmallint, varWord, varBoolean:
    result := SizeOf(tmp.VSmallint)+SizeOf(tmp.VType);
  varSingle, varLongWord, varInteger:
    result := SizeOf(tmp.VInteger)+SizeOf(tmp.VType);
  varInt64, varWord64, varDouble, varDate, varCurrency:
    result := SizeOf(tmp.VInt64)+SizeOf(tmp.VType);
  varString, varOleStr:
    if PtrUInt(v.VAny)=0 then
      result := 1+SizeOf(tmp.VType) else
      result := ToVarUInt32LengthWithData(
        PStrLen(PtrUInt(v.VAny)-_STRLEN)^)+SizeOf(tmp.VType);
  {$ifdef HASVARUSTRING}
  varUString:
    if PtrUInt(v.VAny)=0 then // stored length is in bytes, not (wide)chars
      result := 1+SizeOf(tmp.VType) else
      result := ToVarUInt32LengthWithData(
        PStrLen(PtrUInt(v.VAny)-_STRLEN)^*2)+SizeOf(tmp.VType);
  {$endif}
  else
    try // complex types will be stored as JSON
      result := ToVarUInt32LengthWithData(VariantSaveJSONLength(Value))+SizeOf(tmp.VType);
    except
      on Exception do
        result := 0; // notify invalid/unhandled variant content
    end;
  end;
end;

function VariantSave(const Value: variant): RawByteString;
var P: PAnsiChar;
begin
  SetString(result,nil,VariantSaveLength(Value));
  P := VariantSave(Value,pointer(result));
  if P-pointer(result)<>length(result) then
    raise ESynException.Create('VariantSave length');
end;

function VariantLoad(const Bin: RawByteString;
  CustomVariantOptions: PDocVariantOptions): variant;
begin
  if VariantLoad(result,Pointer(Bin),CustomVariantOptions,
     PAnsiChar(pointer(Bin))+length(Bin))=nil then
    VarClear(result);
end;

function VariantLoad(var Value: variant; Source: PAnsiChar;
  CustomVariantOptions: PDocVariantOptions; SourceMax: PAnsiChar): PAnsiChar;
var JSON: PUTF8Char;
    n: cardinal;
    tmp: TSynTempBuffer; // GetJSON*() does in-place unescape -> private copy
begin
  result := nil; // error
  VarClear(Value);
  if (SourceMax<>nil) and (Source+2>SourceMax) then exit;
  TVarData(Value).VType := PWord(Source)^;
  inc(Source,SizeOf(TVarData(Value).VType));
  case TVarData(Value).VType of
  varNull, varEmpty: ;
  varShortInt, varByte: begin
    if (SourceMax<>nil) and (Source>=SourceMax) then exit;
    TVarData(Value).VByte := byte(Source^);
    inc(Source);
  end;
  varSmallint, varWord, varBoolean: begin
    if (SourceMax<>nil) and (Source+2>SourceMax) then exit;
    TVarData(Value).VWord := PWord(Source)^;
    inc(Source,SizeOf(Word));
  end;
  varSingle, varLongWord, varInteger: begin
    if (SourceMax<>nil) and (Source+4>SourceMax) then exit;
    TVarData(Value).VInteger := PInteger(Source)^;
    inc(Source,SizeOf(Integer));
  end;
  varInt64, varWord64, varDouble, varDate, varCurrency: begin
    if (SourceMax<>nil) and (Source+8>SourceMax) then exit;
    TVarData(Value).VInt64 := PInt64(Source)^;
    inc(Source,SizeOf(Int64));
  end;
  varString, varOleStr {$ifdef HASVARUSTRING}, varUString{$endif}: begin
    TVarData(Value).VAny := nil; // avoid GPF below when assigning a string variable to VAny
    if not FromVarUInt32(PByte(Source),PByte(SourceMax),n) or
       ((SourceMax<>nil) and (Source+n>SourceMax)) then
      exit;
    case TVarData(Value).VType of
    varString:
      FastSetString(RawUTF8(TVarData(Value).VString),Source,n); // explicit RawUTF8
    varOleStr:
      SetString(WideString(TVarData(Value).VAny),PWideChar(Source),n shr 1);
    {$ifdef HASVARUSTRING}
    varUString:
      SetString(UnicodeString(TVarData(Value).VAny),PWideChar(Source),n shr 1);
    {$endif}
    end;
    inc(Source,n);
  end;
  else
    if CustomVariantOptions<>nil then begin
      try // expected format for complex type is JSON (VType may differ)
        if FromVarString(PByte(Source),PByte(SourceMax),tmp) then
        try
          JSON := tmp.buf;
          TVarData(Value).VType := varEmpty; // avoid GPF below
          GetJSONToAnyVariant(Value,JSON,nil,CustomVariantOptions,false);
        finally
          tmp.Done;
        end else
          exit;
      except
        on Exception do
          exit; // notify invalid/unhandled variant content
      end;
    end else
      exit;
  end;
  result := Source;
end;

procedure FromVarVariant(var Source: PByte; var Value: variant;
  CustomVariantOptions: PDocVariantOptions);
begin
  Source := PByte(VariantLoad(Value,PAnsiChar(Source),CustomVariantOptions));
end;

function VariantLoadJSON(var Value: variant; JSON: PUTF8Char; EndOfObject: PUTF8Char;
  TryCustomVariants: PDocVariantOptions; AllowDouble: boolean): PUTF8Char;
var wasString: boolean;
    Val: PUTF8Char;
begin
  result := JSON;
  if JSON=nil then
    exit;
  if TryCustomVariants<>nil then begin
    if dvoJSONObjectParseWithinString in TryCustomVariants^ then begin
      JSON := GotoNextNotSpace(JSON);
      if JSON^='"' then begin
        Val := GetJSONField(result,result,@wasString,EndOfObject);
        GetJSONToAnyVariant(Value,Val,EndOfObject,TryCustomVariants,AllowDouble);
      end else
        GetJSONToAnyVariant(Value,result,EndOfObject,TryCustomVariants,AllowDouble);
    end else
      GetJSONToAnyVariant(Value,result,EndOfObject,TryCustomVariants,AllowDouble);
  end else begin
    Val := GetJSONField(result,result,@wasString,EndOfObject);
    GetVariantFromJSON(Val,wasString,Value,nil,AllowDouble);
  end;
  if result=nil then
    result := @NULCHAR; // reached end, but not invalid input
end;

procedure VariantLoadJSON(var Value: Variant; const JSON: RawUTF8;
  TryCustomVariants: PDocVariantOptions; AllowDouble: boolean);
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON); // temp copy before in-place decoding
  try
    VariantLoadJSON(Value,tmp.buf,nil,TryCustomVariants,AllowDouble);
  finally
    tmp.Done;
  end;
end;

function VariantLoadJSON(const JSON: RawUTF8; TryCustomVariants: PDocVariantOptions;
  AllowDouble: boolean): variant;
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON);
  try
    VariantLoadJSON(result,tmp.buf,nil,TryCustomVariants,AllowDouble);
  finally
    tmp.Done;
  end;
end;

function VariantSaveJSON(const Value: variant; Escape: TTextWriterKind): RawUTF8;
begin
  VariantSaveJSON(Value,Escape,result);
end;

procedure VariantSaveJSON(const Value: variant; Escape: TTextWriterKind;
  var result: RawUTF8);
var temp: TTextWriterStackBuffer;
begin // not very optimized, but fast enough in practice, and creates valid JSON
  with DefaultTextWriterSerializer.CreateOwnedStream(temp) do
  try
    AddVariant(Value,Escape); // may encounter TObjectVariant -> WriteObject
    SetText(result);
  finally
    Free;
  end;
end;

function VariantSaveJSONLength(const Value: variant; Escape: TTextWriterKind): integer;
var Fake: TFakeWriterStream;
    temp: TTextWriterStackBuffer;
begin // will avoid most memory allocations
  Fake := TFakeWriterStream.Create;
  try
    with DefaultTextWriterSerializer.Create(Fake,@temp,SizeOf(temp)) do
    try
      AddVariant(Value,Escape);
      FlushFinal;
      result := fTotalFileSize;
    finally
      Free;
    end;
  finally
    Fake.Free;
  end;
end;

procedure VariantToVarRec(const V: variant; var result: TVarRec);
begin
  result.VType := vtVariant;
  if TVarData(V).VType=varByRef or varVariant then
    result.VVariant := TVarData(V).VPointer else
    result.VVariant := @V;
end;

function VarRecToVariant(const V: TVarRec): variant;
begin
  VarRecToVariant(V,result);
end;

procedure VarRecToVariant(const V: TVarRec; var result: variant);
begin
  VarClear(result);
  with TVarData(result) do
  case V.VType of
    vtPointer:
      VType := varNull;
    vtBoolean: begin
      VType := varBoolean;
      VBoolean := V.VBoolean;
    end;
    vtInteger: begin
      VType := varInteger;
      VInteger := V.VInteger;
    end;
    vtInt64: begin
      VType := varInt64;
      VInt64 := V.VInt64^;
    end;
    {$ifdef FPC}
    vtQWord: begin
      VType := varQWord;
      VQWord := V.VQWord^;
    end;
    {$endif}
    vtCurrency: begin
      VType := varCurrency;
      VCurrency := V.VCurrency^;
    end;
    vtExtended: begin
      VType := varDouble;
      VDouble := V.VExtended^;
    end;
    vtVariant:
      result := V.VVariant^;
    vtAnsiString: begin
      VType := varString;
      VAny := nil;
      RawByteString(VAny) := RawByteString(V.VAnsiString);
    end;
    vtString, {$ifdef HASVARUSTRING}vtUnicodeString,{$endif}
    vtPChar, vtChar, vtWideChar, vtWideString, vtClass: begin
      VType := varString;
      VString := nil; // avoid GPF on next line
      VarRecToUTF8(V,RawUTF8(VString)); // convert to a new RawUTF8 instance
    end;
    vtObject: // class instance will be serialized as a TDocVariant
      ObjectToVariant(V.VObject,result,[woDontStoreDefault]);
    else raise ESynException.CreateUTF8('Unhandled TVarRec.VType=%',[V.VType]);
  end;
end;


{ TSynInvokeableVariantType }

function TSynInvokeableVariantType.IterateCount(const V: TVarData): integer;
begin
  result := -1; // this is not an array
end;

procedure TSynInvokeableVariantType.Iterate(var Dest: TVarData; const V: TVarData;
  Index: integer);
begin // do nothing
end;

{$ifndef FPC}
{$ifndef DELPHI6OROLDER}
function TSynInvokeableVariantType.FixupIdent(const AText: string): string;
begin
  result := AText; // NO uppercased identifier for our custom types!
end;
{$endif DELPHI6OROLDER}
{$endif FPC}

function TSynInvokeableVariantType.IntGet(var Dest: TVarData; const Instance: TVarData;
  Name: PAnsiChar; NameLen: PtrInt): boolean;
begin
  raise ESynException.CreateUTF8('Unexpected %.IntGet(%): this kind of '+
    'custom variant does not support sub-fields',[self,Name]);
end;

function TSynInvokeableVariantType.IntSet(const Instance, Value: TVarData;
  Name: PAnsiChar; NameLen: PtrInt): boolean;
begin
  raise ESynException.CreateUTF8('Unexpected %.IntSet(%): this kind of '+
    'custom variant is read-only',[self,Name]);
end;


function TSynInvokeableVariantType.GetProperty(var Dest: TVarData;
  const V: TVarData; const Name: String): Boolean;
{$ifdef UNICODE} var Buf: array[byte] of AnsiChar; {$endif}
begin
  IntGet(Dest,V,{$ifdef UNICODE}Buf,RawUnicodeToUtf8(Buf,SizeOf(Buf),
    pointer(Name),length(Name),[]){$else}pointer(Name),length(Name){$endif});
  result := true; // IntGet=false+Dest=null e.g. if dvoReturnNullForUnknownProperty
end;

{$ifdef FPC_VARIANTSETVAR} // see http://mantis.freepascal.org/view.php?id=26773
function TSynInvokeableVariantType.SetProperty(var V: TVarData;
  const Name: string; const Value: TVarData): Boolean;
{$else}
function TSynInvokeableVariantType.SetProperty(const V: TVarData;
  const Name: string; const Value: TVarData): Boolean;
{$endif}
var ValueSet: TVarData;
    PropName: PAnsiChar;
    Unicode: pointer;
    PropNameLen, UnicodeLen: PtrInt;
    vt: cardinal;
{$ifdef UNICODE}
    Buf: array[byte] of AnsiChar; // to avoid heap allocation
{$endif}
begin
{$ifdef UNICODE}
  PropNameLen := RawUnicodeToUtf8(Buf,SizeOf(Buf),pointer(Name),length(Name),[]);
  PropName := @Buf[0];
{$else}
  PropName := pointer(Name);
  PropNameLen := length(Name);
{$endif}
  vt := Value.VType;
  if vt=varByRef or varOleStr then begin
    Unicode := PPointer(Value.VAny)^;
    UnicodeLen := length(WideString(Unicode));
  end else
  if vt=varOleStr then begin
    Unicode := Value.VAny;
    UnicodeLen := length(WideString(Unicode));
  end else
  {$ifdef HASVARUSTRING}
  if vt=varByRef or varUString then begin
    Unicode := PPointer(Value.VAny)^;
    UnicodeLen := length(UnicodeString(Unicode));
  end else
  if vt=varUString then begin
    Unicode := Value.VAny;
    UnicodeLen := length(UnicodeString(Unicode));
  end else
  {$endif}
  if SetVariantUnRefSimpleValue(variant(Value),ValueSet) then begin
    result := IntSet(V,ValueSet,PropName,PropNameLen);
    exit;
  end else begin
    result := IntSet(V,Value,PropName,PropNameLen);
    exit;
  end;
  try // unpatched RTL does not like Unicode values :( -> use a temp RawUTF8
    ValueSet.VType := varString;
    ValueSet.VString := nil; // to avoid GPF in next line
    RawUnicodeToUtf8(Unicode,UnicodeLen,RawUTF8(ValueSet.VString));
    result := IntSet(V,ValueSet,PropName,PropNameLen);
  finally
    RawUTF8(ValueSet.VString) := ''; // avoid memory leak
  end;
end;

procedure TSynInvokeableVariantType.Clear(var V: TVarData);
begin
  ZeroFill(@V); // will set V.VType := varEmpty
end;

procedure TSynInvokeableVariantType.Copy(var Dest: TVarData;
  const Source: TVarData; const Indirect: Boolean);
begin
  if Indirect then
    SimplisticCopy(Dest,Source,true) else begin
    VarClear(variant(Dest)); // Dest may be a complex type
    Dest := Source;
  end;
end;

procedure TSynInvokeableVariantType.CopyByValue(var Dest: TVarData; const Source: TVarData);
begin
  Copy(Dest,Source,false);
end;

function TSynInvokeableVariantType.TryJSONToVariant(var JSON: PUTF8Char;
  var Value: variant; EndOfObject: PUTF8Char): boolean;
begin
  result := false;
end;

procedure TSynInvokeableVariantType.ToJSON(W: TTextWriter; const Value: variant;
  Escape: TTextWriterKind);
begin
  raise ESynException.CreateUTF8('%.ToJSON: unimplemented variant type',[self]);
end;

function TSynInvokeableVariantType.IsOfType(const V: variant): boolean;
var vt: cardinal;
    vd: PVarData;
begin
  if self<>nil then begin
    vd := @V;
    repeat
      vt := vd^.VType;
      if vt<>varByRef or varVariant then
        break;
      vd := vd^.VPointer;
    until false;
    result := vt=VarType;
  end else
    result := false;
end;

var // owned by Variants.pas as TInvokeableVariantType/TCustomVariantType
  SynVariantTypes: array of TSynInvokeableVariantType;

function FindSynVariantTypeFromVType(aVarType: cardinal): TSynInvokeableVariantType;
  {$ifdef HASINLINE}inline;{$endif}
var i: integer;
    t: ^TSynInvokeableVariantType;
begin
  t := pointer(SynVariantTypes);
  for i := 1 to length(TObjectDynArray(t)) do begin
    result := t^;
    if result.VarType=aVarType then
      exit;
    inc(t);
  end;
  result := nil;
end;

function TSynInvokeableVariantType.FindSynVariantType(aVarType: Word;
  out CustomType: TSynInvokeableVariantType): boolean;
begin
  if aVarType=VarType then
    CustomType := self else
    CustomType := FindSynVariantTypeFromVType(VarType);
  result := CustomType<>nil;
end;

procedure TSynInvokeableVariantType.Lookup(var Dest: TVarData; const Instance: TVarData;
  FullName: PUTF8Char);
var handler: TSynInvokeableVariantType;
    v, tmp: TVarData; // PVarData wouldn't store e.g. RowID/count
    vt: cardinal;
    itemName: ShortString;
begin
  PInteger(@Dest)^ := varEmpty; // left to Unassigned if not found
  v := Instance;
  repeat
    vt := v.VType;
    if vt<>varByRef or varVariant then
      break;
    v := PVarData(v.VPointer)^;
  until false;
  repeat
    if vt<=varString then
      exit; // we need a complex type to lookup
    GetNextItemShortString(FullName,itemName,'.');
    if itemName[0] in [#0,#255] then
      exit;
    itemName[ord(itemName[0])+1] := #0; // ensure is ASCIIZ
    if vt=VarType then
      handler := self else begin
      handler := FindSynVariantTypeFromVType(vt);
      if handler=nil then
        exit;
    end;
    tmp := v; // v will be modified in-place
    PInteger(@v)^ := varEmpty; // IntGet() would clear it otherwise!
    if not handler.IntGet(v,tmp,@itemName[1],ord(itemName[0])) then
      exit; // property not found
    repeat
      vt := v.VType;
      if vt<>varByRef or varVariant then
        break;
      v := PVarData(v.VPointer)^;
    until false;
    if (vt=cardinal(DocVariantVType)) and (TDocVariantData(v).VCount=0) then
      v.VType := varNull; // recognize void TDocVariant as null
  until FullName=nil;
  Dest := v;
end;

procedure GetJSONToAnyVariant(var Value: variant; var JSON: PUTF8Char;
  EndOfObject: PUTF8Char; Options: PDocVariantOptions; AllowDouble: boolean);
// internal method used by VariantLoadJSON(), GetVariantFromJSON() and
// TDocVariantData.InitJSON()
  procedure ProcessField;
  var val: PUTF8Char;
      wasString: boolean;
  begin
    val := GetJSONField(JSON,JSON,@wasString,EndOfObject);
    GetVariantFromJSON(val,wasString,Value,nil,AllowDouble);
    if JSON=nil then
      JSON := @NULCHAR;
  end;
var i: integer;
    t: ^TSynInvokeableVariantType;
    ToBeParsed: PUTF8Char;
    wasParsedWithinString: boolean;
    wasString: boolean;
begin
  VarClear(Value);
  if (Options<>nil) and (dvoAllowDoubleValue in Options^) then
    AllowDouble := true; // for ProcessField() above
  if EndOfObject<>nil then
    EndOfObject^ := ' ';
  while (JSON^<=' ') and (JSON^<>#0) do inc(JSON);
  if (Options=nil) or (JSON^ in ['-','0'..'9']) or (PInteger(JSON)^=NULL_LOW) or
     (PInteger(JSON)^=TRUE_LOW) or (PInteger(JSON)^=FALSE_LOW) then begin
    ProcessField; // obvious simple type
    exit;
  end;
  wasParsedWithinString := false;
  if JSON^='"' then
    if dvoJSONObjectParseWithinString in Options^ then begin
      ToBeParsed := GetJSONField(JSON,JSON,@wasString,EndOfObject);
      EndOfObject := nil; // already set just above
      wasParsedWithinString := true;
    end else begin
      ProcessField;
      exit;
    end else
      ToBeParsed := JSON;
  t := pointer(SynVariantTypes);
  if (t<>nil) and not(dvoJSONParseDoNotTryCustomVariants in Options^) then
    for i := {$ifdef FPC}0{$else}1{$endif} to PDALen(PtrUInt(t)-_DALEN)^ do
      if t^.TryJSONToVariant(ToBeParsed,Value,EndOfObject) then begin
        if not wasParsedWithinString then
          JSON := ToBeParsed;
        exit;
      end else
      inc(t);
  if ToBeParsed^ in ['[','{'] then begin
    // default JSON parsing and conversion to TDocVariant instance
    ToBeParsed := TDocVariantData(Value).InitJSONInPlace(ToBeParsed,Options^,EndOfObject);
    if ToBeParsed=nil then begin
      TDocVariantData(Value).Clear;
      exit; // eror parsing
    end;
    if not wasParsedWithinString then
      JSON := ToBeParsed;
  end else
    // back to simple variant types
    if wasParsedWithinString then
      GetVariantFromJSON(ToBeParsed,wasString,Value,nil,AllowDouble) else
      ProcessField;
end;

function TextToVariantNumberTypeNoDouble(json: PUTF8Char): cardinal;
var start: PUTF8Char;
    c: AnsiChar;
begin
  result := varString;
  c := json[0];
  if (jcDigitFirstChar in JSON_CHARS[c]) and
     (((c>='1') and (c<='9')) or // is first char numeric?
     ((c='0') and ((json[1]='.') or (json[1]=#0))) or // '012' excluded by JSON
     ((c='-') and (json[1]>='0') and (json[1]<='9'))) then begin
    start := json;
    repeat inc(json) until (json^<'0') or (json^>'9'); // check digits
    case json^ of
    '.':
      if (json[1]>='0') and (json[1]<='9') and (json[2] in [#0,'0'..'9']) then
        if (json[2]=#0) or (json[3]=#0) or
           ((json[3]>='0') and (json[3]<='9') and (json[4]=#0) or
            ((json[4]>='0') and (json[4]<='9') and (json[5]=#0))) then
          result := varCurrency; // currency ###.1234 number
    #0:
      if json-start<=19 then // signed Int64 precision
        result := varInt64;
    end;
  end;
end;

function TextToVariantNumberType(json: PUTF8Char): cardinal;
var start: PUTF8Char;
    exp: PtrInt;
    c: AnsiChar;
label exponent;
begin
  result := varString;
  c := json[0];
  if (jcDigitFirstChar in JSON_CHARS[c]) and
     (((c>='1') and (c<='9')) or // is first char numeric?
     ((c='0') and ((json[1]='.') or (json[1]=#0))) or // '012' excluded by JSON
     ((c='-') and (json[1]>='0') and (json[1]<='9'))) then begin
    start := json;
    repeat inc(json) until (json^<'0') or (json^>'9'); // check digits
    case json^ of
    #0:
      if json-start<=19 then // signed Int64 precision
        result := varInt64 else
        result := varDouble; // we may lost precision, but still a number
    '.':
      if (json[1]>='0') and (json[1]<='9') and (json[2] in [#0,'e','E','0'..'9']) then
        if (json[2]=#0) or (json[3]=#0) or
           ((json[3]>='0') and (json[3]<='9') and (json[4]=#0) or
            ((json[4]>='0') and (json[4]<='9') and (json[5]=#0))) then
          result := varCurrency // currency ###.1234 number
        else begin
          repeat // more than 4 decimals
            inc(json)
          until (json^<'0') or (json^>'9');
          case json^ of
          #0:
            result := varDouble;
          'e','E': begin
exponent:   inc(json); // inlined custom GetInteger()
            start := json;
            c := json^;
            if (c='-') or (c='+') then begin
              inc(json);
              c := json^;
            end;
            inc(json);
            dec(c,48);
            if c>#9 then
              exit;
            exp := ord(c);
            c := json^;
            dec(c,48);
            if c<=#9 then begin
              inc(json);
              exp := exp*10+ord(c);
              c := json^;
              dec(c,48);
              if c<=#9 then begin
                inc(json);
                exp := exp*10+ord(c);
              end;
            end;
            if json^<>#0 then
              exit;
            if start^='-' then
              exp := -exp;
            if (exp>-324) and (exp<308) then
              result := varDouble; // 5.0 x 10^-324 .. 1.7 x 10^308
          end;
          end;
        end;
    'e','E':
      goto exponent;
    end;
  end;
end;

function GetNumericVariantFromJSON(JSON: PUTF8Char; var Value: TVarData;
  AllowVarDouble: boolean): boolean;
var err: integer;
    typ: cardinal;
label dbl;
begin
  if JSON<>nil then begin
    if AllowVarDouble then
      typ := TextToVariantNumberType(JSON) else
      typ := TextToVariantNumberTypeNoDouble(JSON);
    with Value do
    case typ of
    varInt64: begin
      VInt64 := GetInt64(JSON,err);
      if err<>0 then // overflow (>$7FFFFFFFFFFFFFFF) -> try floating point
        if AllowVarDouble then
          goto dbl else begin
          result:= false;
          exit;
        end;
      if (VInt64<=high(integer)) and (VInt64>=low(integer)) then
        VType := varInteger else
        VType := varInt64;
      result := true;
      exit;
    end;
    varCurrency: begin
      VInt64 := StrToCurr64(JSON);
      VType := varCurrency;
      result := true;
      exit;
    end;
    varDouble: begin
dbl:  VDouble := GetExtended(JSON,err);
      if err=0 then begin
        VType := varDouble;
        result := true;
        exit;
      end;
    end;
    end;
  end;
  result := false;
end;

procedure JSONToVariantInPlace(var Value: variant; JSON: PUTF8Char;
  Options: TDocVariantOptions; AllowDouble: boolean);
begin
  if (JSON<>nil) and (JSON^<>#0) then
    GetJSONToAnyVariant(Value,JSON,nil,@Options,AllowDouble) else
    VarClear(Value);
end;

function JSONToVariant(const JSON: RawUTF8; Options: TDocVariantOptions;
  AllowDouble: boolean): variant;
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON); // temp copy before in-place decoding
  try
    JSONToVariantInPlace(result,tmp.buf,Options,AllowDouble);
  finally
    tmp.Done;
  end;
end;

procedure TextToVariant(const aValue: RawUTF8; AllowVarDouble: boolean;
  out aDest: variant);
begin
  if not GetNumericVariantFromJSON(pointer(aValue),TVarData(aDest),AllowVarDouble) then
    RawUTF8ToVariant(aValue,aDest);
end;

function GetNextItemToVariant(var P: PUTF8Char; out Value: Variant;
  Sep: AnsiChar; AllowDouble: boolean): boolean;
var temp: RawUTF8;
begin
  if P=nil then
    result := false else begin
    GetNextItem(P,Sep,temp);
    if not GetNumericVariantFromJSON(pointer(temp),TVarData(Value),AllowDouble) then
      RawUTF8ToVariant(temp,Value);
    result := true;
  end;
end;

function GetVariantFromNotStringJSON(JSON: PUTF8Char; var Value: TVarData;
  AllowDouble: boolean): boolean;
begin
  if JSON<>nil then
    while (JSON^<=' ') and (JSON^<>#0) do inc(JSON);
  if (JSON=nil) or
     ((PInteger(JSON)^=NULL_LOW) and (jcEndOfJSONValueField in JSON_CHARS[JSON[4]])) then
    Value.VType := varNull else
  if (PInteger(JSON)^=FALSE_LOW) and (JSON[4]='e') and
     (jcEndOfJSONValueField in JSON_CHARS[JSON[5]]) then begin
    Value.VType := varBoolean;
    Value.VBoolean := false;
  end else
  if (PInteger(JSON)^=TRUE_LOW) and (jcEndOfJSONValueField in JSON_CHARS[JSON[4]]) then begin
    Value.VType := varBoolean;
    Value.VBoolean := true;
  end else
    if not GetNumericVariantFromJSON(JSON,Value,AllowDouble) then begin
      result := false;
      exit;
    end;
  result := true;
end;

procedure GetVariantFromJSON(JSON: PUTF8Char; wasString: Boolean; var Value: variant;
  TryCustomVariants: PDocVariantOptions; AllowDouble: boolean);
begin
  // first handle any strict-JSON syntax objects or arrays into custom variants
  // (e.g. when called directly from TSQLPropInfoRTTIVariant.SetValue)
  if (TryCustomVariants<>nil) and (JSON<>nil) then
    if (GotoNextNotSpace(JSON)^ in ['{','[']) and not wasString then begin
      GetJSONToAnyVariant(Value,JSON,nil,TryCustomVariants,AllowDouble);
      exit;
    end else
    AllowDouble := dvoAllowDoubleValue in TryCustomVariants^;
  // handle simple text or numerical values
  VarClear(Value);
  if not wasString and GetVariantFromNotStringJSON(JSON,TVarData(Value),AllowDouble) then
    exit;
  with TVarData(Value) do begin
    // found no numerical value -> return a string in the expected format
    VType := varString;
    VString := nil; // avoid GPF below when assigning a string variable to VAny
    FastSetString(RawUTF8(VString),JSON,StrLen(JSON));
  end;
end;

{$ifndef FPC} // better not try it with FPC - rely on the current implementation

function ParseParamPointer(P: pointer; aType: cardinal; var Value: TVarData): pointer;
var Size: Cardinal;
    ByRef: Boolean;
    V: Variant absolute Value;
const TYPE_BYREF = 128;
      TYPE_BYREF_MASK = TYPE_BYREF-1;
begin // this code should copy parameters without any reference count handling
  ZeroFill(@Value); // TVarData is expected to be bulk stack: no VarClear needed
  ByRef := (aType and TYPE_BYREF)<>0;
  Size := SizeOf(pointer);
  case aType and TYPE_BYREF_MASK of
  varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord, varSingle: begin
    if ByRef then
      P := pointer(P^);
    Value.VType := aType and TYPE_BYREF_MASK;
    Value.VInteger := PInteger(P)^;
    {$ifdef CPU64}
    if not ByRef then
      Size := SizeOf(Integer);
    {$endif}
  end;
  varDouble, varCurrency, varDate, varInt64, varWord64, varOleStr: begin
    if ByRef then
      P := pointer(P^);
    Value.VType := aType and TYPE_BYREF_MASK;
    Value.VInt64 := PInt64(P)^;
    {$ifndef CPU64}
    if not ByRef then
      Size := SizeOf(Int64);
    {$endif}
  end;
  varStrArg: begin
    if ByRef then
      P := pointer(P^);
    Value.VType := varString;
    Value.VString := PPointer(P)^;
  end;
  {$ifdef HASVARUSTRARG}
  varUStrArg: begin
    if ByRef then
      P := pointer(P^);
    Value.VType := varUString;
    Value.VUString := PPointer(P)^;
  end;
  {$endif}
  varBoolean:
    if ByRef then
      V := PWordBool(pointer(P^))^ else
      V := PWordBool(P)^;
  varVariant:
    {$ifdef CPU64} // circumvent Delphi x64 compiler oddiness
    Value := PVarData(pointer(P^))^
    {$else}
    if ByRef then
      Value := PVarData(pointer(P^))^ else begin
      Value := PVarData(P)^;
      Size := SizeOf(Value);
    end;
    {$endif}
  else
    raise EInvalidCast.CreateFmt('ParseParamPointer: Invalid VarType=%d',
      [aType and TYPE_BYREF_MASK]);
  end;
  result := PAnsiChar(P)+Size;
end;

var
  LastDispInvokeType: TSynInvokeableVariantType;

procedure SynVarDispProc(Result: PVarData; const Instance: TVarData;
  CallDesc: PCallDesc; Params: Pointer); cdecl;
const DO_PROP = 1; GET_PROP = 2; SET_PROP = 4;
var Value: TVarData;
    Handler: TSynInvokeableVariantType;
    CacheDispInvokeType: TSynInvokeableVariantType; // to be thread-safe
begin
  if Instance.VType=varByRef or varVariant then // handle By Ref variants
    SynVarDispProc(Result,PVarData(Instance.VPointer)^,CallDesc,Params) else begin
    if Result<>nil then
      VarClear(Variant(Result^));
    case Instance.VType of
    varDispatch, varDispatch or varByRef,
    varUnknown, varUnknown or varByRef, varAny:
      // process Ole Automation variants
      if Assigned(VarDispProc) then
        VarDispProc(pointer(Result),Variant(Instance),CallDesc,@Params);
    else begin
      // first we check for our own TSynInvokeableVariantType types
      if SynVariantTypes<>nil then begin
        // simple cache for the latest type: most gets are grouped
        CacheDispInvokeType := LastDispInvokeType;
        if (CacheDispInvokeType<>nil) and
           (CacheDispInvokeType.VarType=TVarData(Instance).VType) and
           (CallDesc^.CallType in [GET_PROP, DO_PROP]) and
           (Result<>nil) and (CallDesc^.ArgCount=0) then begin
          CacheDispInvokeType.IntGet(Result^,Instance,
            @CallDesc^.ArgTypes[0],StrLen(@CallDesc^.ArgTypes[0]));
          exit;
        end;
      end;
      // handle any custom variant type
      if FindCustomVariantType(Instance.VType,TCustomVariantType(Handler)) then begin
        if Handler.InheritsFrom(TSynInvokeableVariantType) then
          case CallDesc^.CallType of
          GET_PROP, DO_PROP: // fast direct call of our IntGet() virtual method
            if (Result<>nil) and (CallDesc^.ArgCount=0) then begin
              Handler.IntGet(Result^,Instance,
                @CallDesc^.ArgTypes[0],StrLen(@CallDesc^.ArgTypes[0]));
              LastDispInvokeType := Handler; // speed up in loop
              exit;
            end;
          SET_PROP: // fast direct call of our IntSet() virtual method
            if (Result=nil) and (CallDesc^.ArgCount=1) then begin
              ParseParamPointer(@Params,CallDesc^.ArgTypes[0],Value);
              Handler.IntSet(Instance,Value,
                @CallDesc^.ArgTypes[1],StrLen(@CallDesc^.ArgTypes[1]));
              exit;
            end;
          end;
        // here we call the default code handling custom types
        Handler.DispInvoke({$ifdef DELPHI6OROLDER}Result^{$else}Result{$endif},
          Instance,CallDesc,@Params)
      end else
        raise EInvalidOp.CreateFmt('Invalid variant type %d invoke',[Instance.VType]);
    end;
    end;
  end;
end;

function VariantsDispInvokeAddress: pointer;
asm
  {$ifdef CPU64}
  mov rax,offset Variants.@DispInvoke
  {$else}
  mov eax,offset Variants.@DispInvoke
  {$endif}
end;

{$ifdef DOPATCHTRTL}
  {$define DOPATCHDISPINVOKE} // much faster late-binding process for our types
{$endif}
{$ifdef CPU64}
  {$define DOPATCHDISPINVOKE}
  // we NEED our patched DispInvoke to circumvent some Delphi bugs on Win64
{$endif}
{$ifdef DELPHI6OROLDER}
  {$define DOPATCHDISPINVOKE}
  // to circumvent LIdent := Uppercase() in TInvokeableVariantType.DispInvoke()
{$endif}

{$endif FPC}

function SynRegisterCustomVariantType(aClass: TSynInvokeableVariantTypeClass): TSynInvokeableVariantType;
var i: PtrInt;
{$ifdef DOPATCHDISPINVOKE}
{$ifdef NOVARCOPYPROC}
    VarMgr: TVariantManager;
{$endif}
{$endif}
begin
  {$ifdef DOPATCHDISPINVOKE}
  if SynVariantTypes=nil then begin
    {$ifndef CPU64} // we NEED our patched RTL on Win64
    if DebugHook=0 then // patch VCL/RTL only outside debugging
    {$endif} begin
      {$ifdef NOVARCOPYPROC}
      GetVariantManager(VarMgr);
      VarMgr.DispInvoke := @SynVarDispProc;
      SetVariantManager(VarMgr);
      {$else}
      RedirectCode(VariantsDispInvokeAddress,@SynVarDispProc);
      {$endif NOVARCOPYPROC}
    end;
  end else
  {$endif DOPATCHDISPINVOKE}
    for i := 0 to length(SynVariantTypes)-1 do
      if PPointer(SynVariantTypes[i])^=pointer(aClass) then begin
        result := SynVariantTypes[i]; // returns already registered instance
        exit;
      end;
  result :=  aClass.Create; // register variant type
  ObjArrayAdd(SynVariantTypes,result);
end;


function VariantDynArrayToJSON(const V: TVariantDynArray): RawUTF8;
var tmp: TDocVariantData;
begin
  tmp.InitArrayFromVariants(V);
  result := tmp.ToJSON;
end;

function JSONToVariantDynArray(const JSON: RawUTF8): TVariantDynArray;
var tmp: TDocVariantData;
begin
  tmp.InitJSON(JSON,JSON_OPTIONS_FAST);
  result := tmp.VValue;
end;

function ValuesToVariantDynArray(const items: array of const): TVariantDynArray;
var tmp: TDocVariantData;
begin
  tmp.InitArray(items,JSON_OPTIONS_FAST);
  result := tmp.VValue;
end;


{ TDocVariantData }

function TDocVariantData.GetKind: TDocVariantKind;
var opt: TDocVariantOptions;
begin
  opt := VOptions;
  if dvoIsArray in opt then
    result := dvArray else
  if dvoIsObject in opt then
    result := dvObject else
    result := dvUndefined;
end;

function DocVariantData(const DocVariant: variant): PDocVariantData;
var docv,vt: integer;
begin
  result := @DocVariant;
  docv := DocVariantVType;
  vt := result^.VType;
  if vt=docv then
    exit else
  if vt=varByRef or varVariant then begin
    result := PVarData(result)^.VPointer;
    if integer(result^.VType)=docv then
      exit;
  end;
  raise EDocVariant.CreateUTF8('DocVariantType.Data(%<>TDocVariant)',[ord(result^.VType)]);
end;

function _Safe(const DocVariant: variant): PDocVariantData;
{$ifdef FPC_OR_PUREPASCAL}
var docv,vt: integer;
begin
  result := @DocVariant;
  docv := DocVariantVType;
  vt := result^.VType;
  if vt=docv then
    exit else
  if vt=varByRef or varVariant then begin
    result := PVarData(result)^.VPointer;
    if integer(result^.VType)=docv then
      exit;
  end;
  result := @DocVariantDataFake;
end;
{$else}
asm
      mov   ecx,DocVariantVType
      movzx edx,word ptr [eax].TVarData.VType
      cmp   edx,ecx
      jne   @by
      ret
@ptr: mov   eax,[eax].TVarData.VPointer
      movzx edx,word ptr [eax].TVarData.VType
      cmp   edx,ecx
      je    @ok
@by:  cmp   edx,varByRef or varVariant
      je    @ptr
      lea   eax,[DocVariantDataFake]
@ok:
end;
{$endif}

function _Safe(const DocVariant: variant; ExpectedKind: TDocVariantKind): PDocVariantData;
var o: TDocVariantOptions;
begin
  result := _Safe(DocVariant);
  o := result^.VOptions;
  if dvoIsArray in o then begin
    if ExpectedKind=dvArray then
      exit;
  end else if (dvoIsObject in o) and (ExpectedKind=dvObject) then
    exit;
  raise EDocVariant.CreateUTF8('_Safe(%)?',[ToText(ExpectedKind)^]);
end;

function _CSV(const DocVariantOrString: variant): RawUTF8;
begin
  with _Safe(DocVariantOrString)^ do
    if dvoIsArray in VOptions then
      result := ToCSV else
    if (dvoIsObject in VOptions) or (TDocVariantData(DocVariantOrString).VType<=varNull) or
       not VariantToUTF8(DocVariantOrString,result) then
      result := ''; // VariantToUTF8() returns 'null' for empty/null
end;

function TDocVariantData.GetValueIndex(const aName: RawUTF8): integer;
begin
  result := GetValueIndex(Pointer(aName),Length(aName),dvoNameCaseSensitive in VOptions);
end;

function TDocVariantData.GetCapacity: integer;
begin
  result := length(VValue);
end;

function TDocVariant.InternNames: TRawUTF8Interning;
begin
  if fInternNames=nil then
    fInternNames := TRawUTF8Interning.Create;
  result := fInternNames;
end;

function TDocVariant.InternValues: TRawUTF8Interning;
begin
  if fInternValues=nil then
    fInternValues := TRawUTF8Interning.Create;
  result := fInternValues;
end;

procedure TDocVariantData.SetOptions(const opt: TDocVariantOptions);
begin
  VOptions := (opt-[dvoIsArray,dvoIsObject])+(VOptions*[dvoIsArray,dvoIsObject]);
end;

procedure TDocVariantData.Init(aOptions: TDocVariantOptions; aKind: TDocVariantKind);
begin
  aOptions := aOptions-[dvoIsArray,dvoIsObject];
  case aKind of
    dvArray:  include(aOptions,dvoIsArray);
    dvObject: include(aOptions,dvoIsObject);
  end;
  ZeroFill(@self);
  VType := DocVariantVType;
  VOptions := aOptions;
end;

procedure TDocVariantData.InitFast;
begin
  ZeroFill(@self);
  VType := DocVariantVType;
  VOptions := JSON_OPTIONS_FAST;
end;

procedure TDocVariantData.InitFast(InitialCapacity: integer; aKind: TDocVariantKind);
begin
  InitFast;
  case aKind of
    dvArray:  include(VOptions,dvoIsArray);
    dvObject: include(VOptions,dvoIsObject);
  end;
  if aKind=dvObject then
    SetLength(VName,InitialCapacity);
  SetLength(VValue,InitialCapacity);
end;

procedure TDocVariantData.InitObject(const NameValuePairs: array of const;
  aOptions: TDocVariantOptions=[]);
begin
  Init(aOptions,dvObject);
  AddNameValuesToObject(NameValuePairs);
end;

procedure TDocVariantData.AddNameValuesToObject(const NameValuePairs: array of const);
var n,arg: PtrInt;
    tmp: variant;
begin
  n := length(NameValuePairs);
  if (n=0) or (n and 1=1) or (dvoIsArray in VOptions) then
    exit; // nothing to add
  include(VOptions,dvoIsObject);
  n := n shr 1;
  if length(VValue)<VCount+n then begin
    SetLength(VValue,VCount+n);
    SetLength(VName,VCount+n);
  end;
  for arg := 0 to n-1 do begin
    VarRecToUTF8(NameValuePairs[arg*2],VName[arg+VCount]);
    if dvoInternNames in VOptions then
      DocVariantType.InternNames.UniqueText(VName[arg+VCount]);
    if dvoValueCopiedByReference in VOptions then
      VarRecToVariant(NameValuePairs[arg*2+1],VValue[arg+VCount]) else begin
      VarRecToVariant(NameValuePairs[arg*2+1],tmp);
      SetVariantByValue(tmp,VValue[arg+VCount]);
    end;
    if dvoInternValues in VOptions then
      DocVariantType.InternValues.UniqueVariant(VValue[arg+VCount]);
  end;
  inc(VCount,n);
end;

procedure TDocVariantData.AddOrUpdateNameValuesToObject(const NameValuePairs: array of const);
var n,arg: integer;
    n2: RawUTF8;
    v: Variant;
begin
  n := length(NameValuePairs) shr 1;
  if (n=0) or (dvoIsArray in VOptions) then
    exit; // nothing to add
  for arg := 0 to n-1 do begin
    VarRecToUTF8(NameValuePairs[arg*2],n2);
    VarRecToVariant(NameValuePairs[arg*2+1],v);
    AddOrUpdateValue(n2,v)
  end;
end;

procedure TDocVariantData.AddOrUpdateObject(const NewValues: variant;
  OnlyAddMissing: boolean; RecursiveUpdate: boolean);
var n, idx: integer;
    new: PDocVariantData;
    wasAdded: boolean;
begin
  new := _Safe(NewValues);
  if not(dvoIsArray in VOptions) and not(dvoIsArray in new^.VOptions) then
    for n := 0 to new^.Count-1 do begin
      idx := AddOrUpdateValue(new^.names[n],new^.Values[n],@wasAdded,OnlyAddMissing);
      if RecursiveUpdate and not wasAdded then
        TDocVariantData(Values[idx]).AddOrUpdateObject(new^.Values[n],OnlyAddMissing,true);
    end;
end;

procedure TDocVariantData.InitArray(const Items: array of const;
  aOptions: TDocVariantOptions=[]);
var arg: integer;
    tmp: variant;
begin
  Init(aOptions,dvArray);
  if high(Items)>=0 then begin
    VCount := length(Items);
    SetLength(VValue,VCount);
    if dvoValueCopiedByReference in VOptions then
      for arg := 0 to high(Items) do
        VarRecToVariant(Items[arg],VValue[arg]) else
      for arg := 0 to high(Items) do begin
        VarRecToVariant(Items[arg],tmp);
        SetVariantByValue(tmp,VValue[arg]);
      end;
  end;
end;

procedure TDocVariantData.InitArrayFromVariants(const Items: TVariantDynArray;
  aOptions: TDocVariantOptions; ItemsCopiedByReference: boolean);
begin
  if Items=nil then
    VType := varNull else begin
    Init(aOptions,dvArray);
    VCount := length(Items);
    VValue := Items; // fast by-reference copy of VValue[]
    if not ItemsCopiedByReference then
      InitCopy(variant(self),aOptions);
  end;
end;

procedure TDocVariantData.InitArrayFromObjArray(const ObjArray;
  aOptions: TDocVariantOptions; aWriterOptions: TTextWriterWriteObjectOptions);
var ndx: integer;
    Items: TObjectDynArray absolute ObjArray;
begin
  if Items=nil then
    VType := varNull else begin
    Init(aOptions,dvArray);
    VCount := length(Items);
    SetLength(VValue,VCount);
    for ndx := 0 to VCount-1 do
      ObjectToVariant(Items[ndx],VValue[ndx],aWriterOptions);
  end;
end;

procedure TDocVariantData.InitArrayFrom(const Items: TRawUTF8DynArray;
  aOptions: TDocVariantOptions);
var ndx: integer;
begin
  if Items=nil then
    VType := varNull else begin
    Init(aOptions,dvArray);
    VCount := length(Items);
    SetLength(VValue,VCount);
    for ndx := 0 to VCount-1 do
      RawUTF8ToVariant(Items[ndx],VValue[ndx]);
  end;
end;

procedure TDocVariantData.InitArrayFrom(const Items: TIntegerDynArray;
  aOptions: TDocVariantOptions);
var ndx: integer;
begin
  if Items=nil then
    VType := varNull else begin
    Init(aOptions,dvArray);
    VCount := length(Items);
    SetLength(VValue,VCount);
    for ndx := 0 to VCount-1 do
      VValue[ndx] := Items[ndx];
  end;
end;

procedure TDocVariantData.InitArrayFrom(const Items: TInt64DynArray;
  aOptions: TDocVariantOptions);
var ndx: integer;
begin
  if Items=nil then
    VType := varNull else begin
    Init(aOptions,dvArray);
    VCount := length(Items);
    SetLength(VValue,VCount);
    for ndx := 0 to VCount-1 do
      VValue[ndx] := Items[ndx];
  end;
end;

procedure TDocVariantData.InitFromTypeInfo(const aValue; aTypeInfo: pointer;
  aEnumSetsAsText: boolean; aOptions: TDocVariantOptions);
var tmp: RawUTF8;
begin
  tmp := SaveJSON(aValue,aTypeInfo,aEnumSetsAsText);
  InitJSONInPlace(pointer(tmp),aOptions);
end;

procedure TDocVariantData.InitObjectFromVariants(const aNames: TRawUTF8DynArray;
  const aValues: TVariantDynArray; aOptions: TDocVariantOptions);
begin
  if (aNames=nil) or (aValues=nil) or (length(aNames)<>length(aValues)) then
    VType := varNull else begin
    Init(aOptions,dvObject);
    VCount := length(aNames);
    VName := aNames; // fast by-reference copy of VName[] and VValue[]
    VValue := aValues;
  end;
end;

procedure TDocVariantData.InitObjectFromPath(const aPath: RawUTF8; const aValue: variant;
  aOptions: TDocVariantOptions);
var right: RawUTF8;
begin
  if aPath='' then
    VType := varNull else begin
    Init(aOptions,dvObject);
    VCount := 1;
    SetLength(VName,1);
    SetLength(VValue,1);
    split(aPath,'.',VName[0],right);
    if right='' then
      VValue[0] := aValue else
      PDocVariantData(@VValue[0])^.InitObjectFromPath(right,aValue,aOptions);
  end;
end;

function TDocVariantData.InitJSONInPlace(JSON: PUTF8Char;
  aOptions: TDocVariantOptions; aEndOfObject: PUTF8Char): PUTF8Char;
var EndOfObject: AnsiChar;
    Name: PUTF8Char;
    NameLen, n: integer;
    intnames, intvalues: TRawUTF8Interning;
begin
  Init(aOptions);
  result := nil;
  if JSON=nil then
    exit;
  if dvoInternValues in VOptions then
    intvalues := DocVariantType.InternValues else
    intvalues := nil;
  while (JSON^<=' ') and (JSON^<>#0) do inc(JSON);
  case JSON^ of
  '[': begin
    repeat inc(JSON); if JSON^=#0 then exit; until JSON^>' ';
    n := JSONArrayCount(JSON); // may be slow if JSON is huge (not very common)
    if n<0 then
      exit; // invalid content
    include(VOptions,dvoIsArray);
    if n>0 then begin
      SetLength(VValue,n);
      repeat
        if VCount>=n then
          exit; // unexpected array size means invalid JSON
        GetJSONToAnyVariant(VValue[VCount],JSON,@EndOfObject,@VOptions,false);
        if JSON=nil then
          if EndOfObject=']' then // valid array end
            JSON := @NULCHAR else
            exit; // invalid input
        if intvalues<>nil then
          intvalues.UniqueVariant(VValue[VCount]);
        inc(VCount);
      until EndOfObject=']';
    end else
      if JSON^=']' then // n=0
        repeat inc(JSON) until (JSON^=#0) or (JSON^>' ') else
        exit;
  end;
  '{': begin
    repeat inc(JSON); if JSON^=#0 then exit; until JSON^>' ';
    n := JSONObjectPropCount(JSON); // may be slow if JSON is huge (not very common)
    if n<0 then
      exit; // invalid content
    include(VOptions,dvoIsObject);
    if dvoInternNames in VOptions then
      intnames := DocVariantType.InternNames else
      intnames := nil;
    if n>0 then begin
      SetLength(VValue,n);
      SetLength(VName,n);
      repeat
        if VCount>=n then
          exit; // unexpected object size means invalid JSON
        // see http://docs.mongodb.org/manual/reference/mongodb-extended-json
        Name := GetJSONPropName(JSON,@NameLen);
        if Name=nil then
          exit;
        FastSetString(VName[VCount],Name,NameLen);
        if intnames<>nil then
          intnames.UniqueText(VName[VCount]);
        GetJSONToAnyVariant(VValue[VCount],JSON,@EndOfObject,@VOptions,false);
        if JSON=nil then
          if EndOfObject='}' then // valid object end
            JSON := @NULCHAR else
            exit; // invalid input
        if intvalues<>nil then
          intvalues.UniqueVariant(VValue[VCount]);
        inc(VCount);
      until EndOfObject='}';
    end else
      if JSON^='}' then // n=0
        repeat inc(JSON) until (JSON^=#0) or (JSON^>' ') else
        exit;
  end;
  'n','N': begin
    if IdemPChar(JSON+1,'ULL') then begin
      include(VOptions,dvoIsObject);
      result := GotoNextNotSpace(JSON+4);
    end;
    exit;
  end;
  else exit;
  end;
  while (JSON^<=' ') and (JSON^<>#0) do inc(JSON);
  if aEndOfObject<>nil then
    aEndOfObject^ := JSON^;
  if JSON^<>#0 then
    repeat inc(JSON) until (JSON^=#0) or (JSON^>' ');
  result := JSON; // indicates successfully parsed
end;

function TDocVariantData.InitJSON(const JSON: RawUTF8;
  aOptions: TDocVariantOptions): boolean;
var tmp: TSynTempBuffer;
begin
  if JSON='' then
    result := false else begin
    tmp.Init(JSON);
    try
      result := InitJSONInPlace(tmp.buf,aOptions)<>nil;
    finally
      tmp.Done;
    end;
  end;
end;

function TDocVariantData.InitJSONFromFile(const JsonFile: TFileName;
  aOptions: TDocVariantOptions; RemoveComments: boolean): boolean;
var content: RawUTF8;
begin
  content := AnyTextFileToRawUTF8(JsonFile,true);
  if RemoveComments then
    RemoveCommentsFromJSON(pointer(content));
  result := InitJSONInPlace(pointer(content),aOptions)<>nil;
end;

procedure TDocVariantData.InitCSV(CSV: PUTF8Char; aOptions: TDocVariantOptions;
  NameValueSep, ItemSep: AnsiChar; DoTrim: boolean);
var n,v: RawUTF8;
    val: variant;
begin
  Init(aOptions,dvObject);
  while CSV<>nil do begin
    GetNextItem(CSV,NameValueSep,n);
    if ItemSep=#10 then
      GetNextItemTrimedCRLF(CSV,v) else
      GetNextItem(CSV,ItemSep,v);
    if DoTrim then
      v := trim(v);
    if n='' then
      break;
    RawUTF8ToVariant(v,val);
    AddValue(n,val);
  end;
end;

procedure TDocVariantData.InitCSV(const CSV: RawUTF8; aOptions: TDocVariantOptions;
  NameValueSep, ItemSep: AnsiChar; DoTrim: boolean);
begin
  InitCSV(pointer(CSV),aOptions,NameValueSep,ItemSep,DoTrim);
end;

procedure TDocVariantData.InitCopy(const SourceDocVariant: variant;
  aOptions: TDocVariantOptions);
var ndx,vt: integer;
    Source: PDocVariantData;
    SourceVValue: TVariantDynArray;
    Handler: TCustomVariantType;
    v: PVarData;
begin
  with TVarData(SourceDocVariant) do
    if integer(VType)=varByRef or varVariant then
      Source := VPointer else
      Source := @SourceDocVariant;
  if integer(Source^.VType)<>DocVariantVType then
    raise ESynException.CreateUTF8('No TDocVariant for InitCopy(%)',[ord(Source.VType)]);
  SourceVValue := Source^.VValue; // local fast per-reference copy
  if Source<>@self then begin
    VType := Source^.VType;
    VCount := Source^.VCount;
    pointer(VName) := nil;  // avoid GPF
    pointer(VValue) := nil;
    aOptions := aOptions-[dvoIsArray,dvoIsObject]; // may not be same as Source
    if dvoIsArray in Source^.VOptions then
      include(aOptions,dvoIsArray) else
    if dvoIsObject in Source^.VOptions then begin
      include(aOptions,dvoIsObject);
      SetLength(VName,VCount);
      for ndx := 0 to VCount-1 do
        VName[ndx] := Source^.VName[ndx]; // manual copy is needed
      if dvoInternNames in aOptions then
        with DocVariantType.InternNames do
          for ndx := 0 to VCount-1 do
            UniqueText(VName[ndx]);
    end;
    VOptions := aOptions;
  end else begin
    SetOptions(aOptions);
    VariantDynArrayClear(VValue); // full copy of all values
  end;
  if VCount>0 then begin
    SetLength(VValue,VCount);
    for ndx := 0 to VCount-1 do begin
      v := @SourceVValue[ndx];
      repeat
        vt := v^.VType;
        if vt<>varByRef or varVariant then
          break;
        v := v^.VPointer;
      until false;
      if vt<=varNativeString then // simple string/number types copy
        VValue[ndx] := variant(v^) else
      if vt=DocVariantVType then // direct recursive copy for TDocVariant
        TDocVariantData(VValue[ndx]).InitCopy(variant(v^),VOptions) else
      if FindCustomVariantType(vt,Handler) then
        if Handler.InheritsFrom(TSynInvokeableVariantType) then
          TSynInvokeableVariantType(Handler).CopyByValue(TVarData(VValue[ndx]),v^) else
          Handler.Copy(TVarData(VValue[ndx]),v^,false) else
        VValue[ndx] := variant(v^); // default copy
    end;
    if dvoInternValues in VOptions then
      with DocVariantType.InternValues do
        for ndx := 0 to VCount-1 do
          UniqueVariant(VValue[ndx]);
  end;
  VariantDynArrayClear(SourceVValue);
end;

procedure TDocVariantData.Clear;
begin
  if integer(VType)=DocVariantVType then begin
    PInteger(@VType)^ := 0;
    RawUTF8DynArrayClear(VName);
    VariantDynArrayClear(VValue);
    VCount := 0;
  end else
    VarClear(variant(self));
end;

procedure TDocVariantData.Reset;
var backup: TDocVariantOptions;
begin
  if VCount=0 then
    exit;
  backup := VOptions-[dvoIsArray,dvoIsObject];
  DocVariantType.Clear(TVarData(self));
  VType := DocVariantVType;
  VOptions := backup;
end;

procedure TDocVariantData.FillZero;
var ndx: integer;
begin
  for ndx := 0 to VCount-1 do
    SynCommons.FillZero(VValue[ndx]);
  Reset;
end;

procedure TDocVariantData.SetCount(aCount: integer);
begin
  VCount := aCount;
end;

function TDocVariantData.InternalAdd(const aName: RawUTF8): integer;
var len: integer;
begin
  if aName<>'' then begin
    if dvoIsArray in VOptions then
      raise EDocVariant.CreateUTF8('Add: Unexpected [%] object property in an array',[aName]);
    if not(dvoIsObject in VOptions) then begin
      VType := DocVariantVType; // may not be set yet
      include(VOptions,dvoIsObject);
    end;
  end else begin
    if dvoIsObject in VOptions then
      raise EDocVariant.Create('Add: Unexpected array item in an object');
    if not(dvoIsArray in VOptions) then begin
      VType := DocVariantVType; // may not be set yet
      include(VOptions,dvoIsArray);
    end;
  end;
  len := length(VValue);
  if VCount>=len then begin
    len := NextGrow(VCount);
    SetLength(VValue,len);
  end;
  if aName<>'' then begin
    if Length(VName)<>len then
      SetLength(VName,len);
    if dvoInternNames in VOptions then begin // inlined InternNames method
      if DocVariantType.fInternNames=nil then
        DocVariantType.fInternNames := TRawUTF8Interning.Create;
      DocVariantType.fInternNames.Unique(VName[VCount],aName);
    end else
      VName[VCount] := aName;
  end;
  result := VCount;
  inc(VCount);
end;

procedure TDocVariantData.SetCapacity(aValue: integer);
begin
  if dvoIsObject in VOptions then
    SetLength(VName,aValue);
  SetLength(VValue,aValue);
end;

function TDocVariantData.AddValue(const aName: RawUTF8;
  const aValue: variant; aValueOwned: boolean): integer;
begin
  if dvoCheckForDuplicatedNames in VOptions then begin
    result := GetValueIndex(aName);
    if result>=0 then
      raise EDocVariant.CreateUTF8('AddValue: Duplicated [%] name',[aName]);
  end;
  result := InternalAdd(aName);
  if aValueOwned then
    VValue[result] := aValue else
    SetVariantByValue(aValue,VValue[result]);
  if dvoInternValues in VOptions then
    DocVariantType.InternValues.UniqueVariant(VValue[result]);
end;

function TDocVariantData.AddValue(aName: PUTF8Char; aNameLen: integer;
  const aValue: variant; aValueOwned: boolean): integer;
var tmp: RawUTF8;
begin
  FastSetString(tmp,aName,aNameLen);
  result := AddValue(tmp,aValue,aValueOwned);
end;

function TDocVariantData.AddValueFromText(const aName,aValue: RawUTF8;
  Update, AllowVarDouble: boolean): integer;
begin
  if aName='' then begin
    result := -1;
    exit;
  end;
  result := GetValueIndex(aName);
  if not Update and (dvoCheckForDuplicatedNames in VOptions) and (result>=0) then
    raise EDocVariant.CreateUTF8('AddValueFromText: Duplicated [%] name',[aName]);
  if result<0 then
    result := InternalAdd(aName);
  VarClear(VValue[result]);
  if not GetNumericVariantFromJSON(pointer(aValue),TVarData(VValue[result]),AllowVarDouble) then
    if dvoInternValues in VOptions then
      DocVariantType.InternValues.UniqueVariant(VValue[result],aValue) else
      RawUTF8ToVariant(aValue,VValue[result]);
end;

procedure TDocVariantData.AddByPath(const aSource: TDocVariantData;
  const aPaths: array of RawUTF8);
var p,added: integer;
    v: TVarData;
begin
  if (aSource.Count=0) or not(dvoIsObject in aSource.VOptions) or
     (dvoIsArray in VOptions) then
    exit;
  for p := 0 to High(aPaths) do begin
    DocVariantType.Lookup(v,TVarData(aSource),pointer(aPaths[p]));
    if integer(v.VType)<varNull then
      continue; // path not found
    added := InternalAdd(aPaths[p]);
    PVarData(@VValue[added])^ := v;
    if dvoInternValues in VOptions then
      DocVariantType.InternValues.UniqueVariant(VValue[added]);
  end;
end;

procedure TDocVariantData.AddFrom(const aDocVariant: Variant);
var src: PDocVariantData;
    ndx: integer;
begin
  src := _Safe(aDocVariant);
  if src^.Count=0 then
    exit; // nothing to add
  if dvoIsArray in src^.VOptions then
    // add array items
    if dvoIsObject in VOptions then // types should match
      exit else
    for ndx := 0 to src^.Count-1 do
      AddItem(src^.VValue[ndx]) else
    // add object items
    if dvoIsArray in VOptions then // types should match
      exit else
    for ndx := 0 to src^.Count-1 do
      AddValue(src^.VName[ndx],src^.VValue[ndx]);
end;

procedure TDocVariantData.AddOrUpdateFrom(const aDocVariant: Variant; aOnlyAddMissing: boolean);
var src: PDocVariantData;
    ndx: integer;
begin
  src := _Safe(aDocVariant,dvObject);
  for ndx := 0 to src^.Count-1 do
    AddOrUpdateValue(src^.VName[ndx],src^.VValue[ndx],nil,aOnlyAddMissing);
end;

function TDocVariantData.AddItem(const aValue: variant): integer;
begin
  result := InternalAdd('');
  SetVariantByValue(aValue,VValue[result]);
  if dvoInternValues in VOptions then
    DocVariantType.InternValues.UniqueVariant(VValue[result]);
end;

function TDocVariantData.AddItemFromText(const aValue: RawUTF8;
  AllowVarDouble: boolean): integer;
begin
  result := InternalAdd('');
  if not GetNumericVariantFromJSON(pointer(aValue),TVarData(VValue[result]),AllowVarDouble) then
    if dvoInternValues in VOptions then
      DocVariantType.InternValues.UniqueVariant(VValue[result],aValue) else
      RawUTF8ToVariant(aValue,VValue[result]);
end;

function TDocVariantData.AddItemText(const aValue: RawUTF8): integer;
begin
  result := InternalAdd('');
  if dvoInternValues in VOptions then
    DocVariantType.InternValues.UniqueVariant(VValue[result],aValue) else
    RawUTF8ToVariant(aValue,VValue[result]);
end;

procedure TDocVariantData.AddItems(const aValue: array of const);
var ndx,added: integer;
begin
  for ndx := 0 to high(aValue) do begin
    added := InternalAdd('');
    VarRecToVariant(aValue[ndx],VValue[added]);
    if dvoInternValues in VOptions then
      DocVariantType.InternValues.UniqueVariant(VValue[added]);
  end;
end;

function TDocVariantData.SearchItemByProp(const aPropName,aPropValue: RawUTF8;
  aPropValueCaseSensitive: boolean): integer;
var ndx: integer;
begin
  if dvoIsObject in VOptions then begin
    result := GetValueIndex(aPropName);
    if (result>=0) and VariantEquals(VValue[result],aPropValue,aPropValueCaseSensitive) then
      exit;
  end else
  if dvoIsArray in VOptions then
    for result := 0 to VCount-1 do
      with _Safe(VValue[result])^ do
      if dvoIsObject in VOptions then begin
        ndx := GetValueIndex(aPropName);
        if (ndx>=0) and VariantEquals(VValue[ndx],aPropValue,aPropValueCaseSensitive) then
          exit;
      end;
  result := -1;
end;

function TDocVariantData.SearchItemByProp(const aPropNameFmt: RawUTF8;
  const aPropNameArgs: array of const; const aPropValue: RawUTF8;
  aPropValueCaseSensitive: boolean): integer;
var name: RawUTF8;
begin
  FormatUTF8(aPropNameFmt,aPropNameArgs,name);
  result := SearchItemByProp(name,aPropValue,aPropValueCaseSensitive);
end;

function TDocVariantData.SearchItemByValue(const aValue: Variant;
  CaseInsensitive: boolean; StartIndex: integer): integer;
begin
  for result := StartIndex to VCount-1 do
    if SortDynArrayVariantComp(TVarData(VValue[result]),TVarData(aValue),CaseInsensitive)=0 then
      exit;
  result := -1;
end;

type
 TQuickSortDocVariant = object
   names: PPointerArray;
   values: PVariantArray;
   nameCompare: TUTF8Compare;
   valueCompare: TVariantCompare;
   procedure SortByName(L, R: PtrInt);
   procedure SortByValue(L, R: PtrInt);
 end;

procedure TQuickSortDocVariant.SortByName(L, R: PtrInt);
var I, J, P: PtrInt;
    pivot: pointer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := names[P];
      while nameCompare(names[I],pivot)<0 do Inc(I);
      while nameCompare(names[J],pivot)>0 do Dec(J);
      if I <= J then begin
        if I <> J then begin
          ExchgPointer(@names[I],@names[J]);
          ExchgVariant(@values[I],@values[J]);
        end;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        SortByName(L,J);
      L := I;
    end else begin
      if I < R then
        SortByName(I,R);
      R := J;
    end;
  until L >= R;
end;

procedure TQuickSortDocVariant.SortByValue(L, R: PtrInt);
var I, J, P: PtrInt;
    pivot: PVariant;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := @values[P];
      while valueCompare(values[I],pivot^)<0 do Inc(I);
      while valueCompare(values[J],pivot^)>0 do Dec(J);
      if I <= J then begin
        if I <> J then begin
          if names<>nil then
            ExchgPointer(@names[I],@names[J]);
          ExchgVariant(@values[I],@values[J]);
        end;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        SortByValue(L,J);
      L := I;
    end else begin
      if I < R then
        SortByValue(I,R);
      R := J;
    end;
  until L >= R;
end;

procedure TDocVariantData.SortByName(Compare: TUTF8Compare);
var qs: TQuickSortDocVariant;
begin
  if not(dvoIsObject in VOptions) or (VCount<=0) then
    exit;
  if Assigned(Compare) then
    qs.nameCompare := Compare else
    qs.nameCompare := @StrIComp;
  qs.names := pointer(VName);
  qs.values := pointer(VValue);
  qs.SortByName(0,VCount-1);
end;

procedure TDocVariantData.SortByValue(Compare: TVariantCompare);
var qs: TQuickSortDocVariant;
begin
  if VCount<=0 then
    exit;
  if Assigned(Compare) then
    qs.valueCompare := Compare else
    qs.valueCompare := @VariantCompare;
  qs.names := pointer(VName);
  qs.values := pointer(VValue);
  qs.SortByValue(0,VCount-1);
end;

type
  {$ifdef USERECORDWITHMETHODS}TQuickSortDocVariantValuesByField = record
    {$else}TQuickSortDocVariantValuesByField = object{$endif}
   Lookup: array of PVariant;
   Compare: TVariantCompare;
   Doc: PDocVariantData;
   Reverse: boolean;
   procedure Sort(L, R: PtrInt);
  end;

procedure TQuickSortDocVariantValuesByField.Sort(L, R: PtrInt);
var I, J, P: PtrInt;
    pivot: PVariant;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := Lookup[P];
      if Reverse then begin
        while Compare(Lookup[I]^,pivot^)<0 do Inc(I);
        while Compare(Lookup[J]^,pivot^)>0 do Dec(J);
      end
      else begin
        while Compare(Lookup[I]^,pivot^)>0 do Inc(I);
        while Compare(Lookup[J]^,pivot^)<0 do Dec(J);
      end;
      if I <= J then begin
        if I <> J then begin
          if Doc.VName<>nil then
            ExchgPointer(@Doc.VName[I],@Doc.VName[J]);
          ExchgVariant(@Doc.VValue[I],@Doc.VValue[J]);
          pivot := Lookup[I];
          Lookup[I] := Lookup[J];
          Lookup[J] := pivot;
        end;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        Sort(L,J);
      L := I;
    end else begin
      if I < R then
        Sort(I,R);
      R := J;
    end;
  until L >= R;
end;

procedure TDocVariantData.SortArrayByField(const aItemPropName: RawUTF8;
  aValueCompare: TVariantCompare; aValueCompareReverse: boolean; aNameSortedCompare: TUTF8Compare);
var
  QS: TQuickSortDocVariantValuesByField;
  p: pointer;
  row: PtrInt;
begin
  if (VCount<=0) or (aItemPropName='') or not (dvoIsArray in VOptions) then
    exit;
  if not Assigned(aValueCompare) then
    QS.Compare := VariantCompare else
    QS.Compare := aValueCompare;
  QS.Reverse := aValueCompareReverse;
  SetLength(QS.Lookup,VCount);
  for row := 0 to VCount-1 do begin // resolve GetPVariantByName(aIdemPropName) once
    p := _Safe(VValue[row])^.GetVarData(aItemPropName,aNameSortedCompare);
    if p = nil then
      p := @NullVarData;
    QS.Lookup[row] := p;
  end;
  QS.Doc := @self;
  QS.Sort(0,VCount-1);
end;

procedure TDocVariantData.Reverse;
var arr: TDynArray;
begin
  if VCount=0 then
    exit;
  if VName<>nil then begin
    SetLength(VName,VCount);
    arr.Init(TypeInfo(TRawUTF8DynArray),VName);
    arr.Reverse;
  end;
  if VValue<>nil then begin
    SetLength(VValue,VCount);
    arr.Init(TypeInfo(TVariantDynArray),VValue);
    arr.Reverse;
  end;
end;

function TDocVariantData.Reduce(const aPropNames: array of RawUTF8;
  aCaseSensitive,aDoNotAddVoidProp: boolean): variant;
begin
  VarClear(result);
  Reduce(aPropNames,aCaseSensitive,PDocVariantData(@result)^,aDoNotAddVoidProp);
end;

procedure TDocVariantData.Reduce(const aPropNames: array of RawUTF8;
  aCaseSensitive: boolean; out result: TDocVariantData; aDoNotAddVoidProp: boolean);
var ndx,j: integer;
    reduced: TDocVariantData;
begin
  result.InitFast;
  if (VCount=0) or (high(aPropNames)<0) then
    exit;
  if dvoIsObject in VOptions then begin
    if aCaseSensitive then begin
      for j := 0 to high(aPropNames) do
        for ndx := 0 to VCount-1 do
          if VName[ndx]=aPropNames[j] then begin
            if not aDoNotAddVoidProp or not VarIsVoid(VValue[ndx]) then
              result.AddValue(VName[ndx],VValue[ndx]);
            break;
          end;
    end else
      for j := 0 to high(aPropNames) do
        for ndx := 0 to VCount-1 do
          if IdemPropNameU(VName[ndx],aPropNames[j]) then begin
            if not aDoNotAddVoidProp or not VarIsVoid(VValue[ndx]) then
              result.AddValue(VName[ndx],VValue[ndx]);
            break;
          end;
  end else
  if dvoIsArray in VOptions then
    for ndx := 0 to VCount-1 do begin
      _Safe(VValue[ndx])^.Reduce(aPropNames,aCaseSensitive,reduced,aDoNotAddVoidProp);
      if dvoIsObject in reduced.VOptions then
        result.AddItem(variant(reduced));
    end;
end;

function TDocVariantData.ReduceAsArray(const aPropName: RawUTF8;
  OnReduce: TOnReducePerItem): variant;
begin
  VarClear(result);
  ReduceAsArray(aPropName,PDocVariantData(@result)^,OnReduce);
end;

procedure TDocVariantData.ReduceAsArray(const aPropName: RawUTF8;
  out result: TDocVariantData; OnReduce: TOnReducePerItem);
var ndx,j: integer;
    item: PDocVariantData;
begin
  result.InitFast;
  if (VCount=0) or (aPropName='') or not(dvoIsArray in VOptions) then
    exit;
  for ndx := 0 to VCount-1 do begin
    item := _Safe(VValue[ndx]);
    j := item^.GetValueIndex(aPropName);
    if j>=0 then
      if not Assigned(OnReduce) or OnReduce(item) then
        result.AddItem(item^.VValue[j]);
  end;
end;

function TDocVariantData.ReduceAsArray(const aPropName: RawUTF8;
  OnReduce: TOnReducePerValue): variant;
begin
  VarClear(result);
  ReduceAsArray(aPropName,PDocVariantData(@result)^,OnReduce);
end;

procedure TDocVariantData.ReduceAsArray(const aPropName: RawUTF8;
  out result: TDocVariantData; OnReduce: TOnReducePerValue);
var ndx,j: integer;
    item: PDocVariantData;
    v: PVariant;
begin
  result.InitFast;
  if (VCount=0) or (aPropName='') or not(dvoIsArray in VOptions) then
    exit;
  for ndx := 0 to VCount-1 do begin
    item := _Safe(VValue[ndx]);
    j := item^.GetValueIndex(aPropName);
    if j>=0 then begin
      v := @item^.VValue[j];
      if not Assigned(OnReduce) or OnReduce(v^) then
        result.AddItem(v^);
    end;
  end;
end;

function TDocVariantData.Rename(const aFromPropName, aToPropName: TRawUTF8DynArray): integer;
var n, p, ndx: integer;
begin
  result := 0;
  n := length(aFromPropName);
  if length(aToPropName)=n then
    for p := 0 to n-1 do begin
      ndx := GetValueIndex(aFromPropName[p]);
      if ndx>=0 then begin
        VName[ndx] := aToPropName[p];
        inc(result);
      end;
    end;
end;

function TDocVariantData.FlattenAsNestedObject(const aObjectPropName: RawUTF8): boolean;
var ndx,len: integer;
    Up: array[byte] of AnsiChar;
    nested: TDocVariantData;
begin // {"p.a1":5,"p.a2":"dfasdfa"} -> {"p":{"a1":5,"a2":"dfasdfa"}}
  result := false;
  if (VCount=0) or (aObjectPropName='') or not(dvoIsObject in VOptions) then
    exit;
  PWord(UpperCopy255(Up,aObjectPropName))^ := ord('.'); // e.g. 'P.'
  for ndx := 0 to Count-1 do
    if not IdemPChar(pointer(VName[ndx]),Up) then
      exit; // all fields should match "p.####"
  len := length(aObjectPropName)+1;
  for ndx := 0 to Count-1 do
    system.delete(VName[ndx],1,len);
  nested := self;
  Clear;
  InitObject([aObjectPropName,variant(nested)]);
  result := true;
end;

function TDocVariantData.Delete(Index: integer): boolean;
begin
  if cardinal(Index)>=cardinal(VCount) then
    result := false else begin
    dec(VCount);
    if VName<>nil then begin
      if PRefCnt(PtrUInt(VName)-_DAREFCNT)^>1 then
        DynArrayMakeUnique(@VName,TypeInfo(TRawUTF8DynArray));
      VName[Index] := '';
    end;
    if PRefCnt(PtrUInt(VValue)-_DAREFCNT)^>1 then
      DynArrayMakeUnique(@VValue,TypeInfo(TVariantDynArray));
    VarClear(VValue[Index]);
    if Index<VCount then begin
      if VName<>nil then begin
        MoveFast(VName[Index+1],VName[Index],(VCount-Index)*SizeOf(pointer));
        PtrUInt(VName[VCount]) := 0; // avoid GPF
      end;
      MoveFast(VValue[Index+1],VValue[Index],(VCount-Index)*SizeOf(variant));
      TVarData(VValue[VCount]).VType := varEmpty; // avoid GPF
    end;
    result := true;
  end;
end;

function TDocVariantData.Delete(const aName: RawUTF8): boolean;
begin
  result := Delete(GetValueIndex(aName));
end;

function TDocVariantData.DeleteByProp(const aPropName,aPropValue: RawUTF8;
  aPropValueCaseSensitive: boolean): boolean;
var ndx: integer;
begin
  ndx := SearchItemByProp(aPropName,aPropValue,aPropValueCaseSensitive);
  if ndx<0 then
    result := false else
    result := Delete(ndx);
end;

function TDocVariantData.DeleteByValue(const aValue: Variant;
  CaseInsensitive: boolean): integer;
var ndx: PtrInt;
begin
  result := 0;
  if VarIsEmptyOrNull(aValue) then begin
    for ndx := VCount-1 downto 0 do
      if VarDataIsEmptyOrNull(@VValue[ndx]) then begin
        Delete(ndx);
        inc(result);
      end;
  end else
    for ndx := VCount-1 downto 0 do
      if SortDynArrayVariantComp(TVarData(VValue[ndx]),TVarData(aValue),CaseInsensitive)=0 then begin
        Delete(ndx);
        inc(result);
      end;
end;

function TDocVariantData.DeleteByStartName(aStartName: PUTF8Char; aStartNameLen: integer): integer;
var ndx: integer;
    upname: array[byte] of AnsiChar;
begin
  result := 0;
  if aStartNameLen=0 then
    aStartNameLen := StrLen(aStartName);
  if (VCount=0) or not(dvoIsObject in VOptions) or (aStartNameLen=0) then
    exit;
  UpperCopy255Buf(upname,aStartName,aStartNameLen)^ := #0;
  for ndx := Count-1 downto 0 do
    if IdemPChar(pointer(names[ndx]),upname) then begin
      Delete(ndx);
      inc(result);
    end;
end;

function FindNonVoidRawUTF8(n: PPtrInt; name: PUTF8Char; len: TStrLen; count: PtrInt): PtrInt;
begin // FPC does proper inlining in this loop
  for result := 0 to count-1 do // all VName[]<>'' so n^<>0
    if (PStrLen(n^-_STRLEN)^=len) and CompareMemFixed(pointer(n^),name,len) then
      exit else
      inc(n);
  result := -1;
end;

function FindNonVoidRawUTF8I(n: PPtrInt; name: PUTF8Char; len: TStrLen; count: PtrInt): PtrInt;
begin
  for result := 0 to count-1 do
    if (PStrLen(n^-_STRLEN)^=len) and IdemPropNameUSameLen(pointer(n^),name,len) then
      exit else
      inc(n);
  result := -1;
end;

function TDocVariantData.GetValueIndex(aName: PUTF8Char; aNameLen: PtrInt;
  aCaseSensitive: boolean): integer;
var err: integer;
begin
  if (integer(VType)=DocVariantVType) and (VCount>0) then
    if dvoIsArray in VOptions then begin // try index text in array document
      result := GetInteger(aName,err);
      if (err<>0) or (cardinal(result)>=cardinal(VCount)) then
        result := -1;
    end else
    // O(n) lookup for object names -> efficient brute force sub-functions
    if aCaseSensitive then
      result := FindNonVoidRawUTF8(pointer(VName),aName,aNameLen,VCount) else
      result := FindNonVoidRawUTF8I(pointer(VName),aName,aNameLen,VCount) else
    result := -1;
end;

function TDocVariantData.GetValueOrRaiseException(const aName: RawUTF8): variant;
begin
  RetrieveValueOrRaiseException(pointer(aName),length(aName),
    dvoNameCaseSensitive in VOptions,result,false);
end;

function TDocVariantData.GetValueOrDefault(const aName: RawUTF8;
  const aDefault: variant): variant;
var ndx: integer;
begin
  if (integer(VType)<>DocVariantVType) or not(dvoIsObject in VOptions) then
    result := aDefault else begin
    ndx := GetValueIndex(aName);
    if ndx>=0 then
      result := VValue[ndx] else
      result := aDefault;
  end;
end;

function TDocVariantData.GetValueOrNull(const aName: RawUTF8): variant;
var ndx: integer;
begin
  if (integer(VType)<>DocVariantVType) or not(dvoIsObject in VOptions) then
    SetVariantNull(result) else begin
    ndx := GetValueIndex(aName);
    if ndx>=0 then
      result := VValue[ndx] else
      SetVariantNull(result);
  end;
end;

function TDocVariantData.GetValueOrEmpty(const aName: RawUTF8): variant;
var ndx: integer;
begin
  VarClear(result);
  if (integer(VType)=DocVariantVType) and (dvoIsObject in VOptions) then begin
    ndx := GetValueIndex(aName);
    if ndx>=0 then
      result := VValue[ndx];
  end;
end;

function TDocVariantData.GetAsBoolean(const aName: RawUTF8; out aValue: boolean;
  aSortedCompare: TUTF8Compare): Boolean;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else
    result := VariantToBoolean(PVariant(found)^,aValue)
end;

function TDocVariantData.GetAsInteger(const aName: RawUTF8; out aValue: integer;
  aSortedCompare: TUTF8Compare): Boolean;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else
    result := VariantToInteger(PVariant(found)^,aValue);
end;

function TDocVariantData.GetAsInt64(const aName: RawUTF8; out aValue: Int64;
  aSortedCompare: TUTF8Compare): Boolean;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else
    result := VariantToInt64(PVariant(found)^,aValue)
end;

function TDocVariantData.GetAsDouble(const aName: RawUTF8; out aValue: double;
  aSortedCompare: TUTF8Compare): Boolean;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else
    result := VariantToDouble(PVariant(found)^,aValue);
end;

function TDocVariantData.GetAsRawUTF8(const aName: RawUTF8; out aValue: RawUTF8;
  aSortedCompare: TUTF8Compare): Boolean;
var found: PVarData;
    wasString: boolean;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else begin
    if integer(found^.VType)>varNull then // default VariantToUTF8(null)='null'
      VariantToUTF8(PVariant(found)^,aValue,wasString);
    result := true;
  end;
end;

function TDocVariantData.GetValueEnumerate(const aName: RawUTF8;
  aTypeInfo: pointer; out aValue; aDeleteFoundEntry: boolean): boolean;
var text: RawUTF8;
    ndx, ord: integer;
begin
  result := false;
  ndx := GetValueIndex(aName);
  if ndx<0 then
    exit;
  VariantToUTF8(Values[ndx],text);
  ord := GetEnumNameValue(aTypeInfo,text,true);
  if ord<0 then
    exit;
  byte(aValue) := ord;
  if aDeleteFoundEntry then
    Delete(ndx);
  result := true;
end;

function TDocVariantData.GetAsDocVariant(const aName: RawUTF8; out aValue: PDocVariantData;
  aSortedCompare: TUTF8Compare): boolean;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else begin
    aValue := _Safe(PVariant(found)^);
    result := aValue<>@DocVariantDataFake;
  end;
end;

function TDocVariantData.GetAsDocVariantSafe(const aName: RawUTF8;
  aSortedCompare: TUTF8Compare): PDocVariantData;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := @DocVariantDataFake else
    result := _Safe(PVariant(found)^);
end;

function TDocVariantData.GetAsPVariant(const aName: RawUTF8; out aValue: PVariant;
  aSortedCompare: TUTF8Compare): boolean;
begin
  aValue := pointer(GetVarData(aName,aSortedCompare));
  result := aValue<>nil;
end;

function TDocVariantData.GetAsPVariant(aName: PUTF8Char; aNameLen: PtrInt): PVariant;
var ndx: integer;
begin
  ndx := GetValueIndex(aName,aNameLen,dvoNameCaseSensitive in VOptions);
  if ndx>=0 then
    result := @VValue[ndx] else
    result := nil;
end;

function TDocVariantData.GetVarData(const aName: RawUTF8;
  aSortedCompare: TUTF8Compare): PVarData;
var ndx: integer;
begin
  if (integer(VType)<>DocVariantVType) or not(dvoIsObject in VOptions) or
     (VCount=0) or (aName='') then
    result := nil else begin
    if Assigned(aSortedCompare) then
      if @aSortedCompare=@StrComp then // to use branchless asm for StrComp()
        ndx := FastFindPUTF8CharSorted(pointer(VName),VCount-1,pointer(aName)) else
        ndx := FastFindPUTF8CharSorted(pointer(VName),VCount-1,pointer(aName),aSortedCompare) else
    if dvoNameCaseSensitive in VOptions then
      ndx := FindNonVoidRawUTF8(pointer(VName),pointer(aName),length(aName),VCount) else
      ndx := FindNonVoidRawUTF8I(pointer(VName),pointer(aName),length(aName),VCount);
    if ndx>=0 then
      result := @VValue[ndx] else
      result := nil;
  end;
end;

function TDocVariantData.GetVarData(const aName: RawUTF8;
  var aValue: TVarData; aSortedCompare: TUTF8Compare): boolean;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else begin
    aValue := found^;
    result := true;
  end;
end;

function TDocVariantData.GetValueByPath(const aPath: RawUTF8): variant;
var Dest: TVarData;
begin
  VarClear(result);
  if (integer(VType)<>DocVariantVType) or not(dvoIsObject in VOptions) then
    exit;
  DocVariantType.Lookup(Dest,TVarData(self),pointer(aPath));
  if integer(Dest.VType)>=varNull then
    result := variant(Dest); // copy
end;

function TDocVariantData.GetValueByPath(const aPath: RawUTF8; out aValue: variant): boolean;
var Dest: TVarData;
begin
  result := false;
  if (integer(VType)<>DocVariantVType) or not(dvoIsObject in VOptions) then
    exit;
  DocVariantType.Lookup(Dest,TVarData(self),pointer(aPath));
  if Dest.VType=varEmpty then
    exit;
  aValue := variant(Dest); // copy
  result := true;
end;

function TDocVariantData.GetPVariantByPath(const aPath: RawUTF8): PVariant;
var p: PUTF8Char;
    item: RawUTF8;
    par: PVariant;
begin
  result := nil;
  if (integer(VType)<>DocVariantVType) or (aPath='') or
     not(dvoIsObject in VOptions) or (Count=0) then
    exit;
  par := @self;
  P := pointer(aPath);
  repeat
    GetNextItem(P,'.',item);
    if _Safe(par^).GetAsPVariant(item,result) then
      par := result else begin
      result := nil;
      exit;
    end;
  until P=nil;
  // if we reached here, we have par=result=found item
end;

function TDocVariantData.GetDocVariantByPath(const aPath: RawUTF8;
  out aValue: PDocVariantData): boolean;
var v: PVariant;
begin
  v := GetPVariantByPath(aPath);
  if v<>nil then begin
    aValue := _Safe(v^);
    result := integer(aValue^.VType)>varNull;
  end else
    result := false;
end;

function TDocVariantData.GetValueByPath(const aDocVariantPath: array of RawUTF8): variant;
var found,res: PVarData;
    vt,P: integer;
begin
  VarClear(result);
  if (integer(VType)<>DocVariantVType) or not(dvoIsObject in VOptions) or
     (high(aDocVariantPath)<0) then
    exit;
  found := @self;
  P := 0;
  repeat
    found := PDocVariantData(found).GetVarData(aDocVariantPath[P]);
    if found=nil then
      exit;
    if P=high(aDocVariantPath) then
      break; // we found the item!
    inc(P);
    // if we reached here, we should try for the next scope within Dest
    repeat
      vt := found^.VType;
      if vt<>varByRef or varVariant then
        break;
      found := found^.VPointer;
    until false;
    if vt=VType then
      continue;
    exit;
  until false;
  res := found;
  while integer(res^.VType)=varByRef or varVariant do
    res := res^.VPointer;
  if (integer(res^.VType)=VType) and (PDocVariantData(res)^.VCount=0) then
    // return void TDocVariant as null
    TVarData(result).VType := varNull else
    // copy found value
    result := PVariant(found)^;
end;

function TDocVariantData.GetItemByProp(const aPropName,aPropValue: RawUTF8;
  aPropValueCaseSensitive: boolean; var Dest: variant; DestByRef: boolean): boolean;
var ndx: integer;
begin
  result := false;
  if not(dvoIsArray in VOptions) then
    exit;
  ndx := SearchItemByProp(aPropName,aPropValue,aPropValueCaseSensitive);
  if ndx<0 then
    exit;
  RetrieveValueOrRaiseException(ndx,Dest,DestByRef);
  result := true;
end;

function TDocVariantData.GetDocVariantByProp(const aPropName,aPropValue: RawUTF8;
  aPropValueCaseSensitive: boolean; out Dest: PDocVariantData): boolean;
var ndx: integer;
begin
  result := false;
  if not(dvoIsArray in VOptions) then
    exit;
  ndx := SearchItemByProp(aPropName,aPropValue,aPropValueCaseSensitive);
  if ndx<0 then
    exit;
  Dest := _Safe(VValue[ndx]);
  result := Dest^.VType>varNull;
end;

function TDocVariantData.GetJsonByStartName(const aStartName: RawUTF8): RawUTF8;
var Up: array[byte] of AnsiChar;
    temp: TTextWriterStackBuffer;
    ndx: integer;
    W: TTextWriter;
begin
  if not(dvoIsObject in VOptions) or (VCount=0) then begin
    result := NULL_STR_VAR;
    exit;
  end;
  UpperCopy255(Up,aStartName)^ := #0;
  W := DefaultTextWriterSerializer.CreateOwnedStream(temp);
  try
    W.Add('{');
    for ndx := 0 to VCount-1 do
    if IdemPChar(Pointer(VName[ndx]),Up) then begin
      if (dvoSerializeAsExtendedJson in VOptions) and
         JsonPropNameValid(pointer(VName[ndx])) then begin
        W.AddNoJSONEscape(pointer(VName[ndx]),Length(VName[ndx]));
      end else begin
        W.Add('"');
        W.AddJSONEscape(pointer(VName[ndx]));
        W.Add('"');
      end;
      W.Add(':');
      W.AddVariant(VValue[ndx],twJSONEscape);
      W.Add(',');
    end;
    W.CancelLastComma;
    W.Add('}');
    W.SetText(result);
  finally
    W.Free;
  end;
end;

function TDocVariantData.GetValuesByStartName(const aStartName: RawUTF8;
  TrimLeftStartName: boolean): variant;
var Up: array[byte] of AnsiChar;
    ndx: integer;
    name: RawUTF8;
begin
  if aStartName='' then begin
    result := Variant(self);
    exit;
  end;
  if not(dvoIsObject in VOptions) or (VCount=0) then begin
    SetVariantNull(result);
    exit;
  end;
  TDocVariant.NewFast(result);
  UpperCopy255(Up,aStartName)^ := #0;
  for ndx := 0 to VCount-1 do
    if IdemPChar(Pointer(VName[ndx]),Up) then begin
      name := VName[ndx];
      if TrimLeftStartName then
        system.delete(name,1,length(aStartName));
      TDocVariantData(result).AddValue(name,VValue[ndx]);
    end;
end;

procedure TDocVariantData.SetValueOrRaiseException(Index: integer; const NewValue: variant);
begin
  if cardinal(Index)>=cardinal(VCount) then
    raise EDocVariant.CreateUTF8('Out of range Values[%] (count=%)',[Index,VCount]) else
    VValue[Index] := NewValue;
end;

procedure TDocVariantData.RetrieveNameOrRaiseException(Index: integer;
  var Dest: RawUTF8);
begin
  if (cardinal(Index)>=cardinal(VCount)) or (VName=nil) then
    if dvoReturnNullForUnknownProperty in VOptions then
      Dest := '' else
      raise EDocVariant.CreateUTF8('Out of range Names[%] (count=%)',[Index,VCount]) else
      Dest := VName[Index];
end;

procedure TDocVariantData.RetrieveValueOrRaiseException(Index: integer;
  var Dest: variant; DestByRef: boolean);
var Source: PVariant;
begin
  if cardinal(Index)>=cardinal(VCount) then
    if dvoReturnNullForUnknownProperty in VOptions then
      SetVariantNull(Dest) else
      raise EDocVariant.CreateUTF8('Out of range Values[%] (count=%)',[Index,VCount]) else
    if DestByRef then
      SetVariantByRef(VValue[Index],Dest) else begin
      Source := @VValue[Index];
      while PVarData(Source)^.VType=varVariant or varByRef do
        Source := PVarData(Source)^.VPointer;
      Dest := Source^;
    end;
end;

function TDocVariantData.RetrieveValueOrRaiseException(
  aName: PUTF8Char; aNameLen: integer; aCaseSensitive: boolean;
  var Dest: variant; DestByRef: boolean): boolean;
var ndx: Integer;
begin
  ndx := GetValueIndex(aName,aNameLen,aCaseSensitive);
  if ndx<0 then
    if dvoReturnNullForUnknownProperty in VOptions then
      SetVariantNull(Dest) else
      raise EDocVariant.CreateUTF8('[%] property not found',[aName]) else
    RetrieveValueOrRaiseException(ndx,Dest,DestByRef);
  result := ndx>=0;
end;

function TDocVariantData.GetValueOrItem(const aNameOrIndex: variant): variant;
var wasString: boolean;
    Name: RawUTF8;
begin
  if dvoIsArray in VOptions then // fast index lookup e.g. for Value[1]
    RetrieveValueOrRaiseException(VariantToIntegerDef(aNameOrIndex,-1),result,true) else begin
    VariantToUTF8(aNameOrIndex,Name,wasString); // by name lookup e.g. for Value['abc']
    if wasString then
      RetrieveValueOrRaiseException(pointer(Name),length(Name),
        dvoNameCaseSensitive in VOptions,result,true) else
      RetrieveValueOrRaiseException(GetIntegerDef(pointer(Name),-1),result,true);
  end;
end;

procedure TDocVariantData.SetValueOrItem(const aNameOrIndex, aValue: variant);
var wasString: boolean;
    ndx: integer;
    Name: RawUTF8;
begin
  if dvoIsArray in VOptions then // fast index lookup e.g. for Value[1]
    SetValueOrRaiseException(VariantToIntegerDef(aNameOrIndex,-1),aValue) else begin
    VariantToUTF8(aNameOrIndex,Name,wasString); // by name lookup e.g. for Value['abc']
    if wasString then begin
      ndx := GetValueIndex(Name);
      if ndx<0 then
        ndx := InternalAdd(Name);
      SetVariantByValue(aValue,VValue[ndx]);
      if dvoInternValues in VOptions then
        DocVariantType.InternValues.UniqueVariant(VValue[ndx]);
    end else
      SetValueOrRaiseException(VariantToIntegerDef(aNameOrIndex,-1),aValue);
  end;
end;

function TDocVariantData.AddOrUpdateValue(const aName: RawUTF8;
  const aValue: variant; wasAdded: PBoolean; OnlyAddMissing: boolean): integer;
begin
  if dvoIsArray in VOptions then
    raise EDocVariant.CreateUTF8('AddOrUpdateValue("%") on an array',[aName]);
  result := GetValueIndex(aName);
  if result<0 then begin
    result := InternalAdd(aName);
    if wasAdded<>nil then
      wasAdded^ := true;
  end else begin
    if wasAdded<>nil then
      wasAdded^ := false;
    if OnlyAddMissing then
      exit;
  end;
  SetVariantByValue(aValue,VValue[result]);
  if dvoInternValues in VOptions then
    DocVariantType.InternValues.UniqueVariant(VValue[result]);
end;

function TDocVariantData.ToJSON(const Prefix, Suffix: RawUTF8;
  Format: TTextWriterJSONFormat): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  if (integer(VType)<>DocVariantVType) and (VType>varNull) then begin
    result := ''; // null -> 'null'
    exit;
  end;
  W := DefaultTextWriterSerializer.CreateOwnedStream(temp);
  try
    W.AddString(Prefix);
    DocVariantType.ToJSON(W,variant(self),twJSONEscape);
    W.AddString(Suffix);
    W.SetText(result, Format);
  finally
    W.Free;
  end;
end;

function TDocVariantData.ToNonExpandedJSON: RawUTF8;
var fields: TRawUTF8DynArray;
    fieldsCount: integer;
    W: TTextWriter;
    r,f: integer;
    row: PDocVariantData;
    temp: TTextWriterStackBuffer;
begin
  fields := nil; // to please Kylix
  fieldsCount := 0;
  if not(dvoIsArray in VOptions) then begin
    result := '';
    exit;
  end;
  if VCount=0 then begin
    result := '[]';
    exit;
  end;
  with _Safe(VValue[0])^ do
    if dvoIsObject in VOptions then begin
      fields := VName;
      fieldsCount := VCount;
    end;
  if fieldsCount=0 then
    raise EDocVariant.Create('ToNonExpandedJSON: Value[0] is not an object');
  W := DefaultTextWriterSerializer.CreateOwnedStream(temp);
  try
    W.Add('{"fieldCount":%,"rowCount":%,"values":[',[fieldsCount,VCount]);
    for f := 0 to fieldsCount-1 do begin
      W.Add('"');
      W.AddJSONEscape(pointer(fields[f]));
      W.Add('"',',');
    end;
    for r := 0 to VCount-1 do begin
      row := _Safe(VValue[r]);
      if (r>0) and (not(dvoIsObject in row^.VOptions) or (row^.VCount<>fieldsCount)) then
        raise EDocVariant.CreateUTF8('ToNonExpandedJSON: Value[%] not expected object',[r]);
      for f := 0 to fieldsCount-1 do
        if (r>0) and not IdemPropNameU(row^.VName[f],fields[f]) then
          raise EDocVariant.CreateUTF8('ToNonExpandedJSON: Value[%] field=% expected=%',
            [r,row^.VName[f],fields[f]]) else begin
          W.AddVariant(row^.VValue[f],twJSONEscape);
          W.Add(',');
        end;
    end;
    W.CancelLastComma;
    W.Add(']','}');
    W.SetText(result);
  finally
    W.Free;
  end;
end;

procedure TDocVariantData.ToRawUTF8DynArray(out Result: TRawUTF8DynArray);
var ndx: integer;
    wasString: boolean;
begin
  if dvoIsObject in VOptions then
    raise EDocVariant.Create('ToRawUTF8DynArray expects a dvArray');
  if dvoIsArray in VOptions then begin
    SetLength(Result,VCount);
    for ndx := 0 to VCount-1 do
      VariantToUTF8(VValue[ndx],Result[ndx],wasString);
  end;
end;

function TDocVariantData.ToRawUTF8DynArray: TRawUTF8DynArray;
begin
  ToRawUTF8DynArray(result);
end;

function TDocVariantData.ToCSV(const Separator: RawUTF8): RawUTF8;
var tmp: TRawUTF8DynArray; // fast enough in practice
begin
  ToRawUTF8DynArray(tmp);
  result := RawUTF8ArrayToCSV(tmp,Separator);
end;

procedure TDocVariantData.ToTextPairsVar(out result: RawUTF8;
  const NameValueSep, ItemSep: RawUTF8; escape: TTextWriterKind);
var ndx: integer;
    temp: TTextWriterStackBuffer;
begin
  if dvoIsArray in VOptions then
    raise EDocVariant.Create('ToTextPairs expects a dvObject');
  if (VCount>0) and (dvoIsObject in VOptions) then
    with DefaultTextWriterSerializer.CreateOwnedStream(temp) do
    try
      ndx := 0;
      repeat
        AddString(VName[ndx]);
        AddString(NameValueSep);
        AddVariant(VValue[ndx],escape);
        inc(ndx);
        if ndx=VCount then
          break;
        AddString(ItemSep);
      until false;
      SetText(result);
    finally
      Free;
    end;
end;

function TDocVariantData.ToTextPairs(const NameValueSep: RawUTF8;
  const ItemSep: RawUTF8; Escape: TTextWriterKind): RawUTF8;
begin
  ToTextPairsVar(result,NameValueSep,ItemSep,escape);
end;

procedure TDocVariantData.ToArrayOfConst(out Result: TTVarRecDynArray);
var ndx: integer;
begin
  if dvoIsObject in VOptions then
    raise EDocVariant.Create('ToArrayOfConst expects a dvArray');
  if dvoIsArray in VOptions then begin
    SetLength(Result,VCount);
    for ndx := 0 to VCount-1 do begin
      Result[ndx].VType := vtVariant;
      Result[ndx].VVariant := @VValue[ndx];
    end;
  end;
end;

function TDocVariantData.ToArrayOfConst: TTVarRecDynArray;
begin
  ToArrayOfConst(result);
end;

function TDocVariantData.ToUrlEncode(const UriRoot: RawUTF8): RawUTF8;
var json: RawUTF8; // temporary in-place modified buffer
begin
  VariantSaveJSON(variant(self),twJSONEscape,json);
  result := UrlEncodeJsonObject(UriRoot,Pointer(json),[]);
end;

function TDocVariantData.GetOrAddIndexByName(const aName: RawUTF8): integer;
begin
  result := GetValueIndex(aName);
  if result<0 then
    result := InternalAdd(aName);
end;

function TDocVariantData.GetOrAddPVariantByName(const aName: RawUTF8): PVariant;
var ndx: integer;
begin
  ndx := GetValueIndex(aName);
  if ndx<0 then
    ndx := InternalAdd(aName);
  result := @VValue[ndx];
end;

function TDocVariantData.GetPVariantByName(const aName: RawUTF8): PVariant;
var ndx: Integer;
begin
  ndx := GetValueIndex(aName);
  if ndx<0 then
    if dvoReturnNullForUnknownProperty in VOptions then
      result := @DocVariantDataFake else
      raise EDocVariant.CreateUTF8('[%] property not found',[aName]) else
    result := @VValue[ndx];
end;

function TDocVariantData.GetInt64ByName(const aName: RawUTF8): Int64;
begin
  if not VariantToInt64(GetPVariantByName(aName)^,result) then
    result := 0;
end;

function TDocVariantData.GetRawUTF8ByName(const aName: RawUTF8): RawUTF8;
var wasString: boolean;
    v: PVariant;
begin
  v := GetPVariantByName(aName);
  if PVarData(v)^.VType<=varNull then // default VariantToUTF8(null)='null'
    result := '' else
    VariantToUTF8(v^,result,wasString);
end;

function TDocVariantData.GetStringByName(const aName: RawUTF8): string;
begin
  result := VariantToString(GetPVariantByName(aName)^);
end;

procedure TDocVariantData.SetInt64ByName(const aName: RawUTF8;
  const aValue: Int64);
begin
  GetOrAddPVariantByName(aName)^ := aValue;
end;

procedure TDocVariantData.SetRawUTF8ByName(const aName, aValue: RawUTF8);
begin
  RawUTF8ToVariant(aValue,GetOrAddPVariantByName(aName)^);
end;

procedure TDocVariantData.SetStringByName(const aName: RawUTF8; const aValue: string);
begin
  RawUTF8ToVariant(StringToUTF8(aValue),GetOrAddPVariantByName(aName)^);
end;

function TDocVariantData.GetBooleanByName(const aName: RawUTF8): Boolean;
begin
  if not VariantToBoolean(GetPVariantByName(aName)^,result) then
    result := false;
end;

procedure TDocVariantData.SetBooleanByName(const aName: RawUTF8; aValue: Boolean);
begin
  GetOrAddPVariantByName(aName)^ := aValue;
end;

function TDocVariantData.GetDoubleByName(const aName: RawUTF8): Double;
begin
  if not VariantToDouble(GetPVariantByName(aName)^,result) then
    result := 0;
end;

procedure TDocVariantData.SetDoubleByName(const aName: RawUTF8;
  const aValue: Double);
begin
  GetOrAddPVariantByName(aName)^ := aValue;
end;

function TDocVariantData.GetDocVariantExistingByName(const aName: RawUTF8;
  aNotMatchingKind: TDocVariantKind): PDocVariantData;
begin
  result := GetAsDocVariantSafe(aName);
  if result^.Kind=aNotMatchingKind then
    result := @DocVariantDataFake;
end;

function TDocVariantData.GetDocVariantOrAddByName(const aName: RawUTF8;
  aKind: TDocVariantKind): PDocVariantData;
var ndx: integer;
begin
  ndx := GetOrAddIndexByName(aName);
  result := _Safe(VValue[ndx]);
  if result^.Kind<>aKind then begin
    result := @VValue[ndx];
    VarClear(PVariant(result)^);
    result^.Init(JSON_OPTIONS_FAST,aKind);
  end;
end;

function TDocVariantData.GetObjectExistingByName(const aName: RawUTF8): PDocVariantData;
begin
  result := GetDocVariantExistingByName(aName,dvArray);
end;

function TDocVariantData.GetObjectOrAddByName(const aName: RawUTF8): PDocVariantData;
begin
  result := GetDocVariantOrAddByName(aName,dvObject);
end;

function TDocVariantData.GetArrayExistingByName(const aName: RawUTF8): PDocVariantData;
begin
  result := GetDocVariantExistingByName(aName,dvObject);
end;

function TDocVariantData.GetArrayOrAddByName(const aName: RawUTF8): PDocVariantData;
begin
  result := GetDocVariantOrAddByName(aName,dvArray);
end;

function TDocVariantData.GetAsDocVariantByIndex(aIndex: integer): PDocVariantData;
begin
  if cardinal(aIndex)<cardinal(VCount) then
    result := _Safe(VValue[aIndex]) else
    if dvoReturnNullForUnknownProperty in VOptions then
      result := @DocVariantDataFake else
      raise EDocVariant.CreateUTF8('Out of range _[%] (count=%)',[aIndex,VCount]);
end;


{ TDocVariant }

destructor TDocVariant.Destroy;
begin
  inherited Destroy;
  fInternNames.Free;
  fInternValues.Free;
end;

function IntGetPseudoProp(ndx: integer; const source: TDocVariantData; var Dest: variant): boolean;
begin // sub-function to avoid temporary RawUTF8
  result := true;
  case ndx of
  0: Dest := source.Count;
  1: Dest := ord(source.Kind);
  2: RawUTF8ToVariant(source.ToJSON,Dest);
  else result := false;
  end;
end;

function TDocVariant.IntGet(var Dest: TVarData; const Instance: TVarData;
  Name: PAnsiChar; NameLen: PtrInt): boolean;
var dv: TDocVariantData absolute Instance;
begin
  if Name=nil then
    result := false else
    if (NameLen>4) and (Name[0]='_') and
       IntGetPseudoProp(IdemPCharArray(@Name[1],['COUNT','KIND','JSON']),dv,variant(Dest)) then
      result := true else
      result := dv.RetrieveValueOrRaiseException(pointer(Name),NameLen,
        dvoNameCaseSensitive in dv.VOptions,PVariant(@Dest)^,{byref=}true);
end;

function TDocVariant.IntSet(const Instance, Value: TVarData;
  Name: PAnsiChar; NameLen: PtrInt): boolean;
var ndx: Integer;
    aName: RawUTF8;
    dv: TDocVariantData absolute Instance;
begin
  result := true;
  if (dvoIsArray in dv.VOptions) and (PWord(Name)^=ord('_')) then begin
    ndx := dv.InternalAdd('');
    SetVariantByValue(variant(Value),dv.VValue[ndx]);
    if dvoInternValues in dv.VOptions then
      DocVariantType.InternValues.UniqueVariant(dv.VValue[ndx]);
    exit;
  end;
  ndx := dv.GetValueIndex(pointer(Name),NameLen,dvoNameCaseSensitive in dv.VOptions);
  if ndx<0 then begin
    FastSetString(aName,Name,NameLen);
    ndx := dv.InternalAdd(aName);
  end;
  SetVariantByValue(variant(Value),dv.VValue[ndx]);
  if dvoInternValues in dv.VOptions then
    DocVariantType.InternValues.UniqueVariant(dv.VValue[ndx]);
end;

function TDocVariant.IterateCount(const V: TVarData): integer;
var Data: TDocVariantData absolute V;
begin
  if dvoIsArray in Data.VOptions then
    result := Data.VCount else
    result := -1;
end;

procedure TDocVariant.Iterate(var Dest: TVarData; const V: TVarData; Index: integer);
var Data: TDocVariantData absolute V;
begin
  if (dvoIsArray in Data.VOptions) and (cardinal(Index)<cardinal(Data.VCount)) then
    Dest := TVarData(Data.VValue[Index]) else
    Dest.VType := varEmpty;
end;

function TDocVariant.DoFunction(var Dest: TVarData; const V: TVarData;
  const Name: string; const Arguments: TVarDataArray): boolean;
var ndx: integer;
    Data: PDocVariantData;
    temp: RawUTF8;
  procedure SetTempFromFirstArgument;
  var wasString: boolean;
  begin
    VariantToUTF8(variant(Arguments[0]),temp,wasString);
  end;
begin
  result := true;
  Data := @V; // Data=V is const so should not be modified - but we need it
  case length(Arguments) of
  {$ifndef FPC} // Data=@V trick raises GPF on FPC -> read/only
   0: if SameText(Name,'Clear') then begin
        Data^.VCount := 0;
        Data^.VOptions := Data^.VOptions-[dvoIsObject,dvoIsArray];
        exit;
      end; {$endif FPC}
   1: {$ifndef FPC} if SameText(Name,'Add') then begin
        ndx := Data^.InternalAdd('');
        SetVariantByValue(variant(Arguments[0]),Data^.VValue[ndx]);
        if dvoInternValues in Data^.VOptions then
          DocVariantType.InternValues.UniqueVariant(Data^.VValue[ndx]);
        exit;
      end else
      if SameText(Name,'Delete') then begin
        SetTempFromFirstArgument;
        Data^.Delete(Data^.GetValueIndex(temp));
        exit;
      end else {$endif FPC}
    if SameText(Name,'Exists') then begin
      SetTempFromFirstArgument;
      variant(Dest) := Data^.GetValueIndex(temp)>=0;
      exit;
    end else
    if SameText(Name,'NameIndex') then begin
      SetTempFromFirstArgument;
      variant(Dest) := Data^.GetValueIndex(temp);
      exit;
    end else
    if VariantToInteger(variant(Arguments[0]),ndx) then begin
      if (Name='_') or SameText(Name,'Value') then begin
        Data^.RetrieveValueOrRaiseException(ndx,variant(Dest),true);
        exit;
      end else
      if SameText(Name,'Name') then begin
        Data^.RetrieveNameOrRaiseException(ndx,temp);
        RawUTF8ToVariant(temp,variant(Dest));
        exit;
      end;
    end else
    if (Name='_') or SameText(Name,'Value') then begin
      SetTempFromFirstArgument;
      Data^.RetrieveValueOrRaiseException(pointer(temp),length(temp),
        dvoNameCaseSensitive in Data^.VOptions,variant(Dest),true);
      exit;
    end;
  2:{$ifndef FPC} if SameText(Name,'Add') then begin
      SetTempFromFirstArgument;
      ndx := Data^.InternalAdd(temp);
      SetVariantByValue(variant(Arguments[1]),Data^.VValue[ndx]);
      if dvoInternValues in Data^.VOptions then
        DocVariantType.InternValues.UniqueVariant(Data^.VValue[ndx]);
      exit;
    end; {$endif FPC}
  end;
  result := false;
end;

procedure TDocVariant.ToJSON(W: TTextWriter; const Value: variant;
  escape: TTextWriterKind);
var ndx: integer;
    vt: cardinal;
    forced: TTextWriterOptions;
    checkExtendedPropName: boolean;
begin
  vt := TDocVariantData(Value).VType;
  if vt>varNull then
  if vt=cardinal(DocVariantVType) then
  with TDocVariantData(Value) do
  if [dvoIsArray,dvoIsObject]*VOptions=[] then
    W.AddShort('null') else begin
    if [twoForceJSONExtended,twoForceJSONStandard]*W.CustomOptions=[] then begin
      if dvoSerializeAsExtendedJson in VOptions then
        forced := [twoForceJSONExtended] else
        forced := [twoForceJSONStandard];
      W.CustomOptions := W.CustomOptions+forced;
    end else
      forced := [];
    if dvoIsObject in VOptions then begin
      checkExtendedPropName := twoForceJSONExtended in W.CustomOptions;
      W.Add('{');
      for ndx := 0 to VCount-1 do begin
        if checkExtendedPropName and JsonPropNameValid(pointer(VName[ndx])) then begin
          W.AddNoJSONEscape(pointer(VName[ndx]),Length(VName[ndx]));
        end else begin
          W.Add('"');
          W.AddJSONEscape(pointer(VName[ndx]));
          W.Add('"');
        end;
        W.Add(':');
        W.AddVariant(VValue[ndx],twJSONEscape);
        W.Add(',');
      end;
      W.CancelLastComma;
      W.Add('}');
    end else begin
      W.Add('[');
      for ndx := 0 to VCount-1 do begin
        W.AddVariant(VValue[ndx],twJSONEscape);
        W.Add(',');
      end;
      W.CancelLastComma;
      W.Add(']');
    end;
    if forced<>[] then
      W.CustomOptions := W.CustomOptions-forced;
  end else
    raise ESynException.CreateUTF8('Unexpected variant type %',[vt]) else
    W.AddShort('null');
end;

procedure TDocVariant.Clear(var V: TVarData);
var dv: TDocVariantData absolute V;
begin
  //Assert(V.VType=DocVariantVType);
  RawUTF8DynArrayClear(dv.VName);
  VariantDynArrayClear(dv.VValue);
  ZeroFill(@V); // will set V.VType := varEmpty and VCount=0
end;

procedure TDocVariant.Copy(var Dest: TVarData; const Source: TVarData;
  const Indirect: Boolean);
begin
  //Assert(Source.VType=DocVariantVType);
  if Indirect then
    SimplisticCopy(Dest,Source,true) else
    if dvoValueCopiedByReference in TDocVariantData(Source).Options then begin
      VarClear(variant(Dest)); // Dest may be a complex type
      pointer(TDocVariantData(Dest).VName) := nil;      // avoid GPF
      pointer(TDocVariantData(Dest).VValue) := nil;
      TDocVariantData(Dest) := TDocVariantData(Source); // copy whole record
    end else
      CopyByValue(Dest,Source);
end;

procedure TDocVariant.CopyByValue(var Dest: TVarData; const Source: TVarData);
var S: TDocVariantData absolute Source;
    D: TDocVariantData absolute Dest;
    i: integer;
begin
  //Assert(Source.VType=DocVariantVType);
  VarClear(variant(Dest)); // Dest may be a complex type
  D.VType := S.VType;
  D.VOptions := S.VOptions; // copies also Kind
  D.VCount := S.VCount;
  pointer(D.VName) := nil; // avoid GPF
  pointer(D.VValue) := nil;
  if S.VCount=0 then
    exit; // no data to copy
  D.VName := S.VName; // names can always be safely copied
  // slower but safe by-value copy
  SetLength(D.VValue,S.VCount);
  for i := 0 to S.VCount-1 do
    D.VValue[i] := S.VValue[i];
end;

procedure TDocVariant.Cast(var Dest: TVarData; const Source: TVarData);
begin
  CastTo(Dest,Source,VarType);
end;

procedure TDocVariant.CastTo(var Dest: TVarData;
  const Source: TVarData; const AVarType: TVarType);
var Tmp: RawUTF8;
    wasString: boolean;
begin
  if AVarType=VarType then begin
    VariantToUTF8(Variant(Source),Tmp,wasString);
    if wasString then begin
      VarClear(variant(Dest));
      variant(Dest) := _JSONFast(Tmp); // convert from JSON text
      exit;
    end;
    RaiseCastError;
  end else begin
    if Source.VType<>VarType then
      RaiseCastError;
    VariantSaveJSON(variant(Source),twJSONEscape,tmp);
    RawUTF8ToVariant(Tmp,Dest,AVarType); // convert to JSON text
  end;
end;

procedure TDocVariant.Compare(const Left, Right: TVarData;
  var Relationship: TVarCompareResult);
var res: integer;
    LeftU,RightU: RawUTF8;
begin
  VariantSaveJSON(variant(Left),twJSONEscape,LeftU);
  VariantSaveJSON(variant(Right),twJSONEscape,RightU);
  if LeftU=RightU then
    Relationship := crEqual else begin
    res := StrComp(pointer(LeftU),pointer(RightU));
    if res<0 then
      Relationship := crLessThan else
    if res>0 then
      Relationship := crGreaterThan else
      Relationship := crEqual;
  end;
end;

class procedure TDocVariant.New(out aValue: variant;
  aOptions: TDocVariantOptions);
begin
  TDocVariantData(aValue).Init(aOptions);
end;

class procedure TDocVariant.NewFast(out aValue: variant);
begin
  TDocVariantData(aValue).InitFast;
end;

class procedure TDocVariant.IsOfTypeOrNewFast(var aValue: variant);
begin
  if DocVariantType.IsOfType(aValue) then
    exit;
  VarClear(aValue);
  TDocVariantData(aValue).InitFast;
end;

class procedure TDocVariant.NewFast(const aValues: array of PDocVariantData);
var i: integer;
begin
  for i := 0 to high(aValues) do
    aValues[i]^.InitFast;
end;

class function TDocVariant.New(Options: TDocVariantOptions): Variant;
begin
  VarClear(result);
  TDocVariantData(result).Init(Options);
end;

class function TDocVariant.NewObject(const NameValuePairs: array of const;
  Options: TDocVariantOptions): variant;
begin
  VarClear(result);
  TDocVariantData(result).InitObject(NameValuePairs,Options);
end;

class function TDocVariant.NewArray(const Items: array of const;
  Options: TDocVariantOptions): variant;
begin
  VarClear(result);
  TDocVariantData(result).InitArray(Items,Options);
end;

class function TDocVariant.NewArray(const Items: TVariantDynArray;
  Options: TDocVariantOptions): variant;
begin
  VarClear(result);
  TDocVariantData(result).InitArrayFromVariants(Items,Options);
end;

class function TDocVariant.NewJSON(const JSON: RawUTF8;
  Options: TDocVariantOptions): variant;
begin
  _Json(JSON,result,Options);
end;

class function TDocVariant.NewUnique(const SourceDocVariant: variant;
  Options: TDocVariantOptions): variant;
begin
  VarClear(result);
  TDocVariantData(result).InitCopy(SourceDocVariant,Options);
end;

class procedure TDocVariant.GetSingleOrDefault(const docVariantArray, default: variant;
  var result: variant);
var vt: integer;
begin
  vt := TVarData(DocVariantArray).VType;
  if vt=varByRef or varVariant then
    GetSingleOrDefault(PVariant(TVarData(DocVariantArray).VPointer)^,default,result) else
  if (vt<>DocVariantVType) or (TDocVariantData(DocVariantArray).Count<>1) or
     not(dvoIsArray in TDocVariantData(DocVariantArray).VOptions) then
    result := default else
    result := TDocVariantData(DocVariantArray).Values[0];
end;

function ToText(kind: TDocVariantKind): PShortString;
begin
  result := GetEnumName(TypeInfo(TDocVariantKind),ord(kind));
end;

function _Obj(const NameValuePairs: array of const;
  Options: TDocVariantOptions): variant;
begin
  VarClear(result);
  TDocVariantData(result).InitObject(NameValuePairs,Options);
end;

function _Arr(const Items: array of const;
  Options: TDocVariantOptions): variant;
begin
  VarClear(result);
  TDocVariantData(result).InitArray(Items,Options);
end;

procedure _ObjAddProps(const NameValuePairs: array of const; var Obj: variant);
var o: PDocVariantData;
begin
  o := _Safe(Obj);
  if not(dvoIsObject in o^.VOptions) then begin // create new object
    VarClear(Obj);
    TDocVariantData(Obj).InitObject(NameValuePairs,JSON_OPTIONS_FAST);
  end else begin // append new names/values to existing object
    TVarData(Obj) := PVarData(o)^; // ensure not stored by reference
    o^.AddNameValuesToObject(NameValuePairs);
  end;
end;

procedure _ObjAddProps(const Document: variant; var Obj: variant);
var ndx: integer;
    d,o: PDocVariantData;
begin
  d := _Safe(Document);
  o := _Safe(Obj);
  if dvoIsObject in d.VOptions then
    if not(dvoIsObject in o.VOptions) then
      Obj := Document else
      for ndx := 0 to d^.VCount-1 do
        o^.AddOrUpdateValue(d^.VName[ndx],d^.VValue[ndx]);
end;

function _ObjFast(const NameValuePairs: array of const): variant;
begin
  VarClear(result);
  TDocVariantData(result).InitObject(NameValuePairs,JSON_OPTIONS_FAST);
end;

function _ObjFast(aObject: TObject; aOptions: TTextWriterWriteObjectOptions): variant;
begin
  VarClear(result);
  if TDocVariantData(result).InitJSONInPlace(
      pointer(ObjectToJson(aObject,aOptions)),JSON_OPTIONS_FAST)=nil then
    VarClear(result);
end;

function _ArrFast(const Items: array of const): variant;
begin
  VarClear(result);
  TDocVariantData(result).InitArray(Items,JSON_OPTIONS_FAST);
end;

function _Json(const JSON: RawUTF8; Options: TDocVariantOptions): variant;
begin
  _Json(JSON,result,Options);
end;

function _JsonFast(const JSON: RawUTF8): variant;
begin
  _Json(JSON,result,JSON_OPTIONS_FAST);
end;

function _JsonFastExt(const JSON: RawUTF8): variant;
begin
  _Json(JSON,result,JSON_OPTIONS_FAST_EXTENDED);
end;

function _JsonFmt(const Format: RawUTF8; const Args,Params: array of const;
  Options: TDocVariantOptions): variant;
begin
  _JsonFmt(Format,Args,Params,Options,result);
end;

procedure _JsonFmt(const Format: RawUTF8; const Args,Params: array of const;
  Options: TDocVariantOptions; out result: variant);
var temp: RawUTF8;
begin
  temp := FormatUTF8(Format,Args,Params,true);
  if TDocVariantData(result).InitJSONInPlace(pointer(temp),Options)=nil then
    TDocVariantData(result).Clear;
end;

function _JsonFastFmt(const Format: RawUTF8; const Args,Params: array of const): variant;
begin
  _JsonFmt(Format,Args,Params,JSON_OPTIONS_FAST,result);
end;

function _Json(const JSON: RawUTF8; var Value: variant;
  Options: TDocVariantOptions): boolean;
begin
  VarClear(Value);
  if not TDocVariantData(Value).InitJSON(JSON,Options) then begin
    VarClear(Value);
    result := false;
  end else
    result := true;
end;

procedure _Unique(var DocVariant: variant);
begin // TDocVariantData(DocVariant): InitCopy() will check the DocVariant type
  TDocVariantData(DocVariant).InitCopy(DocVariant,JSON_OPTIONS[false]);
end;

procedure _UniqueFast(var DocVariant: variant);
begin // TDocVariantData(DocVariant): InitCopy() will check the DocVariant type
  TDocVariantData(DocVariant).InitCopy(DocVariant,JSON_OPTIONS_FAST);
end;

function _Copy(const DocVariant: variant): variant;
begin
  result := TDocVariant.NewUnique(DocVariant,JSON_OPTIONS[false]);
end;

function _CopyFast(const DocVariant: variant): variant;
begin
  result := TDocVariant.NewUnique(DocVariant,JSON_OPTIONS_FAST);
end;

function _ByRef(const DocVariant: variant; Options: TDocVariantOptions): variant;
begin
  VarClear(result);
  TDocVariantData(result) := _Safe(DocVariant)^; // fast byref copy
  TDocVariantData(result).SetOptions(Options);
end;

procedure _ByRef(const DocVariant: variant; out Dest: variant;
  Options: TDocVariantOptions);
begin
  TDocVariantData(Dest) := _Safe(DocVariant)^; // fast byref copy
  TDocVariantData(Dest).SetOptions(Options);
end;

function ObjectToVariant(Value: TObject; EnumSetsAsText: boolean): variant;
const OPTIONS: array[boolean] of TTextWriterWriteObjectOptions = (
     [woDontStoreDefault],[woDontStoreDefault,woEnumSetsAsText]);
begin
  VarClear(result);
  ObjectToVariant(Value,result,OPTIONS[EnumSetsAsText]);
end;

procedure ObjectToVariant(Value: TObject; out Dest: variant);
begin
  ObjectToVariant(Value,Dest,[woDontStoreDefault]);
end;

procedure ObjectToVariant(Value: TObject; var result: variant;
  Options: TTextWriterWriteObjectOptions);
var json: RawUTF8;
begin
  json := ObjectToJSON(Value,Options);
  PDocVariantData(@result)^.InitJSONInPlace(pointer(json),JSON_OPTIONS_FAST);
end;

{$endif NOVARIANTS}


{ ****************** TDynArray wrapper }

{$ifndef DELPHI5OROLDER} // do not know why Delphi 5 compiler does not like CopyFrom()
procedure DynArrayCopy(var Dest; const Source; SourceMaxElem: integer;
  TypeInfo: pointer);
var DestDynArray: TDynArray;
begin
  DestDynArray.Init(TypeInfo,Dest);
  DestDynArray.CopyFrom(Source,SourceMaxElem);
end;
{$endif DELPHI5OROLDER}

function DynArrayLoad(var Value; Source: PAnsiChar; TypeInfo: pointer): PAnsiChar;
var DynArray: TDynArray;
begin
  DynArray.Init(TypeInfo,Value);
  result := DynArray.LoadFrom(Source);
end;

function DynArraySave(var Value; TypeInfo: pointer): RawByteString;
var DynArray: TDynArray;
begin
  DynArray.Init(TypeInfo,Value);
  result := DynArray.SaveTo;
end;

function DynArrayLoadJSON(var Value; JSON: PUTF8Char; TypeInfo: pointer;
  EndOfObject: PUTF8Char): PUTF8Char;
var DynArray: TDynArray;
begin
  DynArray.Init(TypeInfo,Value);
  result := DynArray.LoadFromJSON(JSON,EndOfObject);
end;

function DynArrayLoadJSON(var Value; const JSON: RawUTF8; TypeInfo: pointer): boolean;
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON); // make private copy before in-place decoding
  try
    result := DynArrayLoadJSON(Value,tmp.buf,TypeInfo)<>nil;
  finally
    tmp.Done;
  end;
end;

function DynArraySaveJSON(const Value; TypeInfo: pointer;
  EnumSetsAsText: boolean): RawUTF8;
begin
  result := SaveJSON(Value,TypeInfo,EnumSetsAsText);
end;

{$ifndef DELPHI5OROLDER}
function DynArrayEquals(TypeInfo: pointer; var Array1, Array2;
  Array1Count, Array2Count: PInteger): boolean;
var DA1, DA2: TDynArray;
begin
  DA1.Init(TypeInfo,Array1,Array1Count);
  DA2.Init(TypeInfo,Array2,Array2Count);
  result := DA1.Equals(DA2);
end;
{$endif DELPHI5OROLDER}

function DynArrayBlobSaveJSON(TypeInfo, BlobValue: pointer): RawUTF8;
var DynArray: TDynArray;
    Value: pointer; // store the temporary dynamic array
    temp: TTextWriterStackBuffer;
begin
  Value := nil;
  DynArray.Init(TypeInfo,Value);
  try
    if DynArray.LoadFrom(BlobValue)=nil then
      result := '' else begin
      with DefaultTextWriterSerializer.CreateOwnedStream(temp) do
      try
        AddDynArrayJSON(TypeInfo,Value);
        SetText(result);
      finally
        Free;
      end;
     end;
  finally
    DynArray.SetCount(0);
  end;
end;

function DynArrayElementTypeName(TypeInfo: pointer; ElemTypeInfo: PPointer;
  ExactType: boolean): RawUTF8;
var DynArray: TDynArray;
    VoidArray: pointer;
const KNOWNTYPE_ITEMNAME: array[TDynArrayKind] of RawUTF8 = ('',
  'boolean','byte','word','integer','cardinal','single','Int64','QWord',
  'double','currency','TTimeLog','TDateTime','TDateTimeMS',
  'RawUTF8','WinAnsiString','string','RawByteString','WideString','SynUnicode',
  'THash128','THash256','THash512','IInterface',{$ifndef NOVARIANTS}'variant',{$endif}'');
begin
  VoidArray := nil;
  DynArray.Init(TypeInfo,VoidArray);
  result := '';
  if ElemTypeInfo<>nil then
    ElemTypeInfo^ := DynArray.ElemType;
  if DynArray.ElemType<>nil then
    TypeInfoToName(ElemTypeInfo,result) else
    result := KNOWNTYPE_ITEMNAME[DynArray.GuessKnownType(ExactType)];
end;

procedure RawRecordDynArrayClear(v: PAnsiChar; info: PTypeInfo; n: integer);
var fields,f: PFieldInfo;
    nfields,i: integer;
begin
  info := GetTypeInfo(info);
  nfields := GetManagedFields(info,fields); // inlined RecordClear()
  if nfields>0 then
    repeat
      f := fields;
      i := nfields;
      repeat
        {$ifdef FPC}FPCFinalize{$else}_Finalize{$endif}(v+f^.Offset,
          {$ifdef HASDIRECTTYPEINFO}f^.TypeInfo{$else}PPointer(f^.TypeInfo)^{$endif});
        inc(f);
        dec(i);
      until i=0;
      inc(v,info^.recSize);
      dec(n);
    until n=0;
end;

procedure RawAnsiStringDynArrayClear(v: PPointer; n: PtrInt);
var p: PStrRec;
begin
  repeat
    p := v^;
    if p<>nil then begin
      v^ := nil;
      dec(p);
      if (p^.refCnt>=0) and RefCntDecFree(p^.refCnt) then
        freemem(p);
    end;
    inc(v);
    dec(n);
  until n=0;
end;

procedure FastFinalizeArray(v: PPointer; ElemTypeInfo: pointer; n: integer);
begin //  caller ensured ElemTypeInfo<>nil and n>0
  case PTypeKind(ElemTypeInfo)^ of
    tkRecord{$ifdef FPC},tkObject{$endif}:
      RawRecordDynArrayClear(pointer(v),ElemTypeinfo,n);
    {$ifndef NOVARIANTS}
    tkVariant:
      RawVariantDynArrayClear(pointer(v),n);
    {$endif}
    tkLString{$ifdef FPC},tkLStringOld{$endif}:
      RawAnsiStringDynArrayClear(pointer(v),n);
    tkWString:
      repeat
        if v^<>nil then
          {$ifdef FPC}Finalize(WideString(v^)){$else}WideString(v^) := ''{$endif};
        inc(v);
        dec(n);
      until n=0;
    {$ifdef HASVARUSTRING}
    tkUString:
      repeat
        if v^<>nil then
          {$ifdef FPC}Finalize(UnicodeString(v^)){$else}UnicodeString(v^) := ''{$endif};
        inc(v);
        dec(n);
      until n=0;
    {$endif}
    {$ifndef DELPHI5OROLDER}
    tkInterface:
      repeat
        if v^<>nil then
          {$ifdef FPC}Finalize(IInterface(v^)){$else}IInterface(v^) := nil{$endif};
        inc(v);
        dec(n);
      until n=0;
    {$endif}
    tkDynArray: begin
      ElemTypeInfo := Deref(GetTypeInfo(ElemTypeInfo)^.elType);
      repeat
        if v^<>nil then
          FastDynArrayClear(v,ElemTypeInfo);
        inc(v);
        dec(n);
      until n=0;
    end;
    else // fallback to regular finalization code for less common types
      {$ifdef FPC}FPCFinalizeArray{$else}_FinalizeArray{$endif}(v,ElemTypeInfo,n);
  end;
end;

procedure FastDynArrayClear(Value: PPointer; ElemTypeInfo: pointer);
var p: PDynArrayRec;
begin
  if Value<>nil then begin
    p := Value^;
    if p<>nil then begin
      dec(p);
      if (p^.refCnt>=0) and RefCntDecFree(p^.refCnt) then begin
        if ElemTypeInfo<>nil then
          FastFinalizeArray(Value^,ElemTypeInfo,p^.length);
        Freemem(p);
      end;
      Value^ := nil;
    end;
  end;
end;

{$ifdef FPC_X64}
procedure _dynarray_decr_ref_free(p: PDynArrayRec; info: pointer);
begin
  info := Deref(GetTypeInfo(info)^.elType);
  if info <> nil then
    FastFinalizeArray(pointer(PAnsiChar(p) + SizeOf(p^)), info, p^.length);
  Freemem(p);
end;
{$endif FPC_X64}

function SortDynArrayBoolean(const A,B): integer;
begin
  if boolean(A) then // normalize (seldom used, anyway)
    if boolean(B) then
      result := 0 else
      result := 1 else
    if boolean(B) then
      result := -1 else
      result := 0;
end;

function SortDynArrayByte(const A,B): integer;
begin
  result := byte(A)-byte(B);
end;

function SortDynArraySmallint(const A,B): integer;
begin
  result := smallint(A)-smallint(B);
end;

function SortDynArrayShortint(const A,B): integer;
begin
  result := shortint(A)-shortint(B);
end;

function SortDynArrayWord(const A,B): integer;
begin
  result := word(A)-word(B);
end;

function SortDynArrayPUTF8CharI(const A,B): integer;
begin
  result := StrIComp(PUTF8Char(A),PUTF8Char(B));
end;

function SortDynArrayString(const A,B): integer;
begin
  {$ifdef UNICODE}
  result := StrCompW(PWideChar(A),PWideChar(B));
  {$else}
  result := StrComp(PUTF8Char(A),PUTF8Char(B));
  {$endif}
end;

function SortDynArrayStringI(const A,B): integer;
begin
  {$ifdef UNICODE}
  result := AnsiICompW(PWideChar(A),PWideChar(B));
  {$else}
  result := StrIComp(PUTF8Char(A),PUTF8Char(B));
  {$endif}
end;

function SortDynArrayFileName(const A,B): integer;
var Aname, Aext, Bname, Bext: TFileName;
begin // code below is not very fast, but is correct ;)
  AName := GetFileNameWithoutExt(string(A),@Aext);
  BName := GetFileNameWithoutExt(string(B),@Bext);
  result := AnsiCompareFileName(Aext,Bext);
  if result=0 then // if both extensions matches, compare by filename
    result := AnsiCompareFileName(Aname,Bname);
end;

function SortDynArrayUnicodeString(const A,B): integer;
begin // works for tkWString and tkUString
  result := StrCompW(PWideChar(A),PWideChar(B));
end;

function SortDynArrayUnicodeStringI(const A,B): integer;
begin
  result := AnsiICompW(PWideChar(A),PWideChar(B));
end;

function SortDynArray128(const A,B): integer;
begin
  if THash128Rec(A).Lo<THash128Rec(B).Lo then
    result := -1 else
  if THash128Rec(A).Lo>THash128Rec(B).Lo then
    result := 1 else
    if THash128Rec(A).Hi<THash128Rec(B).Hi then
      result := -1 else
    if THash128Rec(A).Hi>THash128Rec(B).Hi then
      result := 1 else
      result := 0;
end;

function SortDynArray256(const A,B): integer;
begin
  result := SortDynArray128(THash256Rec(A).Lo,THash256Rec(B).Lo);
  if result = 0 then
    result := SortDynArray128(THash256Rec(A).Hi,THash256Rec(B).Hi);
end;

function SortDynArray512(const A,B): integer;
begin
  result := SortDynArray128(THash512Rec(A).c0,THash512Rec(B).c0);
  if result = 0 then begin
    result := SortDynArray128(THash512Rec(A).c1,THash512Rec(B).c1);
    if result = 0 then begin
      result := SortDynArray128(THash512Rec(A).c2,THash512Rec(B).c2);
      if result = 0 then
        result := SortDynArray128(THash512Rec(A).c3,THash512Rec(B).c3);
    end;
  end;
end;

{$ifndef NOVARIANTS}

function VariantCompare(const V1,V2: variant): PtrInt;
begin
  result := SortDynArrayVariantComp(TVarData(V1), TVarData(V2), false);
end;

function VariantCompareI(const V1,V2: variant): PtrInt;
begin
  result := SortDynArrayVariantComp(TVarData(V1), TVarData(V2), true);
end;

function SortDynArrayVariantCompareAsString(const A,B: variant): integer;
var UA,UB: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(A,UA,wasString);
  VariantToUTF8(B,UB,wasString);
  result := StrComp(pointer(UA),pointer(UB));
end;

function SortDynArrayVariantCompareAsStringI(const A,B: variant): integer;
var UA,UB: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(A,UA,wasString);
  VariantToUTF8(B,UB,wasString);
  result := StrIComp(pointer(UA),pointer(UB));
end;

function SortDynArrayZero(const A,B): integer;
begin
  result := 0;
end;

function SortDynArrayVariantComp(const A,B: TVarData; caseInsensitive: boolean): integer;
type
  TSortDynArrayVariantComp = function(const A,B: variant): integer;
const
  CMP: array[boolean] of TSortDynArrayVariantComp = (
    SortDynArrayVariantCompareAsString,SortDynArrayVariantCompareAsStringI);
  ICMP: array[TVariantRelationship] of integer = (0,-1,1,1);
  SORT1: array[varEmpty..varDate] of TDynArraySortCompare = (
    SortDynArrayZero, SortDynArrayZero, SortDynArraySmallInt, SortDynArrayInteger,
    SortDynArraySingle, SortDynArrayDouble, SortDynArrayInt64, SortDynArrayDouble);
  SORT2: array[varShortInt..varWord64] of TDynArraySortCompare = (
    SortDynArrayShortInt, SortDynArrayByte, SortDynArrayWord, SortDynArrayCardinal,
    SortDynArrayInt64, SortDynArrayQWord);
var AT,BT: integer;
begin
  AT := integer(A.VType);
  BT := integer(B.VType);
  if AT=varVariant or varByRef then
    result := SortDynArrayVariantComp(PVarData(A.VPointer)^,B,caseInsensitive) else
  if BT=varVariant or varByRef then
    result := SortDynArrayVariantComp(A,PVarData(B.VPointer)^,caseInsensitive) else
  if AT=BT then
    case AT of // optimized comparison if A and B share the same type
    low(SORT1)..high(SORT1):
      result := SORT1[AT](A.VAny,B.VAny);
    low(SORT2)..high(SORT2):
      result := SORT2[AT](A.VAny,B.VAny);
    varString: // RawUTF8 most of the time (e.g. from TDocVariant)
      if caseInsensitive then
        result := StrIComp(A.VAny,B.VAny) else
        result := StrComp(A.VAny,B.VAny);
    varBoolean:
      if A.VBoolean then // normalize
        if B.VBoolean then
          result := 0 else
          result := 1 else
        if B.VBoolean then
          result := -1 else
          result := 0;
    varOleStr{$ifdef HASVARUSTRING},varUString{$endif}:
      if caseInsensitive then
        result := AnsiICompW(A.VAny,B.VAny) else
        result := StrCompW(A.VAny,B.VAny);
    else
      if AT<varString then
        result := ICMP[VarCompareValue(variant(A),variant(B))] else
        result := CMP[caseInsensitive](variant(A),variant(B));
    end else
  if (AT<=varNull) or (BT<=varNull) then
    result := ord(AT>varNull)-ord(BT>varNull) else
  if (AT<varString) and (BT<varString) then
    result := ICMP[VarCompareValue(variant(A),variant(B))] else
    result := CMP[caseInsensitive](variant(A),variant(B));
end;

function SortDynArrayVariant(const A,B): integer;
begin
  result := SortDynArrayVariantComp(TVarData(A),TVarData(B),false);
end;

function SortDynArrayVariantI(const A,B): integer;
begin
  result := SortDynArrayVariantComp(TVarData(A),TVarData(B),true);
end;

{$endif NOVARIANTS}


{ TDynArray }

function TDynArray.GetCount: PtrInt;
begin
  result := PtrUInt(fCountP);
  if result<>0 then
    result := PInteger(result)^ else begin
    result := PtrUInt(fValue);
    if result<>0 then begin
      result := PPtrInt(result)^;
      if result<>0 then
        result := PDALen(result-_DALEN)^{$ifdef FPC}+1{$endif};
    end;
  end;
end;

procedure TDynArray.ElemCopy(const A; var B);
begin
  if ElemType=nil then
    MoveFast(A,B,ElemSize) else begin
    {$ifdef FPC}
    {$ifdef FPC_OLDRTTI}
    FPCFinalize(@B,ElemType); // inlined CopyArray()
    Move(A,B,ElemSize);
    FPCRecordAddRef(B,ElemType);
    {$else}
    FPCRecordCopy(A,B,ElemType); // works for any kind of ElemTyp
    {$endif FPC_OLDRTTI}
    {$else}
    CopyArray(@B,@A,ElemType,1);
    {$endif FPC}
  end;
end;

function TDynArray.Add(const Elem): PtrInt;
var p: PtrUInt;
begin
  result := GetCount;
  if fValue=nil then
    exit; // avoid GPF if void
  SetCount(result+1);
  p := PtrUInt(fValue^)+PtrUInt(result)*ElemSize;
  if ElemType=nil then
    MoveFast(Elem,pointer(p)^,ElemSize) else
    {$ifdef FPC}
    FPCRecordCopy(Elem,pointer(p)^,ElemType);
    {$else}
    CopyArray(pointer(p),@Elem,ElemType,1);
    {$endif}
end;

function TDynArray.New: integer;
begin
  result := GetCount;
  if fValue=nil then
    exit; // avoid GPF if void
  SetCount(result+1);
end;

function TDynArray.Peek(var Dest): boolean;
var index: PtrInt;
begin
  index := GetCount-1;
  result := index>=0;
  if result then
    ElemCopy(pointer(PtrUInt(fValue^)+PtrUInt(index)*ElemSize)^,Dest);
end;

function TDynArray.Pop(var Dest): boolean;
var index: integer;
begin
  index := GetCount-1;
  result := index>=0;
  if result then begin
    ElemMoveTo(index,Dest);
    SetCount(index);
  end;
end;

procedure TDynArray.Insert(Index: PtrInt; const Elem);
var n: PtrInt;
    P: PByteArray;
begin
  if fValue=nil then
    exit; // avoid GPF if void
  n := GetCount;
  SetCount(n+1);
  if PtrUInt(Index)<PtrUInt(n) then begin
    P := pointer(PtrUInt(fValue^)+PtrUInt(Index)*ElemSize);
    MoveFast(P[0],P[ElemSize],PtrUInt(n-Index)*ElemSize);
    if ElemType<>nil then // avoid GPF in ElemCopy() below
      FillCharFast(P^,ElemSize,0);
  end else
    // Index>=Count -> add at the end
    P := pointer(PtrUInt(fValue^)+PtrUInt(n)*ElemSize);
  ElemCopy(Elem,P^);
end;

procedure TDynArray.Clear;
begin
  SetCount(0);
end;

function TDynArray.ClearSafe: boolean;
begin
  try
    SetCount(0);
    result := true;
  except // weak code, but may be a good idea in a destructor
    result := false;
  end;
end;

function TDynArray.GetIsObjArray: boolean;
begin
  result := (fIsObjArray=oaTrue) or ((fIsObjArray=oaUnknown) and ComputeIsObjArray);
end;

function TDynArray.Delete(aIndex: PtrInt): boolean;
var n, len: PtrInt;
    P: PAnsiChar;
begin
  result := false;
  if fValue=nil then
    exit; // avoid GPF if void
  n := GetCount;
  if PtrUInt(aIndex)>=PtrUInt(n) then
    exit; // out of range
  if PRefCnt(PtrUInt(fValue^)-_DAREFCNT)^>1 then
    InternalSetLength(n,n); // unique
  dec(n);
  P := pointer(PtrUInt(fValue^)+PtrUInt(aIndex)*ElemSize);
  if ElemType<>nil then
    {$ifdef FPC}FPCFinalize{$else}_Finalize{$endif}(P,ElemType) else
    if (fIsObjArray=oaTrue) or ((fIsObjArray=oaUnknown) and ComputeIsObjArray) then
      FreeAndNil(PObject(P)^);
  if n>aIndex then begin
    len := PtrUInt(n-aIndex)*ElemSize;
    MoveFast(P[ElemSize],P[0],len);
    FillCharFast(P[len],ElemSize,0);
  end else
    FillCharFast(P^,ElemSize,0);
  SetCount(n);
  result := true;
end;

function TDynArray.ElemPtr(index: PtrInt): pointer;
label ok;
var c: PtrUInt;
begin // very efficient code on FPC and modern Delphi
  result := pointer(fValue);
  if result=nil then
    exit;
  result := PPointer(result)^;
  if result=nil then
    exit;
  c := PtrUInt(fCountP);
  if c<>0 then begin
    if PtrUInt(index)<PCardinal(c)^ then
ok:   inc(PByte(result),PtrUInt(index)*ElemSize) else
      result := nil
  end else
    {$ifdef FPC}
    if PtrUInt(index)<=PPtrUInt(PtrUInt(result)-_DALEN)^ then
    {$else}
    if PtrUInt(index)<PPtrUInt(PtrUInt(result)-_DALEN)^ then
    {$endif FPC}
      goto ok else
      result := nil;
end;

procedure TDynArray.ElemCopyAt(index: PtrInt; var Dest);
var p: pointer;
begin
  p := ElemPtr(index);
  if p<>nil then
    if ElemType=nil then
      MoveFast(p^,Dest,ElemSize) else
      {$ifdef FPC}
      FPCRecordCopy(p^,Dest,ElemType); // works for any kind of ElemTyp
      {$else}
      CopyArray(@Dest,p,ElemType,1);
      {$endif}
end;

procedure TDynArray.ElemMoveTo(index: PtrInt; var Dest);
var p: pointer;
begin
  p := ElemPtr(index);
  if (p=nil) or (@Dest=nil) then
    exit;
  ElemClear(Dest);
  MoveFast(p^,Dest,ElemSize);
  FillCharFast(p^,ElemSize,0); // ElemType=nil for ObjArray
end;

procedure TDynArray.ElemCopyFrom(const Source; index: PtrInt; ClearBeforeCopy: boolean);
var p: pointer;
begin
  p := ElemPtr(index);
  if p<>nil then
    if ElemType=nil then
      MoveFast(Source,p^,ElemSize) else begin
      if ClearBeforeCopy then // safer if Source is a copy of p^
        {$ifdef FPC}FPCFinalize{$else}_Finalize{$endif}(p,ElemType);
      {$ifdef FPC}
      FPCRecordCopy(Source,p^,ElemType);
      {$else}
      CopyArray(p,@Source,ElemType,1);
      {$endif}
    end;
end;

procedure TDynArray.Reverse;
var n, siz: PtrInt;
    P1, P2: PAnsiChar;
    c: AnsiChar;
    i32: integer;
    i64: Int64;
begin
  n := GetCount-1;
  if n>0 then begin
    siz := ElemSize;
    P1 := fValue^;
    case siz of
    1: begin // optimized version for TByteDynArray and such
      P2 := P1+n;
      while P1<P2 do begin
        c := P1^;
        P1^ := P2^;
        P2^ := c;
        inc(P1);
        dec(P2);
      end;
    end;
    4: begin // optimized version for TIntegerDynArray and such
      P2 := P1+n*SizeOf(Integer);
      while P1<P2 do begin
        i32 := PInteger(P1)^;
        PInteger(P1)^ := PInteger(P2)^;
        PInteger(P2)^ := i32;
        inc(P1,4);
        dec(P2,4);
      end;
    end;
    8: begin // optimized version for TInt64DynArray + TDoubleDynArray and such
      P2 := P1+n*SizeOf(Int64);
      while P1<P2 do begin
        i64 := PInt64(P1)^;
        PInt64(P1)^ := PInt64(P2)^;
        PInt64(P2)^ := i64;
        inc(P1,8);
        dec(P2,8);
      end;
    end;
    16: begin // optimized version for 32-bit TVariantDynArray and such
      P2 := P1+n*16;
      while P1<P2 do begin
        {$ifdef CPU64}Exchg16{$else}ExchgVariant{$endif}(Pointer(P1),Pointer(P2));
        inc(P1,16);
        dec(P2,16);
      end;
    end;
    {$ifdef CPU64}
    24: begin // optimized version for 64-bit TVariantDynArray and such
      P2 := P1+n*24;
      while P1<P2 do begin
        ExchgVariant(Pointer(P1),Pointer(P2));
        inc(P1,24);
        dec(P2,24);
      end;
    end;
    {$endif CPU64}
    else begin // generic version
      P2 := P1+n*siz;
      while P1<P2 do begin
        Exchg(P1,P2,siz);
        inc(P1,siz);
        dec(P2,siz);
      end;
    end;
    end;
  end;
end;

procedure TDynArray.SaveToStream(Stream: TStream);
var Posi, PosiEnd: Integer;
    MemStream: TCustomMemoryStream absolute Stream;
    tmp: RawByteString;
begin
  if (fValue=nil) or (Stream=nil) then
    exit; // avoid GPF if void
  if Stream.InheritsFrom(TCustomMemoryStream) then begin
    Posi := MemStream.Seek(0,soFromCurrent);
    PosiEnd := Posi+SaveToLength;
    if PosiEnd>MemStream.Size then
      MemStream.Size := PosiEnd;
    if SaveTo(PAnsiChar(MemStream.Memory)+Posi)-MemStream.Memory<>PosiEnd then
      raise EStreamError.Create('TDynArray.SaveToStream: SaveTo');
    MemStream.Seek(PosiEnd,soBeginning);
  end else begin
    tmp := SaveTo;
    if Stream.Write(pointer(tmp)^,length(tmp))<>length(tmp) then
      raise EStreamError.Create('TDynArray.SaveToStream: Write error');
  end;
end;

procedure TDynArray.LoadFromStream(Stream: TCustomMemoryStream);
var P: PAnsiChar;
begin
  P := PAnsiChar(Stream.Memory)+Stream.Seek(0,soCurrent);
  Stream.Seek(LoadFrom(P,nil,false,PAnsiChar(Stream.Memory)+Stream.Size)-P,soCurrent);
end;

function TDynArray.SaveToTypeInfoHash(crc: cardinal): cardinal;
begin
  if ElemType=nil then // hash fElemSize only if no pointer within
    result := crc32c(crc,@fElemSize,4) else begin
    result := crc;
    ManagedTypeSaveRTTIHash(ElemType,result);
  end;
end;

function TDynArray.SaveTo(Dest: PAnsiChar): PAnsiChar;
var i, n, LenBytes: integer;
    P: PAnsiChar;
begin
  if fValue=nil then begin
    result := Dest;
    exit; // avoid GPF if void
  end;
  // store the element size+type to check for the format (name='' mostly)
  Dest := PAnsiChar(ToVarUInt32(ElemSize,pointer(Dest)));
  if ElemType=nil then
    Dest^ := #0 else
    {$ifdef FPC}
    Dest^ := AnsiChar(FPCTODELPHI[PTypeKind(ElemType)^]);
    {$else}
    Dest^ := PAnsiChar(ElemType)^;
    {$endif}
  inc(Dest);
  // store dynamic array count
  n := GetCount;
  Dest := PAnsiChar(ToVarUInt32(n,pointer(Dest)));
  if n=0 then begin
    result := Dest;
    exit;
  end;
  inc(Dest,SizeOf(Cardinal)); // leave space for Hash32 checksum
  result := Dest;
  // store dynamic array elements content
  P := fValue^;
  if ElemType=nil then // FPC: nil also if not Kind in tkManagedTypes
    if GetIsObjArray then
      raise ESynException.CreateUTF8('TDynArray.SaveTo(%) is a T*ObjArray',
        [ArrayTypeShort^]) else begin
      n := n*integer(ElemSize); // binary types: store as one
      MoveFast(P^,Dest^,n);
      inc(Dest,n);
    end else
    if PTypeKind(ElemType)^ in tkRecordTypes then
      for i := 1 to n do begin
        Dest := RecordSave(P^,Dest,ElemType,LenBytes);
        inc(P,LenBytes);
      end else
      for i := 1 to n do begin
        Dest := ManagedTypeSave(P,Dest,ElemType,LenBytes);
        if Dest=nil then
          break;
        inc(P,LenBytes);
      end;
  // store Hash32 checksum
  if Dest<>nil then  // may be nil if RecordSave/ManagedTypeSave failed
    PCardinal(result-SizeOf(Cardinal))^ := Hash32(pointer(result),Dest-result);
  result := Dest;
end;

function TDynArray.SaveToLength: integer;
var i,n,L,size: integer;
    P: PAnsiChar;
begin
  if fValue=nil then begin
    result := 0;
    exit; // avoid GPF if void
  end;
  n := GetCount;
  result := ToVarUInt32Length(ElemSize)+ToVarUInt32Length(n)+1;
  if n=0 then
    exit;
  if ElemType=nil then // FPC: nil also if not Kind in tkManagedTypes
    if GetIsObjArray then
      raise ESynException.CreateUTF8('TDynArray.SaveToLength(%) is a T*ObjArray',
        [ArrayTypeShort^]) else
      inc(result,integer(ElemSize)*n) else begin
    P := fValue^;
    case PTypeKind(ElemType)^ of // inlined the most used kind of items
    tkLString{$ifdef FPC},tkLStringOld{$endif}:
      for i := 1 to n do begin
        if PPtrUInt(P)^=0 then
          inc(result) else
          inc(result,ToVarUInt32LengthWithData(PStrLen(PPtrUInt(P)^-_STRLEN)^));
        inc(P,SizeOf(pointer));
      end;
    tkRecord{$ifdef FPC},tkObject{$endif}:
      for i := 1 to n do begin
        inc(result,RecordSaveLength(P^,ElemType));
        inc(P,ElemSize);
      end;
    else
      for i := 1 to n do begin
        L := ManagedTypeSaveLength(P,ElemType,size);
        if L=0 then
          break; // invalid record type (wrong field type)
        inc(result,L);
        inc(P,size);
      end;
    end;
  end;
  inc(result,SizeOf(Cardinal)); // Hash32 checksum
end;

function TDynArray.SaveTo: RawByteString;
var Len: integer;
begin
  Len := SaveToLength;
  SetString(result,nil,Len);
  if Len<>0 then
    if SaveTo(pointer(result))-pointer(result)<>Len then
      raise ESynException.Create('TDynArray.SaveTo len concern');
end;

function TDynArray.SaveToJSON(EnumSetsAsText: boolean; reformat: TTextWriterJSONFormat): RawUTF8;
begin
  SaveToJSON(result,EnumSetsAsText,reformat);
end;

procedure TDynArray.SaveToJSON(out Result: RawUTF8; EnumSetsAsText: boolean;
  reformat: TTextWriterJSONFormat);
var temp: TTextWriterStackBuffer;
begin
  with DefaultTextWriterSerializer.CreateOwnedStream(temp) do
  try
    if EnumSetsAsText then
      CustomOptions := CustomOptions+[twoEnumSetsAsTextInRecord];
    AddDynArrayJSON(self);
    SetText(result,reformat);
  finally
    Free;
  end;
end;

const
  PTRSIZ = SizeOf(Pointer);
  KNOWNTYPE_SIZE: array[TDynArrayKind] of byte = (
    0, 1,1, 2, 4,4,4, 8,8,8,8,8,8,8, PTRSIZ,PTRSIZ,PTRSIZ,PTRSIZ,PTRSIZ,PTRSIZ,
    16,32,64, PTRSIZ,
    {$ifndef NOVARIANTS}SizeOf(Variant),{$endif} 0);
  DYNARRAY_PARSERUNKNOWN = -2;

var // for TDynArray.LoadKnownType
  KINDTYPE_INFO: array[TDynArrayKind] of pointer;

function TDynArray.GetArrayTypeName: RawUTF8;
begin
  TypeInfoToName(fTypeInfo,result);
end;

function TDynArray.GetArrayTypeShort: PShortString;
begin // not inlined since PTypeInfo is private to implementation section
  if fTypeInfo=nil then
    result := @NULCHAR else
    result := PShortString(@PTypeInfo(fTypeInfo).NameLen);
end;

function TDynArray.GuessKnownType(exactType: boolean): TDynArrayKind;
const
  RTTI: array[TJSONCustomParserRTTIType] of TDynArrayKind = (
    djNone, djBoolean, djByte, djCardinal, djCurrency, djDouble, djNone, djInt64,
    djInteger, djQWord, djRawByteString, djNone, djRawUTF8, djNone, djSingle,
    djString, djSynUnicode, djDateTime, djDateTimeMS, djHash128, djInt64, djTimeLog,
    {$ifdef HASVARUSTRING} {$ifdef UNICODE}djSynUnicode{$else}djNone{$endif}, {$endif}
    {$ifndef NOVARIANTS} djVariant, {$endif} djWideString, djWord, djNone);
var info: PTypeInfo;
    field: PFieldInfo;
label bin, rec;
begin
  result := fKnownType;
  if result<>djNone then
    exit;
  info := fTypeInfo;
  case ElemSize of // very fast guess of most known exact dynarray types
  1: if info=TypeInfo(TBooleanDynArray) then
       result := djBoolean;
  4: if info=TypeInfo(TCardinalDynArray) then
       result := djCardinal else
     if info=TypeInfo(TSingleDynArray) then
       result := djSingle
  {$ifdef CPU64} ; 8: {$else} else {$endif}
    if info=TypeInfo(TRawUTF8DynArray) then
      result := djRawUTF8 else
    if info=TypeInfo(TStringDynArray) then
      result := djString else
    if info=TypeInfo(TWinAnsiDynArray) then
      result := djWinAnsi else
    if info=TypeInfo(TRawByteStringDynArray) then
      result := djRawByteString else
    if info=TypeInfo(TSynUnicodeDynArray) then
      result := djSynUnicode else
    if (info=TypeInfo(TClassDynArray)) or
       (info=TypeInfo(TPointerDynArray)) then
      result := djPointer else
    {$ifndef DELPHI5OROLDER}
    if info=TypeInfo(TInterfaceDynArray) then
      result := djInterface
    {$endif DELPHI5OROLDER}
  {$ifdef CPU64} else {$else} ; 8: {$endif}
     if info=TypeInfo(TDoubleDynArray) then
       result := djDouble else
     if info=TypeInfo(TCurrencyDynArray) then
       result := djCurrency else
     if info=TypeInfo(TTimeLogDynArray) then
       result := djTimeLog else
     if info=TypeInfo(TDateTimeDynArray) then
       result := djDateTime else
     if info=TypeInfo(TDateTimeMSDynArray) then
       result := djDateTimeMS;
  end;
  if result=djNone then begin // guess from RTTU
    fKnownSize := 0;
    if fElemType=nil then begin
      {$ifdef DYNARRAYELEMTYPE2} // not backward compatible - disabled
      if fElemType2<>nil then // try if a simple type known by extended RTTI
        result := RTTI[TJSONCustomParserRTTI.TypeInfoToSimpleRTTIType(fElemType2)];
      if result=djNone then
      {$endif}
bin:  case fElemSize of
      1: result := djByte;
      2: result := djWord;
      4: result := djInteger;
      8: result := djInt64;
      16: result := djHash128;
      32: result := djHash256;
      64: result := djHash512;
      else fKnownSize := fElemSize;
      end;
    end else // try to guess from 1st record/object field
    if not exacttype and (PTypeKind(fElemType)^ in tkRecordTypes) then begin
      info := fElemType; // inlined GetTypeInfo()
rec:  {$ifdef HASALIGNTYPEDATA}
      info := FPCTypeInfoOverName(info);
      {$else}
      inc(PByte(info),info^.NameLen);
      {$endif}
      {$ifdef FPC_OLDRTTI}
      field := OldRTTIFirstManagedField(info);
      if field=nil then
      {$else}
      if GetManagedFields(info,field)=0 then // only binary content
      {$endif}
        goto Bin;
      case field^.Offset of
      0: begin
        info := DeRef(field^.TypeInfo);
        if info=nil then // paranoid check
          goto bin else
        if info^.kind in tkRecordTypes then
          goto rec; // nested records
        result := RTTI[TJSONCustomParserRTTI.TypeInfoToSimpleRTTIType(info)];
        if result=djNone then
          goto Bin;
      end;
      1:  result := djByte;
      2:  result := djWord;
      4:  result := djInteger;
      8:  result := djInt64;
      16: result := djHash128;
      32: result := djHash256;
      64: result := djHash512;
      else fKnownSize := field^.Offset;
      end;
    end else
    // will recognize simple arrays from PTypeKind(fElemType)^
    result := RTTI[TJSONCustomParserRTTI.TypeInfoToSimpleRTTIType(fElemType)];
  end;
  if KNOWNTYPE_SIZE[result]<>0 then
    fKnownSize := KNOWNTYPE_SIZE[result];
  fKnownType := result;
end;

function TDynArray.ElemCopyFirstField(Source,Dest: Pointer): boolean;
begin
  if fKnownType=djNone then
    GuessKnownType(false);
  case fKnownType of
  djBoolean..djDateTimeMS,djHash128..djHash512: // no managed field
    MoveFast(Source^,Dest^,fKnownSize);
  djRawUTF8, djWinAnsi, djRawByteString:
    PRawByteString(Dest)^ := PRawByteString(Source)^;
  djSynUnicode:
    PSynUnicode(Dest)^ := PSynUnicode(Source)^;
  djString:
    PString(Dest)^ := PString(Source)^;
  djWideString:
    PWideString(Dest)^ := PWideString(Source)^;
  {$ifndef NOVARIANTS}djVariant: PVariant(Dest)^ := PVariant(Source)^;{$endif}
  else begin // djNone, djInterface, djCustom
    result := false;
    exit;
  end;
  end;
  result := true;
end;

function TDynArray.LoadKnownType(Data,Source,SourceMax: PAnsiChar): boolean;
var info: PTypeInfo;
begin
  if fKnownType=djNone then
    GuessKnownType({exacttype=}false); // set fKnownType and fKnownSize
  if fKnownType in [djBoolean..djDateTimeMS,djHash128..djHash512] then
    if (SourceMax<>nil) and (Source+fKnownSize>SourceMax) then
      result := false else begin
      MoveFast(Source^,Data^,fKnownSize);
      result := true;
    end else begin
    info := KINDTYPE_INFO[fKnownType];
    if info=nil then
      result := false else
      result := (ManagedTypeLoad(Data,Source,info,SourceMax)<>0) and (Source<>nil);
  end;
end;

const // kind of types which are serialized as JSON text
  DJ_STRING = [djTimeLog..djHash512];

function TDynArray.LoadFromJSON(P: PUTF8Char; aEndOfObject: PUTF8Char{$ifndef NOVARIANTS};
  CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char;
var n, i, ValLen: integer;
    T: TDynArrayKind;
    wasString, expectedString, isValid: boolean;
    EndOfObject: AnsiChar;
    Val: PUTF8Char;
    V: pointer;
    CustomReader: TDynArrayJSONCustomReader;
    NestedDynArray: TDynArray;
begin // code below must match TTextWriter.AddDynArrayJSON()
  result := nil;
  if (P=nil) or (fValue=nil) then
    exit;
  P := GotoNextNotSpace(P);
  if P^<>'[' then begin
    if (PInteger(P)^=NULL_LOW) and (jcEndOfJSONValueField in JSON_CHARS[P[4]]) then begin
      SetCount(0);
      result := P+4; // handle 'null' as void array
    end;
    exit;
  end;
  repeat inc(P) until not(P^ in [#1..' ']);
  n := JSONArrayCount(P);
  if n<0 then
    exit; // invalid array content
  if n=0 then begin
    if NextNotSpaceCharIs(P,']') then begin
      SetCount(0);
      result := P;
    end;
    exit; // handle '[]' array
  end;
  {$ifndef NOVARIANTS}
  if CustomVariantOptions=nil then
    CustomVariantOptions := @JSON_OPTIONS[true];
  {$endif}
  if HasCustomJSONParser then
    CustomReader := GlobalJSONCustomParsers.fParser[fParser].Reader else
    CustomReader := nil;
  if Assigned(CustomReader) then
    T := djCustom else
    T := GuessKnownType({exacttype=}true);
  if (T=djNone) and (P^='[') and (PTypeKind(ElemType)^=tkDynArray) then begin
    Count := n; // fast allocation of the whole dynamic array memory at once
    for i := 0 to n-1 do begin
      NestedDynArray.Init(ElemType,PPointerArray(fValue^)^[i]);
      P := NestedDynArray.LoadFromJSON(P,@EndOfObject{$ifndef NOVARIANTS},
        CustomVariantOptions{$endif});
      if P=nil then
        exit;
      EndOfObject := P^; // ',' or ']' for the last item of the array
      inc(P);
    end;
  end else
  if (T=djNone) or
     (PCardinal(P)^=JSON_BASE64_MAGIC_QUOTE) then begin
    if n<>1 then
      exit; // expect one Base64 encoded string value preceded by \uFFF0
    Val := GetJSONField(P,P,@wasString,@EndOfObject,@ValLen);
    if (Val=nil) or (ValLen<3) or not wasString or
       (PInteger(Val)^ and $00ffffff<>JSON_BASE64_MAGIC) or
       not LoadFromBinary(Base64ToBin(PAnsiChar(Val)+3,ValLen-3)) then
      exit; // invalid content
  end else begin
    if GetIsObjArray then
      for i := 0 to Count-1 do // force release any previous instance
        FreeAndNil(PObjectArray(fValue^)^[i]);
    SetCount(n); // fast allocation of the whole dynamic array memory at once
    case T of
    {$ifndef NOVARIANTS}
    djVariant:
      for i := 0 to n-1 do
        P := VariantLoadJSON(PVariantArray(fValue^)^[i],P,@EndOfObject,CustomVariantOptions);
    {$endif}
    djCustom: begin
      Val := fValue^;
      for i := 1 to n do begin
        P := CustomReader(P,Val^,isValid{$ifndef NOVARIANTS},CustomVariantOptions{$endif});
        if not isValid then
          exit;
        EndOfObject := P^; // ',' or ']' for the last item of the array
        inc(P);
        inc(Val,ElemSize);
      end;
    end;
    else begin
      V := fValue^;
      expectedString := T in DJ_STRING;
      for i := 0 to n-1 do begin
        Val := GetJSONField(P,P,@wasString,@EndOfObject,@ValLen);
        if (Val=nil) or (wasString<>expectedString) then
          exit;
        case T of
        djBoolean:  PBooleanArray(V)^[i] := GetBoolean(Val);
        djByte:     PByteArray(V)^[i] := GetCardinal(Val);
        djWord:     PWordArray(V)^[i] := GetCardinal(Val);
        djInteger:  PIntegerArray(V)^[i] := GetInteger(Val);
        djCardinal: PCardinalArray(V)^[i] := GetCardinal(Val);
        djSingle:   PSingleArray(V)^[i] := GetExtended(Val);
        djInt64:    SetInt64(Val,PInt64Array(V)^[i]);
        djQWord:    SetQWord(Val,PQWordArray(V)^[i]);
        djTimeLog:  PInt64Array(V)^[i] := Iso8601ToTimeLogPUTF8Char(Val,ValLen);
        djDateTime, djDateTimeMS:
          Iso8601ToDateTimePUTF8CharVar(Val,ValLen,PDateTimeArray(V)^[i]);
        djDouble:   PDoubleArray(V)^[i] := GetExtended(Val);
        djCurrency: PInt64Array(V)^[i] := StrToCurr64(Val);
        djRawUTF8:  FastSetString(PRawUTF8Array(V)^[i],Val,ValLen);
        djRawByteString:
          if not Base64MagicCheckAndDecode(Val,ValLen,PRawByteStringArray(V)^[i]) then
            FastSetString(PRawUTF8Array(V)^[i],Val,ValLen);
        djWinAnsi:  WinAnsiConvert.UTF8BufferToAnsi(Val,ValLen,PRawByteStringArray(V)^[i]);
        djString:   UTF8DecodeToString(Val,ValLen,string(PPointerArray(V)^[i]));
        djWideString: UTF8ToWideString(Val,ValLen,WideString(PPointerArray(V)^[i]));
        djSynUnicode: UTF8ToSynUnicode(Val,ValLen,SynUnicode(PPointerArray(V)^[i]));
        djHash128:  if ValLen<>SizeOf(THash128)*2 then FillZero(PHash128Array(V)^[i]) else
                      HexDisplayToBin(pointer(Val),@PHash128Array(V)^[i],SizeOf(THash128));
        djHash256:  if ValLen<>SizeOf(THash256)*2 then FillZero(PHash256Array(V)^[i]) else
                      HexDisplayToBin(pointer(Val),@PHash256Array(V)^[i],SizeOf(THash256));
        djHash512:  if ValLen<>SizeOf(THash512)*2 then FillZero(PHash512Array(V)^[i]) else
                      HexDisplayToBin(pointer(Val),@PHash512Array(V)^[i],SizeOf(THash512));
        else raise ESynException.CreateUTF8('% not readable',[ToText(T)^]);
        end;
      end;
    end;
    end;
  end;
  if aEndOfObject<>nil then
    aEndOfObject^ := EndOfObject;
  if EndOfObject=']' then
    if P=nil then
      result := @NULCHAR else
      result := P;
end;

{$ifndef NOVARIANTS}
function TDynArray.LoadFromVariant(const DocVariant: variant): boolean;
begin
  with _Safe(DocVariant)^ do
    if dvoIsArray in Options then
      result := LoadFromJSON(pointer(_Safe(DocVariant)^.ToJSON))<>nil else
      result := false;
end;
{$endif NOVARIANTS}

function TDynArray.LoadFromBinary(const Buffer: RawByteString;
  NoCheckHash: boolean): boolean;
var P: PAnsiChar;
    len: PtrInt;
begin
  len := length(Buffer);
  P := LoadFrom(pointer(Buffer),nil,NoCheckHash,PAnsiChar(pointer(Buffer))+len);
  result := (P<>nil) and (P-pointer(Buffer)=len);
end;

function TDynArray.LoadFromHeader(var Source: PByte; SourceMax: PByte): integer;
var n: cardinal;
begin
  // check context
  result := -1; // to notify error
  if (Source=nil) or (fValue=nil) then
    exit;
  // ignore legacy element size for cross-platform compatibility
  if not FromVarUInt32(Source,SourceMax,n) or
     ((SourceMax<>nil) and (PAnsiChar(Source)>=PAnsiChar(SourceMax))) then
    exit;
  // check stored element type
  if ElemType=nil then begin
    if Source^<>0 then
      exit;
  end else
    if Source^<>{$ifdef FPC}ord(FPCTODELPHI[PTypeKind(ElemType)^]){$else}
        PByte(ElemType)^{$endif} then
      exit;
  inc(Source);
  // retrieve dynamic array count
  if FromVarUInt32(Source,SourceMax,n) then
    if (n=0) or (SourceMax=nil) or
       (PAnsiChar(Source)+SizeOf(cardinal)<PAnsiChar(SourceMax)) then
      result := n;
end;

function TDynArray.LoadFrom(Source: PAnsiChar; AfterEach: TDynArrayAfterLoadFrom;
  NoCheckHash: boolean; SourceMax: PAnsiChar): PAnsiChar;
var i, n: integer;
    P: PAnsiChar;
    Hash: PCardinalArray;
begin
  // validate and unserialize binary header
  result := nil;
  SetCapacity(0); // clear current values, and reset growing factor
  n := LoadFromHeader(PByte(Source),PByte(SourceMax));
  if n<=0 then begin
    if n=0 then
      result := Source;
    exit;
  end;
  SetCount(n);
  // retrieve security checksum
  Hash := pointer(Source);
  inc(Source,SizeOf(cardinal));
  // retrieve dynamic array elements content
  P := fValue^;
  if ElemType=nil then // FPC: nil also if not Kind in tkManagedTypes
    if GetIsObjArray then
      raise ESynException.CreateUTF8('TDynArray.LoadFrom: % is a T*ObjArray',
        [ArrayTypeShort^]) else begin
      // binary type was stored directly
      n := n*integer(ElemSize);
      if (SourceMax<>nil) and (Source+n>SourceMax) then exit;
      MoveFast(Source^,P^,n);
      inc(Source,n);
    end else
    if PTypeKind(ElemType)^ in tkRecordTypes then
      for i := 1 to n do begin
        Source := RecordLoad(P^,Source,ElemType,nil,SourceMax);
        if Source=nil then exit;
        if Assigned(AfterEach) then
          AfterEach(P^);
        inc(P,ElemSize);
      end else
      for i := 1 to n do begin
        ManagedTypeLoad(P,Source,ElemType,SourceMax);
        if Source=nil then exit;
        if Assigned(AfterEach) then
          AfterEach(P^);
        inc(P,ElemSize);
      end;
  // check security checksum (Hash[0]=0 from mORMot2 DynArraySave)
  if NoCheckHash or (Source=nil) or (Hash[0]=0) or
     (Hash32(@Hash[1],Source-PAnsiChar(@Hash[1]))=Hash[0]) then
    result := Source;
end;

function TDynArray.Find(const Elem; const aIndex: TIntegerDynArray;
  aCompare: TDynArraySortCompare): PtrInt;
var n, L: PtrInt;
    cmp: integer;
    P: PAnsiChar;
begin
  n := GetCount;
  if (@aCompare<>nil) and (n>0) then begin
    dec(n);
    P := fValue^;
    if (n>10) and (length(aIndex)>=n) then begin
      // array should be sorted via aIndex[] -> use fast O(log(n)) binary search
      L := 0;
      repeat
        result := (L+n) shr 1;
        cmp := aCompare(P[cardinal(aIndex[result])*ElemSize],Elem);
        if cmp=0 then begin
          result := aIndex[result]; // returns index in TDynArray
          exit;
        end;
        if cmp<0 then
          L := result+1 else
          n := result-1;
      until L>n;
    end else
      // array is not sorted, or aIndex=nil -> use O(n) iterating search
      for result := 0 to n do
        if aCompare(P^,Elem)=0 then
          exit else
          inc(P,ElemSize);
  end;
  result := -1;
end;

function TDynArray.FindIndex(const Elem; aIndex: PIntegerDynArray;
  aCompare: TDynArraySortCompare): PtrInt;
begin
  if aIndex<>nil then
    result := Find(Elem,aIndex^,aCompare) else
  if Assigned(aCompare) then
    result := Find(Elem,nil,aCompare) else
    result := Find(Elem);
end;

function TDynArray.FindAndFill(var Elem; aIndex: PIntegerDynArray;
  aCompare: TDynArraySortCompare): integer;
begin
  result := FindIndex(Elem,aIndex,aCompare);
  if result>=0 then // if found, fill Elem with the matching item
    ElemCopy(PAnsiChar(fValue^)[cardinal(result)*ElemSize],Elem);
end;

function TDynArray.FindAndDelete(const Elem; aIndex: PIntegerDynArray;
  aCompare: TDynArraySortCompare): integer;
begin
  result := FindIndex(Elem,aIndex,aCompare);
  if result>=0 then
    Delete(result);
end;

function TDynArray.FindAndUpdate(const Elem; aIndex: PIntegerDynArray;
  aCompare: TDynArraySortCompare): integer;
begin
  result := FindIndex(Elem,aIndex,aCompare);
  if result>=0 then // if found, fill Elem with the matching item
    ElemCopy(Elem,PAnsiChar(fValue^)[cardinal(result)*ElemSize]);
end;

function TDynArray.FindAndAddIfNotExisting(const Elem; aIndex: PIntegerDynArray;
  aCompare: TDynArraySortCompare): integer;
begin
  result := FindIndex(Elem,aIndex,aCompare);
  if result<0 then
    Add(Elem); // -1 will mark success
end;

function TDynArray.Find(const Elem): PtrInt;
var n, L: PtrInt;
    cmp: integer;
    P: PAnsiChar;
begin
  n := GetCount;
  if (@fCompare<>nil) and (n>0) then begin
    dec(n);
    P := fValue^;
    if fSorted and (n>10) then begin
      // array is sorted -> use fast O(log(n)) binary search
      L := 0;
      repeat
        result := (L+n) shr 1;
        cmp := fCompare(P[cardinal(result)*ElemSize],Elem);
        if cmp=0 then
          exit;
        if cmp<0 then
          L := result+1 else
          n := result-1;
      until L>n;
    end else // array is very small, or not sorted
      for result := 0 to n do
        if fCompare(P^,Elem)=0 then // O(n) search
          exit else
          inc(P,ElemSize);
  end;
  result := -1;
end;

function TDynArray.FindAllSorted(const Elem; out FirstIndex,LastIndex: Integer): boolean;
var found,last: integer;
    P: PAnsiChar;
begin
  result := FastLocateSorted(Elem,found);
  if not result then
    exit;
  FirstIndex := found;
  P := fValue^;
  while (FirstIndex>0) and (fCompare(P[cardinal(FirstIndex-1)*ElemSize],Elem)=0) do
    dec(FirstIndex);
  last := GetCount-1;
  LastIndex := found;
  while (LastIndex<last) and (fCompare(P[cardinal(LastIndex+1)*ElemSize],Elem)=0) do
    inc(LastIndex);
end;

function TDynArray.FastLocateSorted(const Elem; out Index: Integer): boolean;
var n, i, cmp: integer;
    P: PAnsiChar;
begin
  result := False;
  n := GetCount;
  if @fCompare<>nil then
    if n=0 then // a void array is always sorted
      Index := 0 else
    if fSorted then begin
      P := fValue^;
      dec(n);
      cmp := fCompare(Elem,P[cardinal(n)*ElemSize]);
      if cmp>=0 then begin // greater than last sorted item
        Index := n;
        if cmp=0 then
          result := true else // returns true + index of existing Elem
          inc(Index); // returns false + insert after last position
        exit;
      end;
      Index := 0;
      while Index<=n do begin // O(log(n)) binary search of the sorted position
        i := (Index+n) shr 1;
        cmp := fCompare(P[cardinal(i)*ElemSize],Elem);
        if cmp=0 then begin
          Index := i; // returns true + index of existing Elem
          result := True;
          exit;
        end else
          if cmp<0 then
            Index := i+1 else
            n := i-1;
      end;
      // Elem not found: returns false + the index where to insert
    end else
      Index := -1 else // not Sorted
    Index := -1; // no fCompare()
end;

procedure TDynArray.FastAddSorted(Index: Integer; const Elem);
begin
  Insert(Index,Elem);
  fSorted := true; // Insert -> SetCount -> fSorted := false
end;

procedure TDynArray.FastDeleteSorted(Index: Integer);
begin
  Delete(Index);
  fSorted := true; // Delete -> SetCount -> fSorted := false
end;

function TDynArray.FastLocateOrAddSorted(const Elem; wasAdded: PBoolean): integer;
var toInsert: boolean;
begin
  toInsert := not FastLocateSorted(Elem,result) and (result>=0);
  if toInsert then begin
    Insert(result,Elem);
    fSorted := true; // Insert -> SetCount -> fSorted := false
  end;
  if wasAdded<>nil then
    wasAdded^ := toInsert;
end;

type
  // internal structure used to make QuickSort faster & with less stack usage
  TDynArrayQuickSort = object
    Compare: TDynArraySortCompare;
    CompareEvent: TEventDynArraySortCompare;
    Pivot: pointer;
    Index: PCardinalArray;
    ElemSize: cardinal;
    P: PtrInt;
    Value: PAnsiChar;
    IP, JP: PAnsiChar;
    procedure QuickSort(L, R: PtrInt);
    procedure QuickSortIndexed(L, R: PtrInt);
    procedure QuickSortEvent(L, R: PtrInt);
    procedure QuickSortEventReverse(L, R: PtrInt);
  end;

procedure QuickSortIndexedPUTF8Char(Values: PPUtf8CharArray; Count: Integer;
  var SortedIndexes: TCardinalDynArray; CaseSensitive: boolean);
var QS: TDynArrayQuickSort;
begin
  if CaseSensitive then
    QS.Compare := SortDynArrayPUTF8Char else
    QS.Compare := SortDynArrayPUTF8CharI;
  QS.Value := pointer(Values);
  QS.ElemSize := SizeOf(PUTF8Char);
  SetLength(SortedIndexes,Count);
  FillIncreasing(pointer(SortedIndexes),0,Count);
  QS.Index := pointer(SortedIndexes);
  QS.QuickSortIndexed(0,Count-1);
end;

procedure DynArraySortIndexed(Values: pointer; ElemSize, Count: Integer;
  out Indexes: TSynTempBuffer; Compare: TDynArraySortCompare);
var QS: TDynArrayQuickSort;
begin
  QS.Compare := Compare;
  QS.Value := Values;
  QS.ElemSize := ElemSize;
  QS.Index := pointer(Indexes.InitIncreasing(Count));
  QS.QuickSortIndexed(0,Count-1);
end;

procedure TDynArrayQuickSort.QuickSort(L, R: PtrInt);
var I, J: PtrInt;
    {$ifndef PUREPASCAL}tmp: pointer;{$endif}
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      Pivot := Value+PtrUInt(P)*ElemSize;
      IP := Value+PtrUInt(I)*ElemSize;
      JP := Value+PtrUInt(J)*ElemSize;
      while Compare(IP^,Pivot^)<0 do begin
        inc(I);
        inc(IP,ElemSize);
      end;
      while Compare(JP^,Pivot^)>0 do begin
        dec(J);
        dec(JP,ElemSize);
      end;
      if I <= J then begin
        if I<>J then
          {$ifndef PUREPASCAL} // inlined Exchg() is just fine
          if ElemSize=SizeOf(pointer) then begin
            // optimized version e.g. for TRawUTF8DynArray/TObjectDynArray
            tmp := PPointer(IP)^;
            PPointer(IP)^ := PPointer(JP)^;
            PPointer(JP)^ := tmp;
          end else
          {$endif}
            // generic exchange of row element data
            Exchg(IP,JP,ElemSize);
        if P = I then P := J else
        if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSort(L, J);
      L := I;
    end else begin
      if I < R then
        QuickSort(I, R);
      R := J;
    end;
  until L >= R;
end;

procedure TDynArrayQuickSort.QuickSortEvent(L, R: PtrInt);
var I, J: PtrInt;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      Pivot := Value+PtrUInt(P)*ElemSize;
      IP := Value+PtrUInt(I)*ElemSize;
      JP := Value+PtrUInt(J)*ElemSize;
      while CompareEvent(IP^,Pivot^)<0 do begin
        inc(I);
        inc(IP,ElemSize);
      end;
      while CompareEvent(JP^,Pivot^)>0 do begin
        dec(J);
        dec(JP,ElemSize);
      end;
      if I <= J then begin
        if I<>J then
          Exchg(IP,JP,ElemSize);
        if P = I then P := J else
        if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortEvent(L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortEvent(I, R);
      R := J;
    end;
  until L >= R;
end;

procedure TDynArrayQuickSort.QuickSortEventReverse(L, R: PtrInt);
var I, J: PtrInt;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      Pivot := Value+PtrUInt(P)*ElemSize;
      IP := Value+PtrUInt(I)*ElemSize;
      JP := Value+PtrUInt(J)*ElemSize;
      while CompareEvent(IP^,Pivot^)>0 do begin
        inc(I);
        inc(IP,ElemSize);
      end;
      while CompareEvent(JP^,Pivot^)<0 do begin
        dec(J);
        dec(JP,ElemSize);
      end;
      if I <= J then begin
        if I<>J then
          Exchg(IP,JP,ElemSize);
        if P = I then P := J else
        if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortEventReverse(L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortEventReverse(I, R);
      R := J;
    end;
  until L >= R;
end;

procedure TDynArrayQuickSort.QuickSortIndexed(L, R: PtrInt);
var I, J: PtrInt;
    tmp: integer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      Pivot := Value+Index[P]*ElemSize;
      while Compare(Value[Index[I]*ElemSize],Pivot^)<0 do inc(I);
      while Compare(Value[Index[J]*ElemSize],Pivot^)>0 do dec(J);
      if I <= J then begin
        if I<>J then begin
          tmp := Index[I];
          Index[I] := Index[J];
          Index[J] := tmp;
        end;
        if P = I then P := J else
        if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortIndexed(L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortIndexed(I, R);
      R := J;
    end;
  until L >= R;
end;

procedure TDynArray.Sort(aCompare: TDynArraySortCompare);
begin
  SortRange(0,Count-1,aCompare);
  fSorted := true;
end;

procedure QuickSortPtr(L, R: PtrInt; Compare: TDynArraySortCompare; V: PPointerArray);
var I, J, P: PtrInt;
    tmp: pointer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      while Compare(V[I], V[P])<0 do
        inc(I);
      while Compare(V[J], V[P])>0 do
        dec(J);
      if I <= J then begin
        tmp := V[I];
        V[I] := V[J];
        V[J] := tmp;
        if P = I then P := J else
        if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortPtr(L, J, Compare, V);
      L := I;
    end else begin
      if I < R then
        QuickSortPtr(I, R, Compare, V);
      R := J;
    end;
  until L >= R;
end;

procedure TDynArray.SortRange(aStart, aStop: integer; aCompare: TDynArraySortCompare);
var QuickSort: TDynArrayQuickSort;
begin
  if aStop<=aStart then
    exit; // nothing to sort
  if @aCompare=nil then
    Quicksort.Compare := @fCompare else
    Quicksort.Compare := aCompare;
  if (@Quicksort.Compare<>nil) and (fValue<>nil) and (fValue^<>nil) then
    if ElemSize=SizeOf(pointer) then
      QuickSortPtr(aStart,aStop,QuickSort.Compare,fValue^) else begin
      Quicksort.Value := fValue^;
      Quicksort.ElemSize := ElemSize;
      Quicksort.QuickSort(aStart,aStop);
    end;
end;

procedure TDynArray.Sort(const aCompare: TEventDynArraySortCompare; aReverse: boolean);
var QuickSort: TDynArrayQuickSort;
    R: PtrInt;
begin
  if not Assigned(aCompare) or (fValue = nil) or (fValue^=nil) then
    exit; // nothing to sort
  Quicksort.CompareEvent := aCompare;
  Quicksort.Value := fValue^;
  Quicksort.ElemSize := ElemSize;
  R := Count-1;
  if aReverse then
    Quicksort.QuickSortEventReverse(0,R) else
    Quicksort.QuickSortEvent(0,R);
end;

procedure TDynArray.CreateOrderedIndex(var aIndex: TIntegerDynArray;
  aCompare: TDynArraySortCompare);
var QuickSort: TDynArrayQuickSort;
    n: integer;
begin
  if @aCompare=nil then
    Quicksort.Compare := @fCompare else
    Quicksort.Compare := aCompare;
  if (@QuickSort.Compare<>nil) and (fValue<>nil) and (fValue^<>nil) then begin
    n := GetCount;
    if length(aIndex)<n then begin
      SetLength(aIndex,n);
      FillIncreasing(pointer(aIndex),0,n);
    end;
    Quicksort.Value := fValue^;
    Quicksort.ElemSize := ElemSize;
    Quicksort.Index := pointer(aIndex);
    Quicksort.QuickSortIndexed(0,n-1);
  end;
end;

procedure TDynArray.CreateOrderedIndex(out aIndex: TSynTempBuffer;
  aCompare: TDynArraySortCompare);
var QuickSort: TDynArrayQuickSort;
    n: integer;
begin
  if @aCompare=nil then
    Quicksort.Compare := @fCompare else
    Quicksort.Compare := aCompare;
  if (@QuickSort.Compare<>nil) and (fValue<>nil) and (fValue^<>nil) then begin
    n := GetCount;
    Quicksort.Value := fValue^;
    Quicksort.ElemSize := ElemSize;
    Quicksort.Index := PCardinalArray(aIndex.InitIncreasing(n));
    Quicksort.QuickSortIndexed(0,n-1);
  end else
    aIndex.buf := nil; // avoid GPF in aIndex.Done
end;

procedure TDynArray.CreateOrderedIndexAfterAdd(var aIndex: TIntegerDynArray;
  aCompare: TDynArraySortCompare);
var ndx: integer;
begin
  ndx := GetCount-1;
  if ndx<0 then
    exit;
  if aIndex<>nil then begin // whole FillIncreasing(aIndex[]) for first time
    if ndx>=length(aIndex) then
      SetLength(aIndex,NextGrow(ndx)); // grow aIndex[] if needed
    aIndex[ndx] := ndx;
  end;
  CreateOrderedIndex(aIndex,aCompare);
end;

function TDynArray.ElemEquals(const A,B): boolean;
begin
  if @fCompare<>nil then
    result := fCompare(A,B)=0 else
    if ElemType=nil then
      case ElemSize of // optimized versions for arrays of common types
        1: result := byte(A)=byte(B);
        2: result := word(A)=word(B);
        4: result := cardinal(A)=cardinal(B);
        8: result := Int64(A)=Int64(B);
        16: result := IsEqual(THash128(A),THash128(B));
      else result := CompareMemFixed(@A,@B,ElemSize); // binary comparison
      end else
      if PTypeKind(ElemType)^ in tkRecordTypes then // most likely
        result := RecordEquals(A,B,ElemType) else
        result := ManagedTypeCompare(@A,@B,ElemType)>0; // other complex types
end;

{$ifndef DELPHI5OROLDER} // disabled for Delphi 5 buggy compiler
procedure TDynArray.InitFrom(const aAnother: TDynArray; var aValue);
begin
  self := aAnother;
  fValue := @aValue;
  fCountP := nil;
end;

procedure TDynArray.AddDynArray(const aSource: TDynArray; aStartIndex: integer;
  aCount: integer);
var SourceCount: integer;
begin
  if (aSource.fValue<>nil) and (ArrayType=aSource.ArrayType) then begin
    SourceCount := aSource.Count;
    if (aCount<0) or (aCount>SourceCount) then
      aCount := SourceCount; // force use of external Source.Count, if any
    AddArray(aSource.fValue^,aStartIndex,aCount);
  end;
end;

function TDynArray.Equals(const B: TDynArray; ignorecompare: boolean): boolean;
var i, n: integer;
    P1,P2: PAnsiChar;
    A1: PPointerArray absolute P1;
    A2: PPointerArray absolute P2;
  function HandleObjArray: boolean;
  var tmp1,tmp2: RawUTF8;
  begin
    SaveToJSON(tmp1);
    B.SaveToJSON(tmp2);
    result := tmp1=tmp2;
  end;
begin
  result := false;
  if ArrayType<>B.ArrayType then
    exit; // array types should match exactly
  n := GetCount;
  if n<>B.Count then
    exit;
  if GetIsObjArray then begin
    result := HandleObjArray;
    exit;
  end;
  P1 := fValue^;
  P2 := B.fValue^;
  if (@fCompare<>nil) and not ignorecompare then // use customized comparison
    for i := 1 to n do
      if fCompare(P1^,P2^)<>0 then
        exit else begin
        inc(P1,ElemSize);
        inc(P2,ElemSize);
      end else
  if ElemType=nil then begin // binary type is compared as a whole
    result := CompareMem(P1,P2,ElemSize*cardinal(n));
    exit;
  end else
  case PTypeKind(ElemType)^ of // some optimized versions for most used types
  tkLString{$ifdef FPC},tkLStringOld{$endif}:
    for i := 0 to n-1 do
      if AnsiString(A1^[i])<>AnsiString(A2^[i]) then
        exit;
  tkWString:
    for i := 0 to n-1 do
      if WideString(A1^[i])<>WideString(A2^[i]) then
        exit;
  {$ifdef HASVARUSTRING}
  tkUString:
    for i := 0 to n-1 do
      if UnicodeString(A1^[i])<>UnicodeString(A2^[i]) then
        exit;
  {$endif}
  tkRecord{$ifdef FPC},tkObject{$endif}:
    for i := 1 to n do
      if not RecordEquals(P1^,P2^,ElemType) then
        exit else begin
        inc(P1,ElemSize);
        inc(P2,ElemSize);
      end;
  else // generic TypeInfoCompare() use
    for i := 1 to n do
      if ManagedTypeCompare(P1,P2,ElemType)<=0 then
        exit else begin // A^<>B^ or unexpected type
        inc(P1,ElemSize);
        inc(P2,ElemSize);
      end;
  end;
  result := true;
end;

procedure TDynArray.Copy(const Source: TDynArray; ObjArrayByRef: boolean);
var n: Cardinal;
begin
  if (fValue=nil) or (ArrayType<>Source.ArrayType) then
    exit;
  if (fCountP<>nil) and (Source.fCountP<>nil) then
    SetCapacity(Source.GetCapacity);
  n := Source.Count;
  SetCount(n);
  if n<>0 then
    if ElemType=nil then
      if not ObjArrayByRef and GetIsObjArray then
        LoadFromJSON(pointer(Source.SaveToJSON)) else
        MoveFast(Source.fValue^^,fValue^^,n*ElemSize) else
      CopyArray(fValue^,Source.fValue^,ElemType,n);
end;

procedure TDynArray.CopyFrom(const Source; MaxElem: integer; ObjArrayByRef: boolean);
var SourceDynArray: TDynArray;
begin
  SourceDynArray.Init(fTypeInfo,pointer(@Source)^);
  SourceDynArray.fCountP := @MaxElem; // would set Count=0 at Init()
  Copy(SourceDynArray,ObjArrayByRef);
end;

procedure TDynArray.CopyTo(out Dest; ObjArrayByRef: boolean);
var DestDynArray: TDynArray;
begin
  DestDynArray.Init(fTypeInfo,Dest);
  DestDynArray.Copy(self,ObjArrayByRef);
end;
{$endif DELPHI5OROLDER}

function TDynArray.IndexOf(const Elem): PtrInt;
var P: PPointerArray;
    max: PtrInt;
begin
  if fValue<>nil then begin
    max := GetCount-1;
    P := fValue^;
    if @Elem<>nil then
    if ElemType=nil then begin
      result := AnyScanIndex(P,@Elem,max+1,ElemSize);
      exit;
    end else
    case PTypeKind(ElemType)^ of
    tkLString{$ifdef FPC},tkLStringOld{$endif}:
      for result := 0 to max do
        if AnsiString(P^[result])=AnsiString(Elem) then exit;
    tkWString:
      for result := 0 to max do
        if WideString(P^[result])=WideString(Elem) then exit;
    {$ifdef HASVARUSTRING}
    tkUString:
      for result := 0 to max do
        if UnicodeString(P^[result])=UnicodeString(Elem) then exit;
    {$endif}
    {$ifndef NOVARIANTS}
    tkVariant:
      for result := 0 to max do
        if SortDynArrayVariantComp(PVarDataStaticArray(P)^[result],
          TVarData(Elem),false)=0 then exit;
    {$endif}
    tkRecord{$ifdef FPC},tkObject{$endif}:
      // RecordEquals() works with packed records containing binary and string types
      for result := 0 to max do
        if RecordEquals(P^,Elem,ElemType) then
          exit else
          inc(PByte(P),ElemSize);
    tkInterface:
      for result := 0 to max do
        if P^[result]=pointer(Elem) then exit;
    else
      for result := 0 to max do
        if ManagedTypeCompare(pointer(P),@Elem,ElemType)>0 then
          exit else
          inc(PByte(P),ElemSize);
    end;
  end;
  result := -1;
end;

procedure TDynArray.Init(aTypeInfo: pointer; var aValue; aCountPointer: PInteger);
begin
  fValue := @aValue;
  fTypeInfo := aTypeInfo;
  if PTypeKind(aTypeInfo)^<>tkDynArray then // inlined GetTypeInfo()
    raise ESynException.CreateUTF8('TDynArray.Init: % is %, expected tkDynArray',
      [ArrayTypeShort^,ToText(PTypeKind(aTypeInfo)^)^]);
  {$ifdef HASALIGNTYPEDATA}
  aTypeInfo := FPCTypeInfoOverName(aTypeInfo);
  {$else}
  inc(PByte(aTypeInfo),PTypeInfo(aTypeInfo)^.NameLen);
  {$endif}
  fElemSize := PTypeInfo(aTypeInfo)^.elSize {$ifdef FPC}and $7FFFFFFF{$endif};
  fElemType := PTypeInfo(aTypeInfo)^.elType;
  if fElemType<>nil then begin // inlined DeRef()
    {$ifndef HASDIRECTTYPEINFO}
    // FPC compatibility: if you have a GPF here at startup, your 3.1 trunk
    // revision seems older than June 2016
    // -> enable HASDIRECTTYPEINFO conditional below $ifdef VER3_1 in Synopse.inc
    // or in your project's options
    fElemType := PPointer(fElemType)^;
    {$endif HASDIRECTTYPEINFO}
    {$ifdef FPC}
    if not (PTypeKind(fElemType)^ in tkManagedTypes) then
      fElemType := nil; // as with Delphi
    {$endif FPC}
  end;
  {$ifdef DYNARRAYELEMTYPE2} // disabled not to break backward compatibility
  fElemType2 := PTypeInfo(aTypeInfo)^.elType2;
  {$endif}
  fCountP := aCountPointer;
  if fCountP<>nil then
    fCountP^ := 0;
  fCompare := nil;
  fParser := DYNARRAY_PARSERUNKNOWN;
  fKnownSize := 0;
  fSorted := false;
  fKnownType := djNone;
  fIsObjArray := oaUnknown;
end;

procedure TDynArray.InitSpecific(aTypeInfo: pointer; var aValue; aKind: TDynArrayKind;
  aCountPointer: PInteger; aCaseInsensitive: boolean);
var Comp: TDynArraySortCompare;
begin
  Init(aTypeInfo,aValue,aCountPointer);
  Comp := DYNARRAY_SORTFIRSTFIELD[aCaseInsensitive,aKind];
  if @Comp=nil then
    raise ESynException.CreateUTF8('TDynArray.InitSpecific(%) wrong aKind=%',
      [ArrayTypeShort^,ToText(aKind)^]);
  fCompare := Comp;
  fKnownType := aKind;
  fKnownSize := KNOWNTYPE_SIZE[aKind];
end;

procedure TDynArray.UseExternalCount(var aCountPointer: Integer);
begin
  fCountP := @aCountPointer;
end;

function TDynArray.HasCustomJSONParser: boolean;
begin
  if fParser=DYNARRAY_PARSERUNKNOWN then
    fParser := GlobalJSONCustomParsers.DynArraySearch(ArrayType,ElemType);
  result := cardinal(fParser)<cardinal(GlobalJSONCustomParsers.fParsersCount);
end;

procedure TDynArray.Void;
begin
  fValue := nil;
end;

function TDynArray.IsVoid: boolean;
begin
  result := fValue=nil;
end;

function TDynArray.ComputeIsObjArray: boolean;
begin
  result := (fElemSize=SizeOf(pointer)) and (fElemType=nil) and
     Assigned(DynArrayIsObjArray) and (DynArrayIsObjArray(fTypeInfo)<>nil);
  if result then
    fIsObjArray := oaTrue else
    fIsObjArray := oaFalse;
end;

procedure TDynArray.SetIsObjArray(aValue: boolean);
begin
  if aValue then
    fIsObjArray := oaTrue else
    fIsObjArray := oaFalse;
end;

procedure TDynArray.InternalSetLength(OldLength,NewLength: PtrUInt);
var p: PDynArrayRec;
    NeededSize, minLength: PtrUInt;
    pp: pointer;
begin // this method is faster than default System.DynArraySetLength() function
  p := fValue^;
  // check that new array length is not just a finalize in disguise
  if NewLength=0 then begin
    if p<>nil then begin // FastDynArrayClear() with ObjArray support
      dec(p);
      if (p^.refCnt>=0) and RefCntDecFree(p^.refCnt) then begin
        if OldLength<>0 then
          if ElemType<>nil then
            FastFinalizeArray(fValue^,ElemType,OldLength) else
            if GetIsObjArray then
              RawObjectsClear(fValue^,OldLength);
        FreeMem(p);
      end;
      fValue^ := nil;
    end;
    exit;
  end;
  // calculate the needed size of the resulting memory structure on heap
  NeededSize := NewLength*ElemSize+SizeOf(TDynArrayRec);
  {$ifndef CPU64}
  if NeededSize>1024*1024*1024 then // max workable memory block is 1 GB
    raise ERangeError.CreateFmt('TDynArray SetLength(%s,%d) size concern',
      [ArrayTypeShort^,NewLength]);
  {$endif}
  // if not shared (refCnt=1), resize; if shared, create copy (not thread safe)
  if p=nil then begin
    p := AllocMem(NeededSize); // RTL/OS will return zeroed memory
    OldLength := NewLength;    // no FillcharFast() below
  end else begin
    dec(PtrUInt(p),SizeOf(TDynArrayRec)); // p^ = start of heap object
    if (p^.refCnt>=0) and RefCntDecFree(p^.refCnt) then begin
      if NewLength<OldLength then // reduce array in-place
        if ElemType<>nil then // release managed types in trailing items
          FastFinalizeArray(pointer(PAnsiChar(p)+NeededSize),ElemType,OldLength-NewLength) else
          if GetIsObjArray then // FreeAndNil() of resized objects list
            RawObjectsClear(pointer(PAnsiChar(p)+NeededSize),OldLength-NewLength);
      ReallocMem(p,NeededSize);
    end else begin // make copy
      GetMem(p,NeededSize);
      minLength := OldLength;
      if minLength>NewLength then
        minLength := NewLength;
      pp := PAnsiChar(p)+SizeOf(TDynArrayRec);
      if ElemType<>nil then begin
        FillCharFast(pp^,minLength*elemSize,0);
        CopyArray(pp,fValue^,ElemType,minLength);
      end else
        MoveFast(fValue^^,pp^,minLength*elemSize);
    end;
  end;
  // set refCnt=1 and new length to the heap header
  with p^ do begin
    refCnt := 1;
    {$ifdef FPC}
    high := newLength-1;
    {$else}
    length := newLength;
    {$endif}
  end;
  inc(PByte(p),SizeOf(p^)); // p^ = start of dynamic aray items
  fValue^ := p;
  // reset new allocated elements content to zero
  if NewLength>OldLength then begin
    OldLength := OldLength*elemSize;
    FillCharFast(PAnsiChar(p)[OldLength],NewLength*ElemSize-OldLength,0);
  end;
end;

procedure TDynArray.SetCount(aCount: PtrInt);
const MINIMUM_SIZE = 64;
var oldlen, extcount, arrayptr, capa, delta: PtrInt;
begin
  arrayptr := PtrInt(fValue);
  extcount := PtrInt(fCountP);
  fSorted := false;
  if arrayptr=0 then
    exit; // avoid GPF if void
  arrayptr := PPtrInt(arrayptr)^;
  if extcount<>0 then begin // fCountP^ as external capacity
    oldlen := PInteger(extcount)^;
    delta := aCount-oldlen;
    if delta=0 then
      exit;
    PInteger(extcount)^ := aCount; // store new length
    if arrayptr=0 then begin // void array
      if (delta>0) and (aCount<MINIMUM_SIZE) then
        aCount := MINIMUM_SIZE; // reserve some minimal (64) items for Add()
    end else begin
      capa := PDALen(arrayptr-_DALEN)^{$ifdef FPC}+1{$endif};
      if delta>0 then begin  // size-up
        if capa>=aCount then
          exit; // no need to grow
        capa := NextGrow(capa);
        if capa>aCount then
          aCount := capa; // grow by chunks
      end else  // size-down
      if (aCount>0) and ((capa<=MINIMUM_SIZE) or (capa-aCount<capa shr 3)) then
        exit; // reallocate memory only if worth it (for faster Delete)
    end;
  end else // no external capacity: use length()
  if arrayptr=0 then
    oldlen := arrayptr else begin
    oldlen := PDALen(arrayptr-_DALEN)^{$ifdef FPC}+1{$endif};
    if oldlen=aCount then
      exit;  // InternalSetLength(samecount) would make a private copy
  end;
  // no external Count, array size-down or array up-grow -> realloc
  InternalSetLength(oldlen,aCount);
end;

function TDynArray.GetCapacity: PtrInt;
begin // capacity = length(DynArray)
  result := PtrInt(fValue);
  if result<>0 then begin
    result := PPtrInt(result)^;
    if result<>0 then
      result := PDALen(result-_DALEN)^{$ifdef FPC}+1{$endif};
  end;
end;

procedure TDynArray.SetCapacity(aCapacity: PtrInt);
var oldlen,capa: PtrInt;
begin
  if fValue=nil then
    exit;
  capa := GetCapacity;
  if fCountP<>nil then begin
    oldlen := fCountP^;
    if oldlen>aCapacity then
      fCountP^ := aCapacity;
  end else
    oldlen := capa;
  if capa<>aCapacity then
    InternalSetLength(oldlen,aCapacity);
end;

procedure TDynArray.SetCompare(const aCompare: TDynArraySortCompare);
begin
  if @aCompare<>@fCompare then begin
    @fCompare := @aCompare;
    fSorted := false;
  end;
end;

procedure TDynArray.Slice(var Dest; aCount, aFirstIndex: cardinal);
var n: Cardinal;
    D: PPointer;
    P: PAnsiChar;
begin
  if fValue=nil then
    exit; // avoid GPF if void
  n := GetCount;
  if aFirstIndex>=n then
    aCount := 0 else
  if aCount>=n-aFirstIndex then
    aCount := n-aFirstIndex;
  DynArray(ArrayType,Dest).SetCapacity(aCount);
  if aCount>0 then begin
    D := @Dest;
    P := PAnsiChar(fValue^)+aFirstIndex*ElemSize;
    if ElemType=nil then
      MoveFast(P^,D^^,aCount*ElemSize) else
      CopyArray(D^,P,ElemType,aCount);
  end;
end;

function TDynArray.AddArray(const DynArrayVar; aStartIndex, aCount: integer): integer;
var c, n: integer;
    PS,PD: pointer;
begin
  result := 0;
  if fValue=nil then
    exit; // avoid GPF if void
  c := DynArrayLength(pointer(DynArrayVar));
  if aStartIndex>=c then
    exit; // nothing to copy
  if (aCount<0) or (cardinal(aStartIndex+aCount)>cardinal(c)) then
    aCount := c-aStartIndex;
  if aCount<=0 then
    exit;
  result := aCount;
  n := GetCount;
  SetCount(n+aCount);
  PS := pointer(PtrUInt(DynArrayVar)+cardinal(aStartIndex)*ElemSize);
  PD := pointer(PtrUInt(fValue^)+cardinal(n)*ElemSize);
  if ElemType=nil then
    MoveFast(PS^,PD^,cardinal(aCount)*ElemSize) else
    CopyArray(PD,PS,ElemType,aCount);
end;

procedure TDynArray.ElemClear(var Elem);
begin
  if @Elem=nil then
    exit; // avoid GPF
  if ElemType<>nil then
    {$ifdef FPC}FPCFinalize{$else}_Finalize{$endif}(@Elem,ElemType) else
    if (fIsObjArray=oaTrue) or ((fIsObjArray=oaUnknown) and ComputeIsObjArray) then
      TObject(Elem).Free;
  FillCharFast(Elem,ElemSize,0); // always
end;

function TDynArray.ElemLoad(Source,SourceMax: PAnsiChar): RawByteString;
begin
  if (Source<>nil) and (ElemType=nil) then
    SetString(result,Source,ElemSize) else begin
    SetString(result,nil,ElemSize);
    FillCharFast(pointer(result)^,ElemSize,0);
    ElemLoad(Source,pointer(result)^);
  end;
end;

procedure TDynArray.ElemLoadClear(var ElemTemp: RawByteString);
begin
  ElemClear(pointer(ElemTemp));
  ElemTemp := '';
end;

procedure TDynArray.ElemLoad(Source: PAnsiChar; var Elem; SourceMax: PAnsiChar);
begin
  if Source<>nil then // avoid GPF
    if ElemType=nil then begin
      if (SourceMax=nil) or (Source+ElemSize<=SourceMax) then
        MoveFast(Source^,Elem,ElemSize);
    end else
      ManagedTypeLoad(@Elem,Source,ElemType,SourceMax);
end;

function TDynArray.ElemSave(const Elem): RawByteString;
var itemsize: integer;
begin
  if ElemType=nil then
    SetString(result,PAnsiChar(@Elem),ElemSize) else begin
    SetString(result,nil,ManagedTypeSaveLength(@Elem,ElemType,itemsize));
    if result<>'' then
      ManagedTypeSave(@Elem,pointer(result),ElemType,itemsize);
  end;
end;

function TDynArray.ElemLoadFind(Source, SourceMax: PAnsiChar): integer;
var tmp: array[0..2047] of byte;
    data: pointer;
begin
  result := -1;
  if (Source=nil) or (ElemSize>SizeOf(tmp)) then
    exit;
  if ElemType=nil then
    data := Source else begin
    FillCharFast(tmp,ElemSize,0);
    ManagedTypeLoad(@tmp,Source,ElemType,SourceMax);
    if Source=nil then
      exit;
    data := @tmp;
  end;
  try
    if @fCompare=nil then
      result := IndexOf(data^) else
      result := Find(data^);
  finally
    if ElemType<>nil then
      {$ifdef FPC}FPCFinalize{$else}_Finalize{$endif}(data,ElemType);
  end;
end;


{ TDynArrayLoadFrom }

function TDynArrayLoadFrom.Init(ArrayTypeInfo: pointer; Source: PAnsiChar;
  SourceMaxLen: PtrInt): boolean;
var fake: pointer;
begin
  result := false;
  Position := nil; // force Step() to return false if called aterwards
  if Source=nil then
    exit;
  if SourceMaxLen=0 then
    PositionEnd := nil else
    PositionEnd := Source+SourceMaxLen;
  DynArray.Init(ArrayTypeInfo,fake); // just to retrieve RTTI
  Count := DynArray.LoadFromHeader(PByte(Source),PByte(PositionEnd));
  if Count<0 then
    exit;
  Hash := pointer(Source);
  Position := @Hash[1];
  Current := 0;
  result := true;
end;

function TDynArrayLoadFrom.Init(ArrayTypeInfo: pointer; const Source: RawByteString): boolean;
begin
  result := Init(ArrayTypeInfo,pointer(Source),length(Source));
end;

function TDynArrayLoadFrom.Step(out Elem): boolean;
begin
  result := false;
  if (Position<>nil) and (Current<Count) then begin
    if DynArray.ElemType=nil then begin
      if (PositionEnd<>nil) and (Position+DynArray.ElemSize>PositionEnd) then
        exit;
      MoveFast(Position^,Elem,DynArray.ElemSize);
      inc(Position,DynArray.ElemSize);
    end else begin
      ManagedTypeLoad(@Elem,Position,DynArray.ElemType,PositionEnd);
      if Position=nil then
         exit;
    end;
    inc(Current);
    result := true;
  end;
end;

function TDynArrayLoadFrom.FirstField(out Field): boolean;
begin
  if (Position<>nil) and (Current<Count) then
    result := DynArray.LoadKnownType(@Field,Position,PositionEnd) else
    result := false;
end;

function TDynArrayLoadFrom.CheckHash: boolean;
begin
  result := (Position<>nil) and (Hash32(@Hash[1],Position-PAnsiChar(@Hash[1]))=Hash[0]);
end;


{ TDynArrayHasher }

function HashFile(const FileName: TFileName; Hasher: THasher): cardinal;
var buf: array[word] of cardinal; // 256KB of buffer
    read: integer;
    f: THandle;
begin
  if not Assigned(Hasher) then
    Hasher := DefaultHasher;
  result := 0;
  f := FileOpenSequentialRead(FileName);
  if PtrInt(f)>=0 then begin
    repeat
      read := FileRead(f,buf,SizeOf(buf));
      if read<=0 then
        break;
      result := Hasher(result,@buf,read);
    until false;
    FileClose(f);
  end;
end;

function HashAnsiString(const Elem; Hasher: THasher): cardinal;
begin
  if PtrUInt(Elem)=0 then
    result := 0 else
    result := Hasher(0,Pointer(Elem),PStrLen(PtrUInt(Elem)-_STRLEN)^);
end;

function HashAnsiStringI(const Elem; Hasher: THasher): cardinal;
var tmp: array[byte] of AnsiChar; // avoid slow heap allocation
begin
  if PtrUInt(Elem)=0 then
    result := 0 else
    result := Hasher(0,tmp,UpperCopy255Buf(tmp,
      pointer(Elem),PStrLen(PtrUInt(Elem)-_STRLEN)^)-tmp);
end;

{$ifdef UNICODE}

function HashUnicodeString(const Elem; Hasher: THasher): cardinal;
begin
  if PtrUInt(Elem)=0 then
    result := 0 else
    result := Hasher(0,Pointer(Elem),length(UnicodeString(Elem))*2);
end;

function HashUnicodeStringI(const Elem; Hasher: THasher): cardinal;
var tmp: array[byte] of AnsiChar; // avoid slow heap allocation
begin
  if PtrUInt(Elem)=0 then
    result := 0 else
    result := Hasher(0,tmp,UpperCopy255W(tmp,Pointer(Elem),length(UnicodeString(Elem)))-tmp);
end;

{$endif UNICODE}

function HashSynUnicode(const Elem; Hasher: THasher): cardinal;
begin
  if PtrUInt(Elem)=0 then
    result := 0 else
    result := Hasher(0,Pointer(Elem),length(SynUnicode(Elem))*2);
end;

function HashSynUnicodeI(const Elem; Hasher: THasher): cardinal;
var tmp: array[byte] of AnsiChar; // avoid slow heap allocation
begin
  if PtrUInt(Elem)=0 then
    result := 0 else
    result := Hasher(0,tmp,UpperCopy255W(tmp,SynUnicode(Elem))-tmp);
end;

function HashWideString(const Elem; Hasher: THasher): cardinal;
begin // WideString internal size is in bytes, not WideChar
  if PtrUInt(Elem)=0 then
    result := 0 else
    result := Hasher(0,Pointer(Elem),Length(WideString(Elem))*2);
end;

function HashWideStringI(const Elem; Hasher: THasher): cardinal;
var tmp: array[byte] of AnsiChar; // avoid slow heap allocation
begin
  if PtrUInt(Elem)=0 then
    result := 0 else
    result := Hasher(0,tmp,UpperCopy255W(tmp,pointer(Elem),Length(WideString(Elem)))-tmp);
end;

function HashPtrUInt(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(PtrUInt));
end;

function HashPointer(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(pointer));
end;

function HashByte(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(byte));
end;

function HashWord(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(word));
end;

function HashInteger(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(integer));
end;

function HashInt64(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(Int64));
end;

function Hash128(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(THash128));
end;

function Hash256(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(THash256));
end;

function Hash512(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(THash512));
end;

{$ifndef NOVARIANTS}
function VariantHash(const value: variant; CaseInsensitive: boolean;
  Hasher: THasher): cardinal;
var Up: array[byte] of AnsiChar; // avoid heap allocation
    vt: cardinal;
  procedure ComplexType;
  var tmp: RawUTF8;
  begin // slow but always working conversion to string
    VariantSaveJSON(value,twNone,tmp);
    if CaseInsensitive then
      result := Hasher(vt,Up,UpperCopy255(Up,tmp)-Up) else
      result := Hasher(vt,pointer(tmp),length(tmp));
  end;
begin
  if not Assigned(Hasher) then
    Hasher := DefaultHasher;
  vt := TVarData(value).VType;
  with TVarData(value) do
  case vt of
    varNull, varEmpty:
      result := vt; // good enough for void values
    varShortInt, varByte:
      result := Hasher(vt,@VByte,1);
    varSmallint, varWord, varBoolean:
      result := Hasher(vt,@VWord,2);
    varLongWord, varInteger, varSingle:
      result := Hasher(vt,@VLongWord,4);
    varInt64, varDouble, varDate, varCurrency, varWord64:
      result := Hasher(vt,@VInt64,SizeOf(Int64));
    varString:
      if CaseInsensitive then
        result := Hasher(vt,Up,UpperCopy255Buf(Up,VString,length(RawUTF8(VString)))-Up) else
        result := Hasher(vt,VString,length(RawUTF8(VString)));
    varOleStr {$ifdef HASVARUSTRING}, varUString{$endif}:
      if CaseInsensitive then
        result := Hasher(vt,Up,UpperCopy255W(Up,VOleStr,StrLenW(VOleStr))-Up) else
        result := Hasher(vt,VAny,StrLenW(VOleStr)*2);
  else
    ComplexType;
  end;
end;

function HashVariant(const Elem; Hasher: THasher): cardinal;
begin
  result := VariantHash(variant(Elem),false,Hasher);
end;

function HashVariantI(const Elem; Hasher: THasher): cardinal;
begin
  result := VariantHash(variant(Elem),true,Hasher);
end;
{$endif NOVARIANTS}

procedure TDynArrayHasher.Init(aDynArray: PDynArray; aHashElement: TDynArrayHashOne;
  aEventHash: TEventDynArrayHashOne; aHasher: THasher; aCompare: TDynArraySortCompare;
  aEventCompare: TEventDynArraySortCompare; aCaseInsensitive: boolean);
begin
  DynArray := aDynArray;
  if @aHasher=nil then
    Hasher := DefaultHasher else
    Hasher := aHasher;
  HashElement := aHashElement;
  EventHash := aEventHash;
  if (@HashElement=nil) and (@EventHash=nil) then // fallback to first field RTTI
    HashElement := DYNARRAY_HASHFIRSTFIELD[aCaseInsensitive,DynArray^.GuessKnownType];
  Compare := aCompare;
  EventCompare := aEventCompare;
  if (@Compare=nil) and (@EventCompare=nil) then
    Compare := DYNARRAY_SORTFIRSTFIELD[aCaseInsensitive,DynArray^.GuessKnownType];
  CountTrigger := 32;
  Clear;
end;

procedure TDynArrayHasher.InitSpecific(aDynArray: PDynArray; aKind: TDynArrayKind;
  aCaseInsensitive: boolean);
var cmp: TDynArraySortCompare;
    hsh: TDynArrayHashOne;
begin
  cmp := DYNARRAY_SORTFIRSTFIELD[aCaseInsensitive,aKind];
  hsh := DYNARRAY_HASHFIRSTFIELD[aCaseInsensitive,aKind];
  if (@hsh=nil) or (@cmp=nil) then
    raise ESynException.CreateUTF8('TDynArrayHasher.InitSpecific: %?',[ToText(aKind)^]);
  Init(aDynArray,hsh,nil,nil,cmp,nil,aCaseInsensitive)
end;

procedure TDynArrayHasher.Clear;
begin
  HashTable := nil;
  HashTableSize := 0;
  ScanCounter := 0;
  if Assigned(HashElement) or Assigned(EventHash) then
    State := [hasHasher] else
    byte(State) := 0;
end;

function TDynArrayHasher.HashOne(Elem: pointer): cardinal;
begin
  if Assigned(EventHash) then
    result := EventHash(Elem^) else
  if Assigned(HashElement) then
    result := HashElement(Elem^,Hasher) else
    result := 0; // will be ignored afterwards for sure
end;

const // primes reduce memory consumption and enhance distribution
  _PRIMES: array[0..38{$ifndef CPU32DELPHI}+15{$endif}] of integer = (
    {$ifndef CPU32DELPHI} 31, 127, 251, 499, 797, 1259, 2011, 3203, 5087, 8089,
    12853, 20399, 81649, 129607, 205759, {$endif}
    // following HASH_PO2=2^18=262144 for Delphi Win32
    326617, 411527, 518509, 653267, 823117, 1037059, 1306601, 1646237,
    2074129, 2613229, 3292489, 4148279, 5226491, 6584983, 8296553, 10453007,
    13169977, 16593127, 20906033, 26339969, 33186281, 41812097, 52679969,
    66372617, 83624237, 105359939, 132745199, 167248483, 210719881, 265490441,
    334496971, 421439783, 530980861, 668993977, 842879579, 1061961721,
    1337987929, 1685759167, 2123923447);

function NextPrime(v: integer): integer; {$ifdef HASINLINE}inline;{$endif}
var i: PtrInt;
    P: PIntegerArray;
begin
  P := @_PRIMES;
  for i := 0 to high(_PRIMES) do begin
    result := P^[i];
    if result>v then
      exit;
  end;
end;

function TDynArrayHasher.HashTableIndex(aHashCode: cardinal): cardinal;
begin
  result := HashTableSize;
  {$ifdef CPU32DELPHI} // Delphi Win32 is not efficient with 64-bit multiplication
  if result>HASH_PO2 then
    result := aHashCode mod result else
    result := aHashCode and (result-1);
  {$else} // FPC or dcc64 compile next line as very optimized asm
  result := (QWord(aHashCode)*result)shr 32;
  // see https://lemire.me/blog/2016/06/27/a-fast-alternative-to-the-modulo-reduction
  {$endif CPU32DELPHI}
end;

function TDynArrayHasher.Find(aHashCode: cardinal; aForAdd: boolean): integer;
var first,last: integer;
    ndx,siz: PtrInt;
    P: PAnsiChar;
begin
  P := DynArray^.Value^;
  siz := DynArray^.ElemSize;
  if not(canHash in State) then begin // Count=0 or Count<CountTrigger
    if hasHasher in State then
      for result := 0 to DynArray^.Count-1 do // O(n) linear search via hashing
        if HashOne(P)=aHashCode then
          exit else
          inc(P,siz);
    result := -1;
    exit;
  end;
  result := HashTableIndex(aHashCode);
  first := result;
  last := HashTableSize;
  repeat
    ndx := HashTable[result]-1; // index+1 was stored
    if ndx<0 then begin
      result := -(result+1); // found void entry
      exit;
    end else
    if not aForAdd and (HashOne(P+ndx*siz)=aHashCode) then begin
      result := ndx;
      exit;
    end;
    inc(result); // try next entry on hash collision
    if result=last then
      // reached the end -> search once from HashTable[0] to HashTable[first-1]
      if result=first then
        break else begin
        result := 0;
        last := first;
      end;
  until false;
  RaiseFatalCollision('Find',aHashCode);
end;

function TDynArrayHasher.FindOrNew(aHashCode: cardinal; Elem: pointer;
  aHashTableIndex: PInteger): integer;
var first,last,ndx,cmp: integer;
    P: PAnsiChar;
begin
  if not(canHash in State) then begin // e.g. Count<CountTrigger
    result := Scan(Elem);
    exit;
  end;
  result := HashTableIndex(aHashCode);
  first := result;
  last := HashTableSize;
  repeat
    ndx := HashTable[result]-1;  // index+1 was stored
    if ndx<0 then begin
      result := -(result+1);
      exit; // returns void index in HashTable[]
    end;
    with DynArray^ do
      P := PAnsiChar(Value^)+cardinal(ndx)*ElemSize;
    if Assigned(EventCompare) then
      cmp := EventCompare(P^,Elem^) else
    if Assigned(Compare) then
      cmp := Compare(P^,Elem^) else
      cmp := 1;
    if cmp=0 then begin // faster than hash e.g. for huge strings
      if aHashTableIndex<>nil then
        aHashTableIndex^ := result;
      result := ndx;
      exit;
    end;
    // hash or slot collision -> search next item
    {$ifdef DYNARRAYHASHCOLLISIONCOUNT}
    inc(FindCollisions);
    {$endif}
    //inc(TDynArrayHashedCollisionCount);
    inc(result);
    if result=last then
      // reached the end -> search once from HashTable[0] to HashTable[first-1]
      if result=first then
        break else begin
        result := 0;
        last := first;
      end;
  until false;
  RaiseFatalCollision('FindOrNew',aHashCode);
end;

procedure TDynArrayHasher.HashAdd(aHashCode: cardinal; var result: integer);
var n: integer;
begin // on input: HashTable[result] slot is already computed
  n := DynArray^.Count;
  if HashTableSize<n then
    RaiseFatalCollision('HashAdd HashTableSize',aHashCode);
  if HashTableSize-n<n shr 2 then begin // grow hash table when 25% void
    ReHash({foradd=}true);
    result := Find(aHashCode,{foradd=}true); // recompute position
    if result>=0 then
      RaiseFatalCollision('HashAdd',aHashCode);
  end;
  HashTable[-result-1] := n+1; // store Index+1 (0 means void slot)
  result := n;
end; // on output: result holds the position in fValue[]


// brute force O(n) indexes fix after deletion (much faster than full ReHash)
procedure DynArrayHashTableAdjust(P: PIntegerArray; deleted: integer; count: PtrInt);
{$ifdef CPUX64ASM} // SSE2 simd is 25x faster than "if P^>deleted then dec(P^)"
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx=P, edx=deleted, r8=count  (Linux: rdi,esi,rdx)
{$endif FPC}
{$ifdef Linux}
        mov     r8, rdx
        mov     rcx, rdi
        mov     rdx, rsi
{$endif Linux}
        xor     eax, eax    // reset eax high bits for setg al below
        movq    xmm0, rdx   // xmm0 = 128-bit of quad deleted
        pshufd  xmm0, xmm0, 0
        test    cl, 3
        jnz     @1  // paranoid: a dword dynamic array is always dword-aligned
        // ensure P is 256-bit aligned (for avx2)
@align: test    cl, 31
        jz      @ok
        cmp     dword ptr[rcx], edx
        setg    al                  // P[]>deleted -> al=1, 0 otherwise
        sub     dword ptr[rcx], eax // branchless dec(P[])
        add     rcx, 4
        dec     r8
        jmp     @align
@ok:    {$ifdef FPC} // AVX2 asm is not supported by Delphi (even 10.3) :(
        test    byte ptr[rip+CPUIDX64], 1 shl cpuAVX2
        jz      @sse2
        vpshufd ymm0, ymm0, 0          // shuffle to ymm0 128-bit low lane
        vperm2f128 ymm0, ymm0, ymm0, 0 // copy to ymm0 128-bit high lane
        // avx process of 128 bytes (32 indexes) per loop iteration
        align 16
@avx2:  sub      r8, 32
        vmovdqa  ymm1, [rcx]       // 4 x 256-bit process = 4 x 8 integers
        vmovdqa  ymm3, [rcx + 32]
        vmovdqa  ymm5, [rcx + 64]
        vmovdqa  ymm7, [rcx + 96]
        vpcmpgtd ymm2, ymm1, ymm0  // compare P[]>deleted -> -1, 0 otherwise
        vpcmpgtd ymm4, ymm3, ymm0
        vpcmpgtd ymm6, ymm5, ymm0
        vpcmpgtd ymm8, ymm7, ymm0
        vpaddd   ymm1, ymm1, ymm2  // adjust by adding -1 / 0
        vpaddd   ymm3, ymm3, ymm4
        vpaddd   ymm5, ymm5, ymm6
        vpaddd   ymm7, ymm7, ymm8
        vmovdqa  [rcx], ymm1
        vmovdqa  [rcx + 32], ymm3
        vmovdqa  [rcx + 64], ymm5
        vmovdqa  [rcx + 96], ymm7
        add      rcx, 128
        cmp      r8, 32
        jae      @avx2
        vzeroupper
        jmp      @2
        {$endif FPC}
        // SSE2 process of 64 bytes (16 indexes) per loop iteration
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@sse2:  sub     r8, 16
        movaps  xmm1, dqword [rcx]  // 4 x 128-bit process = 4 x 4 integers
        movaps  xmm3, dqword [rcx + 16]
        movaps  xmm5, dqword [rcx + 32]
        movaps  xmm7, dqword [rcx + 48]
        movaps  xmm2, xmm1  // keep copy for paddd below
        movaps  xmm4, xmm3
        movaps  xmm6, xmm5
        movaps  xmm8, xmm7
        pcmpgtd xmm1, xmm0  // quad compare P[]>deleted -> -1, 0 otherwise
        pcmpgtd xmm3, xmm0
        pcmpgtd xmm5, xmm0
        pcmpgtd xmm7, xmm0
        paddd   xmm1, xmm2  // quad adjust by adding -1 / 0
        paddd   xmm3, xmm4
        paddd   xmm5, xmm6
        paddd   xmm7, xmm8
        movaps  dqword [rcx], xmm1  // quad store back
        movaps  dqword [rcx + 16], xmm3
        movaps  dqword [rcx + 32], xmm5
        movaps  dqword [rcx + 48], xmm7
        add     rcx, 64
        cmp     r8, 16
        jae     @sse2
        jmp     @2
        // trailing indexes
@1:     dec     r8
        cmp     dword ptr[rcx + r8 * 4], edx
        setg    al
        sub     dword ptr[rcx + r8 * 4], eax
@2:     test    r8, r8
        jnz     @1
end;
{$else}
begin
  repeat
    dec(count,8);
    dec(P[0],ord(P[0]>deleted)); // branchless code is 10x faster than if :)
    dec(P[1],ord(P[1]>deleted));
    dec(P[2],ord(P[2]>deleted));
    dec(P[3],ord(P[3]>deleted));
    dec(P[4],ord(P[4]>deleted));
    dec(P[5],ord(P[5]>deleted));
    dec(P[6],ord(P[6]>deleted));
    dec(P[7],ord(P[7]>deleted));
    P := @P[8];
  until count<8;
  while count>0 do begin
    dec(count);
    dec(P[count],ord(P[count]>deleted));
  end;
end;
{$endif CPUX64ASM} // SSE2 asm is invalid prior to Delphi XE7 (to be refined)

// with x86_64/sse2 for 200,000 items: adjust=200.57ms (11.4GB/s) hash=2.46ms
//  -> TDynArray.Delete move() takes more time than the HashTable update :)

{ some numbers, with CITIES_MAX=200000, deleting 1/128 entries
  first column (3..23) is the max number of indexes[] chunk to rehash
1. naive loop
  for i := 0 to HashTableSize-1 do
    if HashTable[i]>aArrayIndex then
      dec(HashTable[i]);
  3 #257  adjust=7.95ms 191.7MB hash=8us
  8 #384  adjust=11.93ms 255.8MB hash=10us
  11 #1019  adjust=32.09ms 332.8MB hash=26us
  13 #16259  adjust=511.10ms 379.2MB hash=230us
  13 #32515  adjust=1.01s 383.6MB/s hash=440us
  14 #33531  adjust=1.04s 382.2MB hash=459us
  17 #46612  adjust=1.44s 386.3MB hash=639us
  17 #65027  adjust=1.97s 396.3MB/s hash=916us
  17 #97539  adjust=2.79s 419.9MB/s hash=1.37ms
  18 #109858  adjust=3.05s 431.2MB hash=1.51ms
  18 #130051  adjust=3.44s 454.1MB/s hash=1.75ms
  18 #162563  adjust=3.93s 496.9MB/s hash=2.14ms
  23 #172723  adjust=4.05s 511.7MB hash=2.26ms
  23 #195075  adjust=4.27s 548.6MB/s hash=2.47ms
2. branchless pure pascal code is about 10x faster!
  3 #257  adjust=670us 2.2GB hash=8us
  8 #384  adjust=1ms 2.9GB hash=9us
  11 #1019  adjust=2.70ms 3.8GB hash=21us
  13 #16259  adjust=43.65ms 4.3GB hash=210us
  13 #32515  adjust=87.75ms 4.3GB/s hash=423us
  14 #33531  adjust=90.44ms 4.3GB hash=441us
  17 #46612  adjust=127.68ms 4.2GB hash=627us
  17 #65027  adjust=179.64ms 4.2GB/s hash=908us
  17 #97539  adjust=267.44ms 4.2GB/s hash=1.35ms
  18 #109858  adjust=301.27ms 4.2GB hash=1.50ms
  18 #130051  adjust=355.37ms 4.2GB/s hash=1.74ms
  18 #162563  adjust=438.79ms 4.3GB/s hash=2.11ms
  23 #172723  adjust=465.23ms 4.3GB hash=2.23ms
  23 #195075  adjust=520.85ms 4.3GB/s hash=2.45ms
3. SSE2 simd assembly makes about 3x improvement
  3 #257  adjust=290us 5.1GB hash=8us
  8 #384  adjust=427us 6.9GB hash=10us
  11 #1019  adjust=1.11ms 9.3GB hash=20us
  13 #16259  adjust=18.33ms 10.3GB hash=219us
  13 #32515  adjust=36.32ms 10.5GB/s hash=435us
  14 #33531  adjust=37.39ms 10.4GB hash=452us
  17 #46612  adjust=51.70ms 10.5GB hash=622us
  17 #65027  adjust=72.47ms 10.5GB/s hash=893us
  17 #97539  adjust=107ms 10.6GB/s hash=1.32ms
  18 #109858  adjust=120.08ms 10.7GB hash=1.46ms
  18 #130051  adjust=140.50ms 10.8GB/s hash=1.71ms
  18 #162563  adjust=171.44ms 11.1GB/s hash=2.10ms
  23 #172723  adjust=181.02ms 11.1GB hash=2.22ms
  23 #195075  adjust=201.53ms 11.3GB/s hash=2.44ms
4. AVX2 simd assembly gives some additional 40% (consistent on my iCore3 cpu)
  3 #257  adjust=262us 5.6GB hash=8us
  8 #384  adjust=383us 7.7GB hash=10us
  11 #1019  adjust=994us 10.4GB hash=21us
  13 #16259  adjust=16.34ms 11.5GB hash=248us
  13 #32515  adjust=32.12ms 11.8GB/s hash=464us
  14 #33531  adjust=33.06ms 11.8GB hash=484us
  17 #46612  adjust=45.49ms 11.9GB hash=678us
  17 #65027  adjust=62.36ms 12.2GB/s hash=966us
  17 #97539  adjust=90.80ms 12.6GB/s hash=1.43ms
  18 #109858  adjust=101.82ms 12.6GB hash=1.59ms
  18 #130051  adjust=117.37ms 13GB/s hash=1.83ms
  18 #162563  adjust=140.08ms 13.6GB/s hash=2.23ms
  23 #172723  adjust=147.20ms 13.7GB hash=2.34ms
  23 #195075  adjust=161.73ms 14.1GB/s hash=2.57ms
}
procedure TDynArrayHasher.HashDelete(aArrayIndex,aHashTableIndex: integer; aHashCode: cardinal);
var first,next,last,ndx,i,n: integer;
    P: PAnsiChar;
    indexes: array[0..511] of cardinal; // to be rehashed
begin
  // retrieve hash table entries to be recomputed
  first := aHashTableIndex;
  last := HashTableSize;
  next := first;
  n := 0;
  repeat
    HashTable[next] := 0; // Clear slots
    inc(next);
    if next=last then
      if next=first then
        RaiseFatalCollision('HashDelete down',aHashCode) else begin
        next := 0;
        last := first;
      end;
    ndx := HashTable[next]-1; // stored index+1
    if ndx<0 then
      break; // stop at void entry
    if n=high(indexes) then // typical 0..23
      RaiseFatalCollision('HashDelete indexes overflow',aHashCode);
    indexes[n] := ndx;
    inc(n);
  until false;
  // ReHash collided entries - note: item is not yet deleted in Value^[]
  for i := 0 to n-1 do begin
    P := PAnsiChar(DynArray^.Value^)+indexes[i]*DynArray^.ElemSize;
    ndx := FindOrNew(HashOne(P),P,nil);
    if ndx<0 then
      HashTable[-ndx-1] := indexes[i]+1; // ignore ndx>=0 dups (like ReHash)
  end;
  // adjust all stored indexes
  DynArrayHashTableAdjust(pointer(HashTable),aArrayIndex,HashTableSize);
end;

function TDynArrayHasher.FindBeforeAdd(Elem: pointer;
  out wasAdded: boolean; aHashCode: cardinal): integer;
var n: integer;
begin
  wasAdded := false;
  if not(canHash in State) then begin
    n := DynArray^.Count;
    if n<CountTrigger then begin
      result := Scan(Elem); // may trigger ReHash and set canHash
      if result>=0 then
        exit; // item found
      if not(canHash in State) then begin
        wasadded := true;
        result := n;
        exit;
      end;
    end;
  end;
  if not(canHash in State) then
    ReHash({forced=}true); // hash previous CountTrigger items
  result := FindOrNew(aHashCode,Elem,nil);
  if result<0 then begin // found no matching item
    wasAdded := true;
    HashAdd(aHashCode,result);
  end;
end;

function TDynArrayHasher.FindBeforeDelete(Elem: pointer): integer;
var hc: cardinal;
    ht: integer;
begin
  if canHash in State then begin
    hc := HashOne(Elem);
    result := FindOrNew(hc,Elem,@ht);
    if result<0 then
      result := -1 else
      HashDelete(result,ht,hc);
  end else
    result := Scan(Elem);
end;

procedure TDynArrayHasher.RaiseFatalCollision(const caller: RawUTF8;
  aHashCode: cardinal);
begin // a dedicated sub-procedure reduces code size
  raise ESynException.CreateUTF8('TDynArrayHasher.% fatal collision: '+
    'aHashCode=% HashTableSize=% Count=% Capacity=% ArrayType=% KnownType=%',
    [caller,CardinalToHexShort(aHashCode),HashTableSize,DynArray^.Count,
     DynArray^.Capacity,DynArray^.ArrayTypeShort^,ToText(DynArray^.KnownType)^]);
end;

function TDynArrayHasher.GetHashFromIndex(aIndex: PtrInt): cardinal;
var P: pointer;
begin
  P := DynArray^.ElemPtr(aIndex);
  if P<>nil then
    result := HashOne(P) else
    result := 0;
end;

procedure TDynArrayHasher.SetEventHash(const event: TEventDynArrayHashOne);
begin
  EventHash := event;
  Clear;
end;

function TDynArrayHasher.Scan(Elem: pointer): integer;
var P: PAnsiChar;
    i,max: integer;
    siz: PtrInt;
begin
  result := -1;
  max := DynArray^.Count-1;
  P := DynArray^.Value^;
  siz := DynArray^.ElemSize;
  if Assigned(EventCompare) then // custom comparison
    for i := 0 to max do
      if EventCompare(P^,Elem^)=0 then begin
        result := i;
        break;
      end else
        inc(P,siz) else
  if Assigned(Compare) then
    for i := 0 to max do
      if Compare(P^,Elem^)=0 then begin
        result := i;
        break;
      end else
        inc(P,siz);
  // enable hashing if Scan() called 2*CountTrigger
  if (hasHasher in State) and (max>7) then begin
    inc(ScanCounter);
    if ScanCounter>=CountTrigger*2 then begin
      CountTrigger := 2; // rather use hashing from now on
      ReHash(false);   // set HashTable[] and canHash
    end;
  end;
end;

function TDynArrayHasher.Find(Elem: pointer): integer;
begin
  result := Find(Elem,HashOne(Elem));
end;

function TDynArrayHasher.Find(Elem: pointer; aHashCode: cardinal): integer;
begin
  result := FindOrNew(aHashCode,Elem,nil); // fallback to Scan() if needed
  if result<0 then
    result := -1; // for coherency with most search methods
end;

function TDynArrayHasher.ReHash(forced: boolean): integer;
var i, n, cap, siz, ndx: integer;
    P: PAnsiChar;
    hc: cardinal;
begin
  result := 0;
  n := DynArray^.Count;
  if not (Assigned(HashElement) or Assigned(EventHash)) or
     (not forced and ((n=0) or (n<CountTrigger))) then begin
    Clear; // reset HashTable[]
    exit; // hash only if needed, and avoid GPF after TDynArray.Clear (Count=0)
  end;
  cap := DynArray^.Capacity * 2; // to reserve some void slots
  {$ifdef CPU32DELPHI}
  if cap<=HASH_PO2 then begin
    siz := 256;
    while siz<cap do // find nearest power of two for fast bitwise division
      siz := siz shl 1;
  end else
  {$endif CPU32DELPHI}
    siz := NextPrime(cap);
  if (not forced) and (siz=HashTableSize) then
    exit; // was a paranoid ReHash() call
  Clear;
  HashTableSize := siz;
  SetLength(HashTable,siz); // fill with 0 (void slot)
  // fill HashTable[]=index+1 from all existing items
  include(State,canHash);   // needed before Find() below
  P := DynArray^.Value^;
  for i := 1 to n do begin
    if Assigned(EventHash) then
      hc := EventHash(P^) else
      hc := HashElement(P^,Hasher);
    ndx := FindOrNew(hc,P,nil);
    if ndx>=0 then
      inc(result) else         // found duplicated value
      HashTable[-ndx-1] := i;  // store index+1 (0 means void entry)
    inc(P,DynArray^.ElemSize);
  end;
end;


{ TDynArrayHashed }

{$ifdef UNDIRECTDYNARRAY} // some Delphi 2009+ wrapper definitions

function TDynArrayHashed.GetCount: PtrInt;
begin
  result := InternalDynArray.GetCount;
end;
procedure TDynArrayHashed.SetCount(aCount: PtrInt);
begin
  InternalDynArray.SetCount(aCount);
end;
function TDynArrayHashed.GetCapacity: PtrInt;
begin
  result := InternalDynArray.GetCapacity;
end;
procedure TDynArrayHashed.SetCapacity(aCapacity: PtrInt);
begin
  InternalDynArray.SetCapacity(aCapacity);
end;
function TDynArrayHashed.Value: PPointer;
begin
  result := InternalDynArray.fValue;
end;
function TDynArrayHashed.ElemSize: PtrUInt;
begin
  result := InternalDynArray.fElemSize;
end;
function TDynArrayHashed.ElemType: Pointer;
begin
  result := InternalDynArray.fElemType;
end;
procedure TDynArrayHashed.ElemCopy(const A; var B);
begin
  InternalDynArray.ElemCopy(A,B);
end;
function TDynArrayHashed.ElemPtr(index: PtrInt): pointer;
begin
  result := InternalDynArray.ElemPtr(index);
end;
procedure TDynArrayHashed.ElemCopyAt(index: PtrInt; var Dest);
begin
  InternalDynArray.ElemCopyAt(index,Dest);
end;
function TDynArrayHashed.KnownType: TDynArrayKind;
begin
  result := InternalDynArray.KnownType;
end;
procedure TDynArrayHashed.Clear;
begin
  InternalDynArray.SetCount(0);
end;
function TDynArrayHashed.Add(const Elem): integer;
begin
  result := InternalDynArray.Add(Elem);
end;
procedure TDynArrayHashed.Delete(aIndex: PtrInt);
begin
  InternalDynArray.Delete(aIndex);
end;
function TDynArrayHashed.SaveTo: RawByteString;
begin
  result := InternalDynArray.SaveTo;
end;
function TDynArrayHashed.LoadFrom(Source: PAnsiChar; AfterEach: TDynArrayAfterLoadFrom;
  NoCheckHash: boolean; SourceMax: PAnsiChar): PAnsiChar;
begin
  result := InternalDynArray.LoadFrom(Source,AfterEach,NoCheckHash,SourceMax);
end;
function TDynArrayHashed.LoadFromBinary(const Buffer: RawByteString; NoCheckHash: boolean): boolean;
begin
  result := InternalDynArray.LoadFromBinary(Buffer,NoCheckHash);
end;
function TDynArrayHashed.SaveTo(Dest: PAnsiChar): PAnsiChar;
begin
  result := InternalDynArray.SaveTo(Dest);
end;
function TDynArrayHashed.SaveToJSON(EnumSetsAsText: boolean;
  reformat: TTextWriterJSONFormat): RawUTF8;
begin
  result := InternalDynArray.SaveToJSON(EnumSetsAsText,reformat);
end;
procedure TDynArrayHashed.Sort(aCompare: TDynArraySortCompare);
begin
  InternalDynArray.Sort(aCompare);
end;
procedure TDynArrayHashed.CreateOrderedIndex(var aIndex: TIntegerDynArray;
  aCompare: TDynArraySortCompare);
begin
  InternalDynArray.CreateOrderedIndex(aIndex,aCompare);
end;
function TDynArrayHashed.LoadFromJSON(P: PUTF8Char; aEndOfObject: PUTF8Char{$ifndef NOVARIANTS};
      CustomVariantOptions: PDocVariantOptions{$endif}): PUTF8Char;
begin
  result := InternalDynArray.LoadFromJSON(P,aEndOfObject{$ifndef NOVARIANTS},
    CustomVariantOptions{$endif});
end;
function TDynArrayHashed.SaveToLength: integer;
begin
  result := InternalDynArray.SaveToLength;
end;

{$endif UNDIRECTDYNARRAY}

procedure TDynArrayHashed.Init(aTypeInfo: pointer; var aValue;
  aHashElement: TDynArrayHashOne; aCompare: TDynArraySortCompare;
  aHasher: THasher; aCountPointer: PInteger; aCaseInsensitive: boolean);
begin
  {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$else}inherited{$endif}
    Init(aTypeInfo,aValue,aCountPointer);
  fHash.Init(@self,aHashElement,nil,aHasher,aCompare,nil,aCaseInsensitive);
  {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}SetCompare(fHash.Compare);
end;

procedure TDynArrayHashed.InitSpecific(aTypeInfo: pointer; var aValue;
  aKind: TDynArrayKind; aCountPointer: PInteger; aCaseInsensitive: boolean);
begin
  {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$else}inherited{$endif}
    Init(aTypeInfo,aValue,aCountPointer);
  fHash.InitSpecific(@self,aKind,aCaseInsensitive);
  {$ifdef UNDIRECTDYNARRAY}with InternalDynArray do{$endif} begin
    fCompare := fHash.Compare;
    fKnownType := aKind;
    fKnownSize := KNOWNTYPE_SIZE[aKind];
  end;
end;

function TDynArrayHashed.Scan(const Elem): integer;
begin
  result := fHash.Scan(@Elem);
end;

function TDynArrayHashed.FindHashed(const Elem): integer;
begin
  result := fHash.FindOrNew(fHash.HashOne(@Elem),@Elem);
  if result<0 then
    result := -1; // for coherency with most methods
end;

function TDynArrayHashed.FindFromHash(const Elem; aHashCode: cardinal): integer;
begin // overload FindHashed() trigger F2084 Internal Error: C2130 on Delphi XE3
  result := fHash.FindOrNew(aHashCode,@Elem); // fallback to Scan() if needed
  if result<0 then
    result := -1; // for coherency with most methods
end;

function TDynArrayHashed.FindHashedForAdding(const Elem; out wasAdded: boolean;
  noAddEntry: boolean): integer;
begin
  result := FindHashedForAdding(Elem,wasAdded,fHash.HashOne(@Elem),noAddEntry);
end;

function TDynArrayHashed.FindHashedForAdding(const Elem; out wasAdded: boolean;
  aHashCode: cardinal; noAddEntry: boolean): integer;
begin
  result := fHash.FindBeforeAdd(@Elem,wasAdded,aHashCode);
  if wasAdded and not noAddEntry then
    SetCount(result+1); // reserve space for a void element in array
end;

function TDynArrayHashed.AddAndMakeUniqueName(aName: RawUTF8): pointer;
var ndx,j: integer;
    added: boolean;
    aName_: RawUTF8;
begin
  if aName='' then
    aName := '_';
  ndx := FindHashedForAdding(aName,added);
  if not added then begin // force unique column name
    aName_ := aName+'_';
    j := 1;
    repeat
      aName := aName_+UInt32ToUTF8(j);
      ndx := FindHashedForAdding(aName,added);
      inc(j);
    until added;
  end;
  result := PAnsiChar(Value^)+cardinal(ndx)*ElemSize;
  PRawUTF8(result)^ := aName; // store unique name at 1st elem position
end;

function TDynArrayHashed.AddUniqueName(const aName: RawUTF8; aNewIndex: PInteger): pointer;
begin
  result := AddUniqueName(aName,'',[],aNewIndex);
end;

function TDynArrayHashed.AddUniqueName(const aName: RawUTF8;
  const ExceptionMsg: RawUTF8; const ExceptionArgs: array of const; aNewIndex: PInteger): pointer;
var ndx: integer;
    added: boolean;
begin
  ndx := FindHashedForAdding(aName,added);
  if added then begin
    if aNewIndex<>nil then
      aNewIndex^ := ndx;
    result := PAnsiChar(Value^)+cardinal(ndx)*ElemSize;
    PRawUTF8(result)^ := aName; // store unique name at 1st elem position
  end else
    if ExceptionMsg='' then
      raise ESynException.CreateUTF8('Duplicated [%] name',[aName]) else
      raise ESynException.CreateUTF8(ExceptionMsg,ExceptionArgs);
end;

function TDynArrayHashed.FindHashedAndFill(var ElemToFill): integer;
begin
  result := fHash.FindOrNew(fHash.HashOne(@ElemtoFill),@ElemToFill);
  if result<0 then
    result := -1 else
    ElemCopy(PAnsiChar(Value^)[cardinal(result)*ElemSize],ElemToFill);
end;

procedure TDynArrayHashed.SetEventHash(const event: TEventDynArrayHashOne);
begin
  fHash.SetEventHash(event);
end;

function TDynArrayHashed.FindHashedAndUpdate(const Elem; AddIfNotExisting: boolean): integer;
var hc: cardinal;
label doh;
begin
  if canHash in fHash.State then begin
doh:hc := fHash.HashOne(@Elem);
    result := fHash.FindOrNew(hc,@Elem);
    if (result<0) and AddIfNotExisting then begin
      fHash.HashAdd(hc,result); // ReHash only if necessary
      SetCount(result+1); // add new item
    end;
  end else begin
    result := fHash.Scan(@Elem);
    if result<0 then begin
      if AddIfNotExisting then
        if canHash in fHash.State then // Scan triggered ReHash
          goto doh else begin
          result := Add(Elem); // regular Add
          exit;
        end;
    end;
  end;
  if result>=0 then
    ElemCopy(Elem,PAnsiChar(Value^)[cardinal(result)*ElemSize]); // update
end;

function TDynArrayHashed.FindHashedAndDelete(const Elem; FillDeleted: pointer;
  noDeleteEntry: boolean): integer;
begin
  result := fHash.FindBeforeDelete(@Elem);
  if result>=0 then begin
    if FillDeleted<>nil then
      ElemCopyAt(result,FillDeleted^);
    if not noDeleteEntry then
      Delete(result);
  end;
end;

function TDynArrayHashed.GetHashFromIndex(aIndex: PtrInt): Cardinal;
begin
  result := fHash.GetHashFromIndex(aIndex);
end;

function TDynArrayHashed.ReHash(forAdd: boolean): integer;
begin
  result := fHash.ReHash(forAdd);
end;


function DynArray(aTypeInfo: pointer; var aValue; aCountPointer: PInteger): TDynArray;
begin
  result.Init(aTypeInfo,aValue,aCountPointer);
end;

function SimpleDynArrayLoadFrom(Source: PAnsiChar; aTypeInfo: pointer;
  var Count, ElemSize: integer; NoHash32Check: boolean): pointer;
var Hash: PCardinalArray absolute Source;
    info: PTypeInfo;
begin
  result := nil;
  info := GetTypeInfo(aTypeInfo,tkDynArray);
  if info=nil then
    exit; // invalid type information
  ElemSize := info^.elSize {$ifdef FPC}and $7FFFFFFF{$endif};
  if (info^.ElType<>nil) or (Source=nil) or
     (Source[0]<>AnsiChar(ElemSize)) or (Source[1]<>#0) then
    exit; // invalid type information or Source content
  inc(Source,2);
  Count := FromVarUInt32(PByte(Source)); // dynamic array count
  if (Count<>0) and (NoHash32Check or (Hash32(@Hash[1],Count*ElemSize)=Hash[0])) then
    result := @Hash[1]; // returns valid Source content
end;

function IntegerDynArrayLoadFrom(Source: PAnsiChar; var Count: integer;
  NoHash32Check: boolean): PIntegerArray;
var Hash: PCardinalArray absolute Source;
begin
  result := nil;
  if (Source=nil) or (Source[0]<>#4) or (Source[1]<>#0) then
    exit; // invalid Source content
  inc(Source,2);
  Count := FromVarUInt32(PByte(Source)); // dynamic array count
  if (Count<>0) and (NoHash32Check or (Hash32(@Hash[1],Count*4)=Hash[0])) then
    result := @Hash[1]; // returns valid Source content
end;

function RawUTF8DynArrayLoadFromContains(Source: PAnsiChar;
  Value: PUTF8Char; ValueLen: PtrInt; CaseSensitive: boolean): PtrInt;
var Count, Len: PtrInt;
begin
  if (Value=nil) or (ValueLen=0) or
     (Source=nil) or (Source[0]<>AnsiChar(SizeOf(PtrInt)))
     {$ifndef FPC}or (Source[1]<>AnsiChar(tkLString)){$endif} then begin
    result := -1;
    exit; // invalid Source or Value content
  end;
  inc(Source,2);
  Count := FromVarUInt32(PByte(Source)); // dynamic array count
  inc(Source,SizeOf(cardinal)); // ignore Hash32 security checksum
  for result := 0 to Count-1 do begin
    Len := FromVarUInt32(PByte(Source));
    if CaseSensitive then begin
      if (Len=ValueLen) and CompareMemFixed(Value,Source,Len) then
        exit;
    end else
      if UTF8ILComp(Value,pointer(Source),ValueLen,Len)=0 then
        exit;
    inc(Source,Len);
  end;
  result := -1;
end;


{ TObjectDynArrayWrapper }

constructor TObjectDynArrayWrapper.Create(var aValue; aOwnObjects: boolean);
begin
  fValue := @aValue;
  fOwnObjects := aOwnObjects;
end;

destructor TObjectDynArrayWrapper.Destroy;
begin
  Clear;
  inherited;
end;

function TObjectDynArrayWrapper.Find(Instance: TObject): integer;
var P: PObjectArray;
begin
  P := fValue^;
  if P<>nil then
    for result := 0 to fCount-1 do
      if P[result]=Instance then
        exit;
  result := -1;
end;

function TObjectDynArrayWrapper.Add(Instance: TObject): integer;
var cap: integer;
begin
  cap := length(TObjectDynArray(fValue^));
  if cap<=fCount then
    SetLength(TObjectDynArray(fValue^),NextGrow(cap));
  result := fCount;
  TObjectDynArray(fValue^)[result] := Instance;
  inc(fCount);
end;

procedure TObjectDynArrayWrapper.Delete(Index: integer);
var P: PObjectArray;
begin
  P := fValue^;
  if (P=nil) or (cardinal(Index)>=cardinal(fCount)) then
    exit; // avoid Out of range
  if fOwnObjects then
    P[Index].Free;
  dec(fCount);
  if fCount>Index then
    MoveFast(P[Index+1],P[Index],(fCount-Index)*SizeOf(pointer));
end;

procedure TObjectDynArrayWrapper.Clear;
var i: PtrInt;
    P: PObjectArray;
begin
  P := fValue^;
  if P<>nil then begin
    if fOwnObjects then
      for i := fCount-1 downto 0 do
      try
        P[i].Free;
      except
        on Exception do;
      end;
    TObjectDynArray(fValue^) := nil; // set capacity to 0
    fCount := 0;
  end else
    if fCount>0 then
      raise ESynException.Create('You MUST define your IObjectDynArray field '+
        'BEFORE the corresponding dynamic array');
end;

procedure TObjectDynArrayWrapper.Slice;
begin
  SetLength(TObjectDynArray(fValue^),fCount);
end;

function TObjectDynArrayWrapper.Count: integer;
begin
  result := fCount;
end;

function TObjectDynArrayWrapper.Capacity: integer;
begin
  result := length(TObjectDynArray(fValue^));
end;

procedure TObjectDynArrayWrapper.Sort(Compare: TDynArraySortCompare);
begin
  if (@Compare<>nil) and (fCount>0) then
    QuickSortPtr(0,fCount-1,Compare,fValue^);
end;

function NewSynLocker: PSynLocker;
begin
  result := AllocMem(SizeOf(result^));
  result^.Init;
end;

function PtrArrayAdd(var aPtrArray; aItem: pointer): integer;
var a: TPointerDynArray absolute aPtrArray;
begin
  result := length(a);
  SetLength(a,result+1);
  a[result] := aItem;
end;

function PtrArrayAddOnce(var aPtrArray; aItem: pointer): integer;
var a: TPointerDynArray absolute aPtrArray;
    n: integer;
begin
  n := length(a);
  result := PtrUIntScanIndex(pointer(a),n,PtrUInt(aItem));
  if result>=0 then
    exit;
  SetLength(a,n+1);
  a[n] := aItem;
  result := n;
end;

procedure PtrArrayDelete(var aPtrArray; aIndex: integer; aCount: PInteger);
var a: TPointerDynArray absolute aPtrArray;
    n: integer;
begin
  if aCount=nil then
    n := length(a) else
    n := aCount^;
  if cardinal(aIndex)>=cardinal(n) then
    exit; // out of range
  dec(n);
  if n>aIndex then
    MoveFast(a[aIndex+1],a[aIndex],(n-aIndex)*SizeOf(pointer));
  if aCount=nil then
    SetLength(a,n) else
    aCount^ := n;
end;

function PtrArrayDelete(var aPtrArray; aItem: pointer; aCount: PInteger): integer;
var a: TPointerDynArray absolute aPtrArray;
    n: integer;
begin
  if aCount=nil then
    n := length(a) else
    n := aCount^;
  result := PtrUIntScanIndex(pointer(a),n,PtrUInt(aItem));
  if result<0 then
    exit;
  dec(n);
  if n>result then
    MoveFast(a[result+1],a[result],(n-result)*SizeOf(pointer));
  if aCount=nil then
    SetLength(a,n) else
    aCount^ := n;
end;

function PtrArrayFind(var aPtrArray; aItem: pointer): integer;
var a: TPointerDynArray absolute aPtrArray;
begin
  result := PtrUIntScanIndex(pointer(a),length(a),PtrUInt(aItem));
end;

{ wrapper functions to T*ObjArr types }

function ObjArrayAdd(var aObjArray; aItem: TObject): PtrInt;
var a: TObjectDynArray absolute aObjArray;
begin
  result := length(a);
  SetLength(a,result+1);
  a[result] := aItem;
end;

function ObjArrayAddFrom(var aDestObjArray; const aSourceObjArray): PtrInt;
var n: PtrInt;
    s: TObjectDynArray absolute aSourceObjArray;
    d: TObjectDynArray absolute aDestObjArray;
begin
  result := length(d);
  n := length(s);
  SetLength(d,result+n);
  MoveFast(s[0],d[result],n*SizeOf(pointer));
  inc(result,n);
end;

function ObjArrayAppend(var aDestObjArray, aSourceObjArray): PtrInt;
begin
  result := ObjArrayAddFrom(aDestObjArray,aSourceObjArray);
  TObjectDynArray(aSourceObjArray) := nil; // aSourceObjArray[] changed ownership
end;

function ObjArrayAddCount(var aObjArray; aItem: TObject; var aObjArrayCount: integer): PtrInt;
var a: TObjectDynArray absolute aObjArray;
begin
  result := aObjArrayCount;
  if result=length(a) then
    SetLength(a,NextGrow(result));
  a[result] := aItem;
  inc(aObjArrayCount);
end;

procedure ObjArrayAddOnce(var aObjArray; aItem: TObject);
var a: TObjectDynArray absolute aObjArray;
    n: PtrInt;
begin
  n := length(a);
  if not PtrUIntScanExists(pointer(a),n,PtrUInt(aItem)) then begin
    SetLength(a,n+1);
    a[n] := aItem;
  end;
end;

function ObjArrayAddOnceFrom(var aDestObjArray; const aSourceObjArray): PtrInt;
var n, i: PtrInt;
    s: TObjectDynArray absolute aSourceObjArray;
    d: TObjectDynArray absolute aDestObjArray;
begin
  result := length(d);
  n := length(s);
  if n=0 then
    exit;
  SetLength(d,result+n);
  for i := 0 to n-1 do
    if not PtrUIntScanExists(pointer(d),result,PtrUInt(s[i])) then begin
      d[result] := s[i];
      inc(result);
    end;
  if result<>length(d) then
    SetLength(d,result);
end;

procedure ObjArraySetLength(var aObjArray; aLength: integer);
begin
  SetLength(TObjectDynArray(aObjArray),aLength);
end;

function ObjArrayFind(const aObjArray; aItem: TObject): PtrInt;
begin
  result := PtrUIntScanIndex(pointer(aObjArray),
    length(TObjectDynArray(aObjArray)),PtrUInt(aItem));
end;

function ObjArrayFind(const aObjArray; aCount: integer; aItem: TObject): PtrInt;
begin
  result := PtrUIntScanIndex(pointer(aObjArray),aCount,PtrUInt(aItem));
end;

function ObjArrayCount(const aObjArray): integer;
var i: PtrInt;
    a: TObjectDynArray absolute aObjArray;
begin
  result := 0;
  for i := 0 to length(a)-1 do
    if a[i]<>nil then
      inc(result);
end;

procedure ObjArrayDelete(var aObjArray; aItemIndex: PtrInt;
  aContinueOnException: boolean; aCount: PInteger);
var n: PtrInt;
    a: TObjectDynArray absolute aObjArray;
begin
  if aCount=nil then
    n := length(a) else
    n := aCount^;
  if cardinal(aItemIndex)>=cardinal(n) then
    exit; // out of range
  if aContinueOnException then
    try
      a[aItemIndex].Free;
    except
    end else
    a[aItemIndex].Free;
  dec(n);
  if n>aItemIndex then
    MoveFast(a[aItemIndex+1],a[aItemIndex],(n-aItemIndex)*SizeOf(TObject));
  if aCount=nil then
    SetLength(a,n) else
    aCount^ := n;
end;

function ObjArrayDelete(var aObjArray; aItem: TObject): PtrInt;
begin
  result := PtrUIntScanIndex(pointer(aObjArray),
    length(TObjectDynArray(aObjArray)),PtrUInt(aItem));
  if result>=0 then
    ObjArrayDelete(aObjArray,result);
end;

function ObjArrayDelete(var aObjArray; aCount: integer; aItem: TObject): PtrInt; overload;
begin
  result := PtrUIntScanIndex(pointer(aObjArray),aCount,PtrUInt(aItem));
  if result>=0 then
    ObjArrayDelete(aObjArray,result,false,@aCount);
end;

procedure ObjArraySort(var aObjArray; Compare: TDynArraySortCompare);
begin
  if @Compare<>nil then
    QuickSortPtr(0,length(TObjectDynArray(aObjArray))-1,Compare,pointer(aObjArray));
end;

procedure RawObjectsClear(o: PObject; n: integer);
var obj: TObject;
begin
  if n>0 then
    repeat
      obj := o^;
      if obj<>nil then begin // inlined FreeAndNil(o^)
        o^ := nil;
        obj.Destroy;
      end;
      inc(o);
      dec(n);
    until n=0;
end;

procedure ObjArrayClear(var aObjArray);
var a: TObjectDynArray absolute aObjArray;
begin
  if a=nil then
    exit;
  RawObjectsClear(pointer(aObjArray),length(a));
  a := nil;
end;

procedure ObjArrayClear(var aObjArray; aCount: integer);
var a: TObjectDynArray absolute aObjArray;
    n: integer;
begin
  n := length(a);
  if n=0 then
    exit;
  if n>aCount then
    aCount := n;
  RawObjectsClear(pointer(aObjArray),aCount);
  a := nil;
end;

procedure ObjArrayClear(var aObjArray; aContinueOnException: boolean;
  aCount: PInteger);
var n,i: PtrInt;
    a: TObjectDynArray absolute aObjArray;
begin
  if aCount=nil then
    n := length(a) else begin
    n := aCount^;
    aCount^ := 0;
  end;
  if n=0 then
    exit;
  if aContinueOnException then
    for i := 0 to n-1 do
    try
      a[i].Free;
    except
    end
  else
    RawObjectsClear(pointer(a),n);
  a := nil;
end;

function ObjArrayToJSON(const aObjArray; aOptions: TTextWriterWriteObjectOptions): RawUTF8;
var temp: TTextWriterStackBuffer;
begin
  with DefaultTextWriterSerializer.CreateOwnedStream(temp) do
  try
    if woEnumSetsAsText in aOptions then
      CustomOptions := CustomOptions+[twoEnumSetsAsTextInRecord];
    AddObjArrayJSON(aObjArray,aOptions);
    SetText(result);
  finally
    Free;
  end;
end;


procedure ObjArrayObjArrayClear(var aObjArray);
var i: PtrInt;
    a: TPointerDynArray absolute aObjArray;
begin
  if a<>nil then begin
    for i := 0 to length(a)-1 do
      ObjArrayClear(a[i]);
    a := nil;
  end;
end;

procedure ObjArraysClear(const aObjArray: array of pointer);
var i: PtrInt;
begin
  for i := 0 to high(aObjArray) do
    if aObjArray[i]<>nil then
      ObjArrayClear(aObjArray[i]^);
end;

{$ifndef DELPHI5OROLDER}

function InterfaceArrayAdd(var aInterfaceArray; const aItem: IUnknown): PtrInt;
var a: TInterfaceDynArray absolute aInterfaceArray;
begin
  result := length(a);
  SetLength(a,result+1);
  a[result] := aItem;
end;

procedure InterfaceArrayAddOnce(var aInterfaceArray; const aItem: IUnknown);
var a: TInterfaceDynArray absolute aInterfaceArray;
    n: PtrInt;
begin
  if PtrUIntScanExists(pointer(aInterfaceArray),
     length(TInterfaceDynArray(aInterfaceArray)),PtrUInt(aItem)) then
    exit;
  n := length(a);
  SetLength(a,n+1);
  a[n] := aItem;
end;

function InterfaceArrayFind(const aInterfaceArray; const aItem: IUnknown): PtrInt;
begin
  result := PtrUIntScanIndex(pointer(aInterfaceArray),
    length(TInterfaceDynArray(aInterfaceArray)),PtrUInt(aItem));
end;

procedure InterfaceArrayDelete(var aInterfaceArray; aItemIndex: PtrInt);
var n: PtrInt;
    a: TInterfaceDynArray absolute aInterfaceArray;
begin
  n := length(a);
  if PtrUInt(aItemIndex)>=PtrUInt(n) then
    exit; // out of range
  a[aItemIndex] := nil;
  dec(n);
  if n>aItemIndex then
    MoveFast(a[aItemIndex+1],a[aItemIndex],(n-aItemIndex)*SizeOf(IInterface));
  TPointerDynArray(aInterfaceArray)[n] := nil; // avoid GPF in SetLength()
  SetLength(a,n);
end;

function InterfaceArrayDelete(var aInterfaceArray; const aItem: IUnknown): PtrInt;
begin
  result := InterfaceArrayFind(aInterfaceArray,aItem);
  if result>=0 then
    InterfaceArrayDelete(aInterfaceArray,result);
end;

{$endif DELPHI5OROLDER}


{ TInterfacedObjectWithCustomCreate }

constructor TInterfacedObjectWithCustomCreate.Create;
begin // nothing to do by default - overridden constructor may add custom code
end;

procedure TInterfacedObjectWithCustomCreate.RefCountUpdate(Release: boolean);
begin
  if Release then
    _Release else
    _AddRef;
end;


{ TAutoLock }

type
  /// used by TAutoLocker.ProtectMethod and TSynLocker.ProtectMethod
  TAutoLock = class(TInterfacedObject)
  protected
    fLock: PSynLocker;
  public
    constructor Create(aLock: PSynLocker);
    destructor Destroy; override;
  end;

constructor TAutoLock.Create(aLock: PSynLocker);
begin
  fLock := aLock;
  fLock^.Lock;
end;

destructor TAutoLock.Destroy;
begin
  fLock^.UnLock;
end;


{ TSynLocker }

const
  SYNLOCKER_VTYPENOCLEAR = [varEmpty..varDate,varBoolean,
    varShortInt..varWord64,varUnknown];

procedure TSynLocker.Init;
begin
  fSectionPadding := 0;
  PaddingUsedCount := 0;
  InitializeCriticalSection(fSection);
  fLocked := false;
  fInitialized := true;
end;

procedure TSynLocker.Done;
var i: PtrInt;
begin
  for i := 0 to PaddingUsedCount-1 do
    if not(integer(Padding[i].VType) in SYNLOCKER_VTYPENOCLEAR) then
      VarClear(variant(Padding[i]));
  DeleteCriticalSection(fSection);
  fInitialized := false;
end;

procedure TSynLocker.DoneAndFreeMem;
begin
  Done;
  FreeMem(@self);
end;

procedure TSynLocker.Lock;
begin
  EnterCriticalSection(fSection);
  fLocked := true;
end;

procedure TSynLocker.UnLock;
begin
  fLocked := false;
  LeaveCriticalSection(fSection);
end;

function TSynLocker.TryLock: boolean;
begin
  result := not fLocked and
    (TryEnterCriticalSection(fSection){$ifdef LINUX}{$ifdef FPC}<>0{$endif}{$endif});
end;

function TSynLocker.TryLockMS(retryms: integer): boolean;
begin
  repeat
    result := TryLock;
    if result or (retryms <= 0) then
      break;
    SleepHiRes(1);
    dec(retryms);
  until false;
end;

function TSynLocker.ProtectMethod: IUnknown;
begin
  result := TAutoLock.Create(@self);
end;

{$ifndef NOVARIANTS}

function TSynLocker.GetVariant(Index: integer): Variant;
begin
  if cardinal(Index)<cardinal(PaddingUsedCount) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      result := variant(Padding[Index]);
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    VarClear(result);
end;

procedure TSynLocker.SetVariant(Index: integer; const Value: Variant);
begin
  if cardinal(Index)<=high(Padding) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      if Index>=PaddingUsedCount then
        PaddingUsedCount := Index+1;
      variant(Padding[Index]) := Value;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end;
end;

function TSynLocker.GetInt64(Index: integer): Int64;
begin
  if cardinal(Index)<cardinal(PaddingUsedCount) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      if not VariantToInt64(variant(Padding[index]),result) then
        result := 0;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    result := 0;
end;

procedure TSynLocker.SetInt64(Index: integer; const Value: Int64);
begin
  SetVariant(Index,Value);
end;

function TSynLocker.GetBool(Index: integer): boolean;
begin
  if cardinal(Index)<cardinal(PaddingUsedCount) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      if not VariantToBoolean(variant(Padding[index]),result) then
        result := false;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    result := false;
end;

procedure TSynLocker.SetBool(Index: integer; const Value: boolean);
begin
  SetVariant(Index,Value);
end;

function TSynLocker.GetUnLockedInt64(Index: integer): Int64;
begin
  if (cardinal(Index)>=cardinal(PaddingUsedCount)) or
     not VariantToInt64(variant(Padding[index]),result) then
    result := 0;
end;

procedure TSynLocker.SetUnlockedInt64(Index: integer; const Value: Int64);
begin
  if cardinal(Index)<=high(Padding) then begin
    if Index>=PaddingUsedCount then
      PaddingUsedCount := Index+1;
    variant(Padding[Index]) := Value;
  end;
end;

function TSynLocker.GetPointer(Index: integer): Pointer;
begin
  if cardinal(Index)<cardinal(PaddingUsedCount) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      with Padding[index] do
        if VType=varUnknown then
          result := VUnknown else
          result := nil;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    result := nil;
end;

procedure TSynLocker.SetPointer(Index: integer; const Value: Pointer);
begin
  if cardinal(Index)<=high(Padding) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      if Index>=PaddingUsedCount then
        PaddingUsedCount := Index+1;
      with Padding[index] do begin
        if not(integer(VType) in SYNLOCKER_VTYPENOCLEAR) then
          VarClear(PVariant(@VType)^);
        VType := varUnknown;
        VUnknown := Value;
      end;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end;
end;

function TSynLocker.GetUTF8(Index: integer): RawUTF8;
var wasString: Boolean;
begin
  if cardinal(Index)<cardinal(PaddingUsedCount) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      VariantToUTF8(variant(Padding[Index]),result,wasString);
      if not wasString then
        result := '';
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    result := '';
end;

procedure TSynLocker.SetUTF8(Index: integer; const Value: RawUTF8);
begin
  if cardinal(Index)<=high(Padding) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      if Index>=PaddingUsedCount then
        PaddingUsedCount := Index+1;
      RawUTF8ToVariant(Value,Padding[Index],varString);
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end;
end;

function TSynLocker.LockedInt64Increment(Index: integer; const Increment: Int64): Int64;
begin
  if cardinal(Index)<=high(Padding) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      result := 0;
      if Index<PaddingUsedCount then
        VariantToInt64(variant(Padding[index]),result) else
        PaddingUsedCount := Index+1;
      variant(Padding[Index]) := Int64(result+Increment);
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    result := 0;
end;

function TSynLocker.LockedExchange(Index: integer; const Value: Variant): Variant;
begin
  if cardinal(Index)<=high(Padding) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      with Padding[index] do begin
        if Index<PaddingUsedCount then
          result := PVariant(@VType)^ else begin
          PaddingUsedCount := Index+1;
          VarClear(result);
        end;
        PVariant(@VType)^ := Value;
      end;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    VarClear(result);
end;

function TSynLocker.LockedPointerExchange(Index: integer; Value: pointer): pointer;
begin
  if cardinal(Index)<=high(Padding) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      with Padding[index] do begin
        if Index<PaddingUsedCount then
          if VType=varUnknown then
            result := VUnknown else begin
            VarClear(PVariant(@VType)^);
            result := nil;
          end else begin
          PaddingUsedCount := Index+1;
          result := nil;
        end;
        VType := varUnknown;
        VUnknown := Value;
      end;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    result := nil;
end;

{$endif NOVARIANTS}


{ TInterfacedObjectLocked }

constructor TInterfacedObjectLocked.Create;
begin
  inherited Create;
  fSafe := NewSynLocker;
end;

destructor TInterfacedObjectLocked.Destroy;
begin
  inherited Destroy;
  fSafe^.DoneAndFreeMem;
end;


{ TPersistentWithCustomCreate }

constructor TPersistentWithCustomCreate.Create;
begin // nothing to do by default - overridden constructor may add custom code
end;


{ TSynPersistent }

constructor TSynPersistent.Create;
begin // nothing to do by default - overridden constructor may add custom code
end;

procedure TSynPersistent.AssignError(Source: TSynPersistent);
var SourceName: string;
begin
  if Source <> nil then
    SourceName := Source.ClassName else
    SourceName := 'nil';
  raise EConvertError.CreateFmt('Cannot assign a %s to a %s', [SourceName, ClassName]);
end;

procedure TSynPersistent.AssignTo(Dest: TSynPersistent);
begin
  Dest.AssignError(Self);
end;

procedure TSynPersistent.Assign(Source: TSynPersistent);
begin
  if Source<>nil then
    Source.AssignTo(Self) else
    AssignError(nil);
end;

{$ifdef FPC_OR_PUREPASCAL}
class function TSynPersistent.NewInstance: TObject;
begin // bypass vmtIntfTable and vmt^.vInitTable (FPC management operators)
  {$ifdef FPC_X64MM}
  result := _AllocMem(InstanceSize);
  {$else}
  GetMem(pointer(result),InstanceSize); // InstanceSize is inlined
  FillCharFast(pointer(result)^,InstanceSize,0);
  {$endif}
  PPointer(result)^ := pointer(self); // store VMT
end; // no benefit of rewriting FreeInstance/CleanupInstance
{$else}
class function TSynPersistent.NewInstance: TObject;
asm
        push    eax  // class
        mov     eax, [eax].vmtInstanceSize
        push    eax  // size
        call    System.@GetMem
        pop     edx  // size
        push    eax  // self
        mov     cl, 0
        call    dword ptr[FillcharFast]
        pop     eax   // self
        pop     edx   // class
        mov     [eax], edx // store VMT
end; // TSynPersistent has no interface -> bypass vmtIntfTable

procedure TSynPersistent.FreeInstance;
asm
        push    ebx
        mov     ebx, eax
@loop:  mov     ebx, [ebx] // handle three VMT levels per iteration
        mov     edx, [ebx].vmtInitTable
        mov     ebx, [ebx].vmtParent
        test    edx, edx
        jnz     @clr
        test    ebx, ebx
        jz      @end
        mov     ebx, [ebx]
        mov     edx, [ebx].vmtInitTable
        mov     ebx, [ebx].vmtParent
        test    edx, edx
        jnz     @clr
        test    ebx, ebx
        jz      @end
        mov     ebx, [ebx]
        mov     edx, [ebx].vmtInitTable
        mov     ebx, [ebx].vmtParent
        test    edx, edx
        jnz     @clr
        test    ebx, ebx
        jnz     @loop
@end:   pop     ebx
        jmp     System.@FreeMem
        // TSynPersistent has no TMonitor -> bypass TMonitor.Destroy(self)
        // BTW, TMonitor.Destroy is private, so unreachable
@clr:   push    offset @loop // parent has never any vmtInitTable -> @loop
        jmp     RecordClear // eax=self edx=typeinfo
end;
{$endif FPC_OR_PUREPASCAL}


{ TSynPersistentLock }

constructor TSynPersistentLock.Create;
begin
  inherited Create;
  fSafe := NewSynLocker;
end;

destructor TSynPersistentLock.Destroy;
begin
  inherited Destroy;
  fSafe^.DoneAndFreeMem;
end;


{ TSynList }

function TSynList.Add(item: pointer): integer;
begin
  result := ObjArrayAddCount(fList,item,fCount);
end;

procedure TSynList.Clear;
begin
  fList := nil;
  fCount := 0;
end;

procedure TSynList.Delete(index: integer);
begin
  PtrArrayDelete(fList,index,@fCount);
  if (fCount>64) and (length(fList)>fCount*2) then
    SetLength(fList,fCount); // reduce capacity when half list is void
end;

function TSynList.Exists(item: pointer): boolean;
begin
  result := PtrUIntScanExists(pointer(fList),fCount,PtrUInt(item));
end;

function TSynList.Get(index: Integer): pointer;
begin
  if cardinal(index)<cardinal(fCount) then
    result := fList[index] else
    result := nil;
end;

function TSynList.IndexOf(item: pointer): integer;
begin
  result := PtrUIntScanIndex(pointer(fList),fCount,PtrUInt(item));
end;

function TSynList.Remove(item: Pointer): integer;
begin
  result := PtrUIntScanIndex(pointer(fList),fCount,PtrUInt(item));
  if result>=0 then
    Delete(result);
end;


{ TSynObjectList }

constructor TSynObjectList.Create(aOwnObjects: boolean);
begin
  fOwnObjects := aOwnObjects;
  inherited Create;
end;

procedure TSynObjectList.Delete(index: integer);
begin
  if cardinal(index)>=cardinal(fCount) then
    exit;
  if fOwnObjects then
    TObject(fList[index]).Free;
  inherited Delete(index);
end;

procedure TSynObjectList.Clear;
begin
  if fOwnObjects then
    RawObjectsClear(pointer(fList),fCount);
  inherited Clear;
end;

procedure TSynObjectList.ClearFromLast;
var i: PtrInt;
begin
  if fOwnObjects then
    for i := fCount-1 downto 0 do
      TObject(fList[i]).Free;
  inherited Clear;
end;

destructor TSynObjectList.Destroy;
begin
  Clear;
  inherited Destroy;
end;


{ TSynObjectListLocked }

constructor TSynObjectListLocked.Create(AOwnsObjects: Boolean);
begin
  inherited Create(AOwnsObjects);
  fSafe.Init;
end;

destructor TSynObjectListLocked.Destroy;
begin
  inherited Destroy;
  fSafe.Done;
end;

function TSynObjectListLocked.Add(item: pointer): integer;
begin
  Safe.Lock;
  try
    result := inherited Add(item);
  finally
    Safe.UnLock;
  end;
end;

function TSynObjectListLocked.Remove(item: pointer): integer;
begin
  Safe.Lock;
  try
    result := inherited Remove(item);
  finally
    Safe.UnLock;
  end;
end;

function TSynObjectListLocked.Exists(item: pointer): boolean;
begin
  Safe.Lock;
  try
    result := inherited Exists(item);
  finally
    Safe.UnLock;
  end;
end;

procedure TSynObjectListLocked.Clear;
begin
  Safe.Lock;
  try
    inherited Clear;
  finally
    Safe.UnLock;
  end;
end;

procedure TSynObjectListLocked.ClearFromLast;
begin
  Safe.Lock;
  try
    inherited ClearFromLast;
  finally
    Safe.UnLock;
  end;
end;


{ ****************** text buffer and JSON functions and classes ********* }

{ TTextWriter }

procedure TTextWriter.Add(c: AnsiChar);
begin
  if B>=BEnd then
    FlushToStream;
  inc(B);
  B^ := c;
end;

procedure TTextWriter.AddOnce(c: AnsiChar);
begin
  if (B>=fTempBuf) and (B^=c) then
    exit; // no duplicate
  if B>=BEnd then
    FlushToStream;
  inc(B);
  B^ := c;
end;

procedure TTextWriter.Add(c1, c2: AnsiChar);
begin
  if BEnd-B<=1 then
    FlushToStream;
  B[1] := c1;
  B[2] := c2;
  inc(B,2);
end;

procedure TTextWriter.CancelLastChar;
begin
  if B>=fTempBuf then // Add() methods append at B+1
    dec(B);
end;

function TTextWriter.LastChar: AnsiChar;
begin
  if B>=fTempBuf then
    result := B^ else
    result := #0;
end;

procedure TTextWriter.CancelLastChar(aCharToCancel: AnsiChar);
begin
  if (B>=fTempBuf) and (B^=aCharToCancel) then
    dec(B);
end;

function TTextWriter.PendingBytes: PtrUInt;
begin
  result := B-fTempBuf+1;
end;

procedure TTextWriter.CancelLastComma;
begin
  if (B>=fTempBuf) and (B^=',') then
    dec(B);
end;

procedure TTextWriter.Add(Value: PtrInt);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
    Len: PtrInt;
begin
  if BEnd-B<=24 then
    FlushToStream;
  if PtrUInt(Value)<=high(SmallUInt32UTF8) then begin
    P := pointer(SmallUInt32UTF8[Value]);
    Len := PStrLen(P-_STRLEN)^;
  end else begin
    P := StrInt32(@tmp[23],value);
    Len := @tmp[23]-P;
  end;
  MoveSmall(P,B+1,Len);
  inc(B,Len);
end;

{$ifndef CPU64} // Add(Value: PtrInt) already implemented it
procedure TTextWriter.Add(Value: Int64);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
    Len: integer;
begin
  if BEnd-B<=24 then
    FlushToStream;
  if Value<0 then begin
    P := StrUInt64(@tmp[23],-Value)-1;
    P^ := '-';
    Len := @tmp[23]-P;
  end else
  if Value<=high(SmallUInt32UTF8) then begin
    P := pointer(SmallUInt32UTF8[Value]);
    Len := PStrLen(P-_STRLEN)^;
  end else begin
    P := StrUInt64(@tmp[23],Value);
    Len := @tmp[23]-P;
  end;
  MoveSmall(P,B+1,Len);
  inc(B,Len);
end;
{$endif CPU64}

procedure TTextWriter.AddCurr64(const Value: Int64);
var tmp: array[0..31] of AnsiChar;
    P: PAnsiChar;
    Len: PtrInt;
begin
  if BEnd-B<=31 then
    FlushToStream;
  P := StrCurr64(@tmp[31],Value);
  Len := @tmp[31]-P;
  if Len>4 then
    if P[Len-1]='0' then
      if P[Len-2]='0' then
        if P[Len-3]='0' then
          if P[Len-4]='0' then
            dec(Len,5) else
            dec(Len,3) else
          dec(Len,2) else
        dec(Len);
  MoveSmall(P,B+1,Len);
  inc(B,Len);
end;

procedure TTextWriter.AddCurr64(const Value: currency);
begin
  AddCurr64(PInt64(@Value)^);
end;

procedure TTextWriter.AddTimeLog(Value: PInt64);
begin
  if BEnd-B<=31 then
    FlushToStream;
  inc(B,PTimeLogBits(Value)^.Text(B+1,true,'T'));
end;

procedure TTextWriter.AddUnixTime(Value: PInt64);
begin // inlined UnixTimeToDateTime()
  AddDateTime(Value^/SecsPerDay+UnixDateDelta);
end;

procedure TTextWriter.AddUnixMSTime(Value: PInt64; WithMS: boolean);
begin // inlined UnixMSTimeToDateTime()
  AddDateTime(Value^/MSecsPerDay+UnixDateDelta,WithMS);
end;

procedure TTextWriter.AddDateTime(Value: PDateTime; FirstChar: AnsiChar;
  QuoteChar: AnsiChar; WithMS: boolean);
begin
  if (Value^=0) and (QuoteChar=#0) then
    exit;
  if BEnd-B<=25 then
    FlushToStream;
  inc(B);
  if QuoteChar<>#0 then
    B^ := QuoteChar else
    dec(B);
  if Value^<>0 then begin
    inc(B);
    if trunc(Value^)<>0 then
      B := DateToIso8601PChar(Value^,B,true);
    if frac(Value^)<>0 then
      B := TimeToIso8601PChar(Value^,B,true,FirstChar,WithMS);
    dec(B);
  end;
  if QuoteChar<>#0 then begin
    inc(B);
    B^ := QuoteChar;
  end;
end;

procedure TTextWriter.AddDateTime(const Value: TDateTime; WithMS: boolean);
begin
  if Value=0 then
    exit;
  if BEnd-B<=23 then
    FlushToStream;
  inc(B);
  if trunc(Value)<>0 then
    B := DateToIso8601PChar(Value,B,true);
  if frac(Value)<>0 then
    B := TimeToIso8601PChar(Value,B,true,'T',WithMS);
  dec(B);
end;

procedure TTextWriter.AddDateTimeMS(const Value: TDateTime; Expanded: boolean;
  FirstTimeChar: AnsiChar; const TZD: RawUTF8);
var T: TSynSystemTime;
begin
  if Value=0 then
    exit;
  T.FromDateTime(Value);
  Add(DTMS_FMT[Expanded], [UInt4DigitsToShort(T.Year),
    UInt2DigitsToShortFast(T.Month),UInt2DigitsToShortFast(T.Day),FirstTimeChar,
    UInt2DigitsToShortFast(T.Hour),UInt2DigitsToShortFast(T.Minute),
    UInt2DigitsToShortFast(T.Second),UInt3DigitsToShort(T.MilliSecond),TZD]);
end;

procedure TTextWriter.AddU(Value: cardinal);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
    Len: PtrInt;
begin
  if BEnd-B<=24 then
    FlushToStream;
  if Value<=high(SmallUInt32UTF8) then begin
    P := pointer(SmallUInt32UTF8[Value]);
    Len := PStrLen(P-_STRLEN)^;
  end else begin
    P := StrUInt32(@tmp[23],Value);
    Len := @tmp[23]-P;
  end;
  MoveSmall(P,B+1,Len);
  inc(B,Len);
end;

procedure TTextWriter.AddQ(Value: QWord);
var tmp: array[0..23] of AnsiChar;
    V: Int64Rec absolute Value;
    P: PAnsiChar;
    Len: PtrInt;
begin
  if BEnd-B<=32 then
    FlushToStream;
  if (V.Hi=0) and (V.Lo<=high(SmallUInt32UTF8)) then begin
    P := pointer(SmallUInt32UTF8[V.Lo]);
    Len := PStrLen(P-_STRLEN)^;
  end else begin
    P := StrUInt64(@tmp[23],Value);
    Len := @tmp[23]-P;
  end;
  MoveSmall(P,B+1,Len);
  inc(B,Len);
end;

procedure TTextWriter.AddQHex(Value: QWord);
begin
  AddBinToHexDisplayQuoted(@Value,SizeOf(Value));
end;

procedure TTextWriter.Add(Value: Extended; precision: integer; noexp: boolean);
var tmp: ShortString;
begin
  AddShort(ExtendedToJSON(tmp,Value,precision,noexp)^);
end;

procedure TTextWriter.AddDouble(Value: double; noexp: boolean);
var tmp: ShortString;
begin
  AddShort(DoubleToJSON(tmp,Value,noexp)^);
end;

procedure TTextWriter.AddSingle(Value: single; noexp: boolean);
var tmp: ShortString;
begin
  AddShort(ExtendedToJSON(tmp,Value,SINGLE_PRECISION,noexp)^);
end;

procedure TTextWriter.Add(Value: boolean);
var PS: PShortString;
begin
  if Value then // normalize: boolean may not be in the expected [0,1] range
    PS := @BOOL_STR[true] else
    PS := @BOOL_STR[false];
  AddShort(PS^);
end;

procedure TTextWriter.AddFloatStr(P: PUTF8Char);
begin
  if StrLen(P)>127 then
    exit; // clearly invalid input
  if BEnd-B<=127 then
    FlushToStream;
  inc(B);
  if P<>nil then
    B := FloatStrCopy(P,B)-1 else
    B^ := '0';
end;

procedure TTextWriter.Add({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID);
begin
  if BEnd-B<=36 then
    FlushToStream;
  GUIDToText(B+1,@guid);
  inc(B,36);
end;

procedure TTextWriter.AddCR;
begin
  if BEnd-B<=1 then
    FlushToStream;
  PWord(B+1)^ := 13+10 shl 8; // CR + LF
  inc(B,2);
end;

procedure TTextWriter.AddCRAndIndent;
var ntabs: cardinal;
begin
  if B^=#9 then
    exit; // we most probably just added an indentation level
  ntabs := fHumanReadableLevel;
  if ntabs>=cardinal(fTempBufSize) then
    exit; // avoid buffer overflow
  if BEnd-B<=Integer(ntabs)+1 then
    FlushToStream;
  PWord(B+1)^ := 13+10 shl 8; // CR + LF
  FillCharFast(B[3],ntabs,9); // #9=tab
  inc(B,ntabs+2);
end;

procedure TTextWriter.AddChars(aChar: AnsiChar; aCount: integer);
var n: integer;
begin
  repeat
    n := BEnd-B;
    if aCount<n then
      n := aCount else
      FlushToStream; // loop to avoid buffer overflow
    FillCharFast(B[1],n,ord(aChar));
    inc(B,n);
    dec(aCount,n);
  until aCount<=0;
end;

procedure TTextWriter.Add2(Value: PtrUInt);
begin
  if BEnd-B<=3 then
    FlushToStream;
  if Value>99 then
    PCardinal(B+1)^ := $3030+ord(',')shl 16 else     // '00,' if overflow
    PCardinal(B+1)^ := TwoDigitLookupW[Value]+ord(',')shl 16;
  inc(B,3);
end;

procedure TTextWriter.Add4(Value: PtrUInt);
begin
  if BEnd-B<=5 then
    FlushToStream;
  if Value>9999 then
    PCardinal(B+1)^ := $30303030 else // '0000,' if overflow
    YearToPChar(Value,B+1);
  inc(B,5);
  B^ := ',';
end;

procedure TTextWriter.AddCurrentLogTime(LocalTime: boolean);
var time: TSynSystemTime;
begin
  FromGlobalTime(LocalTime,time);
  time.AddLogTime(self);
end;

procedure TTextWriter.AddCurrentNCSALogTime(LocalTime: boolean);
var time: TSynSystemTime;
begin
  FromGlobalTime(LocalTime,time);
  if BEnd-B<=21 then
    FlushToStream;
  inc(B,time.ToNCSAText(B+1));
end;

function Value3Digits(V: PtrUInt; P: PUTF8Char; W: PWordArray): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}
begin
  result := V div 100;
  PWord(P+1)^ := W[V-result*100];
  V := result;
  result := result div 10;
  P^ := AnsiChar(V-result*10+48);
end;

procedure TTextWriter.AddMicroSec(MS: cardinal);
var W: PWordArray;
begin // in 00.000.000 TSynLog format
  if BEnd-B<=17 then
    FlushToStream;
  B[3] := '.';
  B[7] := '.';
  inc(B);
  W := @TwoDigitLookupW;
  MS := Value3Digits(Value3Digits(MS,B+7,W),B+3,W);
  if MS>99 then
    MS := 99;
  PWord(B)^:= W[MS];
  inc(B,9);
end;

procedure TTextWriter.Add3(Value: PtrUInt);
var V: PtrUInt;
begin
  if BEnd-B<=4 then
    FlushToStream;
  if Value>999 then
    PCardinal(B+1)^ := $303030 else  begin// '0000,' if overflow
    V := Value div 10;
    PCardinal(B+1)^ := TwoDigitLookupW[V]+(Value-V*10+48)shl 16;
  end;
  inc(B,4);
  B^ := ',';
end;

procedure TTextWriter.AddCSVInteger(const Integers: array of Integer);
var i: PtrInt;
begin
  if length(Integers)=0 then
    exit;
  for i := 0 to high(Integers) do begin
    Add(Integers[i]);
    Add(',');
  end;
  CancelLastComma;
end;

procedure TTextWriter.AddCSVDouble(const Doubles: array of double);
var i: PtrInt;
begin
  if length(Doubles)=0 then
    exit;
  for i := 0 to high(Doubles) do begin
    AddDouble(Doubles[i]);
    Add(',');
  end;
  CancelLastComma;
end;

procedure TTextWriter.AddCSVUTF8(const Values: array of RawUTF8);
var i: PtrInt;
begin
  if length(Values)=0 then
    exit;
  for i := 0 to high(Values) do begin
    Add('"');
    AddJSONEscape(pointer(Values[i]));
    Add('"',',');
  end;
  CancelLastComma;
end;

procedure TTextWriter.AddCSVConst(const Values: array of const);
var i: PtrInt;
begin
  if length(Values)=0 then
    exit;
  for i := 0 to high(Values) do begin
    AddJSONEscape(Values[i]);
    Add(',');
  end;
  CancelLastComma;
end;

procedure TTextWriter.Add(const Values: array of const);
var i: PtrInt;
begin
  for i := 0 to high(Values) do
    AddJSONEscape(Values[i]);
end;

procedure TTextWriter.WriteObject(Value: TObject; Options: TTextWriterWriteObjectOptions);
var i: PtrInt;
begin
  if Value<>nil then
    if Value.InheritsFrom(Exception) then
      Add('{"%":"%"}',[Value.ClassType,Exception(Value).Message]) else
    if Value.InheritsFrom(TRawUTF8List) then
    with TRawUTF8List(Value) do begin
      self.Add('[');
      for i := 0 to fCount-1 do begin
        self.Add('"');
        self.AddJSONEscape(pointer(fValue[i]));
        self.Add('"',',');
      end;
      self.CancelLastComma;
      self.Add(']');
      exit;
    end else
    if Value.InheritsFrom(TStrings) then
    with TStrings(Value) do begin
      self.Add('[');
      for i := 0 to Count-1 do begin
        self.Add('"');
        {$ifdef UNICODE}
        self.AddJSONEscapeW(pointer(Strings[i]),Length(Strings[i]));
        {$else}
        self.AddJSONEscapeAnsiString(Strings[i]);
        {$endif}
        self.Add('"',',');
      end;
      self.CancelLastComma;
      self.Add(']');
      exit;
    end else
    if not(woFullExpand in Options) or
       not(Value.InheritsFrom(TList)
       {$ifndef LVCL} or Value.InheritsFrom(TCollection){$endif}) then
      Value := nil;
  if Value=nil then begin
    AddShort('null');
    exit;
  end;
  Add('{');
  AddInstanceName(Value,':');
  Add('[');
  if Value.InheritsFrom(TList) then
    for i := 0 to TList(Value).Count-1 do
      AddInstanceName(TList(Value).List[i],',')
  {$ifndef LVCL} else
  if Value.InheritsFrom(TCollection) then
    for i := 0 to TCollection(Value).Count-1 do
      AddInstanceName(TCollection(Value).Items[i],',') {$endif} ;
  CancelLastComma;
  Add(']','}');
end;

function TTextWriter.InternalJSONWriter: TTextWriter;
begin
  if fInternalJSONWriter=nil then
    fInternalJSONWriter := DefaultTextWriterSerializer.CreateOwnedStream else
    fInternalJSONWriter.CancelAll;
  result := fInternalJSONWriter;
end;

procedure TTextWriter.AddJSONEscape(Source: TTextWriter);
begin
  if Source.fTotalFileSize=0 then
    AddJSONEscape(Source.fTempBuf,Source.B-Source.fTempBuf+1) else
    AddJSONEscape(Pointer(Source.Text));
end;

procedure TTextWriter.AddNoJSONEscape(Source: TTextWriter);
begin
  if Source.fTotalFileSize=0 then
    AddNoJSONEscape(Source.fTempBuf,Source.B-Source.fTempBuf+1) else
    AddNoJSONEscapeUTF8(Source.Text);
end;

procedure TTextWriter.AddRawJSON(const json: RawJSON);
begin
  if json='' then
    AddShort('null') else
    AddNoJSONEscape(pointer(json),length(json));
end;

procedure TTextWriter.WriteObjectAsString(Value: TObject;
  Options: TTextWriterWriteObjectOptions);
begin
  Add('"');
  InternalJSONWriter.WriteObject(Value,Options);
  AddJSONEscape(fInternalJSONWriter);
  Add('"');
end;

class procedure TTextWriter.RegisterCustomJSONSerializer(aTypeInfo: pointer;
  aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
begin
  GlobalJSONCustomParsers.RegisterCallbacks(aTypeInfo,aReader,aWriter);
end;

class procedure TTextWriter.UnRegisterCustomJSONSerializer(aTypeInfo: pointer);
begin
  GlobalJSONCustomParsers.RegisterCallbacks(aTypeInfo,nil,nil);
end;

class function TTextWriter.GetCustomJSONParser(var DynArray: TDynArray;
  out CustomReader: TDynArrayJSONCustomReader;
  out CustomWriter: TDynArrayJSONCustomWriter): boolean;
begin
  result := DynArray.HasCustomJSONParser; // use var above since may set fParser
  if result then
    with GlobalJSONCustomParsers.fParser[DynArray.fParser] do begin
      CustomReader := Reader;
      CustomWriter := Writer;
    end;
end;

{$ifndef NOVARIANTS}
class procedure TTextWriter.RegisterCustomJSONSerializerForVariant(
  aClass: TCustomVariantType; aReader: TDynArrayJSONCustomReader;
  aWriter: TDynArrayJSONCustomWriter);
begin // here we register TCustomVariantTypeClass info instead of TypeInfo()
  GlobalJSONCustomParsers.RegisterCallbacksVariant(aClass,aReader,aWriter);
end;

class procedure TTextWriter.RegisterCustomJSONSerializerForVariantByType(aVarType: TVarType;
  aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
var aClass: TCustomVariantType;
begin
  if FindCustomVariantType(aVarType,aClass) then
    RegisterCustomJSONSerializerForVariant(aClass,aReader,aWriter);
end;
{$endif NOVARIANTS}

class function TTextWriter.RegisterCustomJSONSerializerFromText(aTypeInfo: pointer;
  const aRTTIDefinition: RawUTF8): TJSONRecordAbstract;
begin
  result := GlobalJSONCustomParsers.RegisterFromText(aTypeInfo,aRTTIDefinition);
end;

class procedure TTextWriter.RegisterCustomJSONSerializerFromText(
  const aTypeInfoTextDefinitionPairs: array of const);
var n,i: integer;
    def: RawUTF8;
begin
  n := length(aTypeInfoTextDefinitionPairs);
  if (n=0) or (n and 1=1) then
    exit;
  n := n shr 1;
  if n=0 then
    exit;
  for i := 0 to n-1 do
    if (aTypeInfoTextDefinitionPairs[i*2].VType<>vtPointer) or
       not VarRecToUTF8IsString(aTypeInfoTextDefinitionPairs[i*2+1],def) then
      raise ESynException.Create('RegisterCustomJSONSerializerFromText[?]') else
      GlobalJSONCustomParsers.RegisterFromText(
        aTypeInfoTextDefinitionPairs[i*2].VPointer,def);
end;

class function TTextWriter.RegisterCustomJSONSerializerSetOptions(aTypeInfo: pointer;
  aOptions: TJSONCustomParserSerializationOptions; aAddIfNotExisting: boolean): boolean;
var ndx: integer;
begin
  result := false;
  if aTypeInfo=nil then
    exit;
  case PTypeKind(aTypeInfo)^ of
  tkRecord{$ifdef FPC},tkObject{$endif}:
    ndx := GlobalJSONCustomParsers.RecordSearch(aTypeInfo,aAddIfNotExisting);
  tkDynArray:
    ndx := GlobalJSONCustomParsers.DynArraySearch(aTypeInfo,nil,aAddIfNotExisting);
  else
    exit;
  end;
  if (ndx>=0) and
     (GlobalJSONCustomParsers.fParser[ndx].RecordCustomParser<>nil) then begin
    GlobalJSONCustomParsers.fParser[ndx].RecordCustomParser.Options := aOptions;
    result := true;
  end;
end;

class function TTextWriter.RegisterCustomJSONSerializerSetOptions(
  const aTypeInfo: array of pointer; aOptions: TJSONCustomParserSerializationOptions;
  aAddIfNotExisting: boolean): boolean;
var i: integer;
begin
  result := true;
  for i := 0 to high(aTypeInfo) do
    if not RegisterCustomJSONSerializerSetOptions(aTypeInfo[i],aOptions,aAddIfNotExisting) then
      result := false;
end;

class function TTextWriter.RegisterCustomJSONSerializerFindParser(
  aTypeInfo: pointer; aAddIfNotExisting: boolean): TJSONRecordAbstract;
var ndx: integer;
begin
  result := nil;
  if aTypeInfo=nil then
    exit;
  case PTypeKind(aTypeInfo)^ of
  tkRecord{$ifdef FPC},tkObject{$endif}:
    ndx := GlobalJSONCustomParsers.RecordSearch(aTypeInfo,aAddIfNotExisting);
  tkDynArray:
    ndx := GlobalJSONCustomParsers.DynArraySearch(aTypeInfo,nil,aAddIfNotExisting);
  else
    exit;
  end;
  if ndx>=0 then
    result := GlobalJSONCustomParsers.fParser[ndx].RecordCustomParser;
end;

class procedure TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(
  aTypeInfo: pointer; const aTypeName: RawUTF8);
begin
  JSONSerializerFromTextSimpleTypeAdd(aTypeName,aTypeInfo,0,0);
end;

class procedure TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(
  const aTypeInfos: array of pointer);
var i: integer;
begin
  for i := 0 to high(aTypeInfos) do
    RegisterCustomJSONSerializerFromTextSimpleType(aTypeInfos[i],'');
end;

class procedure TTextWriter.RegisterCustomJSONSerializerFromTextBinaryType(
  aTypeInfo: pointer; aDataSize, aFieldSize: integer);
begin
  JSONSerializerFromTextSimpleTypeAdd('',aTypeInfo,aDataSize,aFieldSize);
end;

class procedure TTextWriter.RegisterCustomJSONSerializerFromTextBinaryType(
  const aTypeInfoDataFieldSize: array of const);
var n,i: integer;
    s1,s2: Int64;
begin
  n := length(aTypeInfoDataFieldSize);
  if n mod 3=0 then
    for i := 0 to (n div 3)-1 do
    if (aTypeInfoDataFieldSize[i*3].VType<>vtPointer) or
       not VarRecToInt64(aTypeInfoDataFieldSize[i*3+1],s1) or
       not VarRecToInt64(aTypeInfoDataFieldSize[i*3+2],s2) then
      raise ESynException.CreateUTF8('RegisterCustomJSONSerializerFromTextBinaryType[%]',[i]) else
      JSONSerializerFromTextSimpleTypeAdd('',aTypeInfoDataFieldSize[i*3].VPointer,s1,s2);
end;

procedure TTextWriter.AddRecordJSON(const Rec; TypeInfo: pointer);
var customWriter: TDynArrayJSONCustomWriter;
begin
  if (self=nil) or (@Rec=nil) or (TypeInfo=nil) or
     not(PTypeKind(TypeInfo)^ in tkRecordTypes) then
    raise ESynException.CreateUTF8('Invalid %.AddRecordJSON(%)',[self,TypeInfo]);
  if GlobalJSONCustomParsers.RecordSearch(TypeInfo,customWriter,nil) then
    customWriter(self,Rec) else
    WrRecord(Rec,TypeInfo);
end;

procedure TTextWriter.AddVoidRecordJSON(TypeInfo: pointer);
var tmp: TBytes;
    info: PTypeInfo;
begin
  info := GetTypeInfo(TypeInfo,tkRecordKinds);
  if (self=nil) or (info=nil) then
    raise ESynException.CreateUTF8('Invalid %.AddVoidRecordJSON(%)',[self,TypeInfo]);
  SetLength(tmp,info^.recSize {$ifdef FPC}and $7FFFFFFF{$endif});
  AddRecordJSON(tmp[0],TypeInfo);
end;

{$ifndef NOVARIANTS}
procedure TTextWriter.AddVariant(const Value: variant; Escape: TTextWriterKind);
var CustomVariantType: TCustomVariantType;
    vt: cardinal;
begin
  vt := TVarData(Value).VType;
  with TVarData(Value) do
  case vt of
  varEmpty,
  varNull:     AddShort('null');
  varSmallint: Add(VSmallint);
  varShortInt: Add(VShortInt);
  varByte:     AddU(VByte);
  varWord:     AddU(VWord);
  varLongWord: AddU(VLongWord);
  varInteger:  Add(VInteger);
  varInt64:    Add(VInt64);
  varWord64:   AddQ(VInt64);
  varSingle:   AddSingle(VSingle);
  varDouble:   AddDouble(VDouble);
  varDate:     AddDateTime(@VDate,'T','"');
  varCurrency: AddCurr64(VInt64);
  varBoolean:  Add(VBoolean); // 'true'/'false'
  varVariant:  AddVariant(PVariant(VPointer)^,Escape);
  varString: begin
    if Escape=twJSONEscape then
      Add('"');
    {$ifdef HASCODEPAGE}
    AddAnyAnsiString(RawByteString(VString),Escape);
    {$else}  // VString is expected to be a RawUTF8
    Add(VString,length(RawUTF8(VString)),Escape);
    {$endif}
    if Escape=twJSONEscape then
      Add('"');
  end;
  varOleStr {$ifdef HASVARUSTRING}, varUString{$endif}: begin
    if Escape=twJSONEscape then
      Add('"');
    AddW(VAny,0,Escape);
    if Escape=twJSONEscape then
      Add('"');
  end;
  else
  if vt=varVariant or varByRef then
    AddVariant(PVariant(VPointer)^,Escape) else
  if vt=varByRef or varString then begin
    if Escape=twJSONEscape then
      Add('"');
    {$ifdef HASCODEPAGE}
    AddAnyAnsiString(PRawByteString(VAny)^,Escape);
    {$else}  // VString is expected to be a RawUTF8
    Add(PPointer(VAny)^,length(PRawUTF8(VAny)^),Escape);
    {$endif}
    if Escape=twJSONEscape then
      Add('"');
  end else
  if {$ifdef HASVARUSTRING}(vt=varByRef or varUString) or {$endif}
     (vt=varByRef or varOleStr) then begin
    if Escape=twJSONEscape then
      Add('"');
    AddW(PPointer(VAny)^,0,Escape);
    if Escape=twJSONEscape then
      Add('"');
  end else
  if FindCustomVariantType(vt,CustomVariantType) then
    if CustomVariantType.InheritsFrom(TSynInvokeableVariantType) then
      TSynInvokeableVariantType(CustomVariantType).ToJson(self,Value,Escape) else
      GlobalJSONCustomParsers.VariantWrite(CustomVariantType,self,Value,Escape) else
    raise ESynException.CreateUTF8('%.AddVariant VType=%',[self,vt]);
  end;
end;
{$endif NOVARIANTS}

procedure TTextWriter.AddDynArrayJSON(var aDynArray: TDynArrayHashed);
begin
  AddDynArrayJson(PDynArray(@aDynArray)^);
end;

procedure TTextWriter.AddDynArrayJSON(aTypeInfo: pointer; const aValue);
var DynArray: TDynArray;
begin
  DynArray.Init(aTypeInfo,pointer(@aValue)^);
  AddDynArrayJSON(DynArray);
end;

procedure TTextWriter.AddDynArrayJSONAsString(aTypeInfo: pointer; var aValue);
begin
  Add('"');
  InternalJSONWriter.AddDynArrayJSON(aTypeInfo,aValue);
  AddJSONEscape(fInternalJSONWriter);
  Add('"');
end;

procedure TTextWriter.AddObjArrayJSON(const aObjArray; aOptions: TTextWriterWriteObjectOptions);
var i: integer;
    a: TObjectDynArray absolute aObjArray;
begin
  Add('[');
  for i := 0 to length(a)-1 do begin
    WriteObject(a[i],aOptions);
    Add(',');
  end;
  CancelLastComma;
  Add(']');
end;

procedure TTextWriter.AddTypedJSON(aTypeInfo: pointer; const aValue);
var max, i: Integer;
    PS: PShortString;
    customWriter: TDynArrayJSONCustomWriter;
    DynArray: TDynArray;
  procedure AddPS; overload;
  begin
    Add('"');
    if twoTrimLeftEnumSets in fCustomOptions then
      AddTrimLeftLowerCase(PS) else
      AddShort(PS^);
    Add('"');
  end;
  procedure AddPS(bool: boolean); overload;
  begin
    AddPS;
    Add(':');
    Add(bool);
  end;
begin
  case PTypeKind(aTypeInfo)^ of
    tkClass:
      WriteObject(TObject(aValue),[woFullExpand]);
    tkEnumeration:
      if twoEnumSetsAsBooleanInRecord in fCustomOptions then begin
        PS := GetEnumName(aTypeInfo,byte(aValue));
        AddPS(true);
      end else
      if twoEnumSetsAsTextInRecord in fCustomOptions then begin
        PS := GetEnumName(aTypeInfo,byte(aValue));
        AddPS;
      end else
        AddU(byte(aValue));
    tkSet:
      if GetSetInfo(aTypeInfo,max,PS) then
        if twoEnumSetsAsBooleanInRecord in fCustomOptions then begin
          Add('{');
          for i := 0 to max do begin
            AddPS(GetBitPtr(@aValue,i));
            Add(',');
            inc(PByte(PS),PByte(PS)^+1); // next
          end;
          CancelLastComma;
          Add('}');
        end else
        if twoEnumSetsAsTextInRecord in fCustomOptions then begin
          Add('[');
          if (twoFullSetsAsStar in fCustomOptions) and
             GetAllBits(cardinal(aValue),max+1) then
            AddShort('"*"') else begin
            for i := 0 to max do begin
              if GetBitPtr(@aValue,i) then begin
                AddPS;
                Add(',');
              end;
              inc(PByte(PS),PByte(PS)^+1); // next
            end;
            CancelLastComma;
          end;
          Add(']');
        end else
        if max<8 then
          AddU(byte(aValue)) else
        if max<16 then
          AddU(word(aValue)) else
        if max<32 then
          AddU(cardinal(aValue)) else
          Add(Int64(aValue))
      else AddShort('null');
    tkRecord{$ifdef FPC},tkObject{$endif}: // inlined AddRecordJSON()
      if GlobalJSONCustomParsers.RecordSearch(aTypeInfo,customWriter,nil) then
        customWriter(self,aValue) else
        WrRecord(aValue,aTypeInfo);
    tkDynArray: begin
      DynArray.Init(aTypeInfo,(@aValue)^);
      AddDynArrayJSON(DynArray);
    end;
{$ifndef NOVARIANTS}
    tkVariant:
      AddVariant(variant(aValue),twJSONEscape);
{$endif}
    else
      AddShort('null');
  end;
end;

function TTextWriter.AddJSONReformat(JSON: PUTF8Char;
  Format: TTextWriterJSONFormat; EndOfObject: PUTF8Char): PUTF8Char;
var objEnd: AnsiChar;
    Name,Value: PUTF8Char;
    NameLen,ValueLen: integer;
begin
  result := nil;
  if JSON=nil then
    exit;
  while (JSON^<=' ') and (JSON^<>#0) do inc(JSON);
  case JSON^ of
  '[': begin // array
    repeat inc(JSON) until (JSON^=#0) or (JSON^>' ');
    if JSON^=']' then begin
      Add('[');
      inc(JSON);
    end else begin
      if not (Format in [jsonCompact,jsonUnquotedPropNameCompact]) then
        AddCRAndIndent;
      inc(fHumanReadableLevel);
      Add('[');
      repeat
        if JSON=nil then
          exit;
        if not (Format in [jsonCompact,jsonUnquotedPropNameCompact]) then
          AddCRAndIndent;
        JSON := AddJSONReformat(JSON,Format,@objEnd);
        if objEnd=']' then
          break;
        Add(objEnd);
      until false;
      dec(fHumanReadableLevel);
      if not (Format in [jsonCompact,jsonUnquotedPropNameCompact]) then
        AddCRAndIndent;
    end;
    Add(']');
  end;
  '{': begin // object
    repeat inc(JSON) until (JSON^=#0) or (JSON^>' ');
    Add('{');
    inc(fHumanReadableLevel);
    if not (Format in [jsonCompact,jsonUnquotedPropNameCompact]) then
      AddCRAndIndent;
    if JSON^='}' then
      repeat inc(JSON) until (JSON^=#0) or (JSON^>' ') else
    repeat
      Name := GetJSONPropName(JSON,@NameLen);
      if Name=nil then
        exit;
      if (Format in [jsonUnquotedPropName,jsonUnquotedPropNameCompact]) and
         JsonPropNameValid(Name) then
        AddNoJSONEscape(Name,NameLen) else begin
        Add('"');
        AddJSONEscape(Name);
        Add('"');
      end;
      if Format in [jsonCompact,jsonUnquotedPropNameCompact] then
        Add(':') else
        Add(':',' ');
      while (JSON^<=' ') and (JSON^<>#0) do inc(JSON);
      JSON := AddJSONReformat(JSON,Format,@objEnd);
      if objEnd='}' then
        break;
      Add(objEnd);
      if not (Format in [jsonCompact,jsonUnquotedPropNameCompact]) then
        AddCRAndIndent;
    until false;
    dec(fHumanReadableLevel);
      if not (Format in [jsonCompact,jsonUnquotedPropNameCompact]) then
      AddCRAndIndent;
    Add('}');
  end;
  '"': begin // string
    Value := JSON;
    JSON := GotoEndOfJSONString(JSON);
    if JSON^<>'"' then
      exit;
    inc(JSON);
    AddNoJSONEscape(Value,JSON-Value);
  end;
  else begin // numeric or true/false/null
    Value := GetJSONField(JSON,result,nil,EndOfObject,@ValueLen); // let wasString=nil
    if Value=nil then
      AddShort('null') else begin
      while (ValueLen>0) and (Value[ValueLen-1]<=' ') do dec(ValueLen);
      AddNoJSONEscape(Value,ValueLen);
    end;
    exit;
  end;
  end;
  if JSON<>nil then begin
    while (JSON^<=' ') and (JSON^<>#0) do inc(JSON);
    if EndOfObject<>nil then
      EndOfObject^ := JSON^;
    if JSON^<>#0 then
      repeat inc(JSON) until (JSON^=#0) or (JSON^>' ');
  end;
  result := JSON;
end;

function TTextWriter.AddJSONToXML(JSON: PUTF8Char; ArrayName,EndOfObject: PUTF8Char): PUTF8Char;
var objEnd: AnsiChar;
    Name,Value: PUTF8Char;
    n,c: integer;
begin
  result := nil;
  if JSON=nil then
    exit;
  while (JSON^<=' ') and (JSON^<>#0) do inc(JSON);
  case JSON^ of
  '[': begin
    repeat inc(JSON) until (JSON^=#0) or (JSON^>' ');
    if JSON^=']' then
      JSON := GotoNextNotSpace(JSON+1) else begin
      n := 0;
      repeat
        if JSON=nil then
          exit;
        Add('<');
        if ArrayName=nil then
          Add(n) else
          AddXmlEscape(ArrayName);
        Add('>');
        JSON := AddJSONToXML(JSON,nil,@objEnd);
        Add('<','/');
        if ArrayName=nil then
          Add(n) else
          AddXmlEscape(ArrayName);
        Add('>');
        inc(n);
      until objEnd=']';
    end;
  end;
  '{': begin
    repeat inc(JSON) until (JSON^=#0) or (JSON^>' ');
    if JSON^='}' then
      repeat inc(JSON) until (JSON^=#0) or (JSON^>' ') else begin
      repeat
        Name := GetJSONPropName(JSON);
        if Name=nil then
          exit;
        while (JSON^<=' ') and (JSON^<>#0) do inc(JSON);
        if JSON^='[' then // arrays are written as list of items, without root
          JSON := AddJSONToXML(JSON,Name,@objEnd) else begin
          Add('<');
          AddXmlEscape(Name);
          Add('>');
          JSON := AddJSONToXML(JSON,Name,@objEnd);
          Add('<','/');
          AddXmlEscape(Name);
          Add('>');
        end;
      until objEnd='}';
    end;
  end;
  else begin
    Value := GetJSONField(JSON,result,nil,EndOfObject); // let wasString=nil
    if Value=nil then
      AddShort('null') else begin
      c := PInteger(Value)^ and $ffffff;
      if (c=JSON_BASE64_MAGIC) or (c=JSON_SQLDATE_MAGIC) then
        inc(Value,3); // just ignore the Magic codepoint encoded as UTF-8
      AddXmlEscape(Value);
    end;
    exit;
  end;
  end;
  if JSON<>nil then begin
    while (JSON^<=' ') and (JSON^<>#0) do inc(JSON);
    if EndOfObject<>nil then
      EndOfObject^ := JSON^;
    if JSON^<>#0 then
      repeat inc(JSON) until (JSON^=#0) or (JSON^>' ');
  end;
  result := JSON;
end;

procedure TTextWriter.AddDynArrayJSON(var aDynArray: TDynArray);
var i,n: PtrInt;
    P: Pointer;
    T: TDynArrayKind;
    tmp: RawByteString;
    customWriter: TDynArrayJSONCustomWriter;
    customParser: TJSONRecordAbstract;
    nested: TDynArray;
    hr: boolean;
begin // code below must match TDynArray.LoadFromJSON
  n := aDynArray.Count-1;
  if n<0 then begin
    Add('[',']');
    exit;
  end;
  if aDynArray.HasCustomJSONParser then
    with GlobalJSONCustomParsers.fParser[aDynArray.fParser] do begin
      customWriter := Writer;
      customParser := RecordCustomParser;
    end else begin
      customWriter := nil;
      customParser := nil;
    end;
  if Assigned(customWriter) then
    T := djCustom else
    T := aDynArray.GuessKnownType({exacttype=}true);
  P := aDynArray.fValue^;
  Add('[');
  case T of
  djNone:
    if (aDynArray.ElemType<>nil) and
       (PTypeKind(aDynArray.ElemType)^=tkDynArray) then begin
      for i := 0 to n do begin
        nested.Init(aDynArray.ElemType,P^);
        AddDynArrayJSON(nested);
        Add(',');
        inc(PByte(P),aDynArray.ElemSize);
      end;
    end else begin
      tmp := aDynArray.SaveTo;
      WrBase64(pointer(tmp),length(tmp),{withMagic=}true);
    end;
  djCustom: begin
      if customParser=nil then
        hr := false else
        hr := soWriteHumanReadable in customParser.Options;
      if hr then
        Inc(fHumanReadableLevel);
      for i := 0 to n do begin
        customWriter(self,P^);
        Add(',');
        inc(PByte(P),aDynArray.ElemSize);
      end;
      if hr then begin
        dec(fHumanReadableLevel);
        CancelLastComma;
        AddCRAndIndent;
      end;
    end;
  {$ifndef NOVARIANTS}
  djVariant:
    for i := 0 to n do begin
      AddVariant(PVariantArray(P)^[i],twJSONEscape);
      Add(',');
    end;
  {$endif}
  djRawUTF8:
    for i := 0 to n do begin
      Add('"');
      AddJSONEscape(PPointerArray(P)^[i]);
      Add('"',',');
    end;
  djRawByteString:
    for i := 0 to n do begin
      WrBase64(PPointerArray(P)^[i],Length(PRawByteStringArray(P)^[i]),{withMagic=}true);
      Add(',');
    end;
  djInteger:
    for i := 0 to n do begin
      Add(PIntegerArray(P)^[i]);
      Add(',');
    end;
  djInt64:
    for i := 0 to n do begin
      Add(PInt64Array(P)^[i]);
      Add(',');
    end;
  djQWord:
  for i := 0 to n do begin
    AddQ(PQwordArray(P)^[i]);
    Add(',');
  end;
  else // slightly less efficient for less-used types
    if T in DJ_STRING then
      for i := 0 to n do begin
        Add('"');
        case T of
        djTimeLog:    AddTimeLog(@PInt64Array(P)^[i]);
        djDateTime:   AddDateTime(@PDoubleArray(P)^[i],'T',#0,false);
        djDateTimeMS: AddDateTime(@PDoubleArray(P)^[i],'T',#0,true);
        djWideString, djSynUnicode: AddJSONEscapeW(PPointerArray(P)^[i]);
        djWinAnsi: AddAnyAnsiString(PRawByteStringArray(P)^[i],twJSONEscape,CODEPAGE_US);
        djString:
          {$ifdef UNICODE}
          AddJSONEscapeW(PPointerArray(P)^[i]);
          {$else}
          AddAnyAnsiString(PRawByteStringArray(P)^[i],twJSONEscape,0);
          {$endif}
        djHash128: AddBinToHexDisplayLower(@PHash128Array(P)[i],SizeOf(THash128));
        djHash256: AddBinToHexDisplayLower(@PHash256Array(P)[i],SizeOf(THash256));
        djHash512: AddBinToHexDisplayLower(@PHash512Array(P)[i],SizeOf(THash512));
        djInterface: AddPointer(PPtrIntArray(P)^[i]);
        else raise ESynException.CreateUTF8('AddDynArrayJSON unsupported %',[ToText(T)^]);
        end;
        Add('"',',');
      end else
    for i := 0 to n do begin
      case T of
      djBoolean:  Add(PBooleanArray(P)^[i]);
      djByte:     AddU(PByteArray(P)^[i]);
      djWord:     AddU(PWordArray(P)^[i]);
      djCardinal: AddU(PCardinalArray(P)^[i]);
      djSingle:   AddSingle(PSingleArray(P)^[i]);
      djDouble:   AddDouble(PDoubleArray(P)^[i]);
      djCurrency: AddCurr64(PInt64Array(P)^[i]);
      else raise ESynException.CreateUTF8('AddDynArrayJSON unsupported %',[ToText(T)^]);
      end;
      Add(',');
    end;
    end;
  CancelLastComma;
  Add(']');
end;

procedure TTextWriter.Add(const Format: RawUTF8; const Values: array of const;
  Escape: TTextWriterKind; WriteObjectOptions: TTextWriterWriteObjectOptions);
var ValuesIndex: integer;
    F: PUTF8Char;
label write;
begin // we put const char > #127 as #??? -> asiatic MBCS codepage OK
  if Format='' then
    exit;
  if (Format='%') and (high(Values)>=0) then begin
    Add(Values[0],Escape);
    exit;
  end;
  ValuesIndex := 0;
  F := pointer(Format);
  repeat
    repeat
      case ord(F^) of
      0: exit;
      ord('%'): break;
      {$ifdef OLDTEXTWRITERFORMAT}
      164: AddCR; // currency sign -> add CR,LF
      167: if B^=',' then dec(B); // section sign to ignore next comma
      ord('|'): begin
        inc(F); // |% -> %
        goto write;
      end;
      ord('$'),163,181: // dollar, pound, micro sign
        break; // process command value
      {$endif}
      else begin
write:  if B>=BEnd then
          FlushToStream;
        B[1] := F^;
        inc(B);
      end;
      end;
      inc(F);
    until false;
    // add next value as text
    if ValuesIndex<=high(Values) then // missing value will display nothing
    case ord(F^) of
    ord('%'):
      Add(Values[ValuesIndex],Escape,WriteObjectOptions);
    {$ifdef OLDTEXTWRITERFORMAT}
    ord('$'): with Values[ValuesIndex] do
           if Vtype=vtInteger then Add2(VInteger);
    163: with Values[ValuesIndex] do // pound sign
           if Vtype=vtInteger then Add4(VInteger);
    181: with Values[ValuesIndex] do // micro sign
           if Vtype=vtInteger then Add3(VInteger);
    {$endif}
    end;
    inc(F);
    inc(ValuesIndex);
  until false;
end;

procedure TTextWriter.AddLine(const Text: shortstring);
var L: PtrInt;
begin
  L := ord(Text[0]);
  if BEnd-B<=L+2 then
    FlushToStream;
  inc(B);
  if L>0 then begin
    MoveFast(Text[1],B^,L);
    inc(B,L);
  end;
  PWord(B)^ := 13+10 shl 8; // CR + LF
  inc(B);
end;

procedure TTextWriter.AddBinToHexDisplay(Bin: pointer; BinBytes: integer);
begin
  if cardinal(BinBytes*2-1)>=cardinal(fTempBufSize) then
    exit;
  if BEnd-B<=BinBytes*2 then
    FlushToStream;
  BinToHexDisplay(Bin,PAnsiChar(B+1),BinBytes);
  inc(B,BinBytes*2);
end;

procedure TTextWriter.AddBinToHexDisplayLower(Bin: pointer; BinBytes: integer);
begin
  if cardinal(BinBytes*2-1)>=cardinal(fTempBufSize) then
    exit;
  if BEnd-B<=BinBytes*2 then
    FlushToStream;
  BinToHexDisplayLower(Bin,PAnsiChar(B+1),BinBytes);
  inc(B,BinBytes*2);
end;

procedure TTextWriter.AddBinToHexDisplayQuoted(Bin: pointer; BinBytes: integer);
begin
  if cardinal(BinBytes*2+2)>=cardinal(fTempBufSize) then
    exit;
  if BEnd-B<=BinBytes*2+2 then
    FlushToStream;
  B[1] := '"';
  BinToHexDisplayLower(Bin,PAnsiChar(B+2),BinBytes);
  inc(B,BinBytes*2);
  B[2] := '"';
  inc(B,2);
end;

procedure TTextWriter.AddBinToHexDisplayMinChars(Bin: pointer; BinBytes: PtrInt);
begin
  if (BinBytes<=0) or (cardinal(BinBytes*2-1)>=cardinal(fTempBufSize)) then
    exit;
  repeat // append hexa chars up to the last non zero byte
    dec(BinBytes);
  until (BinBytes=0) or (PByteArray(Bin)[BinBytes]<>0);
  inc(BinBytes);
  if BEnd-B<=BinBytes*2 then
    FlushToStream;
  BinToHexDisplayLower(Bin,PAnsiChar(B+1),BinBytes);
  inc(B,BinBytes*2);
end;

procedure TTextWriter.AddPointer(P: PtrUInt);
begin
  AddBinToHexDisplayMinChars(@P,SizeOf(P));
end;

procedure TTextWriter.AddBinToHex(Bin: Pointer; BinBytes: integer);
var ChunkBytes: PtrInt;
begin
  if BinBytes<=0 then
    exit;
  if B>=BEnd then
    FlushToStream;
  inc(B);
  repeat
    // guess biggest size to be added into buf^ at once
    ChunkBytes := (BEnd-B) shr 1; // div 2, *2 -> two hexa chars per byte
    if BinBytes<ChunkBytes then
      ChunkBytes := BinBytes;
    // add hexa characters
    SynCommons.BinToHex(PAnsiChar(Bin),PAnsiChar(B),ChunkBytes);
    inc(B,ChunkBytes*2);
    inc(PByte(Bin),ChunkBytes);
    dec(BinBytes,ChunkBytes);
    if BinBytes=0 then break;
    // Flush writes B-buf+1 -> special one below:
    WriteToStream(fTempBuf,B-fTempBuf);
    B := fTempBuf;
  until false;
  dec(B); // allow CancelLastChar
end;

procedure TTextWriter.AddQuotedStr(Text: PUTF8Char; Quote: AnsiChar;
  TextMaxLen: PtrInt);
var BMax: PUTF8Char;
    c: AnsiChar;
begin
  if TextMaxLen<=0 then
    TextMaxLen := maxInt else
    if TextMaxLen>5 then
      dec(TextMaxLen,5);
  BMax := BEnd-3;
  if B>=BMax then begin
    FlushToStream;
    BMax := BEnd-3;
  end;
  inc(B);
  B^ := Quote;
  inc(B);
  if Text<>nil then
    repeat
      if B<BMax then begin
        dec(TextMaxLen);
        if TextMaxLen<>0 then begin
          c := Text^;
          inc(Text);
          if c=#0 then
            break;
          B^ := c;
          inc(B);
          if c<>Quote then
            continue;
          B^ := c;
          inc(B);
        end else begin
          PCardinal(B)^ := ord('.')+ord('.')shl 8+ord('.')shl 16;
          inc(B,3);
          break;
        end;
      end else begin
        FlushToStream;
        BMax := BEnd-3;
      end;
    until false;
  B^ := Quote;
end;

const
  HTML_ESC: array[hfAnyWhere..high(TTextWriterHTMLFormat)] of TSynAnsicharSet = (
    [#0,'&','"','<','>'],[#0,'&','<','>'],[#0,'&','"']);

procedure TTextWriter.AddHtmlEscape(Text: PUTF8Char; Fmt: TTextWriterHTMLFormat);
var B: PUTF8Char;
    esc: ^TSynAnsicharSet;
begin
  if Text=nil then
    exit;
  if Fmt=hfNone then begin
    AddNoJSONEscape(Text);
    exit;
  end;
  esc := @HTML_ESC[Fmt];
  repeat
    B := Text;
    while not(Text^ in esc^) do
      inc(Text);
    AddNoJSONEscape(B,Text-B);
    case Text^ of
    #0: exit;
    '<': AddShort('&lt;');
    '>': AddShort('&gt;');
    '&': AddShort('&amp;');
    '"': AddShort('&quot;');
    end;
    inc(Text);
  until Text^=#0;
end;

procedure TTextWriter.AddHtmlEscape(Text: PUTF8Char; TextLen: PtrInt;
  Fmt: TTextWriterHTMLFormat);
var B: PUTF8Char;
    esc: ^TSynAnsicharSet;
begin
  if (Text=nil) or (TextLen<=0) then
    exit;
  if Fmt=hfNone then begin
    AddNoJSONEscape(Text,TextLen);
    exit;
  end;
  inc(TextLen,PtrInt(Text)); // TextLen = final PtrInt(Text)
  esc := @HTML_ESC[Fmt];
  repeat
    B := Text;
    while (PtrInt(Text)<TextLen) and not(Text^ in esc^) do
      inc(Text);
    AddNoJSONEscape(B,Text-B);
    if PtrInt(Text)=TextLen then
      exit;
    case Text^ of
    #0: exit;
    '<': AddShort('&lt;');
    '>': AddShort('&gt;');
    '&': AddShort('&amp;');
    '"': AddShort('&quot;');
    end;
    inc(Text);
  until false;
end;

procedure TTextWriter.AddHtmlEscapeString(const Text: string; Fmt: TTextWriterHTMLFormat);
begin
  AddHtmlEscape(pointer(StringToUTF8(Text)),Fmt);
end;

procedure TTextWriter.AddHtmlEscapeUTF8(const Text: RawUTF8; Fmt: TTextWriterHTMLFormat);
begin
  AddHtmlEscape(pointer(Text),length(Text),Fmt);
end;

procedure TTextWriter.AddXmlEscape(Text: PUTF8Char);
const XML_ESCAPE: TSynByteSet =
  [0..31,ord('<'),ord('>'),ord('&'),ord('"'),ord('''')];
var i,beg: PtrInt;
begin
  if Text=nil then
    exit;
  i := 0;
  repeat
    beg := i;
    if not(ord(Text[i]) in XML_ESCAPE) then begin
      repeat // it is faster to handle all not-escaped chars at once
        inc(i);
      until ord(Text[i]) in XML_ESCAPE;
      AddNoJSONEscape(Text+beg,i-beg);
    end;
    repeat
      case Text[i] of
      #0: exit;
      #1..#8,#11,#12,#14..#31:
        ; // ignore invalid character - see http://www.w3.org/TR/xml/#NT-Char
      #9,#10,#13: begin // characters below ' ', #9 e.g. -> // '&#x09;'
        AddShort('&#x');
        AddByteToHex(ord(Text[i]));
        Add(';');
      end;
      '<': AddShort('&lt;');
      '>': AddShort('&gt;');
      '&': AddShort('&amp;');
      '"': AddShort('&quot;');
      '''': AddShort('&apos;');
      else break; // should match XML_ESCAPE[] constant above
      end;
      inc(i);
    until false;
  until false;
end;

procedure TTextWriter.AddReplace(Text: PUTF8Char; Orig,Replaced: AnsiChar);
begin
  if Text<>nil then
    while Text^<>#0 do begin
      if Text^=Orig then
        Add(Replaced) else
        Add(Text^);
      inc(Text);
    end;
end;

procedure TTextWriter.AddByteToHex(Value: byte);
begin
  if BEnd-B<=1 then
    FlushToStream;
  PWord(B+1)^ := TwoDigitsHexWB[Value];
  inc(B,2);
end;

procedure TTextWriter.AddInt18ToChars3(Value: cardinal);
begin
  if BEnd-B<=3 then
    FlushToStream;
  PCardinal(B+1)^ := ((Value shr 12) and $3f)+
                     ((Value shr 6) and $3f)shl 8+
                     (Value and $3f)shl 16+$202020;
  //assert(Chars3ToInt18(B+1)=Value);
  inc(B,3);
end;

function Int18ToChars3(Value: cardinal): RawUTF8;
begin
  FastSetString(result,nil,3);
  PCardinal(result)^ := ((Value shr 12) and $3f)+
                        ((Value shr 6) and $3f)shl 8+
                        (Value and $3f)shl 16+$202020;
end;

procedure Int18ToChars3(Value: cardinal; var result: RawUTF8);
begin
  FastSetString(result,nil,3);
  PCardinal(result)^ := ((Value shr 12) and $3f)+
                        ((Value shr 6) and $3f)shl 8+
                        (Value and $3f)shl 16+$202020;
end;

function Chars3ToInt18(P: pointer): cardinal;
begin
  result := PCardinal(P)^-$202020;
  result := ((result shr 16)and $3f)+
            ((result shr 8) and $3f)shl 6+
            (result and $3f)shl 12;
end;

procedure TTextWriter.AddNoJSONEscape(P: Pointer);
begin
  AddNoJSONEscape(P,StrLen(PUTF8Char(P)));
end;

procedure TTextWriter.AddNoJSONEscape(P: Pointer; Len: PtrInt);
var i: PtrInt;
begin
  if (P<>nil) and (Len>0) then begin
    inc(B); // allow CancelLastChar
    repeat
      i := BEnd-B+1; // guess biggest size to be added into buf^ at once
      if Len<i then
        i := Len;
      // add UTF-8 bytes
      if i>0 then begin
        MoveFast(P^,B^,i);
        inc(B,i);
      end;
      if i=Len then
        break;
      inc(PByte(P),i);
      dec(Len,i);
      // FlushInc writes B-buf+1 -> special one below:
      WriteToStream(fTempBuf,B-fTempBuf);
      B := fTempBuf;
    until false;
    dec(B); // allow CancelLastChar
  end;
end;

procedure TTextWriter.AddNoJSONEscapeUTF8(const text: RawByteString);
begin
  AddNoJSONEscape(pointer(text),length(text));
end;

procedure TTextWriter.AddNoJSONEscapeW(WideChar: PWord; WideCharCount: integer);
var PEnd: PtrUInt;
    BMax: PUTF8Char;
begin
  if WideChar=nil then
    exit;
  BMax := BEnd-7; // ensure enough space for biggest Unicode glyph as UTF-8
  if WideCharCount=0 then
    repeat
      if B>=BMax then begin
        FlushToStream;
        BMax := BEnd-7; // B may have been resized -> recompute BMax
      end;
      if WideChar^=0 then
        break;
      if WideChar^<=126 then begin
        B[1] := AnsiChar(ord(WideChar^));
        inc(WideChar);
        inc(B);
      end else
        inc(B,UTF16CharToUtf8(B+1,WideChar));
    until false else begin
    PEnd := PtrUInt(WideChar)+PtrUInt(WideCharCount)*SizeOf(WideChar^);
    repeat
      if B>=BMax then begin
        FlushToStream;
        BMax := BEnd-7;
      end;
      if WideChar^=0 then
        break;
      if WideChar^<=126 then begin
        B[1] := AnsiChar(ord(WideChar^));
        inc(WideChar);
        inc(B);
        if PtrUInt(WideChar)<PEnd then continue else break;
      end;
      inc(B,UTF16CharToUtf8(B+1,WideChar));
      if PtrUInt(WideChar)<PEnd then continue else break;
    until false;
  end;
end;

procedure TTextWriter.Add(P: PUTF8Char; Escape: TTextWriterKind);
begin
  if P<>nil then
  case Escape of
    twNone:       AddNoJSONEscape(P,StrLen(P));
    twJSONEscape: AddJSONEscape(P);
    twOnSameLine: AddOnSameLine(P);
  end;
end;

procedure TTextWriter.Add(P: PUTF8Char; Len: PtrInt; Escape: TTextWriterKind);
begin
  if P<>nil then
  case Escape of
    twNone:       AddNoJSONEscape(P,Len);
    twJSONEscape: AddJSONEscape(P,Len);
    twOnSameLine: AddOnSameLine(P,Len);
  end;
end;

procedure TTextWriter.AddW(P: PWord; Len: PtrInt; Escape: TTextWriterKind);
begin
  if P<>nil then
  case Escape of
    twNone:       AddNoJSONEscapeW(P,Len);
    twJSONEscape: AddJSONEScapeW(P,Len);
    twOnSameLine: AddOnSameLineW(P,Len);
  end;
end;

procedure TTextWriter.AddAnsiString(const s: AnsiString; Escape: TTextWriterKind);
begin
  AddAnyAnsiBuffer(pointer(s),length(s),Escape,0);
end;

procedure TTextWriter.AddAnyAnsiString(const s: RawByteString;
  Escape: TTextWriterKind; CodePage: Integer);
var L: integer;
begin
  L := length(s);
  if L=0 then
    exit;
  if (L>2) and (PInteger(s)^ and $ffffff=JSON_BASE64_MAGIC) then begin
    AddNoJSONEscape(pointer(s),L); // identified as a BLOB content
    exit;
  end;
  if CodePage<0 then
    {$ifdef HASCODEPAGE}
    CodePage := PStrRec(PtrUInt(s)-STRRECSIZE)^.codePage;
    {$else}
    CodePage := 0; // TSynAnsiConvert.Engine(0)=CurrentAnsiConvert
    {$endif}
  AddAnyAnsiBuffer(pointer(s),L,Escape,CodePage);
end;

procedure TTextWriter.AddAnyAnsiBuffer(P: PAnsiChar; Len: PtrInt;
  Escape: TTextWriterKind; CodePage: Integer);
var B: PUTF8Char;
begin
  if Len>0 then
  case CodePage of
  CP_UTF8: // direct write of RawUTF8 content
    if Escape<>twJSONEscape then
      Add(PUTF8Char(P),Len,Escape) else
      Add(PUTF8Char(P),0,Escape);
  CP_RAWBYTESTRING:
    Add(PUTF8Char(P),Len,Escape);  // direct write of RawByteString content
  CP_UTF16:
    AddW(PWord(P),0,Escape); // direct write of UTF-16 content
  CP_SQLRAWBLOB: begin
    AddNoJSONEscape(@PByteArray(@JSON_BASE64_MAGIC_QUOTE_VAR)[1],3);
    WrBase64(P,Len,{withMagic=}false);
  end;
  else begin
    // first handle trailing 7 bit ASCII chars, by quad
    B := pointer(P);
    if Len>=4 then
      repeat
        if PCardinal(P)^ and $80808080<>0 then
          break; // break on first non ASCII quad
        inc(P,4);
        dec(Len,4);
      until Len<4;
    if (Len>0) and (P^<#128)  then
      repeat
        inc(P);
        dec(Len);
      until (Len=0) or (P^>=#127);
    if P<>pointer(B) then
      Add(B,P-B,Escape);
    if Len=0 then
      exit;
    // rely on explicit conversion for all remaining ASCII characters
    TSynAnsiConvert.Engine(CodePage).InternalAppendUTF8(P,Len,self,Escape);
  end;
  end;
end;

var
  /// fast 256-byte branchless lookup table
  // - 0 indicates no escape needed
  // - 1 indicates #0 (end of string)
  // - 2 should be escaped as \u00xx
  // - b,t,n,f,r,\," as escaped character for #8,#9,#10,#12,#13,\,"
  JSON_ESCAPE: TNormTableByte;

function NeedsJsonEscape(P: PUTF8Char; PLen: integer): boolean;
var tab: PNormTableByte;
begin
  result := true;
  tab := @JSON_ESCAPE;
  if PLen>0 then
    repeat
      if tab[ord(P^)]<>0 then
        exit;
      inc(P);
      dec(PLen);
    until PLen=0;
  result := false;
end;

function NeedsJsonEscape(const Text: RawUTF8): boolean;
begin
  result := NeedsJsonEscape(pointer(Text),length(Text));
end;

function NeedsJsonEscape(P: PUTF8Char): boolean;
var tab: PNormTableByte;
    esc: byte;
begin
  result := false;
  if P=nil then
    exit;
  tab := @JSON_ESCAPE;
  repeat
    esc := tab[ord(P^)];
    if esc=0 then
      inc(P) else
    if esc=1 then
      exit else  // #0 reached
      break;
  until false;
  result := true;
end;

procedure TTextWriter.InternalAddFixedAnsi(Source: PAnsiChar; SourceChars: Cardinal;
  AnsiToWide: PWordArray; Escape: TTextWriterKind);
var c: cardinal;
    esc: byte;
begin
  while SourceChars>0 do begin
    c := byte(Source^);
    if c<=$7F then begin
      if c=0 then
        exit;
      if B>=BEnd then
        FlushToStream;
      case Escape of
      twNone: begin
        inc(B);
        B^ := AnsiChar(c);
      end;
      twJSONEscape: begin
        esc := JSON_ESCAPE[c];
        if esc=0 then begin // no escape needed
          inc(B);
          B^ := AnsiChar(c);
        end else
        if esc=1 then // #0
          exit else
        if esc=2 then begin // #7 e.g. -> \u0007
          AddShort('\u00');
          AddByteToHex(c);
        end else
          Add('\',AnsiChar(esc)); // escaped as \ + b,t,n,f,r,\,"
      end;
      twOnSameLine: begin
        inc(B);
        if c<32 then
          B^ := ' ' else
          B^ := AnsiChar(c);
      end;
      end
    end else begin // no surrogate is expected in TSynAnsiFixedWidth charsets
      if BEnd-B<=3 then
        FlushToStream;
      c := AnsiToWide[c]; // convert FixedAnsi char into Unicode char
      if c>$7ff then begin
        B[1] := AnsiChar($E0 or (c shr 12));
        B[2] := AnsiChar($80 or ((c shr 6) and $3F));
        B[3] := AnsiChar($80 or (c and $3F));
        inc(B,3);
      end else begin
        B[1] := AnsiChar($C0 or (c shr 6));
        B[2] := AnsiChar($80 or (c and $3F));
        inc(B,2);
      end;
    end;
    dec(SourceChars);
    inc(Source);
  end;
end;

procedure TTextWriter.AddOnSameLine(P: PUTF8Char);
begin
  if P<>nil then
    while P^<>#0 do begin
      if B>=BEnd then
        FlushToStream;
      if P^<' ' then
        B[1] := ' ' else
        B[1] := P^;
      inc(P);
      inc(B);
    end;
end;

procedure TTextWriter.AddOnSameLine(P: PUTF8Char; Len: PtrInt);
var i: PtrInt;
begin
  if P<>nil then
    for i := 0 to Len-1 do begin
      if B>=BEnd then
        FlushToStream;
      if P[i]<' ' then
        B[1] := ' ' else
        B[1] := P[i];
      inc(B);
    end;
end;

procedure TTextWriter.AddOnSameLineW(P: PWord; Len: PtrInt);
var PEnd: PtrUInt;
begin
  if P=nil then exit;
  if Len=0 then
    PEnd := 0 else
    PEnd := PtrUInt(P)+PtrUInt(Len)*SizeOf(WideChar);
  while (Len=0) or (PtrUInt(P)<PEnd) do begin
    if BEnd-B<=7 then
      FlushToStream;
    // escape chars, so that all content will stay on the same text line
    case P^ of
      0: break;
      1..32: begin
        B[1] := ' ';
        inc(B);
        inc(P);
      end;
      33..126: begin
        B[1] := AnsiChar(ord(P^)); // direct store 7 bits ASCII
        inc(B);
        inc(P);
      end;
      else // characters higher than #126 -> UTF-8 encode
        inc(B,UTF16CharToUtf8(B+1,P));
    end;
  end;
end;

procedure TTextWriter.AddJSONEscape(P: Pointer; Len: PtrInt);
var i,start: PtrInt;
    {$ifdef CPUX86NOTPIC}tab: TNormTableByte absolute JSON_ESCAPE;
    {$else}tab: PNormTableByte;{$endif}
label noesc;
begin
  if P=nil then
    exit;
  if Len=0 then
    dec(Len); // -1 = no end
  i := 0;
  {$ifndef CPUX86NOTPIC} tab := @JSON_ESCAPE; {$endif}
  if tab[PByteArray(P)[i]]=0 then begin
noesc:start := i;
    if Len<0 then
      repeat // fastest loop is for AddJSONEscape(P,nil)
        inc(i);
      until tab[PByteArray(P)[i]]<>0 else
      repeat
        inc(i);
      until (i>=Len) or (tab[PByteArray(P)[i]]<>0);
    inc(PByte(P),start);
    dec(i,start);
    if Len>=0 then
      dec(Len,start);
    if BEnd-B<=i then
      AddNoJSONEscape(P,i) else begin
      MoveFast(P^,B[1],i);
      inc(B,i);
    end;
    if (Len>=0) and (i>=Len) then
      exit;
  end;
  repeat
    if BEnd-B<=10 then
      FlushToStream;
    case tab[PByteArray(P)[i]] of
    0: goto noesc;
    1: exit; // #0
    2: begin // characters below ' ', #7 e.g. -> // 'u0007'
      PCardinal(B+1)^ := ord('\')+ord('u')shl 8+ord('0')shl 16+ord('0')shl 24;
      inc(B,4);
      PWord(B+1)^ := TwoDigitsHexWB[PByteArray(P)[i]];
    end;
    else // escaped as \ + b,t,n,f,r,\,"
      PWord(B+1)^ := (integer(tab[PByteArray(P)[i]]) shl 8) or ord('\');
    end;
    inc(i);
    inc(B,2);
  until (Len>=0) and (i>=Len);
end;

procedure TTextWriter.AddJSONEscapeW(P: PWord; Len: PtrInt);
var i,c,s: PtrInt;
    esc: byte;
begin
  if P=nil then
    exit;
  if Len=0 then
    Len := MaxInt;
  i := 0;
  while i<Len do begin
    s := i;
    repeat
      c := PWordArray(P)[i];
      if (c<=127) and (JSON_ESCAPE[c]<>0) then
        break;
      inc(i);
    until i>=Len;
    if i<>s then
      AddNoJSONEscapeW(@PWordArray(P)[s],i-s);
    if i>=Len then
      exit;
    c := PWordArray(P)[i];
    if c=0 then
      exit;
    esc := JSON_ESCAPE[c];
    if esc=1 then // #0
      exit else
    if esc=2 then begin // characters below ' ', #7 e.g. -> \u0007
      AddShort('\u00');
      AddByteToHex(c);
    end else
      Add('\',AnsiChar(esc)); // escaped as \ + b,t,n,f,r,\,"
    inc(i);
  end;
end;

procedure TTextWriter.AddJSONEscape(const V: TVarRec);
begin
  with V do
  case VType of
    vtPointer: AddShort('null');
    vtString, vtAnsiString,{$ifdef HASVARUSTRING}vtUnicodeString,{$endif}
    vtPChar, vtChar, vtWideChar, vtWideString, vtClass: begin
      Add('"');
      case VType of
        vtString: if VString^[0]<>#0 then AddJSONEscape(@VString^[1],ord(VString^[0]));
        vtAnsiString: AddJSONEscape(VAnsiString);
        {$ifdef HASVARUSTRING}
        vtUnicodeString: AddJSONEscapeW(
          pointer(UnicodeString(VUnicodeString)),length(UnicodeString(VUnicodeString)));
        {$endif}
        vtPChar:      AddJSONEscape(VPChar);
        vtChar:       AddJSONEscape(@VChar,1);
        vtWideChar:   AddJSONEscapeW(@VWideChar,1);
        vtWideString: AddJSONEscapeW(VWideString);
        vtClass:      AddClassName(VClass);
      end;
      Add('"');
    end;
    vtBoolean:  Add(VBoolean); // 'true'/'false'
    vtInteger:  Add(VInteger);
    vtInt64:    Add(VInt64^);
    {$ifdef FPC}
    vtQWord:    AddQ(V.VQWord^);
    {$endif}
    vtExtended: AddDouble(VExtended^);
    vtCurrency: AddCurr64(VInt64^);
    vtObject:   WriteObject(VObject);
    {$ifndef NOVARIANTS}
    vtVariant:  AddVariant(VVariant^,twJSONEscape);
    {$endif}
  end;
end;

procedure TTextWriter.AddJSONString(const Text: RawUTF8);
begin
  Add('"');
  AddJSONEscape(pointer(Text));
  Add('"');
end;

procedure TTextWriter.Add(const V: TVarRec; Escape: TTextWriterKind;
  WriteObjectOptions: TTextWriterWriteObjectOptions);
begin
  with V do
  case VType of
  vtInteger:      Add(VInteger);
  vtBoolean:      if VBoolean then Add('1') else Add('0'); // normalize
  vtChar:         Add(@VChar,1,Escape);
  vtExtended:     AddDouble(VExtended^);
  vtCurrency:     AddCurr64(VInt64^);
  vtInt64:        Add(VInt64^);
  {$ifdef FPC}
  vtQWord:        AddQ(VQWord^);
  {$endif}
  {$ifndef NOVARIANTS}
  vtVariant:      AddVariant(VVariant^,Escape);
  {$endif}
  vtString:  if VString^[0]<>#0 then Add(@VString^[1],ord(VString^[0]),Escape);
  vtInterface,
  vtPointer:      AddBinToHexDisplayMinChars(@VPointer,SizeOf(VPointer));
  vtPChar:        Add(PUTF8Char(VPChar),Escape);
  vtObject:       WriteObject(VObject,WriteObjectOptions);
  vtClass:        AddClassName(VClass);
  vtWideChar:     AddW(@VWideChar,1,Escape);
  vtPWideChar:
    AddW(pointer(VPWideChar),StrLenW(VPWideChar),Escape);
  vtAnsiString:
    if VAnsiString<>nil then
      Add(VAnsiString,length(RawUTF8(VAnsiString)),Escape); // expect RawUTF8
  vtWideString:
    if VWideString<>nil then
      AddW(VWideString,length(WideString(VWideString)),Escape);
  {$ifdef HASVARUSTRING}
  vtUnicodeString:
    if VUnicodeString<>nil then // convert to UTF-8
      AddW(VUnicodeString,length(UnicodeString(VUnicodeString)),Escape);
  {$endif}
  end;
end;

{$ifndef NOVARIANTS}
procedure TTextWriter.AddJSON(const Format: RawUTF8; const Args,Params: array of const);
var temp: variant;
begin
  _JsonFmt(Format,Args,Params,JSON_OPTIONS_FAST,temp);
  AddVariant(temp,twJSONEscape);
end;
{$endif}

procedure TTextWriter.AddJSONArraysAsJSONObject(keys,values: PUTF8Char);
var k,v: PUTF8Char;
begin
  if (keys=nil) or (keys^<>'[') or (values=nil) or (values^<>'[') then begin
    AddShort('null');
    exit;
  end;
  inc(keys); // jump initial [
  inc(values);
  Add('{');
  repeat
    k := GotoEndJSONItem(keys);
    v := GotoEndJSONItem(values);
    if (k=nil) or (v=nil) then
      break; // invalid JSON input
    AddNoJSONEscape(keys,k-keys);
    Add(':');
    AddNoJSONEscape(values,v-values);
    Add(',');
    if (k^<>',') or (v^<>',') then
      break; // reached the end of the input JSON arrays
    keys := k+1;
    values := v+1;
  until false;
  CancelLastComma;
  Add('}');
end;

procedure TTextWriter.AddJSONEscape(const NameValuePairs: array of const);
var a: integer;
procedure WriteValue;
begin
  case VarRecAsChar(NameValuePairs[a]) of
  ord('['): begin
    Add('[');
    while a<high(NameValuePairs) do begin
      inc(a);
      if VarRecAsChar(NameValuePairs[a])=ord(']') then
        break;
      WriteValue;
    end;
    CancelLastComma;
    Add(']');
  end;
  ord('{'): begin
    Add('{');
    while a<high(NameValuePairs) do begin
      inc(a);
      if VarRecAsChar(NameValuePairs[a])=ord('}') then
        break;
      AddJSONEscape(NameValuePairs[a]);
      Add(':');
      inc(a);
      WriteValue;
    end;
    CancelLastComma;
    Add('}');
  end else
    AddJSONEscape(NameValuePairs[a]);
  end;
  Add(',');
end;
begin
  Add('{');
  a := 0;
  while a<high(NameValuePairs) do begin
    AddJSONEscape(NameValuePairs[a]);
    inc(a);
    Add(':');
    WriteValue;
    inc(a);
  end;
  CancelLastComma;
  Add('}');
end;

procedure TTextWriter.AddNoJSONEscapeString(const s: string);
begin
  if s<>'' then
    {$ifdef UNICODE}
    AddNoJSONEscapeW(pointer(s),0);
    {$else}
    AddAnsiString(s,twNone);
    {$endif}
end;

procedure TTextWriter.AddJSONEscapeString(const s: string);
begin
  if s<>'' then
    {$ifdef UNICODE}
    AddJSONEscapeW(pointer(s),Length(s));
    {$else}
    AddAnyAnsiString(s,twJSONEscape,0);
    {$endif}
end;

procedure TTextWriter.AddJSONEscapeAnsiString(const s: AnsiString);
begin
  AddAnyAnsiString(s,twJSONEscape,0);
end;

procedure TTextWriter.AddProp(PropName: PUTF8Char; PropNameLen: PtrInt);
begin
  if PropNameLen=0 then
    exit; // paranoid check
  if BEnd-B<=PropNameLen+3 then
    FlushToStream;
  if twoForceJSONExtended in CustomOptions then begin
    MoveSmall(PropName,B+1,PropNameLen);
    inc(B,PropNameLen+1);
    B^ := ':';
  end else begin
    B[1] := '"';
    MoveSmall(PropName,B+2,PropNameLen);
    inc(B,PropNameLen+2);
    PWord(B)^ := ord('"')+ord(':')shl 8;
    inc(B);
  end;
end;

procedure TTextWriter.AddPropName(const PropName: ShortString);
begin
  AddProp(@PropName[1],ord(PropName[0]));
end;

procedure TTextWriter.AddPropJSONString(const PropName: shortstring; const Text: RawUTF8);
begin
  AddProp(@PropName[1],ord(PropName[0]));
  AddJSONString(Text);
  Add(',');
end;

procedure TTextWriter.AddPropJSONInt64(const PropName: shortstring; Value: Int64);
begin
  AddProp(@PropName[1],ord(PropName[0]));
  Add(Value);
  Add(',');
end;

procedure TTextWriter.AddFieldName(const FieldName: RawUTF8);
begin
  AddProp(Pointer(FieldName),length(FieldName));
end;

procedure TTextWriter.AddClassName(aClass: TClass);
begin
  if aClass<>nil then
    AddShort(PShortString(PPointer(PtrInt(PtrUInt(aClass))+vmtClassName)^)^);
end;

procedure TTextWriter.AddInstanceName(Instance: TObject; SepChar: AnsiChar);
begin
  Add('"');
  if Instance=nil then
    AddShort('void') else
    AddShort(PShortString(PPointer(PPtrInt(Instance)^+vmtClassName)^)^);
  Add('(');
  AddBinToHexDisplayMinChars(@Instance,SizeOf(Instance));
  Add(')','"');
  if SepChar<>#0 then
    Add(SepChar);
end;

procedure TTextWriter.AddInstancePointer(Instance: TObject; SepChar: AnsiChar;
  IncludeUnitName, IncludePointer: boolean);
var info: PTypeInfo;
begin
  if IncludeUnitName then begin
    info := PPointer(PPtrInt(Instance)^+vmtTypeInfo)^;
    if info<>nil then begin // avoid GPF if no RTTI for this class
      AddShort(PShortString(@GetTypeInfo(info)^.UnitNameLen)^);
      Add('.');
    end;
  end;
  AddShort(PShortString(PPointer(PPtrInt(Instance)^+vmtClassName)^)^);
  if IncludePointer then begin
    Add('(');
    AddBinToHexDisplayMinChars(@Instance,SizeOf(Instance));
    Add(')');
  end;
  if SepChar<>#0 then
    Add(SepChar);
end;

procedure TTextWriter.AddShort(const Text: ShortString);
var L: PtrInt;
begin
  L := ord(Text[0]);
  if L=0 then
    exit;
  if BEnd-B<=L then
    FlushToStream;
  MoveFast(Text[1],B[1],L);
  inc(B,L);
end;

procedure TTextWriter.AddQuotedStringAsJSON(const QuotedString: RawUTF8);
var L: integer;
    P,B: PUTF8Char;
    quote: AnsiChar;
begin
  L := length(QuotedString);
  if L>0 then begin
    quote := QuotedString[1];
    if (quote in ['''','"']) and (QuotedString[L]=quote) then begin
      Add('"');
      P := pointer(QuotedString);
      inc(P);
      repeat
        B := P;
        while P[0]<>quote do inc(P);
        if P[1]<>quote then
          break; // end quote
        inc(P);
        AddJSONEscape(B,P-B);
        inc(P); // ignore double quote
      until false;
      if P-B<>0 then
        AddJSONEscape(B,P-B);
      Add('"');
    end else
      AddNoJSONEscape(pointer(QuotedString),length(QuotedString));
  end;
end;

procedure TTextWriter.AddTrimLeftLowerCase(Text: PShortString);
var P: PAnsiChar;
    L: integer;
begin
  L := length(Text^);
  P := @Text^[1];
  while (L>0) and (P^ in ['a'..'z']) do begin
    inc(P);
    dec(L);
  end;
  if L=0 then
    AddShort(Text^) else
    AddNoJSONEscape(P,L);
end;

procedure TTextWriter.AddTrimSpaces(const Text: RawUTF8);
begin
  AddTrimSpaces(pointer(Text));
end;

procedure TTextWriter.AddTrimSpaces(P: PUTF8Char);
var c: AnsiChar;
begin
  if P<>nil then
    repeat
      c := P^;
      inc(P);
      if c>' ' then
        Add(c);
    until c=#0;
end;

procedure TTextWriter.AddString(const Text: RawUTF8);
var L: PtrInt;
begin
  L := PtrInt(Text);
  if L=0 then
    exit;
  L := PStrLen(L-_STRLEN)^;
  if L<fTempBufSize then begin
    if BEnd-B<=L then
      FlushToStream;
    MoveFast(pointer(Text)^,B[1],L);
    inc(B,L);
  end else
    AddNoJSONEscape(pointer(Text),L);
end;

procedure TTextWriter.AddStringCopy(const Text: RawUTF8; start,len: PtrInt);
var L: PtrInt;
begin
  L := PtrInt(Text);
  if (len<=0) or (L=0) then
    exit;
  if start<0 then
    start := 0 else
    dec(start);
  L := PStrLen(L-_STRLEN)^;
  dec(L,start);
  if L>0 then begin
    if len<L then
      L := len;
    AddNoJSONEscape(@PByteArray(Text)[start],L);
  end;
end;

procedure TTextWriter.AddStrings(const Text: array of RawUTF8);
var i: PtrInt;
begin
  for i := 0 to high(Text) do
    AddString(Text[i]);
end;

procedure TTextWriter.AddStrings(const Text: RawUTF8; count: integer);
var i,L: integer;
begin
  L := length(Text);
  if L>0 then
    if L*count>fTempBufSize then
      for i := 1 to count do
        AddString(Text) else begin
      if BEnd-B<=L*count then
        FlushToStream;
      for i := 1 to count do begin
        MoveFast(pointer(Text)^,B[1],L);
        inc(B,L);
      end;
    end;
end;

procedure TTextWriter.CancelAll;
begin
  if self=nil then
    exit; // avoid GPF
  if fTotalFileSize<>0 then
    fTotalFileSize := fStream.Seek(fInitialStreamPosition,soBeginning);
  B := fTempBuf-1;
end;

procedure TTextWriter.SetBuffer(aBuf: pointer; aBufSize: integer);
begin
  if aBufSize<=16 then
    raise ESynException.CreateUTF8('%.SetBuffer(size=%)',[self,aBufSize]);
  if aBuf=nil then
    GetMem(fTempBuf,aBufSize) else begin
    fTempBuf := aBuf;
    Include(fCustomOptions,twoBufferIsExternal);
  end;
  fTempBufSize := aBufSize;
  B := fTempBuf-1; // Add() methods will append at B+1
  BEnd := fTempBuf+fTempBufSize-16; // -16 to avoid buffer overwrite/overread
  if DefaultTextWriterTrimEnum then
    Include(fCustomOptions,twoTrimLeftEnumSets);
end;

constructor TTextWriter.Create(aStream: TStream; aBufSize: integer);
begin
  SetStream(aStream);
  if aBufSize<256 then
    aBufSize := 256;
  SetBuffer(nil,aBufSize);
end;

constructor TTextWriter.Create(aStream: TStream; aBuf: pointer; aBufSize: integer);
begin
  SetStream(aStream);
  SetBuffer(aBuf,aBufSize);
end;

constructor TTextWriter.CreateOwnedStream(aBufSize: integer);
begin
  Create(TRawByteStringStream.Create,aBufSize);
  Include(fCustomOptions,twoStreamIsOwned);
end;

constructor TTextWriter.CreateOwnedStream(aBuf: pointer; aBufSize: integer);
begin
  SetStream(TRawByteStringStream.Create);
  SetBuffer(aBuf,aBufSize);
  Include(fCustomOptions,twoStreamIsOwned);
end;

constructor TTextWriter.CreateOwnedStream(var aStackBuf: TTextWriterStackBuffer;
  aBufSize: integer);
begin
  if aBufSize>SizeOf(aStackBuf) then // too small -> allocate on heap
    CreateOwnedStream(aBufSize) else
    CreateOwnedStream(@aStackBuf,SizeOf(aStackBuf));
end;

constructor TTextWriter.CreateOwnedFileStream(const aFileName: TFileName;
  aBufSize: integer);
begin
  DeleteFile(aFileName);
  Create(TFileStream.Create(aFileName,fmCreate or fmShareDenyWrite),aBufSize);
  Include(fCustomOptions,twoStreamIsOwned);
end;

destructor TTextWriter.Destroy;
begin
  if twoStreamIsOwned in fCustomOptions then
    fStream.Free;
  if not (twoBufferIsExternal in fCustomOptions) then
    FreeMem(fTempBuf);
  fInternalJSONWriter.Free;
  inherited;
end;

class procedure TTextWriter.SetDefaultEnumTrim(aShouldTrimEnumsAsText: boolean);
begin
  DefaultTextWriterTrimEnum := aShouldTrimEnumsAsText;
end;

procedure TTextWriter.SetStream(aStream: TStream);
begin
  if fStream<>nil then
    if twoStreamIsOwned in fCustomOptions then begin
      FreeAndNil(fStream);
      Exclude(fCustomOptions,twoStreamIsOwned);
    end;
  if aStream<>nil then begin
    fStream := aStream;
    fInitialStreamPosition := fStream.Seek(0,soCurrent);
    fTotalFileSize := fInitialStreamPosition;
  end;
end;

procedure TTextWriter.FlushToStream;
var i: PtrInt;
    s: PtrUInt;
begin
  i := B-fTempBuf+1;
  if i<=0 then
    exit;
  WriteToStream(fTempBuf,i);
  if not (twoFlushToStreamNoAutoResize in fCustomOptions) then begin
    s := fTotalFileSize-fInitialStreamPosition;
    if (fTempBufSize<49152) and (s>PtrUInt(fTempBufSize)*4) then
      s := fTempBufSize*2 else // tune small (stack-alloc?) buffer
    if (fTempBufSize<1 shl 20) and (s>40 shl 20) then
      s := 1 shl 20 else // 40MB -> 1MB buffer
      s := 0;
    if s>0 then begin
      fTempBufSize := s;
      if twoBufferIsExternal in fCustomOptions then // use heap, not stack
        exclude(fCustomOptions,twoBufferIsExternal) else
        FreeMem(fTempBuf); // with big content comes bigger buffer
      GetMem(fTempBuf,fTempBufSize);
      BEnd := fTempBuf+(fTempBufSize-16);
    end;
  end;
  B := fTempBuf-1;
end;

procedure TTextWriter.WriteToStream(data: pointer; len: PtrUInt);
begin
  if Assigned(fOnFlushToStream) then
    fOnFlushToStream(data,len);
  fStream.WriteBuffer(data^,len);
  inc(fTotalFileSize,len);
end;

function TTextWriter.GetTextLength: PtrUInt;
begin
  if self=nil then
    result := 0 else
    result := PtrUInt(B-fTempBuf+1)+fTotalFileSize-fInitialStreamPosition;
end;

function TTextWriter.Text: RawUTF8;
begin
  SetText(result);
end;

procedure TTextWriter.ForceContent(const text: RawUTF8);
begin
  CancelAll;
  if (fInitialStreamPosition=0) and fStream.InheritsFrom(TRawByteStringStream) then
    TRawByteStringStream(fStream).fDataString := text else
    fStream.WriteBuffer(pointer(text)^,length(text));
  fTotalFileSize := fInitialStreamPosition+cardinal(length(text));
end;

procedure TTextWriter.FlushFinal;
begin
  Include(fCustomOptions,twoFlushToStreamNoAutoResize);
  FlushToStream;
end;

procedure TTextWriter.SetText(var result: RawUTF8; reformat: TTextWriterJSONFormat);
var Len: cardinal;
begin
  FlushFinal;
  Len := fTotalFileSize-fInitialStreamPosition;
  if Len=0 then
    result := '' else
  if fStream.InheritsFrom(TRawByteStringStream) then
    with TRawByteStringStream(fStream) do
    if fInitialStreamPosition=0 then begin
      {$ifdef HASCODEPAGE} // FPC expects this
      SetCodePage(fDataString,CP_UTF8,false);
      {$endif}
      result := fDataString;
      fDataString := '';
    end else
      FastSetString(result,PAnsiChar(pointer(DataString))+fInitialStreamPosition,Len) else
  if fStream.InheritsFrom(TCustomMemoryStream) then
    with TCustomMemoryStream(fStream) do
      FastSetString(result,PAnsiChar(Memory)+fInitialStreamPosition,Len) else begin
    FastSetString(result,nil,Len);
    fStream.Seek(fInitialStreamPosition,soBeginning);
    fStream.Read(pointer(result)^,Len);
  end;
  if reformat<>jsonCompact then begin // reformat using the very same instance
    CancelAll;
    AddJSONReformat(pointer(result),reformat,nil);
    SetText(result);
  end;
end;

procedure TTextWriter.WrRecord(const Rec; TypeInfo: pointer);
var L: integer;
    tmp: RawByteString;
begin
  L := RecordSaveLength(Rec,TypeInfo);
  SetString(tmp,nil,L);
  if L<>0 then
    RecordSave(Rec,pointer(tmp),TypeInfo);
  WrBase64(pointer(tmp),L,{withMagic=}true);
end;

procedure TTextWriter.WrBase64(P: PAnsiChar; Len: PtrUInt; withMagic: boolean);
var trailing, main, n: PtrUInt;
begin
  if withMagic then
    if Len<=0 then begin
      AddShort('null'); // JSON null is better than "" for BLOBs
      exit;
    end else
    AddNoJSONEscape(@JSON_BASE64_MAGIC_QUOTE_VAR,4);
  if len>0 then begin
    n := Len div 3;
    trailing := Len-n*3;
    dec(Len,trailing);
    if BEnd-B>integer(n+1) shl 2 then begin
      // will fit in available space in Buf -> fast in-buffer Base64 encoding
      n := Base64EncodeMain(@B[1],P,Len);
      inc(B,n*4);
      inc(P,n*3);
    end else begin
      // bigger than available space in Buf -> do it per chunk
      FlushToStream;
      while Len>0 do begin // length(buf) const -> so is ((length(buf)-4)shr2 )*3
        n := ((fTempBufSize-4)shr 2)*3;
        if Len<n then
          n := Len;
        main := Base64EncodeMain(PAnsiChar(fTempBuf),P,n);
        n := main*4;
        if n<cardinal(fTempBufSize)-4 then
          inc(B,n) else
          WriteToStream(fTempBuf,n);
        n := main*3;
        inc(P,n);
        dec(Len,n);
      end;
    end;
    if trailing>0 then begin
      Base64EncodeTrailing(@B[1],P,trailing);
      inc(B,4);
    end;
  end;
  if withMagic then
    Add('"');
end;


{ TTextWriterWithEcho }

procedure TTextWriterWithEcho.AddEndOfLine(aLevel: TSynLogInfo=sllNone);
var i: integer;
begin
  if BEnd-B<=1 then
    FlushToStream;
  if twoEndOfLineCRLF in fCustomOptions then begin
    PWord(B+1)^ := 13+10 shl 8; // CR + LF
    inc(B,2);
  end else begin
    B[1] := #10; // LF
    inc(B);
  end;
  if fEchos<>nil then begin
    fEchoStart := EchoFlush;
    for i := length(fEchos)-1 downto 0 do // for MultiEventRemove() below
    try
      fEchos[i](self,aLevel,fEchoBuf);
    except // remove callback in case of exception during echoing in user code
      MultiEventRemove(fEchos,i);
    end;
    fEchoBuf := '';
  end;
end;

procedure TTextWriterWithEcho.FlushToStream;
begin
  if fEchos<>nil then begin
    EchoFlush;
    fEchoStart := 0;
  end;
  inherited FlushToStream;
end;

procedure TTextWriterWithEcho.EchoAdd(const aEcho: TOnTextWriterEcho);
begin
  if self<>nil then
    if MultiEventAdd(fEchos,TMethod(aEcho)) then
      if fEchos<>nil then
        fEchoStart := B-fTempBuf+1; // ignore any previous buffer
end;

procedure TTextWriterWithEcho.EchoRemove(const aEcho: TOnTextWriterEcho);
begin
  if self<>nil then
    MultiEventRemove(fEchos,TMethod(aEcho));
end;

function TTextWriterWithEcho.EchoFlush: PtrInt;
var L,LI: PtrInt;
    P: PByteArray;
begin
  result := B-fTempBuf+1;
  L := result-fEchoStart;
  P := @PByteArray(fTempBuf)[fEchoStart];
  while (L>0) and (P[L-1] in [10,13]) do // trim right CR/LF chars
    dec(L);
  LI := length(fEchoBuf); // fast append to fEchoBuf
  SetLength(fEchoBuf,LI+L);
  MoveFast(P^,PByteArray(fEchoBuf)[LI],L);
end;

procedure TTextWriterWithEcho.EchoReset;
begin
  fEchoBuf := '';
end;

function TTextWriterWithEcho.GetEndOfLineCRLF: boolean;
begin
  result := twoEndOfLineCRLF in fCustomOptions;
end;

procedure TTextWriterWithEcho.SetEndOfLineCRLF(aEndOfLineCRLF: boolean);
begin
  if aEndOfLineCRLF then
    include(fCustomOptions,twoEndOfLineCRLF) else
    exclude(fCustomOptions,twoEndOfLineCRLF);
end;



function JSONEncode(const NameValuePairs: array of const): RawUTF8;
var temp: TTextWriterStackBuffer;
begin
  if high(NameValuePairs)<1 then
    result := '{}' else // return void JSON object on error
    with DefaultTextWriterSerializer.CreateOwnedStream(temp) do
    try
      AddJSONEscape(NameValuePairs);
      SetText(result);
    finally
      Free
    end;
end;

{$ifndef NOVARIANTS}
function JSONEncode(const Format: RawUTF8; const Args,Params: array of const): RawUTF8;
var temp: TTextWriterStackBuffer;
begin
  with DefaultTextWriterSerializer.CreateOwnedStream(temp) do
  try
    AddJSON(Format,Args,Params);
    SetText(result);
  finally
    Free
  end;
end;
{$endif}

function JSONEncodeArrayDouble(const Values: array of double): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := TTextWriter.CreateOwnedStream(temp);
  try
    W.Add('[');
    W.AddCSVDouble(Values);
    W.Add(']');
    W.SetText(result);
  finally
    W.Free
  end;
end;

function JSONEncodeArrayUTF8(const Values: array of RawUTF8): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := TTextWriter.CreateOwnedStream(temp);
  try
    W.Add('[');
    W.AddCSVUTF8(Values);
    W.Add(']');
    W.SetText(result);
  finally
    W.Free
  end;
end;

function JSONEncodeArrayInteger(const Values: array of integer): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := TTextWriter.CreateOwnedStream(temp);
  try
    W.Add('[');
    W.AddCSVInteger(Values);
    W.Add(']');
    W.SetText(result);
  finally
    W.Free
  end;
end;

function JSONEncodeArrayOfConst(const Values: array of const;
  WithoutBraces: boolean): RawUTF8;
begin
  JSONEncodeArrayOfConst(Values,WithoutBraces,result);
end;

procedure JSONEncodeArrayOfConst(const Values: array of const;
  WithoutBraces: boolean; var result: RawUTF8);
var temp: TTextWriterStackBuffer;
begin
  if length(Values)=0 then
    if WithoutBraces then
      result := '' else
      result := '[]' else
    with DefaultTextWriterSerializer.CreateOwnedStream(temp) do
    try
      if not WithoutBraces then
        Add('[');
      AddCSVConst(Values);
      if not WithoutBraces then
        Add(']');
      SetText(result);
    finally
      Free
    end;
end;

procedure JSONEncodeNameSQLValue(const Name,SQLValue: RawUTF8;
  var result: RawUTF8);
var temp: TTextWriterStackBuffer;
begin
  if (SQLValue<>'') and (SQLValue[1] in ['''','"']) then
    // unescape SQL quoted string value into a valid JSON string
    with TTextWriter.CreateOwnedStream(temp) do
    try
      Add('{','"');
      AddNoJSONEscapeUTF8(Name);
      Add('"',':');
      AddQuotedStringAsJSON(SQLValue);
      Add('}');
      SetText(result);
    finally
      Free;
    end else
    // Value is a number or null/true/false
    result := '{"'+Name+'":'+SQLValue+'}';
end;

{ TValuePUTF8Char }

procedure TValuePUTF8Char.ToUTF8(var Text: RawUTF8);
begin
  FastSetString(Text,Value,ValueLen);
end;

function TValuePUTF8Char.ToUTF8: RawUTF8;
begin
  FastSetString(result,Value,ValueLen);
end;

function TValuePUTF8Char.ToString: string;
begin
  UTF8DecodeToString(Value,ValueLen,result);
end;

function TValuePUTF8Char.ToInteger: PtrInt;
begin
  result := GetInteger(Value);
end;

function TValuePUTF8Char.ToCardinal: PtrUInt;
begin
  result := GetCardinal(Value);
end;

function TValuePUTF8Char.Idem(const Text: RawUTF8): boolean;
begin
  if length(Text)=ValueLen then
    result := IdemPropNameUSameLen(pointer(Text),Value,ValueLen) else
    result := false;
end;

procedure JSONDecode(var JSON: RawUTF8; const Names: array of RawUTF8;
  Values: PValuePUTF8CharArray; HandleValuesAsObjectOrArray: Boolean);
begin
  JSONDecode(UniqueRawUTF8(JSON),Names,Values,HandleValuesAsObjectOrArray);
end;

procedure JSONDecode(var JSON: RawJSON; const Names: array of RawUTF8;
  Values: PValuePUTF8CharArray; HandleValuesAsObjectOrArray: Boolean);
begin
  JSONDecode(UniqueRawUTF8(RawUTF8(JSON)),Names,Values,HandleValuesAsObjectOrArray);
end;

function JSONDecode(P: PUTF8Char; const Names: array of RawUTF8;
  Values: PValuePUTF8CharArray; HandleValuesAsObjectOrArray: Boolean): PUTF8Char;
var n, i: PtrInt;
    namelen, valuelen: integer;
    name, value: PUTF8Char;
    EndOfObject: AnsiChar;
begin
  result := nil;
  if Values=nil then
    exit; // avoid GPF
  n := length(Names);
  FillCharFast(Values[0],n*SizeOf(Values[0]),0);
  dec(n);
  if P=nil then
    exit;
  while P^<>'{' do
    if P^=#0 then
      exit else
      inc(P);
  inc(P); // jump {
  repeat
    name := GetJSONPropName(P,@namelen);
    if name=nil then
      exit;  // invalid JSON content
    value := GetJSONFieldOrObjectOrArray(P,nil,@EndOfObject,HandleValuesAsObjectOrArray,true,@valuelen);
    if not(EndOfObject in [',','}']) then
      exit; // invalid item separator
    for i := 0 to n do
      if (Values[i].Value=nil) and IdemPropNameU(Names[i],name,namelen) then begin
        Values[i].Value := value;
        Values[i].ValueLen := valuelen;
        break;
      end;
  until (P=nil) or (EndOfObject='}');
  if P=nil then // result=nil indicates failure -> points to #0 for end of text
    result := @NULCHAR else
    result := P;
end;

function JSONDecode(var JSON: RawUTF8; const aName: RawUTF8;
  wasString: PBoolean; HandleValuesAsObjectOrArray: Boolean): RawUTF8;
var P, Name, Value: PUTF8Char;
    NameLen, ValueLen: integer;
    EndOfObject: AnsiChar;
begin
  result := '';
  P := pointer(JSON);
  if P=nil then
    exit;
  while P^<>'{' do
    if P^=#0 then
      exit else
      inc(P);
  inc(P); // jump {
  repeat
    Name := GetJSONPropName(P,@NameLen);
    if Name=nil then
      exit;  // invalid JSON content
    Value := GetJSONFieldOrObjectOrArray(
      P,wasString,@EndOfObject,HandleValuesAsObjectOrArray,true,@ValueLen);
    if not(EndOfObject in [',','}']) then
      exit; // invalid item separator
    if IdemPropNameU(aName,Name,NameLen) then begin
      FastSetString(result,Value,ValueLen);
      exit;
    end;
  until (P=nil) or (EndOfObject='}');
end;

function JSONDecode(P: PUTF8Char; out Values: TNameValuePUTF8CharDynArray;
  HandleValuesAsObjectOrArray: Boolean): PUTF8Char;
var n: PtrInt;
    field: TNameValuePUTF8Char;
    EndOfObject: AnsiChar;
begin
  {$ifdef FPC}
  Values := nil;
  {$endif}
  result := nil;
  n := 0;
  if P<>nil then begin
    while P^<>'{' do
      if P^=#0 then
        exit else
        inc(P);
    inc(P); // jump {
    repeat
      field.Name := GetJSONPropName(P,@field.NameLen);
      if field.Name=nil then
        exit;  // invalid JSON content
      field.Value := GetJSONFieldOrObjectOrArray(P,nil,@EndOfObject,
        HandleValuesAsObjectOrArray,true,@field.ValueLen);
      if not(EndOfObject in [',','}']) then
        exit; // invalid item separator
      if n=length(Values) then
        SetLength(Values,n+32);
      Values[n] := field;
      inc(n);
    until (P=nil) or (EndOfObject='}');
  end;
  SetLength(Values,n);
  if P=nil then // result=nil indicates failure -> points to #0 for end of text
    result := @NULCHAR else
    result := P;
end;

function JSONRetrieveStringField(P: PUTF8Char; out Field: PUTF8Char;
  out FieldLen: integer; ExpectNameField: boolean): PUTF8Char;
begin
  result := nil;
  // retrieve string field
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^<>'"' then exit;
  Field := P+1;
  P := GotoEndOfJSONString(P);
  if P^<>'"' then
    exit; // here P^ should be '"'
  FieldLen := P-Field;
  // check valid JSON delimiter
  repeat inc(P) until (P^>' ') or (P^=#0);
  if ExpectNameField then begin
    if P^<>':' then
      exit; // invalid name field
  end else
    if not (P^ in ['}',',']) then
      exit; // invalid value field
  result := P; // return either ':' for name field, either '}',',' for value
end;

// decode a JSON field into an UTF-8 encoded buffer, stored inplace of input buffer
function GetJSONField(P: PUTF8Char; out PDest: PUTF8Char;
  wasString: PBoolean; EndOfObject: PUTF8Char; Len: PInteger): PUTF8Char;
var D: PUTF8Char;
    c4,surrogate,j: integer;
    c: AnsiChar;
    b: byte;
    jsonset: PJsonCharSet;
    {$ifdef CPUX86NOTPIC} tab: TNormTableByte absolute ConvertHexToBin;
    {$else} tab: PNormTableByte; {$endif}
label slash,num,lit;
begin // see http://www.ietf.org/rfc/rfc4627.txt
  if wasString<>nil then
    wasString^ := false; // not a string by default
  if Len<>nil then
    Len^ := 0; // avoid buffer overflow on parsing error
  PDest := nil; // PDest=nil indicates parsing error (e.g. unexpected #0 end)
  result := nil;
  if P=nil then exit;
  if P^<=' ' then repeat inc(P); if P^=#0 then exit; until P^>' ';
  case P^ of
  '"': begin // " -> unescape P^ into D^
    if wasString<>nil then
      wasString^ := true;
    inc(P);
    result := P;
    D := P;
    repeat
      c := P^;
      if c=#0 then exit else
      if c='"' then break else
      if c='\' then goto slash;
      inc(P);
      D^ := c;
      inc(D);
      continue;
slash:inc(P); // unescape JSON string
      c := P^;
      if (c='"') or (c='\') then begin
lit:    inc(P);
        D^ := c; // most common case
        inc(D);
        continue;
      end else
      if c=#0 then
        exit else // to avoid potential buffer overflow issue on \#0
      if c='b' then
        c := #8 else
      if c='t' then
        c := #9 else
      if c='n' then
        c := #10 else
      if c='f' then
        c := #12 else
      if c='r' then
        c := #13 else
      if c='u' then begin
        // inlined decoding of '\u0123' UTF-16 codepoint(s) into UTF-8
        {$ifndef CPUX86NOTPIC}tab := @ConvertHexToBin;{$endif}
        c4 := tab[ord(P[1])];
        if c4<=15 then begin
          b := tab[ord(P[2])];
          if b<=15 then begin
            c4 := c4 shl 4;
            c4 := c4 or b;
            b := tab[ord(P[3])];
            if b<=15 then begin
              c4 := c4 shl 4;
              c4 := c4 or b;
              b := tab[ord(P[4])];
              if b<=15 then begin
                c4 := c4 shl 4;
                c4 := c4 or b;
                case c4 of
                0: begin
                  D^ := '?'; // \u0000 is an invalid value
                  inc(D);
                end;
                1..$7f: begin
                  D^ := AnsiChar(c4);
                  inc(D);
                end;
                $80..$7ff: begin
                  D[0] := AnsiChar($C0 or (c4 shr 6));
                  D[1] := AnsiChar($80 or (c4 and $3F));
                  inc(D,2);
                end;
                UTF16_HISURROGATE_MIN..UTF16_LOSURROGATE_MAX:
                  if PWord(P+5)^=ord('\')+ord('u') shl 8 then begin
                    inc(P,6); // optimistic conversion (no check)
                    surrogate := (ConvertHexToBin[ord(P[1])] shl 12)+
                                 (ConvertHexToBin[ord(P[2])] shl 8)+
                                 (ConvertHexToBin[ord(P[3])] shl 4)+
                                  ConvertHexToBin[ord(P[4])];
                    case c4 of // inlined UTF16CharToUtf8()
                    UTF16_HISURROGATE_MIN..UTF16_HISURROGATE_MAX:
                      c4 := ((c4-$D7C0)shl 10)+(surrogate xor UTF16_LOSURROGATE_MIN);
                    UTF16_LOSURROGATE_MIN..UTF16_LOSURROGATE_MAX:
                      c4 := ((surrogate-$D7C0)shl 10)+(c4 xor UTF16_LOSURROGATE_MIN);
                    end;
                    case c4 of
                    0..$7ff: b := 2;
                    $800..$ffff: b := 3;
                    $10000..$1FFFFF: b := 4;
                    $200000..$3FFFFFF: b := 5;
                    else b := 6;
                    end;
                    for j := b-1 downto 1 do begin
                      D[j] := AnsiChar((c4 and $3f)+$80);
                      c4 := c4 shr 6;
                    end;
                    D^ := AnsiChar(Byte(c4) or UTF8_FIRSTBYTE[b]);
                    inc(D,b);
                  end else begin
                    D^ := '?'; // unexpected surrogate without its pair
                    inc(D);
                  end;
                else begin
                  D[0] := AnsiChar($E0 or (c4 shr 12));
                  D[1] := AnsiChar($80 or ((c4 shr 6) and $3F));
                  D[2] := AnsiChar($80 or (c4 and $3F));
                  inc(D,3);
                end;
                end;
                inc(P,5);
                continue;
                end;
              end;
            end;
          end;
          c := '?'; // bad formated hexa number -> '?0123'
        end;
      goto lit;
    until false;
    // here P^='"'
    D^ := #0; // make zero-terminated
    if Len<>nil then
      Len^ := D-result;
    inc(P);
    if P^=#0 then
      exit;
  end;
  '0':
    if P[1] in ['0'..'9'] then // 0123 excluded by JSON!
      exit else // leave PDest=nil for unexpected end
      goto num;// may be 0.123
  '-','1'..'9': begin // numerical field: all chars before end of field
num:result := P;
    jsonset := @JSON_CHARS;
    repeat
      if not (jcDigitFloatChar in jsonset[P^]) then
        break;
      inc(P);
    until false;
    if P^=#0 then
      exit;
    if Len<>nil then
      Len^ := P-result;
    if P^<=' ' then begin
      P^ := #0; // force numerical field with no trailing ' '
      inc(P);
    end;
  end;
  'n':
    if (PInteger(P)^=NULL_LOW) and (jcEndOfJSONValueField in JSON_CHARS[P[4]])  then begin
      result := nil; // null -> returns nil and wasString=false
      if Len<>nil then
        Len^ := 0; // when result is converted to string
      inc(P,4);
    end else
      exit;
  'f':
    if (PInteger(P+1)^=FALSE_LOW2) and (jcEndOfJSONValueField in JSON_CHARS[P[5]]) then begin
      result := P; // false -> returns 'false' and wasString=false
      if Len<>nil then
        Len^ := 5;
      inc(P,5);
    end else
      exit;
  't':
    if (PInteger(P)^=TRUE_LOW) and (jcEndOfJSONValueField in JSON_CHARS[P[4]]) then begin
      result := P; // true -> returns 'true' and wasString=false
      if Len<>nil then
        Len^ := 4;
      inc(P,4);
    end else
      exit;
  else
    exit; // PDest=nil to indicate error
  end;
  jsonset := @JSON_CHARS;
  while not (jcEndOfJSONField in jsonset[P^]) do begin
    if P^=#0 then
      exit; // leave PDest=nil for unexpected end
    inc(P);
  end;
  if EndOfObject<>nil then
    EndOfObject^ := P^;
  P^ := #0; // make zero-terminated
  PDest := @P[1];
  if P[1]=#0 then
    PDest := nil;
end;

function GetJSONPropName(var P: PUTF8Char; Len: PInteger): PUTF8Char;
var Name: PUTF8Char;
    wasString: boolean;
    c, EndOfObject: AnsiChar;
    tab: PJsonCharSet;
begin // should match GotoNextJSONObjectOrArray() and JsonPropNameValid()
  result := nil;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  Name := P; // put here to please some versions of Delphi compiler
  c := P^;
  if c='"' then begin
    Name := GetJSONField(P,P,@wasString,@EndOfObject,Len);
    if (Name=nil) or not wasString or (EndOfObject<>':') then
      exit;
  end else
  if c = '''' then begin // single quotes won't handle nested quote character
    inc(P);
    Name := P;
    while P^<>'''' do
      if P^<' ' then
        exit else
        inc(P);
    if Len<>nil then
      Len^ := P-Name;
    P^ := #0;
    repeat inc(P) until (P^>' ') or (P^=#0);
    if P^<>':' then
      exit;
    inc(P);
  end else begin // e.g. '{age:{$gt:18}}'
    tab := @JSON_CHARS;
    if not (jcJsonIdentifierFirstChar in tab[c]) then
      exit;
    repeat
      inc(P);
    until not (jcJsonIdentifier in tab[P^]);
    if Len<>nil then
      Len^ := P-Name;
    if (P^<=' ') and (P^<>#0) then begin
      P^ := #0;
      inc(P);
    end;
    while (P^<=' ') and (P^<>#0) do inc(P);
    if not (P^ in [':','=']) then // allow both age:18 and age=18 pairs
      exit;
    P^ := #0;
    inc(P);
  end;
  result := Name;
end;

procedure GetJSONPropName(var P: PUTF8Char; out PropName: shortstring);
var Name: PAnsiChar;
    c: AnsiChar;
    tab: PJsonCharSet;
begin // match GotoNextJSONObjectOrArray() and overloaded GetJSONPropName()
  PropName[0] := #0;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  Name := pointer(P);
  c := P^;
  if c='"' then begin
    inc(Name);
    P := GotoEndOfJSONString(P);
    if P^<>'"' then
      exit;
    SetString(PropName,Name,P-Name); // note: won't unescape JSON strings
    repeat inc(P) until (P^>' ') or (P^=#0);
    if P^<>':' then begin
      PropName[0] := #0;
      exit;
    end;
    inc(P);
  end else
  if c='''' then begin // single quotes won't handle nested quote character
    inc(P);
    inc(Name);
    while P^<>'''' do
      if P^<' ' then
        exit else
        inc(P);
    SetString(PropName,Name,P-Name);
    repeat inc(P) until (P^>' ') or (P^=#0);
    if P^<>':' then begin
      PropName[0] := #0;
      exit;
    end;
    inc(P);
  end else begin // e.g. '{age:{$gt:18}}'
    tab := @JSON_CHARS;
    if not (jcJsonIdentifierFirstChar in tab[c]) then
      exit;
    repeat
      inc(P);
    until not (jcJsonIdentifier in tab[P^]);
    SetString(PropName,Name,P-Name);
    while (P^<=' ') and (P^<>#0) do inc(P);
    if not (P^ in [':','=']) then begin // allow both age:18 and age=18 pairs
      PropName[0] := #0;
      exit;
    end;
    inc(P);
  end;
end;

function GotoNextJSONPropName(P: PUTF8Char): PUTF8Char;
var c: AnsiChar;
    tab: PJsonCharSet;
label s;
begin  // should match GotoNextJSONObjectOrArray()
  while (P^<=' ') and (P^<>#0) do inc(P);
  result := nil;
  if P=nil then
    exit;
  c := P^;
  if c='"' then begin
    P := GotoEndOfJSONString(P);
    if P^<>'"' then
      exit;
s:  repeat inc(P) until (P^>' ') or (P^=#0);
    if P^<>':' then
      exit;
  end else
  if c='''' then begin // single quotes won't handle nested quote character
    inc(P);
    while P^<>'''' do
      if P^<' ' then
        exit else
        inc(P);
    goto s;
  end else  begin // e.g. '{age:{$gt:18}}'
    tab := @JSON_CHARS;
    if not (jcJsonIdentifierFirstChar in tab[c]) then
      exit;
    repeat
      inc(P);
    until not (jcJsonIdentifier in tab[P^]);
    if (P^<=' ') and (P^<>#0) then
      inc(P);
    while (P^<=' ') and (P^<>#0) do inc(P);
    if not (P^ in [':','=']) then // allow both age:18 and age=18 pairs
      exit;
  end;
  repeat inc(P) until (P^>' ') or (P^=#0);
  result := P;
end;

function GetJSONFieldOrObjectOrArray(var P: PUTF8Char; wasString: PBoolean;
  EndOfObject: PUTF8Char; HandleValuesAsObjectOrArray: Boolean;
  NormalizeBoolean: Boolean; Len: PInteger): PUTF8Char;
var Value: PUTF8Char;
    wStr: boolean;
begin
  result := nil;
  if P=nil then
    exit;
  while ord(P^) in [1..32] do inc(P);
  if HandleValuesAsObjectOrArray and (P^ in ['{','[']) then begin
    Value := P;
    P := GotoNextJSONObjectOrArray(P);
    if P=nil then
      exit; // invalid content
    if Len<>nil then
      Len^ := P-Value;
    if wasString<>nil then
      wasString^ := false; // was object or array
    while ord(P^) in [1..32] do inc(P);
    if EndOfObject<>nil then
     EndOfObject^ := P^;
    P^ := #0; // make zero-terminated
    if P[1]=#0 then
      P := nil else
      inc(P);
    result := Value;
  end else begin
    result := GetJSONField(P,P,@wStr,EndOfObject,Len);
    if wasString<>nil then
      wasString^ := wStr;
    if not wStr and NormalizeBoolean and (result<>nil) then begin
      if PInteger(result)^=TRUE_LOW then
        result := pointer(SmallUInt32UTF8[1]) else   // normalize true -> 1
      if PInteger(result)^=FALSE_LOW then
        result := pointer(SmallUInt32UTF8[0]) else   // normalize false -> 0
        exit;
      if Len<>nil then
        Len^ := 1;
    end;
  end;
end;

function IsString(P: PUTF8Char): boolean;  // test if P^ is a "string" value
begin
  if P=nil then begin
    result := false;
    exit;
  end;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if (P[0] in ['0'..'9']) or // is first char numeric?
     ((P[0] in ['-','+']) and (P[1] in ['0'..'9'])) then begin
    // check if P^ is a true numerical value
    repeat inc(P) until not (P^ in ['0'..'9']); // check digits
    if P^='.' then
      repeat inc(P) until not (P^ in ['0'..'9']); // check fractional digits
    if ((P^='e') or (P^='E')) and (P[1] in ['0'..'9','+','-']) then begin
      inc(P);
      if P^='+' then inc(P) else
      if P^='-' then inc(P);
      while (P^>='0') and (P^<='9') do inc(P);
    end;
    while (P^<=' ') and (P^<>#0) do inc(P);
    result := (P^<>#0);
    exit;
  end else
    result := true; // don't begin with a numerical value -> must be a string
end;

function IsStringJSON(P: PUTF8Char): boolean;  // test if P^ is a "string" value
var c4: integer;
    c: AnsiChar;
    tab: PJsonCharSet;
begin
  if P=nil then begin
    result := false;
    exit;
  end;
  while (P^<=' ') and (P^<>#0) do inc(P);
  tab := @JSON_CHARS;
  c4 := PInteger(P)^;
  if (((c4=NULL_LOW)or(c4=TRUE_LOW)) and (jcEndOfJSONValueField in tab[P[4]])) or
     ((c4=FALSE_LOW) and (P[4]='e') and (jcEndOfJSONValueField in tab[P[5]])) then begin
    result := false; // constants are no string
    exit;
  end;
  c := P^;
  if (jcDigitFirstChar in tab[c]) and
     (((c>='1') and (c<='9')) or // is first char numeric?
     ((c='0') and ((P[1]<'0') or (P[1]>'9'))) or // '012' excluded by JSON
     ((c='-') and (P[1]>='0') and (P[1]<='9'))) then begin
    // check if c is a true numerical value
    repeat inc(P) until (P^<'0') or (P^>'9'); // check digits
    if P^='.' then
      repeat inc(P) until (P^<'0') or (P^>'9'); // check fractional digits
    if ((P^='e') or (P^='E')) and (jcDigitChar in tab[P[1]]) then begin
      inc(P);
      c := P^;
      if c='+' then inc(P) else
      if c='-' then inc(P);
      while (P^>='0') and (P^<='9') do inc(P);
    end;
    while (P^<=' ') and (P^<>#0) do inc(P);
    result := (P^<>#0);
    exit;
  end else
    result := true; // don't begin with a numerical value -> must be a string
end;

function IsValidJSON(const s: RawUTF8): boolean;
begin
  result := IsValidJSON(pointer(s),length(s));
end;

function IsValidJSON(P: PUTF8Char; len: PtrInt): boolean;
var B: PUTF8Char;
begin
  result := false;
  if (P=nil) or (len<=0) or (StrLen(P)<>len) then
    exit;
  B := P;
  P :=  GotoEndJSONItem(B,{strict=}true);
  result := (P<>nil) and (P-B=len);
end;

procedure GetJSONItemAsRawJSON(var P: PUTF8Char; var result: RawJSON;
  EndOfObject: PAnsiChar);
var B: PUTF8Char;
begin
  result := '';
  if P=nil then
    exit;
  B := GotoNextNotSpace(P);
  P := GotoEndJSONItem(B);
  if P=nil then
    exit;
  FastSetString(RawUTF8(result),B,P-B);
  while (P^<=' ') and (P^<>#0) do inc(P);
  if EndOfObject<>nil then
    EndOfObject^ := P^;
  if P^<>#0 then //if P^=',' then
    repeat inc(P) until (P^>' ') or (P^=#0);
end;

function GetJSONItemAsRawUTF8(var P: PUTF8Char; var output: RawUTF8;
  wasString: PBoolean; EndOfObject: PUTF8Char): boolean;
var V: PUTF8Char;
    VLen: integer;
begin
  V := GetJSONFieldOrObjectOrArray(P,wasstring,EndOfObject,true,true,@VLen);
  if V=nil then // parsing error
    result := false else begin
    FastSetString(output,V,VLen);
    result := true;
  end;
end;

function GotoNextJSONObjectOrArrayInternal(P,PMax: PUTF8Char; EndChar: AnsiChar): PUTF8Char;
var tab: PJsonCharSet;
label Prop;
begin // should match GetJSONPropName()
  result := nil;
  repeat
    case P^ of
    '{','[': begin
      if PMax=nil then
        P := GotoNextJSONObjectOrArray(P) else
        P := GotoNextJSONObjectOrArrayMax(P,PMax);
      if P=nil then exit;
    end;
    ':': if EndChar<>'}' then exit else inc(P); // syntax for JSON object only
    ',': inc(P); // comma appears in both JSON objects and arrays
    '}': if EndChar='}' then break else exit;
    ']': if EndChar=']' then break else exit;
    '"': begin
      P := GotoEndOfJSONString(P);
      if P^<>'"' then
        exit;
      inc(P);
    end;
    '-','+','0'..'9': begin // '0123' excluded by JSON, but not here
      tab := @JSON_CHARS;
      repeat
        inc(P);
      until not (jcDigitFloatChar in tab[P^]);
    end;
    't': if PInteger(P)^=TRUE_LOW then inc(P,4) else goto Prop;
    'f': if PInteger(P+1)^=FALSE_LOW2 then inc(P,5) else goto Prop;
    'n': if PInteger(P)^=NULL_LOW then inc(P,4) else goto Prop;
    '''': begin // single-quoted identifier
      repeat inc(P); if P^<=' ' then exit; until P^='''';
      repeat inc(P) until (P^>' ') or (P^=#0);
      if P^<>':' then exit;
    end;
    '/': begin
      repeat // allow extended /regex/ syntax
        inc(P);
        if P^=#0 then
          exit;
      until P^='/';
      repeat inc(P) until (P^>' ') or (P^=#0);
    end;
    else begin
Prop: tab := @JSON_CHARS;
      if not (jcJsonIdentifierFirstChar in tab[P^]) then
        exit;
      repeat
        inc(P);
      until not (jcJsonIdentifier in tab[P^]);
      while (P^<=' ') and (P^<>#0) do inc(P);
      if P^='(' then begin // handle e.g. "born":isodate("1969-12-31")
        inc(P);
        while (P^<=' ') and (P^<>#0) do inc(P);
        if P^='"' then begin
         P := GotoEndOfJSONString(P);
         if P^<>'"' then
          exit;
        end;
        inc(P);
        while (P^<=' ') and (P^<>#0) do inc(P);
        if P^<>')' then
          exit;
        inc(P);
       end
       else
       if P^<>':' then exit;
    end;
    end;
    while (P^<=' ') and (P^<>#0) do inc(P);
    if (PMax<>nil) and (P>=PMax) then
      exit;
  until P^=EndChar;
  result := P+1;
end;

function GotoEndJSONItem(P: PUTF8Char; strict: boolean): PUTF8Char;
var tab: PJsonCharSet;
label pok,ok;
begin
  result := nil; // to notify unexpected end
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  case P^ of
  #0: exit;
  '"': begin
    P := GotoEndOfJSONString(P);
    if P^<>'"' then
      exit;
    inc(P);
    goto ok;
  end;
  '[': begin
    repeat inc(P) until (P^>' ') or (P^=#0);
    P := GotoNextJSONObjectOrArrayInternal(P,nil,']');
    goto pok;
  end;
  '{': begin
    repeat inc(P) until (P^>' ') or (P^=#0);
    P := GotoNextJSONObjectOrArrayInternal(P,nil,'}');
pok:if P=nil then
      exit;
ok: while (P^<=' ') and (P^<>#0) do inc(P);
    result := P;
    exit;
  end;
  end;
  if strict then
    case P^ of
    't': if PInteger(P)^=TRUE_LOW then begin inc(P,4); goto ok; end;
    'f': if PInteger(P+1)^=FALSE_LOW2 then begin inc(P,5); goto ok; end;
    'n': if PInteger(P)^=NULL_LOW then begin inc(P,4); goto ok; end;
    '-','+','0'..'9': begin
      tab := @JSON_CHARS;
      repeat inc(P) until not (jcDigitFloatChar in tab[P^]);
      goto ok;
    end;
    end else begin // not strict
      tab := @JSON_CHARS;
      repeat // numeric or true/false/null or MongoDB extended {age:{$gt:18}}
        inc(P);
      until jcEndOfJSONFieldOr0 in tab[P^];
      if P^=#0 then exit; // unexpected end
    end;
  if P^=#0 then
    exit;
  result := P;
end;

function GotoNextJSONItem(P: PUTF8Char; NumberOfItemsToJump: cardinal;
  EndOfObject: PAnsiChar): PUTF8Char;
var tab: PJsonCharSet;
label pok,n;
begin
 result := nil; // to notify unexpected end
 while NumberOfItemsToJump>0 do begin
   while (P^<=' ') and (P^<>#0) do inc(P);
   // get a field
   case P^ of
   #0: exit;
   '"': begin
     P := GotoEndOfJSONString(P);
     if P^<>'"' then
       exit; // P^ should be '"' here
   end;
   '[': begin
     repeat inc(P) until (P^>' ') or (P^=#0);
     P := GotoNextJSONObjectOrArrayInternal(P,nil,']');
     goto pok;
   end;
   '{': begin
     repeat inc(P) until (P^>' ') or (P^=#0);
     P := GotoNextJSONObjectOrArrayInternal(P,nil,'}');
pok: if P=nil then
       exit;
     while (P^<=' ') and (P^<>#0) do inc(P);
     goto n;
   end;
   end;
   tab := @JSON_CHARS;
   repeat // numeric or true/false/null or MongoDB extended {age:{$gt:18}}
     inc(P);
   until jcEndOfJSONFieldOr0 in tab[P^];
n: if P^=#0 then
     exit;
   if EndOfObject<>nil then
     EndOfObject^ := P^;
   inc(P);
   dec(NumberOfItemsToJump);
 end;
 result := P;
end;

function GotoNextJSONObjectOrArray(P: PUTF8Char): PUTF8Char;
var EndChar: AnsiChar;
begin // should match GetJSONPropName()
  result := nil; // mark error or unexpected end (#0)
  while (P^<=' ') and (P^<>#0) do inc(P);
  case P^ of
  '[': EndChar := ']';
  '{': EndChar := '}';
  else exit;
  end;
  repeat inc(P) until (P^>' ') or (P^=#0);
  result := GotoNextJSONObjectOrArrayInternal(P,nil,EndChar);
end;

function GotoNextJSONObjectOrArray(P: PUTF8Char; EndChar: AnsiChar): PUTF8Char;
begin // should match GetJSONPropName()
  while (P^<=' ') and (P^<>#0) do inc(P);
  result := GotoNextJSONObjectOrArrayInternal(P,nil,EndChar);
end;

function GotoNextJSONObjectOrArrayMax(P,PMax: PUTF8Char): PUTF8Char;
var EndChar: AnsiChar;
begin // should match GetJSONPropName()
  result := nil; // mark error or unexpected end (#0)
  while (P^<=' ') and (P^<>#0) do inc(P);
  case P^ of
  '[': EndChar := ']';
  '{': EndChar := '}';
  else exit;
  end;
  repeat inc(P) until (P^>' ') or (P^=#0);
  result := GotoNextJSONObjectOrArrayInternal(P,PMax,EndChar);
end;

function JSONArrayCount(P: PUTF8Char): integer;
var n: integer;
begin
  result := -1;
  n := 0;
  P := GotoNextNotSpace(P);
  if P^<>']' then
  repeat
    case P^ of
    '"': begin
      P := GotoEndOfJSONString(P);
      if P^<>'"' then
        exit;
      inc(P);
    end;
    '{','[': begin
      P := GotoNextJSONObjectOrArray(P);
      if P=nil then
        exit; // invalid content
    end;
    end;
    while not (P^ in [#0,',',']']) do inc(P);
    inc(n);
    if P^<>',' then break;
    repeat inc(P) until (P^>' ') or (P^=#0);
  until false;
  if P^=']' then
    result := n;
end;

function JSONArrayDecode(P: PUTF8Char; out Values: TPUTF8CharDynArray): boolean;
var n,max: integer;
begin
  result := false;
  max := 0;
  n := 0;
  P := GotoNextNotSpace(P);
  if P^<>']' then
  repeat
    if max=n then begin
      max := NextGrow(max);
      SetLength(Values,max);
    end;
    Values[n] := P;
    case P^ of
    '"': begin
      P := GotoEndOfJSONString(P);
      if P^<>'"' then
        exit;
      inc(P);
    end;
    '{','[': begin
      P := GotoNextJSONObjectOrArray(P);
      if P=nil then
        exit; // invalid content
    end;
    end;
    while not (P^ in [#0,',',']']) do inc(P);
    inc(n);
    if P^<>',' then break;
    repeat inc(P) until (P^>' ') or (P^=#0);
  until false;
  if P^=']' then begin
    SetLength(Values,n);
    result := true;
  end else
    Values := nil;
end;

function JSONArrayItem(P: PUTF8Char; Index: integer): PUTF8Char;
begin
  if P<>nil then begin
    P := GotoNextNotSpace(P);
    if P^='[' then begin
      P := GotoNextNotSpace(P+1);
      if P^<>']' then
      repeat
        if Index<=0 then begin
          result := P;
          exit;
        end;
        case P^ of
        '"': begin
          P := GotoEndOfJSONString(P);
          if P^<>'"' then
            break; // invalid content
          inc(P);
        end;
        '{','[': begin
          P := GotoNextJSONObjectOrArray(P);
          if P=nil then
            break; // invalid content
        end;
        end;
        while not (P^ in [#0,',',']']) do inc(P);
        if P^<>',' then break;
        repeat inc(P) until (P^>' ') or (P^=#0);
        dec(Index);
      until false;
    end;
  end;
  result := nil;
end;

function JSONArrayCount(P,PMax: PUTF8Char): integer;
var n: integer;
begin
  result := -1;
  n := 0;
  P := GotoNextNotSpace(P);
  if P^<>']' then
  while P<PMax do begin
    case P^ of
    '"': begin
      P := GotoEndOfJSONString(P);
      if P^<>'"' then
        exit;
      inc(P);
    end;
    '{','[': begin
      P := GotoNextJSONObjectOrArrayMax(P,PMax);
      if P=nil then
        exit; // invalid content or PMax reached
      end;
    end;
    while not (P^ in [#0,',',']']) do inc(P);
    inc(n);
    if P^<>',' then break;
    repeat inc(P) until (P^>' ') or (P^=#0);
  end;
  if P^=']' then
    result := n;
end;

function JSONObjectPropCount(P: PUTF8Char): integer;
var n: integer;
begin
  result := -1;
  n := 0;
  P := GotoNextNotSpace(P);
  if P^<>'}' then
  repeat
    P := GotoNextJSONPropName(P);
    if P=nil then
      exit;
    case P^ of
    '"': begin
      P := GotoEndOfJSONString(P);
      if P^<>'"' then
        exit;
      inc(P);
    end;
    '{','[': begin
      P := GotoNextJSONObjectOrArray(P);
      if P=nil then
        exit; // invalid content
    end;
    end;
    while not (P^ in [#0,',','}']) do inc(P);
    inc(n);
    if P^<>',' then break;
    repeat inc(P) until (P^>' ') or (P^=#0);
  until false;
  if P^='}' then
    result := n;
end;

function JsonObjectItem(P: PUTF8Char; const PropName: RawUTF8;
  PropNameFound: PRawUTF8): PUTF8Char;
var name: shortstring; // no memory allocation nor P^ modification
    PropNameLen: integer;
    PropNameUpper: array[byte] of AnsiChar;
begin
  if P<>nil then begin
    P := GotoNextNotSpace(P);
    PropNameLen := length(PropName);
    if PropNameLen<>0 then begin
      if PropName[PropNameLen]='*' then begin
        UpperCopy255Buf(PropNameUpper,pointer(PropName),PropNameLen-1)^ := #0;
        PropNameLen := 0;
      end;
      if P^='{' then
        P := GotoNextNotSpace(P+1);
      if P^<>'}' then
      repeat
        GetJSONPropName(P,name);
        if (name[0]=#0) or (name[0]>#200) then
          break;
        while (P^<=' ') and (P^<>#0) do inc(P);
        if PropNameLen=0 then begin
          name[ord(name[0])+1] := #0; // make ASCIIZ
          if IdemPChar(@name[1],PropNameUpper) then begin
            if PropNameFound<>nil then
              FastSetString(PropNameFound^,@name[1],ord(name[0]));
            result := P;
            exit;
          end;
        end else
        if IdemPropName(name,pointer(PropName),PropNameLen) then begin
          result := P;
          exit;
        end;
        case P^ of
        '"': begin
          P := GotoEndOfJSONString(P);
          if P^<>'"' then
            break; // invalid content
          inc(P);
        end;
        '{','[': begin
          P := GotoNextJSONObjectOrArray(P);
          if P=nil then
            break; // invalid content
        end;
        end;
        while not (P^ in [#0,',','}']) do inc(P);
        if P^<>',' then break;
        repeat inc(P) until (P^>' ') or (P^=#0);
      until false;
    end;
  end;
  result := nil;
end;

function JsonObjectByPath(JsonObject,PropPath: PUTF8Char): PUTF8Char;
var objName: RawUTF8;
begin
  result := nil;
  if (JsonObject=nil) or (PropPath=nil) then
    exit;
  repeat
    GetNextItem(PropPath,'.',objName);
    if objName='' then
      exit;
    JsonObject := JsonObjectItem(JsonObject,objName);
    if JsonObject=nil then
      exit;
  until PropPath=nil; // found full name scope
  result := JsonObject;
end;

function JsonObjectsByPath(JsonObject,PropPath: PUTF8Char): RawUTF8;
var itemName,objName,propNameFound,objPath: RawUTF8;
    start,ending,obj: PUTF8Char;
    WR: TTextWriter;
    temp: TTextWriterStackBuffer;
  procedure AddFromStart(const name: RaWUTF8);
  begin
    start := GotoNextNotSpace(start);
    ending := GotoEndJSONItem(start);
    if ending=nil then
      exit;
    if WR=nil then begin
      WR := TTextWriter.CreateOwnedStream(temp);
      WR.Add('{');
    end else
      WR.Add(',');
    WR.AddFieldName(name);
    while (ending>start) and (ending[-1]<=' ') do dec(ending); // trim right
    WR.AddNoJSONEscape(start,ending-start);
  end;
begin
  result := '';
  if (JsonObject=nil) or (PropPath=nil) then
    exit;
  WR := nil;
  try
    repeat
      GetNextItem(PropPath,',',itemName);
      if itemName='' then
        break;
      if itemName[length(itemName)]<>'*' then begin
        start := JsonObjectByPath(JsonObject,pointer(itemName));
        if start<>nil then
          AddFromStart(itemName);
      end else begin
        objPath := '';
        obj := pointer(itemName);
        repeat
          GetNextItem(obj,'.',objName);
          if objName='' then
            exit;
          propNameFound := '';
          JsonObject := JsonObjectItem(JsonObject,objName,@propNameFound);
          if JsonObject=nil then
            exit;
          if obj=nil then begin // found full name scope
            start := JsonObject;
            repeat
              AddFromStart(objPath+propNameFound);
              ending := GotoNextNotSpace(ending);
              if ending^<>',' then
                break;
              propNameFound := '';
              start := JsonObjectItem(GotoNextNotSpace(ending+1),objName,@propNameFound);
            until start=nil;
            break;
          end else
            objPath := objPath+objName+'.';
        until false;
      end;
    until PropPath=nil;
    if WR<>nil then begin
      WR.Add('}');
      WR.SetText(result);
    end;
  finally
    WR.Free;
  end;
end;

function JSONObjectAsJSONArrays(JSON: PUTF8Char; out keys,values: RawUTF8): boolean;
var wk,wv: TTextWriter;
    kb,ke,vb,ve: PUTF8Char;
    temp1,temp2: TTextWriterStackBuffer;
begin
  result := false;
  if (JSON=nil) or (JSON^<>'{') then
    exit;
  wk := TTextWriter.CreateOwnedStream(temp1);
  wv := TTextWriter.CreateOwnedStream(temp2);
  try
    wk.Add('[');
    wv.Add('[');
    kb := JSON+1;
    repeat
      ke := GotoEndJSONItem(kb);
      if (ke=nil) or (ke^<>':') then
        exit; // invalid input content
      vb := ke+1;
      ve := GotoEndJSONItem(vb);
      if (ve=nil) or not(ve^ in [',','}']) then
        exit;
      wk.AddNoJSONEscape(kb,ke-kb);
      wk.Add(',');
      wv.AddNoJSONEscape(vb,ve-vb);
      wv.Add(',');
      kb := ve+1;
    until ve^='}';
    wk.CancelLastComma;
    wk.Add(']');
    wk.SetText(keys);
    wv.CancelLastComma;
    wv.Add(']');
    wv.SetText(values);
    result := true;
  finally
    wv.Free;
    wk.Free;
  end;
end;

function TryRemoveComment(P: PUTF8Char): PUTF8Char; {$ifdef HASINLINE}inline;{$endif}
begin
  result := P + 1;
  case result^ of
   '/': begin // this is // comment - replace by ' '
     dec(result);
     repeat
       result^ := ' ';
       inc(result)
     until result^ in [#0, #10, #13];
     if result^<>#0 then inc(result);
   end;
   '*': begin // this is /* comment - replace by ' ' but keep CRLF
     result[-1] := ' ';
     repeat
       if not(result^ in [#10, #13]) then
         result^ := ' '; // keep CRLF for correct line numbering (e.g. for error)
       inc(result);
       if PWord(result)^=ord('*')+ord('/')shl 8 then begin
         PWord(result)^ := $2020;
         inc(result,2);
         break;
       end;
     until result^=#0;
   end;
  end;
end;

procedure RemoveCommentsFromJSON(P: PUTF8Char);
var PComma: PUTF8Char;
begin // replace comments by ' ' characters which will be ignored by parser
  if P<>nil then
  while P^<>#0 do begin
    case P^ of
      '"': begin
        P := GotoEndOfJSONString(P);
        if P^<>'"' then
          exit else
          Inc(P);
      end;
      '/': P := TryRemoveComment(P);
      ',': begin // replace trailing comma by space for strict JSON parsers
        PComma := P;
        repeat inc(P) until (P^>' ') or (P^=#0);
        if P^='/' then
          P := TryRemoveComment(P);
        while (P^<=' ') and (P^<>#0) do inc(P);
        if P^ in ['}', ']'] then
          PComma^ := ' '; // see https://github.com/synopse/mORMot/pull/349
      end;
    else
      inc(P);
    end;
  end;
end;

procedure JSONBufferToXML(P: PUTF8Char; const Header,NameSpace: RawUTF8;
  out result: RawUTF8);
var i,j,L: integer;
    temp: TTextWriterStackBuffer;
begin
  if P=nil then
    result := Header else
    with TTextWriter.CreateOwnedStream(temp) do
    try
      AddNoJSONEscape(pointer(Header),length(Header));
      L := length(NameSpace);
      if L<>0 then
        AddNoJSONEscape(pointer(NameSpace),L);
      AddJSONToXML(P);
      if L<>0 then
        for i := 1 to L do
          if NameSpace[i]='<' then begin
            for j := i+1 to L do
              if NameSpace[j] in [' ','>'] then begin
                Add('<','/');
                AddStringCopy(NameSpace,i+1,j-i-1);
                Add('>');
                break;
              end;
            break;
          end;
      SetText(result);
    finally
      Free;
    end;
end;

function JSONToXML(const JSON: RawUTF8; const Header: RawUTF8;
  const NameSpace: RawUTF8): RawUTF8;
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON);
  try
    JSONBufferToXML(tmp.buf,Header,NameSpace,result);
  finally
    tmp.Done;
  end;
end;

procedure JSONBufferReformat(P: PUTF8Char; out result: RawUTF8;
  Format: TTextWriterJSONFormat);
var temp: array[word] of byte; // 64KB buffer
begin
  if P<>nil then
    with TTextWriter.CreateOwnedStream(@temp,SizeOf(temp)) do
    try
      AddJSONReformat(P,Format,nil);
      SetText(result);
    finally
      Free;
    end;
end;

function JSONReformat(const JSON: RawUTF8; Format: TTextWriterJSONFormat): RawUTF8;
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON);
  try
    JSONBufferReformat(tmp.buf,result,Format);
  finally
    tmp.Done;
  end;
end;

function JSONBufferReformatToFile(P: PUTF8Char; const Dest: TFileName;
  Format: TTextWriterJSONFormat): boolean;
var F: TFileStream;
    temp: array[word] of word; // 128KB
begin
  try
    F := TFileStream.Create(Dest,fmCreate);
    try
      with TTextWriter.Create(F,@temp,SizeOf(temp)) do
      try
        AddJSONReformat(P,Format,nil);
        FlushFinal;
      finally
        Free;
      end;
      result := true;
    finally
      F.Free;
    end;
  except
    on Exception do
      result := false;
  end;
end;

function JSONReformatToFile(const JSON: RawUTF8; const Dest: TFileName;
  Format: TTextWriterJSONFormat=jsonHumanReadable): boolean;
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON);
  try
    result := JSONBufferReformatToFile(tmp.buf,Dest,Format);
  finally
    tmp.Done;
  end;
end;


procedure KB(bytes: Int64; out result: TShort16; nospace: boolean);
type TUnits = (kb,mb,gb,tb,pb,eb,b);
const TXT: array[boolean,TUnits] of RawUTF8 =
    ((' KB',' MB',' GB',' TB',' PB',' EB','% B'), ('KB','MB','GB','TB','PB','EB','%B'));
var hi,rem: cardinal;
    u: TUnits;
begin
  if bytes<1 shl 10-(1 shl 10) div 10 then begin
    FormatShort16(TXT[nospace,b],[integer(bytes)],result);
    exit;
  end;
  if bytes<1 shl 20-(1 shl 20) div 10 then begin
    u := kb;
    rem := bytes;
    hi := bytes shr 10;
  end else
  if bytes<1 shl 30-(1 shl 30) div 10 then begin
    u := mb;
    rem := bytes shr 10;
    hi := bytes shr 20;
  end else
  if bytes<Int64(1) shl 40-(Int64(1) shl 40) div 10 then begin
    u := gb;
    rem := bytes shr 20;
    hi := bytes shr 30;
  end else
  if bytes<Int64(1) shl 50-(Int64(1) shl 50) div 10 then begin
    u := tb;
    rem := bytes shr 30;
    hi := bytes shr 40;
  end else
  if bytes<Int64(1) shl 60-(Int64(1) shl 60) div 10 then begin
    u := pb;
    rem := bytes shr 40;
    hi := bytes shr 50;
  end else begin
    u := eb;
    rem := bytes shr 50;
    hi := bytes shr 60;
  end;
  rem := rem and 1023;
  if rem<>0 then
    rem := rem div 102;
  if rem=10 then begin
    rem := 0;
    inc(hi); // round up as expected by (most) human beings
  end;
  if rem<>0 then
    FormatShort16('%.%%',[hi,rem,TXT[nospace,u]],result) else
    FormatShort16('%%',[hi,TXT[nospace,u]],result);
end;

function KB(bytes: Int64): TShort16;
begin
  KB(bytes,result,{nospace=}false);
end;

function KBNoSpace(bytes: Int64): TShort16;
begin
  KB(bytes,result,{nospace=}true);
end;

function KB(bytes: Int64; nospace: boolean): TShort16;
begin
  KB(bytes,result,nospace);
end;

function KB(const buffer: RawByteString): TShort16;
begin
  KB(length(buffer),result,{nospace=}false);
end;

procedure KBU(bytes: Int64; var result: RawUTF8);
var tmp: TShort16;
begin
  KB(bytes,tmp,{nospace=}false);
  FastSetString(result,@tmp[1],ord(tmp[0]));
end;

function IntToThousandString(Value: integer; const ThousandSep: TShort4): shortstring;
var i,L,Len: cardinal;
begin
  str(Value,result);
  L := length(result);
  Len := L+1;
  if Value<0 then
    dec(L,2) else // ignore '-' sign
    dec(L);
  for i := 1 to L div 3 do
    insert(ThousandSep,result,Len-i*3);
end;

function MicroSecToString(Micro: QWord): TShort16;
begin
  MicroSecToString(Micro,result);
end;

procedure MicroSecToString(Micro: QWord; out result: TShort16);
  procedure TwoDigitToString(value: cardinal; const u: shortstring; var result: TShort16);
  var d100: TDiv100Rec;
  begin
    if value<100 then
      FormatShort16('0.%%',[UInt2DigitsToShortFast(value),u],result) else begin
      Div100(value,d100);
      if d100.m=0 then
        FormatShort16('%%',[d100.d,u],result) else
        FormatShort16('%.%%',[d100.d,UInt2DigitsToShortFast(d100.m),u],result);
    end;
  end;
  procedure TimeToString(value: cardinal; const u: shortstring; var result: TShort16);
  var d: cardinal;
  begin
    d := value div 60;
    FormatShort16('%%%',[d,u,UInt2DigitsToShortFast(value-(d*60))],result);
  end;
begin
  if Int64(Micro)<=0 then
    result := '0us' else
  if Micro<1000 then
    FormatShort16('%us',[Micro],result) else
  if Micro<1000000 then
    TwoDigitToString({$ifdef CPU32}PCardinal(@Micro)^{$else}Micro{$endif} div 10,'ms',result) else
  if Micro<60000000 then
    TwoDigitToString({$ifdef CPU32}PCardinal(@Micro)^{$else}Micro{$endif} div 10000,'s',result) else
  if Micro<QWord(3600000000) then
    TimeToString({$ifdef CPU32}PCardinal(@Micro)^{$else}Micro{$endif} div 1000000,'m',result) else
  if Micro<QWord(86400000000*2) then
    TimeToString(Micro div 60000000,'h',result) else
    FormatShort16('%d',[Micro div QWord(86400000000)],result)
end;

function IsInitializedCriticalSection(const CS: TRTLCriticalSection): Boolean;
begin
  result := not IsZero(PHash128(@CS)^); // minimum size is 24 bytes = 192 bits
end;

procedure InitializeCriticalSectionIfNeededAndEnter(var CS: TRTLCriticalSection);
begin
  if IsZero(PHash128(@CS)^) then
    InitializeCriticalSection(CS);
  EnterCriticalSection(CS);
end;

procedure DeleteCriticalSectionIfNeeded(var CS: TRTLCriticalSection);
begin
  if not IsZero(PHash128(@CS)^) then
    DeleteCriticalSection(CS);
end;


{ ******************* process monitoring / statistics ********************** }

{ TPrecisionTimer }

procedure TPrecisionTimer.Init;
begin
  FillCharFast(self,SizeOf(self),0);
end;

procedure TPrecisionTimer.Start;
begin
  FillCharFast(self,SizeOf(self),0);
  {$ifdef LINUX}QueryPerformanceMicroSeconds{$else}QueryPerformanceCounter{$endif}(fStart);
end;

function TPrecisionTimer.Started: boolean;
begin
  result := (fStart<>0) or (fTime<>0);
end;

procedure TPrecisionTimer.Resume;
begin
  if fStart=0 then
    {$ifdef LINUX}QueryPerformanceMicroSeconds{$else}QueryPerformanceCounter{$endif}(fStart);
end;

procedure TPrecisionTimer.Pause;
begin
  if fStart=0 then
    exit;
  {$ifdef LINUX}QueryPerformanceMicroSeconds{$else}QueryPerformanceCounter{$endif}(fStop);
  FromExternalQueryPerformanceCounters(fStop-fStart);
  inc(fPauseCount);
end;

procedure TPrecisionTimer.FromExternalMicroSeconds(const MicroSeconds: QWord);
begin
  fLastTime := MicroSeconds;
  inc(fTime,MicroSeconds);
  fStart := 0; // indicates time has been computed
end;

function TPrecisionTimer.FromExternalQueryPerformanceCounters(const CounterDiff: QWord): QWord;
begin // mimics Pause from already known elapsed time
  {$ifdef LINUX}
  FromExternalMicroSeconds(CounterDiff);
  {$else}
  if fWinFreq=0 then
    QueryPerformanceFrequency(fWinFreq);
  if fWinFreq<>0 then
    FromExternalMicroSeconds((CounterDiff*1000000)div PQWord(@fWinFreq)^);
  {$endif LINUX}
  result := fLastTime;
end;

function TPrecisionTimer.Stop: TShort16;
begin
  if fStart<>0 then
    Pause;
  MicroSecToString(fTime,result);
end;

function TPrecisionTimer.StopInMicroSec: TSynMonitorTotalMicroSec;
begin
  if fStart<>0 then
    Pause;
  result := fTime;
end;

function TPrecisionTimer.Time: TShort16;
begin
  if fStart<>0 then
    Pause;
  MicroSecToString(fTime,result);
end;

function TPrecisionTimer.LastTime: TShort16;
begin
  if fStart<>0 then
    Pause;
  MicroSecToString(fLastTime,result);
end;

function TPrecisionTimer.ByCount(Count: QWord): TShort16;
begin
  if Count=0 then // avoid div per 0 exception
    result := '0' else begin
    if fStart<>0 then
      Pause;
    MicroSecToString(fTime div Count,result);
  end;
end;

function TPrecisionTimer.PerSec(const Count: QWord): QWord;
begin
  if fStart<>0 then
    Pause;
  if fTime<=0 then // avoid negative value in case of incorrect Start/Stop sequence
    result := 0 else // avoid div per 0 exception
    result := (Count*1000000) div fTime;
end;

function TPrecisionTimer.SizePerSec(Size: QWord): shortstring;
begin
  FormatShort('% in % i.e. %/s',[KB(Size),Stop,KB(PerSec(Size))],result);
end;


type
  /// a class used internaly by TPrecisionTimer.ProfileMethod
  TPrecisionTimerProfiler = class(TInterfacedObject)
  protected
    fTimer: PPrecisionTimer;
  public
    constructor Create(aTimer: PPrecisionTimer);
    destructor Destroy; override;
  end;

constructor TPrecisionTimerProfiler.Create(aTimer: PPrecisionTimer);
begin
  fTimer := aTimer;
end;

destructor TPrecisionTimerProfiler.Destroy;
begin
  if fTimer<>nil then
    fTimer^.Pause;
  inherited;
end;


function TPrecisionTimer.ProfileCurrentMethod: IUnknown;
begin
  Resume;
  result := TPrecisionTimerProfiler.Create(@self);
end;


{ TLocalPrecisionTimer }

function TLocalPrecisionTimer.ByCount(Count: cardinal): RawUTF8;
begin
  result := fTimer.ByCount(Count);
end;

procedure TLocalPrecisionTimer.Pause;
begin
  fTimer.Pause;
end;

function TLocalPrecisionTimer.PerSec(Count: cardinal): cardinal;
begin
  result := fTimer.PerSec(Count);
end;

procedure TLocalPrecisionTimer.Resume;
begin
  fTimer.Resume;
end;

procedure TLocalPrecisionTimer.Start;
begin
  fTimer.Start;
end;

function TLocalPrecisionTimer.Stop: TShort16;
begin
  result := fTimer.Stop;
end;

constructor TLocalPrecisionTimer.CreateAndStart;
begin
  inherited;
  fTimer.Start;
end;

{ TSynMonitorTime }

function TSynMonitorTime.GetAsText: TShort16;
begin
  MicroSecToString(fMicroSeconds,result);
end;

function TSynMonitorTime.PerSecond(const Count: QWord): QWord;
begin
  if {$ifdef FPC}Int64(fMicroSeconds){$else}PInt64(@fMicroSeconds)^{$endif}<=0 then
    result := 0 else // avoid negative or div per 0
    result := (Count*1000000) div fMicroSeconds;
end;


{ TSynMonitorOneTime }

function TSynMonitorOneTime.GetAsText: TShort16;
begin
  MicroSecToString(fMicroSeconds,result);
end;

function TSynMonitorOneTime.PerSecond(const Count: QWord): QWord;
begin
  if {$ifdef FPC}Int64(fMicroSeconds){$else}PInt64(@fMicroSeconds)^{$endif}<=0 then
    result := 0 else
    result := (Count*QWord(1000000)) div fMicroSeconds;
end;


{ TSynMonitorSizeParent }

constructor TSynMonitorSizeParent.Create(aTextNoSpace: boolean);
begin
  inherited Create;
  fTextNoSpace := aTextNoSpace;
end;

{ TSynMonitorSize }

function TSynMonitorSize.GetAsText: TShort16;
begin
  KB(fBytes,result,fTextNoSpace);
end;

{ TSynMonitorOneSize }

function TSynMonitorOneSize.GetAsText: TShort16;
begin
  KB(fBytes,result,fTextNoSpace);
end;

{ TSynMonitorThroughput }

function TSynMonitorThroughput.GetAsText: TShort16;
begin
  FormatShort16('%/s',[KB(fBytesPerSec,fTextNoSpace)],result);
end;


{ TSynMonitor }

constructor TSynMonitor.Create;
begin
  inherited Create;
  fTotalTime := TSynMonitorTime.Create;
  fLastTime := TSynMonitorOneTime.Create;
  fMinimalTime := TSynMonitorOneTime.Create;
  fAverageTime := TSynMonitorOneTime.Create;
  fMaximalTime := TSynMonitorOneTime.Create;
end;

constructor TSynMonitor.Create(const aName: RawUTF8);
begin
  Create;
  fName := aName;
end;

destructor TSynMonitor.Destroy;
begin
  fMaximalTime.Free;
  fAverageTime.Free;
  fMinimalTime.Free;
  fLastTime.Free;
  fTotalTime.Free;
  inherited Destroy;
end;

procedure TSynMonitor.Lock;
begin
  fSafe^.Lock;
end;

procedure TSynMonitor.UnLock;
begin
  fSafe^.UnLock;
end;

procedure TSynMonitor.Changed;
begin // do nothing by default - overriden classes may track modified changes
end;

procedure TSynMonitor.ProcessStart;
begin
  if fProcessing then
    raise ESynException.CreateUTF8('Reentrant %.ProcessStart',[self]);
  fSafe^.Lock;
  try
    InternalTimer.Resume;
    fTaskStatus := taskNotStarted;
    fProcessing := true;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.ProcessDoTask;
begin
  fSafe^.Lock;
  try
    inc(fTaskCount);
    fTaskStatus := taskStarted;
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.ProcessStartTask;
begin
  if fProcessing then
    raise ESynException.CreateUTF8('Reentrant %.ProcessStart',[self]);
  fSafe^.Lock;
  try
    InternalTimer.Resume;
    fProcessing := true;
    inc(fTaskCount);
    fTaskStatus := taskStarted;
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.ProcessEnd;
begin
  fSafe^.Lock;
  try
    InternalTimer.Pause;
    LockedFromProcessTimer;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.LockedFromProcessTimer;
begin
  fTotalTime.MicroSec := InternalTimer.TimeInMicroSec;
  if fTaskStatus=taskStarted then begin
    fLastTime.MicroSec := InternalTimer.LastTimeInMicroSec;
    if (fMinimalTime.MicroSec=0) or
       (InternalTimer.LastTimeInMicroSec<fMinimalTime.MicroSec) then
      fMinimalTime.MicroSec := InternalTimer.LastTimeInMicroSec;
    if InternalTimer.LastTimeInMicroSec>fMaximalTime.MicroSec then
      fMaximalTime.MicroSec := InternalTimer.LastTimeInMicroSec;
    fTaskStatus := taskNotStarted;
  end;
  LockedPerSecProperties;
  fProcessing := false;
  Changed;
end;

function TSynMonitor.FromExternalQueryPerformanceCounters(const CounterDiff: QWord): QWord;
begin
  fSafe^.Lock;
  try // thread-safe ProcessStart+ProcessDoTask+ProcessEnd
    inc(fTaskCount);
    fTaskStatus := taskStarted;
    result := InternalTimer.FromExternalQueryPerformanceCounters(CounterDiff);
    LockedFromProcessTimer;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.FromExternalMicroSeconds(const MicroSecondsElapsed: QWord);
begin
  fSafe^.Lock;
  try // thread-safe ProcessStart+ProcessDoTask+ProcessEnd
    inc(fTaskCount);
    fTaskStatus := taskStarted;
    InternalTimer.FromExternalMicroSeconds(MicroSecondsElapsed);
    LockedFromProcessTimer;
  finally
    fSafe^.UnLock;
  end;
end;

class procedure TSynMonitor.InitializeObjArray(var ObjArr; Count: integer);
var i: integer;
begin
  ObjArrayClear(ObjArr);
  SetLength(TPointerDynArray(ObjArr),Count);
  for i := 0 to Count-1 do
    TPointerDynArray(ObjArr)[i] := Create;
end;

procedure TSynMonitor.ProcessError(const info: variant);
begin
  fSafe^.Lock;
  try
    if not VarIsEmptyOrNull(info) then
      inc(fInternalErrors);
    fLastInternalError := info;
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.ProcessErrorFmt(const Fmt: RawUTF8; const Args: array of const);
begin
  ProcessError({$ifndef NOVARIANTS}RawUTF8ToVariant{$endif}(FormatUTF8(Fmt,Args)));
end;

procedure TSynMonitor.ProcessErrorRaised(E: Exception);
begin
  {$ifndef NOVARIANTS}if E.InheritsFrom(ESynException) then
    ProcessError(_ObjFast([E,ObjectToVariant(E,true)])) else{$endif}
    ProcessErrorFmt('%: %', [E,E.Message]);
end;

procedure TSynMonitor.ProcessErrorNumber(info: integer);
begin
  ProcessError(info);
end;

procedure TSynMonitor.LockedPerSecProperties;
begin
  if fTaskCount=0 then
    exit; // avoid division per zero
  fPerSec := fTotalTime.PerSecond(fTaskCount);
  fAverageTime.MicroSec := fTotalTime.MicroSec div fTaskCount;
end;

procedure TSynMonitor.Sum(another: TSynMonitor);
begin
  if (self=nil) or (another=nil) then
    exit;
  fSafe^.Lock;
  another.fSafe^.Lock;
  try
    LockedSum(another);
  finally
    another.fSafe^.UnLock;
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.LockedSum(another: TSynMonitor);
begin
  fTotalTime.MicroSec := fTotalTime.MicroSec+another.fTotalTime.MicroSec;
  if (fMinimalTime.MicroSec=0) or
     (another.fMinimalTime.MicroSec<fMinimalTime.MicroSec) then
    fMinimalTime.MicroSec := another.fMinimalTime.MicroSec;
  if another.fMaximalTime.MicroSec>fMaximalTime.MicroSec then
    fMaximalTime.MicroSec := another.fMaximalTime.MicroSec;
  inc(fTaskCount,another.fTaskCount);
  if another.Processing then
    fProcessing := true; // if any thread is active, whole daemon is active
  inc(fInternalErrors,another.Errors);
end;

procedure TSynMonitor.WriteDetailsTo(W: TTextWriter);
begin
  fSafe^.Lock;
  try
    W.WriteObject(self);
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.ComputeDetailsTo(W: TTextWriter);
begin
  fSafe^.Lock;
  try
    LockedPerSecProperties; // may not have been calculated after Sum()
    WriteDetailsTo(W);
  finally
    fSafe^.UnLock;
  end;
end;

function TSynMonitor.ComputeDetailsJSON: RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := DefaultTextWriterSerializer.CreateOwnedStream(temp);
  try
    ComputeDetailsTo(W);
    W.SetText(result);
  finally
    W.Free;
  end;
end;

{$ifndef NOVARIANTS}
function TSynMonitor.ComputeDetails: variant;
begin
  _Json(ComputeDetailsJSON,result,JSON_OPTIONS_FAST);
end;
{$endif}


{ TSynMonitorWithSize}

constructor TSynMonitorWithSize.Create;
begin
  inherited Create;
  fSize := TSynMonitorSize.Create({nospace=}false);
  fThroughput := TSynMonitorThroughput.Create({nospace=}false);
end;

destructor TSynMonitorWithSize.Destroy;
begin
  inherited Destroy;
  fThroughput.Free;
  fSize.Free;
end;

procedure TSynMonitorWithSize.LockedPerSecProperties;
begin
  inherited LockedPerSecProperties;
  fThroughput.BytesPerSec := fTotalTime.PerSecond(fSize.Bytes);
end;

procedure TSynMonitorWithSize.AddSize(const Bytes: QWord);
begin
  fSafe^.Lock;
  try
    fSize.Bytes := fSize.Bytes+Bytes;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitorWithSize.LockedSum(another: TSynMonitor);
begin
  inherited LockedSum(another);
  if another.InheritsFrom(TSynMonitorWithSize) then
    AddSize(TSynMonitorWithSize(another).Size.Bytes);
end;


{ TSynMonitorInputOutput }

constructor TSynMonitorInputOutput.Create;
begin
  inherited Create;
  fInput := TSynMonitorSize.Create({nospace=}false);
  fOutput := TSynMonitorSize.Create({nospace=}false);
  fInputThroughput := TSynMonitorThroughput.Create({nospace=}false);
  fOutputThroughput := TSynMonitorThroughput.Create({nospace=}false);
end;

destructor TSynMonitorInputOutput.Destroy;
begin
  fOutputThroughput.Free;
  fOutput.Free;
  fInputThroughput.Free;
  fInput.Free;
  inherited Destroy;
end;

procedure TSynMonitorInputOutput.LockedPerSecProperties;
begin
  inherited LockedPerSecProperties;
  fInputThroughput.BytesPerSec := fTotalTime.PerSecond(fInput.Bytes);
  fOutputThroughput.BytesPerSec := fTotalTime.PerSecond(fOutput.Bytes);
end;

procedure TSynMonitorInputOutput.AddSize(const Incoming, Outgoing: QWord);
begin
  fSafe^.Lock;
  try
    fInput.Bytes := fInput.Bytes+Incoming;
    fOutput.Bytes := fOutput.Bytes+Outgoing;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitorInputOutput.LockedSum(another: TSynMonitor);
begin
  inherited LockedSum(another);
  if another.InheritsFrom(TSynMonitorInputOutput) then begin
    fInput.Bytes := fInput.Bytes+TSynMonitorInputOutput(another).Input.Bytes;
    fOutput.Bytes := fOutput.Bytes+TSynMonitorInputOutput(another).Output.Bytes;
  end;
end;


{ TSynMonitorServer }

procedure TSynMonitorServer.ClientConnect;
begin
  if self=nil then
    exit;
  fSafe^.Lock;
  try
    inc(fClientsCurrent);
    if fClientsCurrent>fClientsMax then
      fClientsMax := fClientsCurrent;
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitorServer.ClientDisconnect;
begin
  if self=nil then
    exit;
  fSafe^.Lock;
  try
    if fClientsCurrent>0 then
      dec(fClientsCurrent);
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitorServer.ClientDisconnectAll;
begin
  if self=nil then
    exit;
  fSafe^.Lock;
  try
    fClientsCurrent := 0;
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

function TSynMonitorServer.GetClientsCurrent: TSynMonitorOneCount;
begin
  if self=nil then begin
    result := 0;
    exit;
  end;
  fSafe^.Lock;
  try
    result := fClientsCurrent;
  finally
    fSafe^.UnLock;
  end;
end;

function TSynMonitorServer.AddCurrentRequestCount(diff: integer): integer;
begin
  if self=nil then begin
    result := 0;
    exit;
  end;
  fSafe^.Lock;
  try
    inc(fCurrentRequestCount,diff);
    result := fCurrentRequestCount;
  finally
    fSafe^.UnLock;
  end;
end;


{ ******************* cross-cutting classes and functions ***************** }

{ TSynInterfacedObject }

function TSynInterfacedObject._AddRef: {$ifdef FPC}longint{$else}integer{$endif};
begin
  result := VirtualAddRef;
end;

function TSynInterfacedObject._Release: {$ifdef FPC}longint{$else}integer{$endif};
begin
  result := VirtualRelease;
end;

{$ifdef FPC}
function TSynInterfacedObject.QueryInterface(
  {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID;
  out Obj): longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
{$else}
function TSynInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
{$endif}
begin
  result := VirtualQueryInterface(IID,Obj);
end;

function TSynInterfacedObject.VirtualQueryInterface(const IID: TGUID; out Obj): HResult;
begin
  result := E_NOINTERFACE;
end;

{$ifdef CPUINTEL}
{$ifndef DELPHI5OROLDER}

{ TSynFPUException }

function TSynFPUException.VirtualAddRef: integer;
begin
  if fRefCount=0 then begin
    {$ifndef CPU64}
    fSaved8087 := Get8087CW;
    Set8087CW(fExpected8087); // set FPU exceptions mask
    {$else}
    fSavedMXCSR := GetMXCSR;
    SetMXCSR(fExpectedMXCSR); // set FPU exceptions mask
    {$endif}
  end;
  inc(fRefCount);
  result := 1; // should never be 0 (mark release of TSynFPUException instance)
end;

function TSynFPUException.VirtualRelease: integer;
begin
  dec(fRefCount);
  if fRefCount=0 then
    {$ifndef CPU64}
    Set8087CW(fSaved8087);
    {$else}
    SetMXCSR(fSavedMXCSR);
    {$endif}
  result := 1; // should never be 0 (mark release of TSynFPUException instance)
end;

threadvar
  GlobalSynFPUExceptionDelphi,
  GlobalSynFPUExceptionLibrary: TSynFPUException;

{$ifndef CPU64}
constructor TSynFPUException.Create(Expected8087Flag: word);
begin // $1372=Delphi $137F=library (mask all exceptions)
  inherited Create;
  fExpected8087 := Expected8087Flag;
end;
{$else}
constructor TSynFPUException.Create(ExpectedMXCSR: word);
begin // $1920=Delphi $1FA0=library (mask all exceptions)
  inherited Create;
  fExpectedMXCSR := ExpectedMXCSR;
end;
{$endif}

class function TSynFPUException.ForLibraryCode: IUnknown;
var obj: TSynFPUException;
begin
  result := GlobalSynFPUExceptionLibrary;
  if result<>nil then
    exit;
  {$ifndef CPU64}
  obj := TSynFPUException.Create($137F);
  {$else}
  obj := TSynFPUException.Create($1FA0);
  {$endif}
  GarbageCollector.Add(obj);
  GlobalSynFPUExceptionLibrary := obj;
  result := obj;
end;

class function TSynFPUException.ForDelphiCode: IUnknown;
var obj: TSynFPUException;
begin
  result := GlobalSynFPUExceptionDelphi;
  if result<>nil then
    exit;
  {$ifndef CPU64}
  obj := TSynFPUException.Create($1372);
  {$else}
  obj := TSynFPUException.Create($1920);
  {$endif}
  GarbageCollector.Add(obj);
  GlobalSynFPUExceptionDelphi := obj;
  result := obj;
end;

{$endif DELPHI5OROLDER}
{$endif CPUINTEL}


{ TAutoFree }

constructor TAutoFree.Create(var localVariable; obj: TObject);
begin
  fObject := obj;
  TObject(localVariable) := obj;
end;

class function TAutoFree.One(var localVariable; obj: TObject): IAutoFree;
begin
  result := Create(localVariable,obj);
end;

class function TAutoFree.Several(const varObjPairs: array of pointer): IAutoFree;
begin
  result := Create(varObjPairs);
end;

constructor TAutoFree.Create(const varObjPairs: array of pointer);
var n,i: integer;
begin
  n := length(varObjPairs);
  if (n=0) or (n and 1=1) then
    exit;
  n := n shr 1;
  if n=0 then
    exit;
  SetLength(fObjectList,n);
  for i := 0 to n-1 do begin
    fObjectList[i] := varObjPairs[i*2+1];
    PPointer(varObjPairs[i*2])^ := fObjectList[i];
  end;
end;

procedure TAutoFree.Another(var localVariable; obj: TObject);
var n: integer;
begin
  n := length(fObjectList);
  SetLength(fObjectList,n+1);
  fObjectList[n] := obj;
  TObject(localVariable) := obj;
end;

destructor TAutoFree.Destroy;
var i: integer;
begin
  if fObjectList<>nil then
    for i := high(fObjectList) downto 0 do // release FILO
      fObjectList[i].Free;
  fObject.Free;
  inherited;
end;


{ TAutoLocker }

constructor TAutoLocker.Create;
begin
  fSafe.Init;
end;

destructor TAutoLocker.Destroy;
begin
  fSafe.Done;
  inherited;
end;

function TAutoLocker.ProtectMethod: IUnknown;
begin
  result := TAutoLock.Create(@fSafe);
end;

procedure TAutoLocker.Enter;
begin
  EnterCriticalSection(fSafe.fSection);
end;

procedure TAutoLocker.Leave;
begin
  LeaveCriticalSection(fSafe.fSection);
end;

function TAutoLocker.Safe: PSynLocker;
begin
  result := @fSafe;
end;

{$ifndef DELPHI5OROLDER} // internal error C3517 under Delphi 5 :(
{$ifndef NOVARIANTS}

{ TLockedDocVariant }

constructor TLockedDocVariant.Create;
begin
  Create(JSON_OPTIONS_FAST);
end;

constructor TLockedDocVariant.Create(FastStorage: boolean);
begin
  Create(JSON_OPTIONS[FastStorage]);
end;

constructor TLockedDocVariant.Create(options: TDocVariantOptions);
begin
  fLock := TAutoLocker.Create;
  fValue.Init(options);
end;

destructor TLockedDocVariant.Destroy;
begin
  inherited;
  fLock.Free;
end;

function TLockedDocVariant.Lock: TAutoLocker;
begin
  result := fLock;
end;

function TLockedDocVariant.Exists(const Name: RawUTF8; out Value: Variant): boolean;
var i: integer;
begin
  fLock.Enter;
  try
    i := fValue.GetValueIndex(Name);
    if i<0 then
      result := false else begin
      Value := fValue.Values[i];
      result := true;
    end;
  finally
    fLock.Leave;
  end;
end;

function TLockedDocVariant.ExistsOrLock(const Name: RawUTF8; out Value: Variant): boolean;
var i: integer;
begin
  result := true;
  fLock.Enter;
  try
    i := fValue.GetValueIndex(Name);
    if i<0 then
      result := false else
      Value := fValue.Values[i];
  finally
    if result then
      fLock.Leave;
  end;
end;

procedure TLockedDocVariant.ReplaceAndUnlock(
  const Name: RawUTF8; const Value: Variant; out LocalValue: Variant);
begin // caller made fLock.Enter
  try
    SetValue(Name,Value);
    LocalValue := Value;
  finally
    fLock.Leave;
  end;
end;

function TLockedDocVariant.AddExistingPropOrLock(const Name: RawUTF8;
  var Obj: variant): boolean;
var i: integer;
begin
  result := true;
  fLock.Enter;
  try
    i := fValue.GetValueIndex(Name);
    if i<0 then
      result := false else
      _ObjAddProps([Name,fValue.Values[i]],Obj);
  finally
    if result then
      fLock.Leave;
  end;
end;

procedure TLockedDocVariant.AddNewPropAndUnlock(const Name: RawUTF8;
  const Value: variant;
  var Obj: variant);
begin // caller made fLock.Enter
  try
    SetValue(Name,Value);
    _ObjAddProps([Name,Value],Obj);
  finally
    fLock.Leave;
  end;
end;

function TLockedDocVariant.AddExistingProp(const Name: RawUTF8;
  var Obj: variant): boolean;
var i: integer;
begin
  result := true;
  fLock.Enter;
  try
    i := fValue.GetValueIndex(Name);
    if i<0 then
      result := false else
      _ObjAddProps([Name,fValue.Values[i]],Obj);
  finally
    fLock.Leave;
  end;
end;

procedure TLockedDocVariant.AddNewProp(const Name: RawUTF8;
  const Value: variant; var Obj: variant);
begin
  fLock.Enter;
  try
    SetValue(Name,Value);
    _ObjAddProps([Name,Value],Obj);
  finally
    fLock.Leave;
  end;
end;

function TLockedDocVariant.GetValue(const Name: RawUTF8): Variant;
begin
  fLock.Enter;
  try
    fValue.RetrieveValueOrRaiseException(pointer(Name),length(Name),
      dvoNameCaseSensitive in fValue.Options,result,false);
  finally
    fLock.Leave;
  end;
end;

procedure TLockedDocVariant.SetValue(const Name: RawUTF8;
  const Value: Variant);
begin
  fLock.Enter;
  try
    fValue.AddOrUpdateValue(Name,Value);
  finally
    fLock.Leave;
  end;
end;

procedure TLockedDocVariant.AddItem(const Value: variant);
begin
  fLock.Enter;
  try
    fValue.AddItem(Value);
  finally
    fLock.Leave;
  end;
end;

function TLockedDocVariant.Copy: variant;
begin
  VarClear(result);
  fLock.Enter;
  try
    TDocVariantData(result).InitCopy(variant(fValue),JSON_OPTIONS_FAST);
  finally
    fLock.Leave;
  end;
end;

procedure TLockedDocVariant.Clear;
var opt: TDocVariantOptions;
begin
  fLock.Enter;
  try
    opt := fValue.Options;
    fValue.Clear;
    fValue.Init(opt);
  finally
    fLock.Leave;
  end;
end;

function TLockedDocVariant.ToJSON(HumanReadable: boolean): RawUTF8;
var tmp: RawUTF8;
begin
  fLock.Enter;
  try
    VariantSaveJSON(variant(fValue),twJSONEscape,tmp);
  finally
    fLock.Leave;
  end;
  if HumanReadable then
    JSONBufferReformat(pointer(tmp),result) else
    result := tmp;
end;

{$endif NOVARIANTS}
{$endif DELPHI5OROLDER}


function GetDelphiCompilerVersion: RawUTF8;
begin
  result :=
{$ifdef FPC}
  'Free Pascal'
  {$ifdef VER2_6_4}+' 2.6.4'{$endif}
  {$ifdef VER3_0_0}+' 3.0.0'{$endif}
  {$ifdef VER3_0_1}+' 3.0.1'{$endif}
  {$ifdef VER3_0_2}+' 3.0.2'{$endif}
  {$ifdef VER3_1_1}+' 3.1.1'{$endif}
  {$ifdef VER3_2}  +' 3.2'  {$endif}
  {$ifdef VER3_3_1}+' 3.3.1'{$endif}
{$else}
  {$ifdef VER130} 'Delphi 5'{$endif}
  {$ifdef CONDITIONALEXPRESSIONS}  // Delphi 6 or newer
    {$if     defined(KYLIX3)}'Kylix 3'
    {$elseif defined(VER140)}'Delphi 6'
    {$elseif defined(VER150)}'Delphi 7'
    {$elseif defined(VER160)}'Delphi 8'
    {$elseif defined(VER170)}'Delphi 2005'
    {$elseif defined(VER185)}'Delphi 2007'
    {$elseif defined(VER180)}'Delphi 2006'
    {$elseif defined(VER200)}'Delphi 2009'
    {$elseif defined(VER210)}'Delphi 2010'
    {$elseif defined(VER220)}'Delphi XE'
    {$elseif defined(VER230)}'Delphi XE2'
    {$elseif defined(VER240)}'Delphi XE3'
    {$elseif defined(VER250)}'Delphi XE4'
    {$elseif defined(VER260)}'Delphi XE5'
    {$elseif defined(VER265)}'AppMethod 1'
    {$elseif defined(VER270)}'Delphi XE6'
    {$elseif defined(VER280)}'Delphi XE7'
    {$elseif defined(VER290)}'Delphi XE8'
    {$elseif defined(VER300)}'Delphi 10 Seattle'
    {$elseif defined(VER310)}'Delphi 10.1 Berlin'
    {$elseif defined(VER320)}'Delphi 10.2 Tokyo'
    {$elseif defined(VER330)}'Delphi 10.3 Rio'
    {$elseif defined(VER340)}'Delphi 10.4 Sydney'
    {$elseif defined(VER350)}'Delphi 11 Alexandria'
    {$elseif defined(VER360)}'Delphi 11.1 Next'
    {$ifend}
  {$endif CONDITIONALEXPRESSIONS}
{$endif FPC}
{$ifdef CPU64} +' 64 bit' {$else} +' 32 bit' {$endif}
end;


{ TRawUTF8List }

constructor TRawUTF8List.Create(aOwnObjects, aNoDuplicate, aCaseSensitive: boolean);
begin
  if aOwnObjects then
    include(fFlags,fObjectsOwned);
  if aNoDuplicate then
    include(fFlags,fNoDuplicate);
  if aCaseSensitive then
    include(fFlags,fCaseSensitive);
  Create(fFlags);
end;

constructor TRawUTF8List.Create(aFlags: TRawUTF8ListFlags);
begin
  fNameValueSep := '=';
  fFlags := aFlags;
  fValues.InitSpecific(TypeInfo(TRawUTF8DynArray),fValue,djRawUTF8,@fCount,
    not (fCaseSensitive in aFlags));
  fSafe.Init;
end;

destructor TRawUTF8List.Destroy;
begin
  SetCapacity(0);
  inherited;
  fSafe.Done;
end;

procedure TRawUTF8List.SetCaseSensitive(Value: boolean);
begin
  if (self=nil) or (fCaseSensitive in fFlags=Value) then
    exit;
  fSafe.Lock;
  try
    if Value then
      include(fFlags,fCaseSensitive) else
      exclude(fFlags,fCaseSensitive);
    fValues.Hasher.InitSpecific(@fValues,djRawUTF8,not Value);
    Changed;
  finally
    fSafe.UnLock;
  end;
end;

procedure TRawUTF8List.SetCapacity(const capa: PtrInt);
begin
  if self<>nil then begin
    fSafe.Lock;
    try
      if capa<=0 then begin // clear
        if fObjects<>nil then begin
          if fObjectsOwned in fFlags then
            RawObjectsClear(pointer(fObjects),fCount);
          fObjects := nil;
        end;
        fValues.Clear;
        if fNoDuplicate in fFlags then
          fValues.Hasher.Clear;
        Changed;
      end else begin // resize
        if capa<fCount then begin // resize down
          if fObjects<>nil then begin
            if fObjectsOwned in fFlags then
              RawObjectsClear(@fObjects[capa],fCount-capa-1);
            SetLength(fObjects,capa);
          end;
          fValues.Count := capa;
          if fNoDuplicate in fFlags then
            fValues.ReHash;
          Changed;
        end;
        if capa>length(fValue) then begin // resize up
          SetLength(fValue,capa);
          if fObjects<>nil then
            SetLength(fObjects,capa);
        end;
      end;
    finally
      fSafe.UnLock;
    end;
  end;
end;

function TRawUTF8List.Add(const aText: RawUTF8; aRaiseExceptionIfExisting: boolean): PtrInt;
begin
  result := AddObject(aText,nil,aRaiseExceptionIfExisting);
end;

function TRawUTF8List.AddObject(const aText: RawUTF8; aObject: TObject;
  aRaiseExceptionIfExisting: boolean; aFreeAndReturnExistingObject: PPointer): PtrInt;
var added: boolean;
    obj: TObject;
begin
  result := -1;
  if self=nil then
    exit;
  fSafe.Lock;
  try
    if fNoDuplicate in fFlags then begin
      result := fValues.FindHashedForAdding(aText,added,{noadd=}true);
      if not added then begin
        obj := GetObject(result);
        if (obj=aObject) and (obj<>nil) then
          exit; // found identical aText/aObject -> behave as if added
        if aFreeAndReturnExistingObject<>nil then begin
          aObject.Free;
          aFreeAndReturnExistingObject^ := obj;
        end;
        if aRaiseExceptionIfExisting then
          raise ESynException.CreateUTF8('%.Add duplicate [%]',[self,aText]);
        result := -1;
        exit;
      end;
    end;
    result := fValues.Add(aText);
    if (fObjects<>nil) or (aObject<>nil) then begin
      if result>=length(fObjects) then
        SetLength(fObjects,length(fValue)); // same capacity
      if aObject<>nil then
        fObjects[result] := aObject;
    end;
    if Assigned(fOnChange) then
      Changed;
  finally
    fSafe.UnLock;
  end;
end;

procedure TRawUTF8List.AddObjectUnique(const aText: RawUTF8;
  aObjectToAddOrFree: PPointer);
begin
  if fNoDuplicate in fFlags then
    AddObject(aText,aObjectToAddOrFree^,{raiseexc=}false,
      {freeandreturnexisting=}aObjectToAddOrFree);
end;

procedure TRawUTF8List.AddRawUTF8List(List: TRawUTF8List);
var i: PtrInt;
begin
  if List<>nil then begin
    BeginUpdate; // includes Safe.Lock
    try
      for i := 0 to List.fCount-1 do
        AddObject(List.fValue[i],List.GetObject(i));
    finally
      EndUpdate;
    end;
  end;
end;

procedure TRawUTF8List.BeginUpdate;
begin
  if InterLockedIncrement(fOnChangeLevel)>1 then
    exit;
  fSafe.Lock;
  fOnChangeBackupForBeginUpdate := fOnChange;
  fOnChange := OnChangeHidden;
  exclude(fFlags,fOnChangeTrigerred);
end;

procedure TRawUTF8List.EndUpdate;
begin
  if (fOnChangeLevel<=0) or (InterLockedDecrement(fOnChangeLevel)>0) then
    exit; // allows nested BeginUpdate..EndUpdate calls
  fOnChange := fOnChangeBackupForBeginUpdate;
  if (fOnChangeTrigerred in fFlags) and Assigned(fOnChange) then
    Changed;
  exclude(fFlags,fOnChangeTrigerred);
  fSafe.UnLock;
end;

procedure TRawUTF8List.Changed;
begin
  if Assigned(fOnChange) then
    try
      fOnChange(self);
    except // ignore any exception in user code (may not trigger fSafe.UnLock)
    end;
end;

procedure TRawUTF8List.Clear;
begin
  SetCapacity(0); // will also call Changed
end;

procedure TRawUTF8List.InternalDelete(Index: PtrInt);
begin // caller ensured Index is correct
  fValues.Delete(Index); // includes dec(fCount)
  if PtrUInt(Index)<PtrUInt(length(fObjects)) then begin
    if fObjectsOwned in fFlags then
      fObjects[Index].Free;
    if fCount>Index then
      MoveFast(fObjects[Index+1],fObjects[Index],(fCount-Index)*SizeOf(pointer));
    fObjects[fCount] := nil;
  end;
  if Assigned(fOnChange) then
    Changed;
end;

procedure TRawUTF8List.Delete(Index: PtrInt);
begin
  if (self<>nil) and (PtrUInt(Index)<PtrUInt(fCount)) then
    if fNoDuplicate in fFlags then // force update the hash table
      Delete(fValue[Index]) else
      InternalDelete(Index);
end;

function TRawUTF8List.Delete(const aText: RawUTF8): PtrInt;
begin
  fSafe.Lock;
  try
    if fNoDuplicate in fFlags then
      result := fValues.FindHashedAndDelete(aText,nil,{nodelete=}true) else
      result := FindRawUTF8(pointer(fValue),aText,fCount,fCaseSensitive in fFlags);
    if result>=0 then
      InternalDelete(result);
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8List.DeleteFromName(const Name: RawUTF8): PtrInt;
begin
  fSafe.Lock;
  try
    result := IndexOfName(Name);
    Delete(result);
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8List.IndexOf(const aText: RawUTF8): PtrInt;
begin
  if self<>nil then begin
    fSafe.Lock;
    try
      if fNoDuplicate in fFlags then
        result := fValues.FindHashed(aText) else
        result := FindRawUTF8(pointer(fValue),aText,fCount,fCaseSensitive in fFlags);
    finally
      fSafe.UnLock;
    end;
  end else
    result := -1;
end;

function TRawUTF8List.Get(Index: PtrInt): RawUTF8;
begin
  if (self=nil) or (PtrUInt(Index)>=PtrUInt(fCount)) then
    result := '' else
    result := fValue[Index];
end;

function TRawUTF8List.GetCapacity: PtrInt;
begin
  if self=nil then
    result := 0 else
    result := length(fValue);
end;

function TRawUTF8List.GetCount: PtrInt;
begin
  if self=nil then
    result := 0 else
    result := fCount;
end;

function TRawUTF8List.GetTextPtr: PPUtf8CharArray;
begin
  if self=nil then
    result := nil else
    result := pointer(fValue);
end;

function TRawUTF8List.GetObjectPtr: PPointerArray;
begin
  if self=nil then
    result := nil else
    result := pointer(fObjects);
end;

function TRawUTF8List.GetName(Index: PtrInt): RawUTF8;
begin
  result := Get(Index);
  if result='' then
    exit;
  Index := PosExChar(NameValueSep,result);
  if Index=0 then
    result := '' else
    SetLength(result,Index-1);
end;

function TRawUTF8List.GetObject(Index: PtrInt): pointer;
begin
  if (self<>nil) and (fObjects<>nil) and (PtrUInt(Index)<PtrUInt(fCount)) then
    result := fObjects[Index] else
    result := nil;
end;

function TRawUTF8List.GetObjectFrom(const aText: RawUTF8): pointer;
var ndx: PtrUInt;
begin
  result := nil;
  if (self<>nil) and (fObjects<>nil) then begin
    fSafe.Lock;
    try
      ndx := IndexOf(aText);
      if ndx<PtrUInt(fCount) then
        result := fObjects[ndx];
    finally
      fSafe.UnLock;
    end;
  end;
end;

function TRawUTF8List.GetText(const Delimiter: RawUTF8): RawUTF8;
var DelimLen, i, Len: PtrInt;
    P: PUTF8Char;
begin
  result := '';
  if (self=nil) or (fCount=0) then
    exit;
  fSafe.Lock;
  try
    DelimLen := length(Delimiter);
    Len := DelimLen*(fCount-1);
    for i := 0 to fCount-1 do
      inc(Len,length(fValue[i]));
    FastSetString(result,nil,len);
    P := pointer(result);
    i := 0;
    repeat
      Len := length(fValue[i]);
      if Len>0 then begin
        MoveFast(pointer(fValue[i])^,P^,Len);
        inc(P,Len);
      end;
      inc(i);
      if i>=fCount then
        Break;
      if DelimLen>0 then begin
        MoveSmall(pointer(Delimiter),P,DelimLen);
        inc(P,DelimLen);
      end;
    until false;
  finally
    fSafe.UnLock;
  end;
end;

procedure TRawUTF8List.SaveToStream(Dest: TStream; const Delimiter: RawUTF8);
var W: TTextWriter;
    i: PtrInt;
    temp: TTextWriterStackBuffer;
begin
  if (self=nil) or (fCount=0) then
    exit;
  fSafe.Lock;
  try
    W := TTextWriter.Create(Dest,@temp,SizeOf(temp));
    try
      i := 0;
      repeat
        W.AddString(fValue[i]);
        inc(i);
        if i>=fCount then
          Break;
        W.AddString(Delimiter);
      until false;
      W.FlushFinal;
    finally
      W.Free;
    end;
  finally
    fSafe.UnLock;
  end;
end;

procedure TRawUTF8List.SaveToFile(const FileName: TFileName; const Delimiter: RawUTF8);
var FS: TFileStream;
begin
  FS := TFileStream.Create(FileName,fmCreate);
  try
    SaveToStream(FS,Delimiter);
  finally
    FS.Free;
  end;
end;

function TRawUTF8List.GetTextCRLF: RawUTF8;
begin
  result := GetText;
end;

function TRawUTF8List.GetValue(const Name: RawUTF8): RawUTF8;
begin
  fSafe.Lock;
  try
    result := GetValueAt(IndexOfName(Name));
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8List.GetValueAt(Index: PtrInt): RawUTF8;
begin
  if (self=nil) or (PtrUInt(Index)>=PtrUInt(fCount)) then
    result := '' else
    result := Get(Index);
  if result='' then
    exit;
  Index := PosExChar(NameValueSep,result);
  if Index=0 then
    result := '' else
    result := copy(result,Index+1,maxInt);
end;

function TRawUTF8List.IndexOfName(const Name: RawUTF8): PtrInt;
var UpperName: array[byte] of AnsiChar;
begin
  if self<>nil then begin
    PWord(UpperCopy255(UpperName,Name))^ := ord(NameValueSep);
    for result := 0 to fCount-1 do
      if IdemPChar(Pointer(fValue[result]),UpperName) then
        exit;
  end;
  result := -1;
end;

function TRawUTF8List.IndexOfObject(aObject: TObject): PtrInt;
begin
  if (self<>nil) and (fObjects<>nil) then begin
    fSafe.Lock;
    try
      result := PtrUIntScanIndex(pointer(fObjects),fCount,PtrUInt(aObject));
    finally
      fSafe.UnLock;
    end
  end else
    result := -1;
end;

function TRawUTF8List.Contains(const aText: RawUTF8; aFirstIndex: integer): PtrInt;
var i: PtrInt; // use a temp variable to make oldest Delphi happy :(
begin
  result := -1;
  if self<>nil then begin
    fSafe.Lock;
    try
      for i := aFirstIndex to fCount-1 do
        if PosEx(aText,fValue[i])>0 then begin
          result := i;
          exit;
        end;
    finally
      fSafe.UnLock;
    end;
  end;
end;

procedure TRawUTF8List.OnChangeHidden(Sender: TObject);
begin
  if self<>nil then
    include(fFlags,fOnChangeTrigerred);
end;

procedure TRawUTF8List.Put(Index: PtrInt; const Value: RawUTF8);
begin
  if (self<>nil) and (PtrUInt(Index)<PtrUInt(fCount)) then begin
    fValue[Index] := Value;
    if Assigned(fOnChange) then
      Changed;
  end;
end;

procedure TRawUTF8List.PutObject(Index: PtrInt; Value: pointer);
begin
  if (self<>nil) and (PtrUInt(Index)<PtrUInt(fCount)) then begin
    if fObjects=nil then
      SetLength(fObjects,Length(fValue));
    fObjects[Index] := Value;
    if Assigned(fOnChange) then
      Changed;
  end;
end;

procedure TRawUTF8List.SetText(const aText: RawUTF8; const Delimiter: RawUTF8);
begin
  SetTextPtr(pointer(aText),PUTF8Char(pointer(aText))+length(aText),Delimiter);
end;

procedure TRawUTF8List.LoadFromFile(const FileName: TFileName);
var Map: TMemoryMap;
    P: PUTF8Char;
begin
  if Map.Map(FileName) then
  try
    if Map.Size<>0 then begin
      if TextFileKind(Map)=isUTF8 then begin // ignore UTF-8 BOM
        P := pointer(Map.Buffer+3);
        SetTextPtr(P,P+Map.Size-3,#13#10);
      end else begin
        P := pointer(Map.Buffer);
        SetTextPtr(P,P+Map.Size,#13#10);
      end;
    end;
  finally
    Map.UnMap;
  end;
end;

procedure TRawUTF8List.SetTextPtr(P,PEnd: PUTF8Char; const Delimiter: RawUTF8);
var DelimLen: PtrInt;
    DelimFirst: AnsiChar;
    PBeg, DelimNext: PUTF8Char;
    Line: RawUTF8;
begin
  DelimLen := length(Delimiter);
  BeginUpdate; // also makes fSafe.Lock
  try
    Clear;
    if (P<>nil) and (DelimLen>0) and (P<PEnd) then begin
      DelimFirst := Delimiter[1];
      DelimNext := PUTF8Char(pointer(Delimiter))+1;
      repeat
        PBeg := P;
        while P<PEnd do begin
          if (P^=DelimFirst) and CompareMemSmall(P+1,DelimNext,DelimLen-1) then
            break;
          inc(P);
        end;
        FastSetString(Line,PBeg,P-PBeg);
        AddObject(Line,nil);
        if P>=PEnd then
          break;
        inc(P,DelimLen);
      until P>=PEnd;
    end;
  finally
    EndUpdate;
  end;
end;

procedure TRawUTF8List.SetTextCRLF(const Value: RawUTF8);
begin
  SetText(Value,#13#10);
end;

procedure TRawUTF8List.SetFrom(const aText: TRawUTF8DynArray; const aObject: TObjectDynArray);
var n: integer;
begin
  BeginUpdate; // also makes fSafe.Lock
  try
    Clear;
    n := length(aText);
    if n=0 then
      exit;
    SetCapacity(n);
    fCount := n;
    fValue := aText;
    fObjects := aObject;
    if fNoDuplicate in fFlags then
      fValues.ReHash;
  finally
    EndUpdate;
  end;
end;

procedure TRawUTF8List.SetValue(const Name, Value: RawUTF8);
var i: PtrInt;
    txt: RawUTF8;
begin
  txt := Name+RawUTF8(NameValueSep)+Value;
  fSafe.Lock;
  try
    i := IndexOfName(Name);
    if i<0 then
      AddObject(txt,nil) else
    if fValue[i]<>txt then begin
      fValue[i] := txt;
      if fNoDuplicate in fFlags then
        fValues.Hasher.Clear; // invalidate internal hash table
      Changed;
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8List.GetCaseSensitive: boolean;
begin
  result := (self<>nil) and (fCaseSensitive in fFlags);
end;

function TRawUTF8List.GetNoDuplicate: boolean;
begin
  result := (self<>nil) and (fNoDuplicate in fFlags);
end;

function TRawUTF8List.UpdateValue(const Name: RawUTF8; var Value: RawUTF8;
  ThenDelete: boolean): boolean;
var i: PtrInt;
begin
  result := false;
  fSafe.Lock;
  try
    i := IndexOfName(Name);
    if i>=0 then begin
      Value := GetValueAt(i); // copy value
      if ThenDelete then
        Delete(i); // optionally delete
      result := true;
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8List.PopFirst(out aText: RawUTF8; aObject: PObject): boolean;
begin
  result := false;
  if fCount=0 then
    exit;
  fSafe.Lock;
  try
    if fCount>0 then begin
      aText := fValue[0];
      if aObject<>nil then
        if fObjects<>nil then
          aObject^ := fObjects[0] else
          aObject^ := nil;
      Delete(0);
      result := true;
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8List.PopLast(out aText: RawUTF8; aObject: PObject): boolean;
var last: PtrInt;
begin
  result := false;
  if fCount=0 then
    exit;
  fSafe.Lock;
  try
    last := fCount-1;
    if last>=0 then begin
      aText := fValue[last];
      if aObject<>nil then
        if fObjects<>nil then
          aObject^ := fObjects[last] else
          aObject^ := nil;
      Delete(last);
      result := true;
    end;
  finally
    fSafe.UnLock;
  end;
end;


{ TObjectListHashedAbstract}

constructor TObjectListHashedAbstract.Create(aFreeItems: boolean);
begin
  inherited Create;
  fHash.Init(TypeInfo(TObjectDynArray),fList,@HashPtrUInt,@SortDynArrayPointer,nil,@fCount);
  fHash.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}SetIsObjArray(aFreeItems);
end;

destructor TObjectListHashedAbstract.Destroy;
begin
  fHash.Clear; // will free items if needed
  inherited;
end;

procedure TObjectListHashedAbstract.Delete(aIndex: integer);
begin
  if (self<>nil) and
     fHash.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}Delete(aIndex) then
    fHash.fHash.Clear;
end;

procedure TObjectListHashedAbstract.Delete(aObject: TObject);
begin
  Delete(IndexOf(aObject));
end;

{ TObjectListHashed }

function TObjectListHashed.Add(aObject: TObject; out wasAdded: boolean): integer;
begin
  wasAdded := false;
  if self<>nil then begin
    result := fHash.FindHashedForAdding(aObject,wasAdded);
    if wasAdded then
      fList[result] := aObject;
  end else
    result := -1;
end;

function TObjectListHashed.IndexOf(aObject: TObject): integer;
begin
  if (self<>nil) and (fCount>0) then
    result := fHash.FindHashed(aObject) else
    result := -1;
end;

procedure TObjectListHashed.Delete(aObject: TObject);
begin
  fHash.FindHashedAndDelete(aObject);
end;

{ TObjectListPropertyHashed }

constructor TObjectListPropertyHashed.Create(
  aSubPropAccess: TObjectListPropertyHashedAccessProp;
  aHashElement: TDynArrayHashOne; aCompare: TDynArraySortCompare;
  aFreeItems: boolean);
begin
  inherited Create(aFreeItems);
  fSubPropAccess := aSubPropAccess;
  if Assigned(aHashElement) then
    fHash.fHash.HashElement := aHashElement;
  if Assigned(aCompare) then
    fHash.fHash.Compare := aCompare;
  fHash.EventCompare := IntComp;
  fHash.EventHash := IntHash;
end;

function TObjectListPropertyHashed.IntHash(const Elem): cardinal;
var O: TObject;
begin
  O := fSubPropAccess(TObject(Elem));
  result := fHash.fHash.HashElement(O,fHash.fHash.Hasher);
end;

function TObjectListPropertyHashed.IntComp(const A,B): integer;
var O: TObject;
begin
  O := fSubPropAccess(TObject(A));
  result := fHash.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCompare(O,B);
end;

function TObjectListPropertyHashed.Add(aObject: TObject; out wasAdded: boolean): integer;
begin
  wasAdded := false;
  if self<>nil then begin
    result := fHash.FindHashedForAdding(aObject,wasAdded,
      fHash.fHash.HashElement(aObject,fHash.fHash.Hasher));
    if wasAdded then
      fList[result] := aObject;
  end else
    result := -1;
end;

function TObjectListPropertyHashed.IndexOf(aObject: TObject): integer;
var h: cardinal;
begin
  if fCount>0 then begin
    h := fHash.fHash.HashElement(aObject,fHash.fHash.Hasher);
    result := fHash.fHash.FindOrNew(h,@aObject); // fallback to Scan() if needed
    if result>=0 then
      exit else // found
      result := -1; // for consistency
  end else
    result := -1;
end;

{ TPointerClassHashed }

constructor TPointerClassHashed.Create(aInfo: pointer);
begin
  fInfo := aInfo;
end;

{ TPointerClassHash }

function PointerClassHashProcess(aObject: TPointerClassHashed): pointer;
begin
  if aObject=nil then // may happen for Rehash after SetCount(n+1)
    result := nil else
    result := aObject.Info;
end;

constructor TPointerClassHash.Create;
begin
  inherited Create(@PointerClassHashProcess);
end;

function TPointerClassHash.TryAdd(aInfo: pointer): PPointerClassHashed;
var wasAdded: boolean;
    i: integer;
begin
  i := inherited Add(aInfo,wasAdded);
  if wasAdded then
    result := @List[i] else
    result := nil;
end;

function TPointerClassHash.Find(aInfo: pointer): TPointerClassHashed;
var i: integer;
    p: ^TPointerClassHashed;
begin
  if self<>nil then begin
    if fCount<64 then begin // brute force is faster for small count
      p := pointer(List);
      for i := 1 to fCount do begin
        result := p^;
        if result.fInfo=aInfo then
          exit;
        inc(p);
      end;
    end else begin
      i := IndexOf(aInfo); // use hashing
      if i>=0 then begin
        result := TPointerClassHashed(List[i]);
        exit;
      end;
    end;
  end;
  result := nil;
end;

{ TPointerClassHashLocked }

constructor TPointerClassHashLocked.Create;
begin
  inherited Create;
  fSafe.Init;
end;

destructor TPointerClassHashLocked.Destroy;
begin
  fSafe.Done;
  inherited Destroy;
end;

function TPointerClassHashLocked.FindLocked(aInfo: pointer): TPointerClassHashed;
begin
  if self=nil then
    result := nil else begin
    fSafe.Lock;
    try
      result := inherited Find(aInfo);
    finally
      fSafe.UnLock;
    end;
  end;
end;

function TPointerClassHashLocked.TryAddLocked(aInfo: pointer;
  out aNewEntry: PPointerClassHashed): boolean;
var wasAdded: boolean;
    i: integer;
begin
  fSafe.Lock;
  i := inherited Add(aInfo,wasAdded);
  if wasAdded then begin
    aNewEntry := @List[i];
    result := true; // caller should call Unlock
  end else begin
    fSafe.UnLock;
    result := false;
  end;
end;

procedure TPointerClassHashLocked.Unlock;
begin
  fSafe.UnLock;
end;


{ TSynDictionary }

const
  DIC_KEYCOUNT = 0;
  DIC_KEY = 1;
  DIC_VALUECOUNT = 2;
  DIC_VALUE = 3;
  DIC_TIMECOUNT = 4;
  DIC_TIMESEC = 5;
  DIC_TIMETIX = 6;

function TSynDictionary.KeyFullHash(const Elem): cardinal;
begin
  result := fKeys.fHash.Hasher(0,@Elem,fKeys.ElemSize);
end;

function TSynDictionary.KeyFullCompare(const A,B): integer;
var i: PtrInt;
begin

  for i := 0 to fKeys.ElemSize-1 do begin
    result := TByteArray(A)[i]-TByteArray(B)[i];
    if result<>0 then
      exit;
  end;
  result := 0;
end;

constructor TSynDictionary.Create(aKeyTypeInfo,aValueTypeInfo: pointer;
  aKeyCaseInsensitive: boolean; aTimeoutSeconds: cardinal; aCompressAlgo: TAlgoCompress);
begin
  inherited Create;
  fSafe.Padding[DIC_KEYCOUNT].VType := varInteger;
  fSafe.Padding[DIC_KEY].VType := varUnknown;
  fSafe.Padding[DIC_VALUECOUNT].VType := varInteger;
  fSafe.Padding[DIC_VALUE].VType := varUnknown;
  fSafe.Padding[DIC_TIMECOUNT].VType := varInteger;
  fSafe.Padding[DIC_TIMESEC].VType := varInteger;
  fSafe.Padding[DIC_TIMETIX].VType := varInteger;
  fSafe.PaddingUsedCount := DIC_TIMETIX+1;
  fKeys.Init(aKeyTypeInfo,fSafe.Padding[DIC_KEY].VAny,nil,nil,nil,
    @fSafe.Padding[DIC_KEYCOUNT].VInteger,aKeyCaseInsensitive);
  if not Assigned(fKeys.HashElement) then
    fKeys.EventHash := KeyFullHash;
  if not Assigned(fKeys.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCompare) then
    fKeys.EventCompare := KeyFullCompare;
  fValues.Init(aValueTypeInfo,fSafe.Padding[DIC_VALUE].VAny,
    @fSafe.Padding[DIC_VALUECOUNT].VInteger);
  fTimeouts.Init(TypeInfo(TIntegerDynArray),fTimeOut,@fSafe.Padding[DIC_TIMECOUNT].VInteger);
  if aCompressAlgo=nil then
    aCompressAlgo := AlgoSynLZ;
  fCompressAlgo := aCompressAlgo;
  fSafe.Padding[DIC_TIMESEC].VInteger := aTimeoutSeconds;
end;

function TSynDictionary.ComputeNextTimeOut: cardinal;
begin
  result := fSafe.Padding[DIC_TIMESEC].VInteger;
  if result<>0 then
    result := cardinal({$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10)+result;
end;

function TSynDictionary.GetCapacity: integer;
begin
  fSafe.Lock;
  result := fKeys.GetCapacity;
  fSafe.UnLock;
end;

procedure TSynDictionary.SetCapacity(const Value: integer);
begin
  fSafe.Lock;
  fKeys.Capacity := Value;
  fValues.Capacity := Value;
  if fSafe.Padding[DIC_TIMESEC].VInteger>0 then
    fTimeOuts.Capacity := Value;
  fSafe.UnLock;
end;

function TSynDictionary.GetTimeOutSeconds: cardinal;
begin
  result := fSafe.Padding[DIC_TIMESEC].VInteger;
end;

procedure TSynDictionary.SetTimeouts;
var i: PtrInt;
    timeout: cardinal;
begin
  if fSafe.Padding[DIC_TIMESEC].VInteger=0 then
    exit;
  fTimeOuts.SetCount(fSafe.Padding[DIC_KEYCOUNT].VInteger);
  timeout := ComputeNextTimeOut;
  for i := 0 to fSafe.Padding[DIC_TIMECOUNT].VInteger-1 do
    fTimeOut[i] := timeout;
end;

function TSynDictionary.DeleteDeprecated: integer;
var i: PtrInt;
    now: cardinal;
begin
  result := 0;
  if (self=nil) or (fSafe.Padding[DIC_TIMECOUNT].VInteger=0) or // no entry
     (fSafe.Padding[DIC_TIMESEC].VInteger=0) then // nothing in fTimeOut[]
    exit;
  now := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10;
  if fSafe.Padding[DIC_TIMETIX].VInteger=integer(now) then
    exit; // no need to search more often than every second
  fSafe.Lock;
  try
    fSafe.Padding[DIC_TIMETIX].VInteger := now;
    for i := fSafe.Padding[DIC_TIMECOUNT].VInteger-1 downto 0 do
      if (now>fTimeOut[i]) and (fTimeOut[i]<>0) and
         (not Assigned(fOnCanDelete) or
         fOnCanDelete(fKeys.ElemPtr(i)^,fValues.ElemPtr(i)^,i)) then begin
        fKeys.Delete(i);
        fValues.Delete(i);
        fTimeOuts.Delete(i);
        inc(result);
      end;
    if result>0 then
      fKeys.Rehash; // mandatory after fKeys.Delete(i)
  finally
    fSafe.UnLock;
  end;
end;

procedure TSynDictionary.DeleteAll;
begin
  if self=nil then
    exit;
  fSafe.Lock;
  try
    fKeys.Clear;
    fKeys.Hasher.Clear; // mandatory to avoid GPF
    fValues.Clear;
    if fSafe.Padding[DIC_TIMESEC].VInteger>0 then
      fTimeOuts.Clear;
  finally
    fSafe.UnLock;
  end;
end;

destructor TSynDictionary.Destroy;
begin
  fKeys.Clear;
  fValues.Clear;
  inherited Destroy;
end;

function TSynDictionary.Add(const aKey, aValue): integer;
var added: boolean;
    tim: cardinal;
begin
  fSafe.Lock;
  try
    result := fKeys.FindHashedForAdding(aKey,added);
    if added then begin
      with fKeys{$ifdef UNDIRECTDYNARRAY}.InternalDynArray{$endif} do
        ElemCopyFrom(aKey,result); // fKey[result] := aKey;
      if fValues.Add(aValue)<>result then
        raise ESynException.CreateUTF8('%.Add fValues.Add',[self]);
      tim := ComputeNextTimeOut;
      if tim>0 then
        fTimeOuts.Add(tim);
    end else
      result := -1;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.AddOrUpdate(const aKey, aValue): integer;
var added: boolean;
    tim: cardinal;
begin
  fSafe.Lock;
  try
    tim := ComputeNextTimeOut;
    result := fKeys.FindHashedForAdding(aKey,added);
    if added then begin
      with fKeys{$ifdef UNDIRECTDYNARRAY}.InternalDynArray{$endif} do
        ElemCopyFrom(aKey,result); // fKey[result] := aKey
      if fValues.Add(aValue)<>result then
        raise ESynException.CreateUTF8('%.AddOrUpdate fValues.Add',[self]);
      if tim<>0 then
        fTimeOuts.Add(tim);
    end else begin
      fValues.ElemCopyFrom(aValue,result,{ClearBeforeCopy=}true);
      if tim<>0 then
        fTimeOut[result] := tim;
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.Clear(const aKey): integer;
begin
  fSafe.Lock;
  try
    result := fKeys.FindHashed(aKey);
    if result>=0 then begin
      fValues.ElemClear(fValues.ElemPtr(result)^);
      if fSafe.Padding[DIC_TIMESEC].VInteger>0 then
        fTimeOut[result] := 0;
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.Delete(const aKey): integer;
begin
  fSafe.Lock;
  try
    result := fKeys.FindHashedAndDelete(aKey);
    if result>=0 then begin
      fValues.Delete(result);
      if fSafe.Padding[DIC_TIMESEC].VInteger>0 then
        fTimeOuts.Delete(result);
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.DeleteAt(aIndex: integer): boolean;
begin
  if cardinal(aIndex)<cardinal(fSafe.Padding[DIC_KEYCOUNT].VInteger) then
    // use Delete(aKey) to have efficient hash table update
    result := Delete(fKeys.ElemPtr(aIndex)^)=aIndex else
    result := false;
end;

function TSynDictionary.InArray(const aKey, aArrayValue;
  aAction: TSynDictionaryInArray): boolean;
var nested: TDynArray;
    ndx: integer;
begin
  result := false;
  if (fValues.ElemType=nil) or (PTypeKind(fValues.ElemType)^<>tkDynArray) then
    raise ESynException.CreateUTF8('%.Values: % items are not dynamic arrays',
      [self,fValues.ArrayTypeShort^]);
  fSafe.Lock;
  try
    ndx := fKeys.FindHashed(aKey);
    if ndx<0 then
      exit;
    nested.Init(fValues.ElemType,fValues.ElemPtr(ndx)^);
    case aAction of
    iaFind:
      result := nested.Find(aArrayValue)>=0;
    iaFindAndDelete:
      result := nested.FindAndDelete(aArrayValue)>=0;
    iaFindAndUpdate:
      result := nested.FindAndUpdate(aArrayValue)>=0;
    iaFindAndAddIfNotExisting:
      result := nested.FindAndAddIfNotExisting(aArrayValue)>=0;
    iaAdd:
      result := nested.Add(aArrayValue)>=0;
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.FindInArray(const aKey, aArrayValue): boolean;
begin
  result := InArray(aKey,aArrayValue,iaFind);
end;

function TSynDictionary.FindKeyFromValue(const aValue; out aKey;
  aUpdateTimeOut: boolean): boolean;
var ndx: integer;
begin
  fSafe.Lock;
  try
    ndx := fValues.IndexOf(aValue);
    result := ndx>=0;
    if result then begin
      fKeys.ElemCopyAt(ndx,aKey);
      if aUpdateTimeOut then
        SetTimeoutAtIndex(ndx);
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.DeleteInArray(const aKey, aArrayValue): boolean;
begin
  result := InArray(aKey,aArrayValue,iaFindAndDelete);
end;

function TSynDictionary.UpdateInArray(const aKey, aArrayValue): boolean;
begin
  result := InArray(aKey,aArrayValue,iaFindAndUpdate);
end;

function TSynDictionary.AddInArray(const aKey, aArrayValue): boolean;
begin
  result := InArray(aKey,aArrayValue,iaAdd);
end;

function TSynDictionary.AddOnceInArray(const aKey, aArrayValue): boolean;
begin
  result := InArray(aKey,aArrayValue,iaFindAndAddIfNotExisting);
end;

function TSynDictionary.Find(const aKey; aUpdateTimeOut: boolean): integer;
var tim: cardinal;
begin // caller is expected to call fSafe.Lock/Unlock
  if self=nil then
    result := -1 else
    result := fKeys.FindHashed(aKey);
  if aUpdateTimeOut and (result>=0) then begin
    tim := fSafe.Padding[DIC_TIMESEC].VInteger;
    if tim>0 then // inlined fTimeout[result] := GetTimeout
      fTimeout[result] := cardinal({$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10)+tim;
  end;
end;

function TSynDictionary.FindValue(const aKey; aUpdateTimeOut: boolean; aIndex: PInteger): pointer;
var ndx: PtrInt;
begin
  ndx := Find(aKey,aUpdateTimeOut);
  if aIndex<>nil then
    aIndex^ := ndx;
  if ndx<0 then
    result := nil else
    result := pointer(PtrUInt(fValues.fValue^)+PtrUInt(ndx)*fValues.ElemSize);
end;

function TSynDictionary.FindValueOrAdd(const aKey; var added: boolean;
  aIndex: PInteger): pointer;
var ndx: integer;
    tim: cardinal;
begin
  tim := fSafe.Padding[DIC_TIMESEC].VInteger; // inlined tim := GetTimeout
  if tim<>0 then
    tim := cardinal({$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10)+tim;
  ndx := fKeys.FindHashedForAdding(aKey,added);
  if added then begin
    with fKeys{$ifdef UNDIRECTDYNARRAY}.InternalDynArray{$endif} do
      ElemCopyFrom(aKey,ndx); // fKey[i] := aKey
    fValues.SetCount(ndx+1); // reserve new place for associated value
    if tim>0 then
      fTimeOuts.Add(tim);
  end else
    if tim>0 then
      fTimeOut[ndx] := tim;
  if aIndex<>nil then
    aIndex^ := ndx;
  result := fValues.ElemPtr(ndx);
end;

function TSynDictionary.FindAndCopy(const aKey; out aValue; aUpdateTimeOut: boolean): boolean;
var ndx: integer;
begin
  fSafe.Lock;
  try
    ndx := Find(aKey, aUpdateTimeOut);
    if ndx>=0 then begin
      fValues.ElemCopyAt(ndx,aValue);
      result := true;
    end else
      result := false;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.FindAndExtract(const aKey; out aValue): boolean;
var ndx: integer;
begin
  fSafe.Lock;
  try
    ndx := fKeys.FindHashedAndDelete(aKey);
    if ndx>=0 then begin
      fValues.ElemCopyAt(ndx,aValue);
      fValues.Delete(ndx);
      if fSafe.Padding[DIC_TIMESEC].VInteger>0 then
        fTimeOuts.Delete(ndx);
      result := true;
    end else
      result := false;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.Exists(const aKey): boolean;
begin
  fSafe.Lock;
  try
    result := fKeys.FindHashed(aKey)>=0;
  finally
    fSafe.UnLock;
  end;
end;

{$ifndef DELPHI5OROLDER}
procedure TSynDictionary.CopyValues(out Dest; ObjArrayByRef: boolean);
begin
  fSafe.Lock;
  try
    fValues.CopyTo(Dest,ObjArrayByRef);
  finally
    fSafe.UnLock;
  end;
end;
{$endif DELPHI5OROLDER}

function TSynDictionary.ForEach(const OnEach: TSynDictionaryEvent; Opaque: pointer): integer;
var k,v: PAnsiChar;
    i,n,ks,vs: integer;
begin
  result := 0;
  fSafe.Lock;
  try
    n := fSafe.Padding[DIC_KEYCOUNT].VInteger;
    if (n=0) or not Assigned(OnEach) then
      exit;
    k := fKeys.Value^;
    ks := fKeys.ElemSize;
    v := fValues.Value^;
    vs := fValues.ElemSize;
    for i := 0 to n-1 do begin
      inc(result);
      if not OnEach(k^,v^,i,n,Opaque) then
        break;
      inc(k,ks);
      inc(v,vs);
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.ForEach(const OnMatch: TSynDictionaryEvent;
  KeyCompare,ValueCompare: TDynArraySortCompare; const aKey,aValue;
  Opaque: pointer): integer;
var k,v: PAnsiChar;
    i,n,ks,vs: integer;
begin
  fSafe.Lock;
  try
    result := 0;
    if not Assigned(OnMatch) or
       (not Assigned(KeyCompare) and not Assigned(ValueCompare)) then
      exit;
    n := fSafe.Padding[DIC_KEYCOUNT].VInteger;
    k := fKeys.Value^;
    ks := fKeys.ElemSize;
    v := fValues.Value^;
    vs := fValues.ElemSize;
    for i := 0 to n-1 do begin
      if (Assigned(KeyCompare) and (KeyCompare(k^,aKey)=0)) or
         (Assigned(ValueCompare) and (ValueCompare(v^,aValue)=0)) then begin
        inc(result);
        if not OnMatch(k^,v^,i,n,Opaque) then
          break;
      end;
      inc(k,ks);
      inc(v,vs);
    end;
  finally
    fSafe.UnLock;
  end;
end;

procedure TSynDictionary.SetTimeoutAtIndex(aIndex: integer);
var tim: cardinal;
begin
  if cardinal(aIndex) >= cardinal(fSafe.Padding[DIC_KEYCOUNT].VInteger) then
    exit;
  tim := fSafe.Padding[DIC_TIMESEC].VInteger;
  if tim > 0 then
    fTimeOut[aIndex] := cardinal({$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10)+tim;
end;

function TSynDictionary.Count: integer;
begin
  {$ifdef NOVARIANTS}
  result := RawCount;
  {$else}
  result := fSafe.LockedInt64[DIC_KEYCOUNT];
  {$endif}
end;

function TSynDictionary.RawCount: integer;
begin
  result := fSafe.Padding[DIC_KEYCOUNT].VInteger;
end;

procedure TSynDictionary.SaveToJSON(W: TTextWriter; EnumSetsAsText: boolean);
var k,v: RawUTF8;
begin
  fSafe.Lock;
  try
    fKeys.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}SaveToJSON(k,EnumSetsAsText);
    fValues.SaveToJSON(v,EnumSetsAsText);
  finally
    fSafe.UnLock;
  end;
  W.AddJSONArraysAsJSONObject(pointer(k),pointer(v));
end;

function TSynDictionary.SaveToJSON(EnumSetsAsText: boolean): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := DefaultTextWriterSerializer.CreateOwnedStream(temp);
  try
    SaveToJSON(W,EnumSetsAsText);
    W.SetText(result);
  finally
    W.Free;
  end;
end;

function TSynDictionary.SaveValuesToJSON(EnumSetsAsText: boolean): RawUTF8;
begin
  fSafe.Lock;
  try
    fValues.SaveToJSON(result,EnumSetsAsText);
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.LoadFromJSON(const JSON: RawUTF8
  {$ifndef NOVARIANTS}; CustomVariantOptions: PDocVariantOptions{$endif}): boolean;
begin // pointer(JSON) is not modified in-place thanks to JSONObjectAsJSONArrays()
  result := LoadFromJSON(pointer(JSON){$ifndef NOVARIANTS},CustomVariantOptions{$endif});
end;

function TSynDictionary.LoadFromJSON(JSON: PUTF8Char{$ifndef NOVARIANTS};
  CustomVariantOptions: PDocVariantOptions{$endif}): boolean;
var k,v: RawUTF8; // private copy of the JSON input, expanded as Keys/Values arrays
begin
  result := false;
  if not JSONObjectAsJSONArrays(JSON,k,v) then
    exit;
  fSafe.Lock;
  try
    if fKeys.LoadFromJSON(pointer(k),nil{$ifndef NOVARIANTS},CustomVariantOptions{$endif})<>nil then
      if fValues.LoadFromJSON(pointer(v),nil{$ifndef NOVARIANTS},CustomVariantOptions{$endif})<>nil then
        if fKeys.Count=fValues.Count then begin
          SetTimeouts;
          fKeys.Rehash; // warning: duplicated keys won't be identified
          result := true;
        end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.LoadFromBinary(const binary: RawByteString): boolean;
var plain: RawByteString;
    P,PEnd: PAnsiChar;
begin
  result := false;
  plain := fCompressAlgo.Decompress(binary);
  P := pointer(plain);
  if P=nil then
    exit;
  PEnd := P+length(plain);
  fSafe.Lock;
  try
    P := fKeys.LoadFrom(P,nil,{checkhash=}false,PEnd);
    if P<>nil then
      P := fValues.LoadFrom(P,nil,{checkhash=}false,PEnd);
    if (P<>nil) and (fKeys.Count=fValues.Count) then begin
      SetTimeouts;  // set ComputeNextTimeOut for all items
      fKeys.ReHash; // optimistic: input from safe TSynDictionary.SaveToBinary
      result := true;
    end;
  finally
    fSafe.UnLock;
  end;
end;

class function TSynDictionary.OnCanDeleteSynPersistentLock(const aKey, aValue;
  aIndex: integer): boolean;
begin
  result := not TSynPersistentLock(aValue).Safe^.IsLocked;
end;

class function TSynDictionary.OnCanDeleteSynPersistentLocked(const aKey, aValue;
  aIndex: integer): boolean;
begin
  result := not TSynPersistentLock(aValue).Safe.IsLocked;
end;

function TSynDictionary.SaveToBinary(NoCompression: boolean): RawByteString;
var tmp: TSynTempBuffer;
    trigger: integer;
begin
  fSafe.Lock;
  try
    result := '';
    if fSafe.Padding[DIC_KEYCOUNT].VInteger = 0 then
      exit;
    tmp.Init(fKeys.SaveToLength+fValues.SaveToLength);
    if fValues.SaveTo(fKeys.SaveTo(tmp.buf))-PAnsiChar(tmp.buf)=tmp.len then begin
      if NoCompression then
        trigger := maxInt else
        trigger := 128;
      result := fCompressAlgo.Compress(tmp.buf,tmp.len,trigger);
    end;
    tmp.Done;
  finally
    fSafe.UnLock;
  end;
end;


{ TMemoryMap }

function TMemoryMap.Map(aFile: THandle; aCustomSize: PtrUInt; aCustomOffset: Int64): boolean;
var Available: Int64;
begin
  fBuf := nil;
  fBufSize := 0;
  {$ifdef MSWINDOWS}
  fMap := 0;
  {$endif}
  fFileLocal := false;
  fFile := aFile;
  fFileSize := FileSeek64(fFile,0,soFromEnd);
  if fFileSize=0 then begin
    result := true; // handle 0 byte file without error (but no memory map)
    exit;
  end;
  result := false;
  if (fFileSize<=0) {$ifdef CPU32}or (fFileSize>maxInt){$endif} then
    /// maxInt = $7FFFFFFF = 1.999 GB (2GB would induce PtrInt errors)
    exit;
  if aCustomSize=0 then
    fBufSize := fFileSize else begin
    Available := fFileSize-aCustomOffset;
    if Available<0 then
      exit;
    if aCustomSize>Available then
      fBufSize := Available;
      fBufSize := aCustomSize;
  end;
  {$ifdef MSWINDOWS}
  with PInt64Rec(@fFileSize)^ do
    fMap := CreateFileMapping(fFile,nil,PAGE_READONLY,Hi,Lo,nil);
  if fMap=0 then
    raise ESynException.Create('TMemoryMap.Map: CreateFileMapping()=0');
  with PInt64Rec(@aCustomOffset)^ do
    fBuf := MapViewOfFile(fMap,FILE_MAP_READ,Hi,Lo,fBufSize);
  if fBuf=nil then begin
    // Windows failed to find a contiguous VA space -> fall back on direct read
    CloseHandle(fMap);
    fMap := 0;
  {$else}
  if aCustomOffset<>0 then
    if aCustomOffset and (SystemInfo.dwPageSize-1)<>0 then
      raise ESynException.CreateUTF8('fpmmap(aCustomOffset=%) with SystemInfo.dwPageSize=%',
        [aCustomOffset,SystemInfo.dwPageSize]) else
      aCustomOffset := aCustomOffset div SystemInfo.dwPageSize;
  fBuf := {$ifdef KYLIX3}mmap{$else}fpmmap{$endif}(
    nil,fBufSize,PROT_READ,MAP_SHARED,fFile,aCustomOffset);
  if fBuf=MAP_FAILED then begin
    fBuf := nil;
  {$endif}
  end else
    result := true;
end;

procedure TMemoryMap.Map(aBuffer: pointer; aBufferSize: PtrUInt);
begin
  fBuf := aBuffer;
  fFileSize := aBufferSize;
  fBufSize := aBufferSize;
  {$ifdef MSWINDOWS}
  fMap := 0;
  {$endif}
  fFile := 0;
  fFileLocal := false;
end;

function TMemoryMap.Map(const aFileName: TFileName): boolean;
var F: THandle;
begin
  result := false;
  // Memory-mapped file access does not go through the cache manager so
  // using FileOpenSequentialRead() is pointless here
  F := FileOpen(aFileName,fmOpenRead or fmShareDenyNone);
  if PtrInt(F)<0 then
    exit;
  if Map(F)  then
    result := true else
    FileClose(F);
  fFileLocal := result;
end;

procedure TMemoryMap.UnMap;
begin
  {$ifdef MSWINDOWS}
  if fMap<>0 then begin
    UnmapViewOfFile(fBuf);
    CloseHandle(fMap);
    fMap := 0;
  end;
  {$else}
  if (fBuf<>nil) and (fBufSize>0) and (fFile<>0) then
    {$ifdef KYLIX3}munmap{$else}fpmunmap{$endif}(fBuf,fBufSize);
  {$endif}
  fBuf := nil;
  fBufSize := 0;
  if fFile<>0 then begin
    if fFileLocal then
      FileClose(fFile);
    fFile := 0;
  end;
end;


{ TSynMemoryStream }

constructor TSynMemoryStream.Create(const aText: RawByteString);
begin
  inherited Create;
  SetPointer(pointer(aText),length(aText));
end;

constructor TSynMemoryStream.Create(Data: pointer; DataLen: PtrInt);
begin
  inherited Create;
  SetPointer(Data,DataLen);
end;

function TSynMemoryStream.Write(const Buffer; Count: Integer): Longint;
begin
  {$ifdef FPC}
  result := 0; // makes FPC compiler happy
  {$endif}
  raise EStreamError.CreateFmt('Unexpected %s.Write',[ClassNameShort(self)^]);
end;


{ TSynMemoryStreamMapped }

constructor TSynMemoryStreamMapped.Create(const aFileName: TFileName;
  aCustomSize: PtrUInt; aCustomOffset: Int64);
begin
  fFileName := aFileName;
  // Memory-mapped file access does not go through the cache manager so
  // using FileOpenSequentialRead() is pointless here
  fFileStream := TFileStream.Create(aFileName,fmOpenRead or fmShareDenyNone);
  Create(fFileStream.Handle,aCustomSize,aCustomOffset);
end;

constructor TSynMemoryStreamMapped.Create(aFile: THandle;
  aCustomSize: PtrUInt; aCustomOffset: Int64);
begin
  if not fMap.Map(aFile,aCustomSize,aCustomOffset) then
    raise ESynException.CreateUTF8('%.Create(%) mapping error',[self,fFileName]);
  inherited Create(fMap.fBuf,fMap.fBufSize);
end;

destructor TSynMemoryStreamMapped.Destroy;
begin
  fMap.UnMap;
  fFileStream.Free;
  inherited;
end;

function FileSeek64(Handle: THandle; const Offset: Int64; Origin: DWORD): Int64;
{$ifdef MSWINDOWS}
var R64: packed record Lo, Hi: integer; end absolute Result;
begin
  Result := Offset;
  R64.Lo := integer(SetFilePointer(Handle,R64.Lo,@R64.Hi,Origin));
  if (R64.Lo=-1) and (GetLastError<>0) then
    R64.Hi := -1; // so result=-1
end;
{$else}
begin
  {$ifdef FPC}
  result := FPLSeek(Handle,Offset,Origin);
  {$else}
  {$ifdef KYLIX3}
  result := LibC.lseek64(Handle,Offset,Origin);
  {$else}
  // warning: this won't handle file size > 2 GB :(
  result := FileSeek(Handle,Offset,Origin);
  {$endif}
  {$endif}
end;
{$endif}

function PropNameValid(P: PUTF8Char): boolean;
var tab: PTextCharSet;
begin
  result := false;
  tab := @TEXT_CHARS;
  if (P=nil) or not (tcIdentifierFirstChar in tab[P^]) then
    exit; // first char must be alphabetical
  repeat
    inc(P); // following chars can be alphanumerical
    if tcIdentifier in tab[P^] then
      continue;
    if P^=#0 then
      break;
    exit;
  until false;
  result := true;
end;

function PropNamesValid(const Values: array of RawUTF8): boolean;
var i,j: integer;
    tab: PTextCharSet;
begin
  result := false;
  tab := @TEXT_CHARS;
  for i := 0 to high(Values) do
    for j := 1 to length(Values[i]) do
      if not (tcIdentifier in tab[Values[i][j]]) then
        exit;
  result := true;
end;

function JsonPropNameValid(P: PUTF8Char): boolean;
var tab: PJsonCharSet;
begin
  tab := @JSON_CHARS;
  if (P<>nil) and (jcJsonIdentifierFirstChar in tab[P^]) then begin
    repeat
      inc(P);
    until not(jcJsonIdentifier in tab[P^]);
    result := P^ = #0;
  end else
    result := false;
end;

function StrCompL(P1,P2: PUTF8Char; L, Default: Integer): PtrInt;
var i: PtrInt;
begin
  i := 0;
  repeat
    result := PtrInt(P1[i])-PtrInt(P2[i]);
    if result=0 then begin
      inc(i);
      if i<L then continue else break;
    end;
    exit;
  until false;
  result := Default;
end;

function StrCompIL(P1,P2: PUTF8Char; L, Default: Integer): PtrInt;
var i: PtrInt;
    tab: {$ifdef CPUX86NOTPIC}TNormTable absolute NormToUpperAnsi7{$else}PNormTable{$endif};
begin
  i := 0;
  {$ifndef CPUX86NOTPIC}tab := @NormToUpperAnsi7;{$endif} // faster on PIC and x86_64
  repeat
    if tab[P1[i]]=tab[P2[i]] then begin
      inc(i);
      if i<L then continue else break;
    end;
    result := PtrInt(P1[i])-PtrInt(P2[i]);
    exit;
  until false;
  result := Default;
end;

function IsRowID(FieldName: PUTF8Char): boolean;
{$ifdef CPU64}
var f: Int64;
begin
  if FieldName<>nil then begin
    f := PInt64(FieldName)^;
    result := (f and $ffdfdf=(ord('I')+ord('D')shl 8)) or (f and $ffdfdfdfdfdf=
      (ord('R')+ord('O')shl 8+ord('W')shl 16+ord('I')shl 24+Int64(ord('D')) shl 32))
  end
{$else}
begin
  if FieldName<>nil then
    result := (PInteger(FieldName)^ and $ffdfdf=ord('I')+ord('D')shl 8) or
      ((PIntegerArray(FieldName)^[0] and $dfdfdfdf=
        ord('R')+ord('O')shl 8+ord('W')shl 16+ord('I')shl 24) and
       (PIntegerArray(FieldName)^[1] and $ffdf=ord('D')))
{$endif} else result := false;
end;

function IsRowID(FieldName: PUTF8Char; FieldLen: integer): boolean;
begin
  case FieldLen of
  2: result :=
    PWord(FieldName)^ and $dfdf=ord('I')+ord('D')shl 8;
  5: result :=
    (PInteger(FieldName)^ and $dfdfdfdf=
      ord('R')+ord('O')shl 8+ord('W')shl 16+ord('I')shl 24) and
    (ord(FieldName[4]) and $df=ord('D'));
  else result := false;
  end;
end;

function IsRowIDShort(const FieldName: shortstring): boolean;
begin
  result :=
    (PInteger(@FieldName)^ and $DFDFFF=
      2+ord('I')shl 8+ord('D')shl 16) or
    ((PIntegerArray(@FieldName)^[0] and $dfdfdfff=
      5+ord('R')shl 8+ord('O')shl 16+ord('W')shl 24) and
     (PIntegerArray(@FieldName)^[1] and $dfdf=
       ord('I')+ord('D')shl 8));
end;

function GotoNextSqlIdentifier(P: PUtf8Char; tab: PTextCharSet): PUtf8Char;
  {$ifdef HASINLINE} inline; {$endif}
begin
  while tcCtrlNot0Comma in tab[P^] do inc(P); // in [#1..' ', ';']
  if PWord(P)^=ord('/')+ord('*') shl 8 then begin // ignore e.g. '/*nocache*/'
    repeat
      inc(P);
      if PWord(P)^ = ord('*')+ord('/') shl 8 then begin
        inc(P, 2);
        break;
      end;
    until P^ = #0;
    while tcCtrlNot0Comma in tab[P^] do inc(P);
  end;
  result := P;
end;

function GetNextFieldProp(var P: PUTF8Char; var Prop: RawUTF8): boolean;
var B: PUTF8Char;
    tab: PTextCharSet;
begin
  tab := @TEXT_CHARS;
  P := GotoNextSqlIdentifier(P, tab);
  B := P;
  while tcIdentifier in tab[P^] do inc(P); // go to end of field name
  FastSetString(Prop,B,P-B);
  P := GotoNextSqlIdentifier(P, tab);
  result := Prop<>'';
end;

function GetNextFieldPropSameLine(var P: PUTF8Char; var Prop: ShortString): boolean;
var B: PUTF8Char;
    tab: PTextCharSet;
begin
  tab := @TEXT_CHARS;
  while tcCtrlNotLF in tab[P^] do inc(P);
  B := P;
  while tcIdentifier in tab[P^] do inc(P); // go to end of field name
  SetString(Prop,PAnsiChar(B),P-B);
  while tcCtrlNotLF in TEXT_CHARS[P^] do inc(P);
  result := Prop<>'';
end;


type
  TSynLZHead = packed record
    Magic: cardinal;
    CompressedSize: integer;
    HashCompressed: cardinal;
    UnCompressedSize: integer;
    HashUncompressed: cardinal;
  end;
  PSynLZHead = ^TSynLZHead;
  TSynLZTrailer = packed record
    HeaderRelativeOffset: cardinal;
    Magic: cardinal;
  end;
  PSynLZTrailer = ^TSynLZTrailer;

function StreamSynLZComputeLen(P: PAnsiChar; Len, aMagic: cardinal): integer;
begin
  if (P=nil) or (Len<=SizeOf(TSynLZTrailer)) then
    result := 0 else
    with PSynLZTrailer(P+Len-SizeOf(TSynLZTrailer))^ do
      if (Magic=aMagic) and (HeaderRelativeOffset<Len) and
         (PSynLZHead(P+Len-HeaderRelativeOffset)^.Magic=aMagic) then
        // trim existing content
        result := Len-HeaderRelativeOffset else
        result := Len;
end;

function CompressSynLZ(var DataRawByteString; Compress: boolean): AnsiString;
var DataLen, len: integer;
    P: PAnsiChar;
    Data: RawByteString absolute DataRawByteString;
begin
  DataLen := length(Data);
  if DataLen<>0 then // '' is compressed and uncompressed to ''
  if Compress then begin
    len := SynLZcompressdestlen(DataLen)+8;
    SetString(result,nil,len);
    P := pointer(result);
    PCardinal(P)^ := Hash32(pointer(Data),DataLen);
    len := SynLZcompress1(pointer(Data),DataLen,P+8);
    PCardinal(P+4)^ := Hash32(pointer(P+8),len);
    SetString(Data,P,len+8);
  end else begin
    result := '';
    P := pointer(Data);
    if (DataLen<=8) or (Hash32(pointer(P+8),DataLen-8)<>PCardinal(P+4)^) then
      exit;
    len := SynLZdecompressdestlen(P+8);
    SetLength(result,len);
    if (len<>0) and  ((SynLZDecompress1(P+8,DataLen-8,pointer(result))<>len) or
       (Hash32(pointer(result),len)<>PCardinal(P)^)) then begin
      result := '';
      exit;
    end else
      SetString(Data,PAnsiChar(pointer(result)),len);
  end;
  result := 'synlz';
end;

function StreamSynLZ(Source: TCustomMemoryStream; Dest: TStream; Magic: cardinal): integer;
var DataLen: integer;
    S,D: pointer;
    Head: TSynLZHead;
    Trailer: TSynLZTrailer;
    tmp: TSynTempBuffer;
begin
  if Dest=nil then begin
    result := 0;
    exit;
  end;
  if Source<>nil then begin
    S := Source.Memory;
    DataLen := Source.Size;
  end else begin
    S := nil;
    DataLen := 0;
  end;
  tmp.Init(SynLZcompressdestlen(DataLen));
  try
    Head.Magic := Magic;
    Head.UnCompressedSize := DataLen;
    Head.HashUncompressed := Hash32(S,DataLen);
    result := SynLZcompress1(S,DataLen,tmp.buf);
    if result>tmp.len then
      raise ESynException.Create('StreamLZ: SynLZ compression overflow');
    if result>DataLen then begin
      result := DataLen; // compression not worth it
      D := S;
    end else
      D := tmp.buf;
    Head.CompressedSize := result;
    Head.HashCompressed := Hash32(D,result);
    Dest.WriteBuffer(Head,SizeOf(Head));
    Dest.WriteBuffer(D^,Head.CompressedSize);
    Trailer.HeaderRelativeOffset := result+(SizeOf(Head)+SizeOf(Trailer));
    Trailer.Magic := Magic;
    Dest.WriteBuffer(Trailer,SizeOf(Trailer));
    result := Head.CompressedSize+(SizeOf(Head)+SizeOf(Trailer));
  finally
    tmp.Done;
  end;
end;

function StreamSynLZ(Source: TCustomMemoryStream; const DestFile: TFileName;
  Magic: cardinal): integer;
var F: TFileStream;
begin
  F := TFileStream.Create(DestFile,fmCreate);
  try
    result := StreamSynLZ(Source,F,Magic);
  finally
    F.Free;
  end;
end;

function FileSynLZ(const Source, Dest: TFileName; Magic: Cardinal): boolean;
var src,dst: RawByteString;
    S,D: THandleStream;
    Head: TSynLZHead;
    Count,Max: Int64;
begin
  result := false;
  if FileExists(Source) then
  try
    S := FileStreamSequentialRead(Source);
    try
      DeleteFile(Dest);
      Max := 128 shl 20; // 128 MB default compression chunk
      D := TFileStream.Create(Dest,fmCreate);
      try
        Head.Magic := Magic;
        Count := S.Size;
        while Count>0 do begin
          if Count>Max then
            Head.UnCompressedSize := Max else
            Head.UnCompressedSize := Count;
          if src='' then
            SetString(src,nil,Head.UnCompressedSize);
          if dst='' then
            SetString(dst,nil,SynLZcompressdestlen(Head.UnCompressedSize));
          Head.UnCompressedSize := S.Read(pointer(src)^,Head.UnCompressedSize);
          {$ifdef MSWINDOWS}
          if (Head.UnCompressedSize<=0) and
             (GetLastError=ERROR_NO_SYSTEM_RESOURCES) then begin
            Max := 32 shl 20; // we observed a 32MB chunk size limitation on XP
            Head.UnCompressedSize := S.Read(pointer(src)^,Max);
          end;
          {$endif MSWINDOWS}
          if Head.UnCompressedSize<=0 then
            exit; // read error
          Head.HashUncompressed := Hash32(pointer(src),Head.UnCompressedSize);
          Head.CompressedSize :=
            SynLZcompress1(pointer(src),Head.UnCompressedSize,pointer(dst));
          Head.HashCompressed := Hash32(pointer(dst),Head.CompressedSize);
          if (D.Write(Head,SizeOf(Head))<>SizeOf(Head)) or
             (D.Write(pointer(dst)^,Head.CompressedSize)<>Head.CompressedSize) then
            exit;
          dec(Count,Head.UnCompressedSize);
        end;
      finally
        D.Free;
      end;
      result := FileSetDateFrom(Dest,S.Handle);
    finally
      S.Free;
    end;
  except
    on Exception do
      result := false;
  end;
end;

function FileUnSynLZ(const Source, Dest: TFileName; Magic: Cardinal): boolean;
var src,dst: RawByteString;
    S,D: THandleStream;
    Count: Int64;
    Head: TSynLZHead;
begin
  result := false;
  if FileExists(Source) then
  try
    S := FileStreamSequentialRead(Source);
    try
      DeleteFile(Dest);
      D := TFileStream.Create(Dest,fmCreate);
      try
        Count := S.Size;
        while Count>0 do begin
          if S.Read(Head,SizeOf(Head))<>SizeOf(Head) then
            exit;
          dec(Count,SizeOf(Head));
          if (Head.Magic<>Magic) or
             (Head.CompressedSize>Count) then
            exit;
          if Head.CompressedSize>length(src) then
            SetString(src,nil,Head.CompressedSize);
          if S.Read(pointer(src)^,Head.CompressedSize)<>Head.CompressedSize then
            exit;
          dec(Count,Head.CompressedSize);
          if (Hash32(pointer(src),Head.CompressedSize)<>Head.HashCompressed) or
             (SynLZdecompressdestlen(pointer(src))<>Head.UnCompressedSize) then
            exit;
          if Head.UnCompressedSize>length(dst) then
            SetString(dst,nil,Head.UnCompressedSize);
          if (SynLZDecompress1(pointer(src),Head.CompressedSize,pointer(dst))<>Head.UnCompressedSize) or
             (Hash32(pointer(dst),Head.UnCompressedSize)<>Head.HashUncompressed) then
            exit;
          if D.Write(pointer(dst)^,Head.UncompressedSize)<>Head.UncompressedSize then
            exit;
        end;
      finally
        D.Free;
      end;
      result := FileSetDateFrom(Dest,S.Handle);
    finally
      S.Free;
    end;
  except
    on Exception do
      result := false;
  end;
end;

function FileIsSynLZ(const Name: TFileName; Magic: Cardinal): boolean;
var S: TFileStream;
    Head: TSynLZHead;
begin
  result := false;
  if FileExists(Name) then
  try
    S := TFileStream.Create(Name,fmOpenRead or fmShareDenyNone);
    try
      if S.Read(Head,SizeOf(Head))=SizeOf(Head) then
        if Head.Magic=Magic then
          result := true; // only check magic, since there may be several chunks
    finally
      S.Free;
    end;
  except
    on Exception do
      result := false;
  end;
end;

function StreamUnSynLZ(const Source: TFileName; Magic: cardinal): TMemoryStream;
var S: TStream;
begin
  try
    S := TSynMemoryStreamMapped.Create(Source);
    try
     result := StreamUnSynLZ(S,Magic);
    finally
      S.Free;
    end;
  except
    on E: Exception do
      result := nil;
  end;
end;

function StreamUnSynLZ(Source: TStream; Magic: cardinal): TMemoryStream;
var S,D: PAnsiChar;
    sourcePosition,resultSize,sourceSize: Int64;
    Head: TSynLZHead;
    Trailer: TSynLZTrailer;
    buf: RawByteString;
    stored: boolean;
begin
  result := nil;
  if Source=nil then
    exit;
  sourceSize := Source.Size;
  {$ifndef CPU64}
  if sourceSize>maxInt then
    exit; // result TMemoryStream should stay in memory!
  {$endif}
  sourcePosition := Source.Position;
  if sourceSize-sourcePosition<SizeOf(head) then
    exit;
  resultSize := 0;
  repeat
    if (Source.Read(Head,SizeOf(Head))<>SizeOf(Head)) or
       (Head.Magic<>Magic) then begin
      // Source not positioned as expected -> try from the end
      Source.Position := sourceSize-SizeOf(Trailer);
      if (Source.Read(Trailer,SizeOf(Trailer))<>SizeOf(Trailer)) or
         (Trailer.Magic<>Magic) then
        exit;
      sourcePosition := sourceSize-Trailer.HeaderRelativeOffset;
      Source.Position := sourcePosition;
      if (Source.Read(Head,SizeOf(Head))<>SizeOf(Head)) or
         (Head.Magic<>Magic) then
        exit;
    end;
    inc(sourcePosition,SizeOf(Head));
    if sourcePosition+Head.CompressedSize>sourceSize then
      exit;
    if Source.InheritsFrom(TCustomMemoryStream) then begin
      S := PAnsiChar(TCustomMemoryStream(Source).Memory)+PtrUInt(sourcePosition);
      Source.Seek(Head.CompressedSize,soCurrent);
    end else begin
      if Head.CompressedSize>length(Buf) then
        SetString(Buf,nil,Head.CompressedSize);
      S := pointer(Buf);
      Source.Read(S^,Head.CompressedSize);
    end;
    inc(sourcePosition,Head.CompressedSize);
    if (Source.Read(Trailer,SizeOf(Trailer))<>SizeOf(Trailer)) or
       (Trailer.Magic<>Magic) then
      // trailer not available in old .synlz layout, or in FileSynLZ multiblocks
      Source.Position := sourcePosition else
      sourceSize := 0; // should be monoblock
    // Source stream will now point after all data
    stored := (Head.CompressedSize=Head.UnCompressedSize) and
              (Head.HashCompressed=Head.HashUncompressed);
    if not stored then
      if SynLZdecompressdestlen(S)<>Head.UnCompressedSize then
        exit;
    if Hash32(pointer(S),Head.CompressedSize)<>Head.HashCompressed then
      exit;
    if result=nil then
      result := THeapMemoryStream.Create else begin
      {$ifndef CPU64}
      if resultSize+Head.UnCompressedSize>maxInt then begin
        FreeAndNil(result); // result TMemoryStream should stay in memory!
        break;
      end;
      {$endif CPU64}
    end;
    result.Size := resultSize+Head.UnCompressedSize;
    D := PAnsiChar(result.Memory)+resultSize;
    inc(resultSize,Head.UnCompressedSize);
    if stored then
      MoveFast(S^,D^,Head.CompressedSize) else
    if SynLZDecompress1(S,Head.CompressedSize,D)<>Head.UnCompressedSize then
      FreeAndNil(result) else
    if Hash32(pointer(D),Head.UnCompressedSize)<>Head.HashUncompressed then
      FreeAndNil(result);
  until (result=nil) or (sourcePosition>=sourceSize);
end;


{ TAlgoCompress }

const
  COMPRESS_STORED = #0;
  COMPRESS_SYNLZ = 1;

var
  SynCompressAlgos: TSynObjectList;

constructor TAlgoCompress.Create;
var existing: TAlgoCompress;
begin
  inherited Create;
  if SynCompressAlgos=nil then
    GarbageCollectorFreeAndNil(SynCompressAlgos,TSynObjectList.Create) else begin
    existing := Algo(AlgoID);
    if existing<>nil then
      raise ESynException.CreateUTF8('%.Create: AlgoID=% already registered by %',
        [self,AlgoID,existing.ClassType]);
  end;
  SynCompressAlgos.Add(self);
end;

class function TAlgoCompress.Algo(const Comp: RawByteString): TAlgoCompress;
begin
  result := Algo(Pointer(Comp),Length(Comp));
end;

class function TAlgoCompress.Algo(const Comp: TByteDynArray): TAlgoCompress;
begin
  result := Algo(Pointer(Comp),Length(Comp));
end;

class function TAlgoCompress.Algo(Comp: PAnsiChar; CompLen: integer): TAlgoCompress;
begin
  if (Comp<>nil) and (CompLen>9) then
    if ord(Comp[4])<=1 then // inline-friendly Comp[4]<=COMPRESS_SYNLZ
      result := AlgoSynLZ else // COMPRESS_STORED is also handled as SynLZ
      result := Algo(ord(Comp[4])) else
    result := nil;
end;

class function TAlgoCompress.Algo(Comp: PAnsiChar; CompLen: integer; out IsStored: boolean): TAlgoCompress;
begin
  if (Comp<>nil) and (CompLen>9) then begin
    IsStored := Comp[4]=COMPRESS_STORED;
    result := Algo(ord(Comp[4]));
  end else begin
    IsStored := false;
    result := nil;
  end;
end;

class function TAlgoCompress.Algo(AlgoID: byte): TAlgoCompress;
var i: integer;
    ptr: ^TAlgoCompress;
begin
  if AlgoID<=COMPRESS_SYNLZ then // COMPRESS_STORED is handled as SynLZ
    result := AlgoSynLZ else begin
    if SynCompressAlgos<>nil then begin
      ptr := pointer(SynCompressAlgos.List);
      inc(ptr); // ignore List[0] = AlgoSynLZ
      for i := 2 to SynCompressAlgos.Count do
        if ptr^.AlgoID=AlgoID then begin
          result := ptr^;
          exit;
        end
        else
          inc(ptr);
    end;
    result := nil;
  end;
end;

class function TAlgoCompress.UncompressedSize(const Comp: RawByteString): integer;
begin
  result := Algo(Comp).DecompressHeader(pointer(Comp),length(Comp));
end;

function TAlgoCompress.AlgoName: TShort16;
var s: PShortString;
    i: integer;
begin
  if self=nil then
    result := 'none' else begin
    s := ClassNameShort(self);
    if IdemPChar(@s^[1],'TALGO') then begin
      result[0] := AnsiChar(ord(s^[0])-5);
      inc(PByte(s),5);
    end else
      result[0] := s^[0];
    if result[0]>#16 then
      result[0] := #16;
    for i := 1 to ord(result[0]) do
      result[i] := NormToLower[s^[i]];
  end;
end;

function TAlgoCompress.AlgoHash(Previous: cardinal; Data: pointer; DataLen: integer): cardinal;
begin
  result := crc32c(Previous,Data,DataLen);
end;

function TAlgoCompress.Compress(const Plain: RawByteString; CompressionSizeTrigger: integer;
  CheckMagicForCompressed: boolean; BufferOffset: integer): RawByteString;
begin
  result := Compress(pointer(Plain),Length(Plain),CompressionSizeTrigger,
    CheckMagicForCompressed,BufferOffset);
end;

function TAlgoCompress.Compress(Plain: PAnsiChar; PlainLen: integer; CompressionSizeTrigger: integer;
  CheckMagicForCompressed: boolean; BufferOffset: integer): RawByteString;
var len: integer;
    R: PAnsiChar;
    crc: cardinal;
    tmp: array[0..16383] of AnsiChar;  // big enough to resize Result in-place
begin
  if (self=nil) or (PlainLen=0) or (Plain=nil) then begin
    result := '';
    exit;
  end;
  crc := AlgoHash(0,Plain,PlainLen);
  if (PlainLen<CompressionSizeTrigger) or
     (CheckMagicForCompressed and IsContentCompressed(Plain,PlainLen)) then begin
    SetString(result,nil,PlainLen+BufferOffset+9);
    R := pointer(result);
    inc(R,BufferOffset);
    PCardinal(R)^ := crc;
    R[4] := COMPRESS_STORED;
    PCardinal(R+5)^ := crc;
    MoveFast(Plain^,R[9],PlainLen);
  end else begin
    len := CompressDestLen(PlainLen)+BufferOffset;
    if len>SizeOf(tmp) then begin
      SetString(result,nil,len);
      R := pointer(result);
    end else
      R := @tmp;
    inc(R,BufferOffset);
    PCardinal(R)^ := crc;
    len := AlgoCompress(Plain,PlainLen,R+9);
    if len+64>=PlainLen then begin // store if compression was not worth it
      R[4] := COMPRESS_STORED;
      PCardinal(R+5)^ := crc;
      MoveFast(Plain^,R[9],PlainLen);
      len := PlainLen;
    end else begin
      R[4] := AnsiChar(AlgoID);
      PCardinal(R+5)^ := AlgoHash(0,R+9,len);
    end;
    if R=@tmp[BufferOffset] then
      SetString(result,tmp,len+BufferOffset+9) else
      SetLength(result,len+BufferOffset+9); // MM may not move the data
  end;
end;

function TAlgoCompress.Compress(Plain, Comp: PAnsiChar; PlainLen, CompLen: integer;
  CompressionSizeTrigger: integer; CheckMagicForCompressed: boolean): integer;
var len: integer;
begin
  result := 0;
  if (self=nil) or (PlainLen=0) or (CompLen<PlainLen+9) then
    exit;
  PCardinal(Comp)^ := AlgoHash(0,Plain,PlainLen);
  if (PlainLen>=CompressionSizeTrigger) and
     not(CheckMagicForCompressed and IsContentCompressed(Plain,PlainLen)) then begin
    len := CompressDestLen(PlainLen);
    if CompLen<len then
      exit;
    len := AlgoCompress(Plain,PlainLen,Comp+9);
    if len<PlainLen then begin
      Comp[4] := AnsiChar(AlgoID);
      PCardinal(Comp+5)^ := AlgoHash(0,Comp+9,len);
      result := len+9;
      exit;
    end;
  end;
  Comp[4] := COMPRESS_STORED;
  PCardinal(Comp+5)^ := PCardinal(Comp)^;
  MoveFast(Plain^,Comp[9],PlainLen);
  result := PlainLen+9;
end;

function TAlgoCompress.CompressDestLen(PlainLen: integer): integer;
begin
  if self=nil then
    result := 0 else
    result := AlgoCompressDestLen(PLainLen)+9;
end;

function TAlgoCompress.CompressToBytes(Plain: PAnsiChar; PlainLen: integer;
  CompressionSizeTrigger: integer; CheckMagicForCompressed: boolean): TByteDynArray;
var len: integer;
    R: PAnsiChar;
    crc: cardinal;
begin
  Finalize(result);
  if (self=nil) or (PlainLen=0) then
    exit;
  crc := AlgoHash(0,Plain,PlainLen);
  if PlainLen<CompressionSizeTrigger then begin
    SetLength(result,PlainLen+9);
    R := pointer(result);
    PCardinal(R)^ := crc;
    R[4] := COMPRESS_STORED;
    PCardinal(R+5)^ := crc;
    MoveFast(Plain^,R[9],PlainLen);
  end else begin
    SetLength(result,CompressDestLen(PlainLen));
    R := pointer(result);
    PCardinal(R)^ := crc;
    len := AlgoCompress(Plain,PlainLen,R+9);
    if len>=PlainLen then begin // store if compression not worth it
      R[4] := COMPRESS_STORED;
      PCardinal(R+5)^ := crc;
      MoveFast(Plain^,R[9],PlainLen);
      len := PlainLen;
    end else begin
      R[4] := AnsiChar(AlgoID);
      PCardinal(R+5)^ := AlgoHash(0,R+9,len);
    end;
    SetLength(result,len+9);
  end;
end;

function TAlgoCompress.CompressToBytes(const Plain: RawByteString;
  CompressionSizeTrigger: integer; CheckMagicForCompressed: boolean): TByteDynArray;
begin
  result := CompressToBytes(pointer(Plain),Length(Plain),
    CompressionSizeTrigger,CheckMagicForCompressed);
end;

function TAlgoCompress.Decompress(const Comp: TByteDynArray): RawByteString;
begin
  Decompress(pointer(Comp),length(Comp),result);
end;

procedure TAlgoCompress.Decompress(Comp: PAnsiChar; CompLen: integer;
  out Result: RawByteString; Load: TAlgoCompressLoad; BufferOffset: integer);
var len: integer;
    dec: PAnsiChar;
begin
  len := DecompressHeader(Comp,CompLen,Load);
  if len=0 then
    exit;
  SetString(result,nil,len+BufferOffset);
  dec := pointer(result);
  if not DecompressBody(Comp,dec+BufferOffset,CompLen,len,Load) then
    result := '';
end;

function TAlgoCompress.Decompress(const Comp: RawByteString;
  Load: TAlgoCompressLoad; BufferOffset: integer): RawByteString;
begin
  Decompress(pointer(Comp),length(Comp),result,Load,BufferOffset);
end;

function TAlgoCompress.TryDecompress(const Comp: RawByteString;
  out Dest: RawByteString; Load: TAlgoCompressLoad): boolean;
var len: integer;
begin
  result := Comp='';
  if result then
    exit;
  len := DecompressHeader(pointer(Comp),length(Comp),Load);
  if len=0 then
    exit; // invalid crc32c
  SetString(Dest,nil,len);
  if DecompressBody(pointer(Comp),pointer(Dest),length(Comp),len,Load) then
    result := true else
    Dest := '';
end;

function TAlgoCompress.Decompress(const Comp: RawByteString;
  out PlainLen: integer; var tmp: RawByteString; Load: TAlgoCompressLoad): pointer;
begin
  result := Decompress(pointer(Comp),length(Comp),PlainLen,tmp,Load);
end;

function TAlgoCompress.Decompress(Comp: PAnsiChar; CompLen: integer;
  out PlainLen: integer; var tmp: RawByteString; Load: TAlgoCompressLoad): pointer;
begin
  result := nil;
  PlainLen := DecompressHeader(Comp,CompLen,Load);
  if PlainLen=0 then
    exit;
  if Comp[4]=COMPRESS_STORED then
    result := Comp+9 else begin
    if PlainLen > length(tmp) then
      SetString(tmp,nil,PlainLen);
    if DecompressBody(Comp,pointer(tmp),CompLen,PlainLen,Load) then
      result := pointer(tmp);
  end;
end;

function TAlgoCompress.DecompressPartial(Comp, Partial: PAnsiChar;
  CompLen, PartialLen, PartialLenMax: integer): integer;
var BodyLen: integer;
begin
  result := 0;
  if (self=nil) or (CompLen<=9) or (Comp=nil) or (PartialLenMax<PartialLen) then
    exit;
  if Comp[4]=COMPRESS_STORED then
    if PCardinal(Comp)^=PCardinal(Comp+5)^ then
      BodyLen := CompLen-9 else
      exit
  else if Comp[4]=AnsiChar(AlgoID) then
    BodyLen := AlgoDecompressDestLen(Comp+9) else
    exit;
  if PartialLen>BodyLen then
    PartialLen := BodyLen;
  if Comp[4]=COMPRESS_STORED then
    MoveFast(Comp[9],Partial[0],PartialLen) else
    if AlgoDecompressPartial(Comp+9,CompLen-9,Partial,PartialLen,PartialLenMax)<PartialLen then
      exit;
  result := PartialLen;
end;

function TAlgoCompress.DecompressHeader(Comp: PAnsiChar; CompLen: integer;
  Load: TAlgoCompressLoad): integer;
begin
  result := 0;
  if (self=nil) or (CompLen<=9) or (Comp=nil) or
     ((Load<>aclNoCrcFast) and (AlgoHash(0,Comp+9,CompLen-9)<>PCardinal(Comp+5)^)) then
    exit;
  if Comp[4]=COMPRESS_STORED then begin
    if PCardinal(Comp)^=PCardinal(Comp+5)^ then
      result := CompLen-9;
  end else
  if Comp[4]=AnsiChar(AlgoID) then
    result := AlgoDecompressDestLen(Comp+9);
end;

function TAlgoCompress.DecompressBody(Comp, Plain: PAnsiChar;
  CompLen, PlainLen: integer; Load: TAlgoCompressLoad): boolean;
begin
  result := false;
  if (self=nil) or (PlainLen<=0) then
    exit;
  if Comp[4]=COMPRESS_STORED then
    MoveFast(Comp[9],Plain[0],PlainLen) else
  if Comp[4]=AnsiChar(AlgoID) then
    case Load of
    aclNormal:
      if (AlgoDecompress(Comp+9,CompLen-9,Plain)<>PlainLen) or
         (AlgoHash(0,Plain,PlainLen)<>PCardinal(Comp)^) then
        exit;
    aclSafeSlow:
      if (AlgoDecompressPartial(Comp+9,CompLen-9,Plain,PlainLen,PlainLen)<>PlainLen) or
         (AlgoHash(0,Plain,PlainLen)<>PCardinal(Comp)^) then
        exit;
    aclNoCrcFast:
      if (AlgoDecompress(Comp+9,CompLen-9,Plain)<>PlainLen) then
        exit;
    end;
  result := true;
end;


{ TAlgoSynLZ }

function TAlgoSynLZ.AlgoID: byte;
begin
  result := COMPRESS_SYNLZ; // =1
end;

function TAlgoSynLZ.AlgoCompress(Plain: pointer; PlainLen: integer;
  Comp: pointer): integer;
begin
  result := SynLZcompress1(Plain,PlainLen,Comp);
end;

function TAlgoSynLZ.AlgoCompressDestLen(PlainLen: integer): integer;
begin
  result := SynLZcompressdestlen(PlainLen);
end;

function TAlgoSynLZ.AlgoDecompress(Comp: pointer; CompLen: integer;
  Plain: pointer): integer;
begin
  result := SynLZdecompress1(Comp,CompLen,Plain);
end;

function TAlgoSynLZ.AlgoDecompressDestLen(Comp: pointer): integer;
begin
  result := SynLZdecompressdestlen(Comp);
end;

function TAlgoSynLZ.AlgoDecompressPartial(Comp: pointer;
  CompLen: integer; Partial: pointer; PartialLen, PartialLenMax: integer): integer;
begin
  result := SynLZdecompress1partial(Comp,CompLen,Partial,PartialLen);
end;

// deprecated wrapper methods - use SynLZ global variable instead

function SynLZCompress(const Data: RawByteString; CompressionSizeTrigger: integer;
  CheckMagicForCompressed: boolean): RawByteString;
begin
  result := AlgoSynLZ.Compress(pointer(Data),length(Data),CompressionSizeTrigger,
    CheckMagicForCompressed);
end;

procedure SynLZCompress(P: PAnsiChar; PLen: integer; out Result: RawByteString;
  CompressionSizeTrigger: integer; CheckMagicForCompressed: boolean);
begin
  result := AlgoSynLZ.Compress(P,PLen,CompressionSizeTrigger,CheckMagicForCompressed);
end;

function SynLZCompress(P, Dest: PAnsiChar; PLen, DestLen: integer;
  CompressionSizeTrigger: integer; CheckMagicForCompressed: boolean): integer;
begin
  result := AlgoSynLZ.Compress(P,Dest,PLen,DestLen,CompressionSizeTrigger,CheckMagicForCompressed);
end;

function SynLZDecompress(const Data: RawByteString): RawByteString;
begin
  AlgoSynLZ.Decompress(pointer(Data),Length(Data),result);
end;

function SynLZDecompressHeader(P: PAnsiChar; PLen: integer): integer;
begin
  result := AlgoSynLZ.DecompressHeader(P,PLen);
end;

function SynLZDecompressBody(P,Body: PAnsiChar; PLen,BodyLen: integer;
  SafeDecompression: boolean): boolean;
begin
  result := AlgoSynLZ.DecompressBody(P,Body,PLen,BodyLen,ALGO_SAFE[SafeDecompression]);
end;

function SynLZDecompressPartial(P,Partial: PAnsiChar; PLen,PartialLen: integer): integer;
begin
  result := AlgoSynLZ.DecompressPartial(P,Partial,PLen,PartialLen,PartialLen);
end;

procedure SynLZDecompress(P: PAnsiChar; PLen: integer; out Result: RawByteString;
  SafeDecompression: boolean);
begin
  AlgoSynLZ.Decompress(P,PLen,Result);
end;

function SynLZDecompress(const Data: RawByteString; out Len: integer;
  var tmp: RawByteString): pointer;
begin
  result := AlgoSynLZ.Decompress(pointer(Data),length(Data),Len,tmp);
end;

function SynLZDecompress(P: PAnsiChar; PLen: integer; out Len: integer;
  var tmp: RawByteString): pointer;
begin
  result := AlgoSynLZ.Decompress(P,PLen,Len,tmp);
end;

function SynLZCompressToBytes(const Data: RawByteString;
  CompressionSizeTrigger: integer): TByteDynArray;
begin
  result := AlgoSynLZ.CompressToBytes(pointer(Data),length(Data),CompressionSizeTrigger);
end;

function SynLZCompressToBytes(P: PAnsiChar; PLen,CompressionSizeTrigger: integer): TByteDynArray;
begin
  result := AlgoSynLZ.CompressToBytes(P,PLen,CompressionSizeTrigger);
end;

function SynLZDecompress(const Data: TByteDynArray): RawByteString;
begin
  AlgoSynLZ.Decompress(pointer(Data),length(Data),result);
end;


{ TAlgoCompressWithNoDestLen }

function TAlgoCompressWithNoDestLen.AlgoCompress(Plain: pointer;
  PlainLen: integer; Comp: pointer): integer;
begin
  Comp := ToVarUInt32(PlainLen,Comp); // deflate don't store PlainLen
  result := RawProcess(Plain,Comp,PlainLen,AlgoCompressDestLen(PlainLen),0,doCompress);
  if result>0 then
    inc(result,ToVarUInt32Length(PlainLen));
end;

function TAlgoCompressWithNoDestLen.AlgoDecompress(Comp: pointer;
  CompLen: integer; Plain: pointer): integer;
var start: PAnsiChar;
begin
  start := Comp;
  result := FromVarUInt32(PByte(Comp));
  if RawProcess(Comp,Plain,CompLen+(Start-Comp),result,0,doUnCompress)<>result then
    result := 0;
end;

function TAlgoCompressWithNoDestLen.AlgoDecompressDestLen(Comp: pointer): integer;
begin
  if Comp=nil then
    result := 0 else
    result := FromVarUInt32(PByte(Comp));
end;

function TAlgoCompressWithNoDestLen.AlgoDecompressPartial(Comp: pointer;
  CompLen: integer; Partial: pointer; PartialLen, PartialLenMax: integer): integer;
var start: PAnsiChar;
begin
  start := Comp;
  result := FromVarUInt32(PByte(Comp));
  if PartialLenMax>result then
    PartialLenMax := result;
  result := RawProcess(Comp,Partial,CompLen+(Start-Comp),PartialLen,PartialLenMax,doUncompressPartial);
end;


{ ESynException }

constructor ESynException.CreateUTF8(const Format: RawUTF8; const Args: array of const);
var msg: string;
begin
  FormatString(Format,Args,msg);
  inherited Create(msg);
end;

constructor ESynException.CreateLastOSError(const Format: RawUTF8; const Args: array of const);
var tmp: RawUTF8;
    error: integer;
begin
  error := GetLastError;
  FormatUTF8(Format,Args,tmp);
  CreateUTF8('OSError % [%] %',[error,SysErrorMessage(error),tmp]);
end;

{$ifndef NOEXCEPTIONINTERCEPT}
function ESynException.CustomLog(WR: TTextWriter;
  const Context: TSynLogExceptionContext): boolean;
begin
  if Assigned(TSynLogExceptionToStrCustom) then
    result := TSynLogExceptionToStrCustom(WR,Context) else
  if Assigned(DefaultSynLogExceptionToStr) then
    result := DefaultSynLogExceptionToStr(WR,Context) else
    result := false;
end;
{$endif}


{ TMemoryMapText }

constructor TMemoryMapText.Create;
begin
end;

constructor TMemoryMapText.Create(aFileContent: PUTF8Char; aFileSize: integer);
begin
  Create;
  fMap.Map(aFileContent,aFileSize);
  LoadFromMap;
end;

constructor TMemoryMapText.Create(const aFileName: TFileName);
begin
  Create;
  fFileName := aFileName;
  if fMap.Map(aFileName) then
    LoadFromMap;
end; // invalid file or unable to memory map its content -> Count := 0

destructor TMemoryMapText.Destroy;
begin
  Freemem(fLines);
  fMap.UnMap;
  inherited;
end;

procedure TMemoryMapText.SaveToStream(Dest: TStream; const Header: RawUTF8);
var i: integer;
    W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  i := length(Header);
  if i>0 then
    Dest.WriteBuffer(pointer(Header)^,i);
  if fMap.Size>0 then
    Dest.WriteBuffer(fMap.Buffer^,fMap.Size);
  if fAppendedLinesCount=0 then
    exit;
  W := TTextWriter.Create(Dest,@temp,SizeOf(temp));
  try
    if (fMap.Size>0) and (fMap.Buffer[fMap.Size-1]>=' ') then
      W.Add(#10);
    for i := 0 to fAppendedLinesCount-1 do begin
      W.AddString(fAppendedLines[i]);
      W.Add(#10);
    end;
    W.FlushFinal;
  finally
    W.Free;
  end;
end;

procedure TMemoryMapText.SaveToFile(FileName: TFileName; const Header: RawUTF8);
var FS: TFileStream;
begin
  FS := TFileStream.Create(FileName,fmCreate);
  try
    SaveToStream(FS,Header);
  finally
    FS.Free;
  end;
end;

function TMemoryMapText.GetLine(aIndex: integer): RawUTF8;
begin
  if (self=nil) or (cardinal(aIndex)>=cardinal(fCount)) then
    result := '' else
    FastSetString(result,fLines[aIndex],GetLineSize(fLines[aIndex],fMapEnd));
end;

function TMemoryMapText.GetString(aIndex: integer): string;
begin
  if (self=nil) or (cardinal(aIndex)>=cardinal(fCount)) then
    result := '' else
    UTF8DecodeToString(fLines[aIndex],GetLineSize(fLines[aIndex],fMapEnd),result);
end;

function GetLineContains(p, pEnd, up: PUTF8Char): boolean;
var
  i: PtrInt;
  {$ifdef CPUX86NOTPIC} table: TNormTable absolute NormToUpperAnsi7Byte;
  {$else} table: PNormTable; {$endif}
label
  Fnd1, LF1, Fnd2, LF2, Ok; // ugly but fast
begin
  if (p<>nil) and (up<>nil) then begin
    {$ifndef CPUX86NOTPIC} table := @NormToUpperAnsi7; {$endif}
    if pEnd=nil then
      repeat
        if p^<=#13 then
          goto LF1
        else if table[p^]=up^ then
          goto Fnd1;
        inc(p);
        continue;
LF1:    if (p^=#0) or (p^=#13) or (p^=#10) then
          break;
        inc(p);
        continue;
Fnd1:   i := 0;
        repeat
          inc(i);
          if up[i]<>#0 then
            if up[i]=table[p[i]] then
              continue else
              break else begin
Ok:         result := true; // found
            exit;
          end;
        until false;
        inc(p);
      until false
    else
      repeat
        if p>=pEnd then
          break;
        if p^<=#13 then
          goto LF2
        else if table[p^]=up^ then
          goto Fnd2;
        inc(p);
        continue;
LF2:    if (p^=#13) or (p^=#10) then
          break;
        inc(p);
        continue;
Fnd2:   i := 0;
        repeat
          inc(i);
          if up[i]=#0 then
            goto Ok;
          if p+i>=pEnd then
            break;
        until up[i]<>table[p[i]];
        inc(p);
      until false;
  end;
  result := false;
end;

function TMemoryMapText.LineContains(const aUpperSearch: RawUTF8;
  aIndex: Integer): Boolean;
begin
  if (self=nil) or (cardinal(aIndex)>=cardinal(fCount)) or (aUpperSearch='') then
    result := false else
    result := GetLineContains(fLines[aIndex],fMapEnd,pointer(aUpperSearch));
end;

function TMemoryMapText.LineSize(aIndex: integer): integer;
begin
  result := GetLineSize(fLines[aIndex],fMapEnd);
end;

function GetLineSizeSmallerThan(P,PEnd: PUTF8Char; aMinimalCount: integer): boolean;
begin
  if P<>nil then
    while (P<PEnd) and (P^<>#10) and (P^<>#13) do
      if aMinimalCount=0 then begin
        result := false;
        exit;
      end else begin
        dec(aMinimalCount);
        inc(P);
      end;
  result := true;
end;

function TMemoryMapText.LineSizeSmallerThan(aIndex, aMinimalCount: integer): boolean;
begin
  result := GetLineSizeSmallerThan(fLines[aIndex],fMapEnd,aMinimalCount);
end;

procedure TMemoryMapText.ProcessOneLine(LineBeg, LineEnd: PUTF8Char);
begin
  if fCount=fLinesMax then begin
    fLinesMax := NextGrow(fLinesMax);
    ReallocMem(fLines,fLinesMax*SizeOf(pointer));
  end;
  fLines[fCount] := LineBeg;
  inc(fCount);
end;

procedure TMemoryMapText.LoadFromMap(AverageLineLength: integer=32);
  procedure ParseLines(P,PEnd: PUTF8Char);
  var PBeg: PUTF8Char;
  begin // generated asm is much better with a local proc
    while P<PEnd do begin
      PBeg := P;
      while (P<PEnd) and (P^<>#13) and (P^<>#10) do
        inc(P);
      ProcessOneLine(PBeg,P);
      if P+1>=PEnd then
        break;
      if P[0]=#13 then
        if P[1]=#10 then
          inc(P,2) else // ignore #13#10
          inc(P) else   // ignore #13
        inc(P);         // ignore #10
    end;
  end;
var P: PUTF8Char;
begin
  fLinesMax := fMap.fFileSize div AverageLineLength+8;
  GetMem(fLines,fLinesMax*SizeOf(pointer));
  P := pointer(fMap.Buffer);
  fMapEnd := P+fMap.Size;
  if TextFileKind(Map)=isUTF8 then
    inc(PByte(P),3); // ignore UTF-8 BOM
  ParseLines(P,fMapEnd);
  if fLinesMax>fCount+16384 then
    Reallocmem(fLines,fCount*SizeOf(pointer)); // size down only if worth it
end;

procedure TMemoryMapText.AddInMemoryLine(const aNewLine: RawUTF8);
var P: PUTF8Char;
begin
  if aNewLine='' then
    exit;
  AddRawUTF8(fAppendedLines,fAppendedLinesCount,aNewLine);
  P := pointer(fAppendedLines[fAppendedLinesCount-1]);
  ProcessOneLine(P,P+StrLen(P));
end;

procedure TMemoryMapText.AddInMemoryLinesClear;
begin
  dec(fCount,fAppendedLinesCount);
  fAppendedLinesCount := 0;
  fAppendedLines := nil;
end;


{ TRawByteStringStream }

constructor TRawByteStringStream.Create(const aString: RawByteString);
begin
  fDataString := aString;
end;

function TRawByteStringStream.Read(var Buffer; Count: Integer): Longint;
begin
  if Count<=0 then
    Result := 0 else begin
    Result := Length(fDataString)-fPosition;
    if Result>Count then
      Result := Count;
    MoveFast(PByteArray(fDataString)[fPosition],Buffer,Result);
    inc(fPosition, Result);
  end;
end;

function TRawByteStringStream.Seek(Offset: Integer; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning: fPosition := Offset;
    soFromCurrent:   fPosition := fPosition+Offset;
    soFromEnd:       fPosition := Length(fDataString)-Offset;
  end;
  if fPosition>Length(fDataString) then
    fPosition := Length(fDataString) else
    if fPosition<0 then
      fPosition := 0;
  result := fPosition;
end;

procedure TRawByteStringStream.SetSize(NewSize: Integer);
begin
  SetLength(fDataString, NewSize);
  if fPosition>NewSize then
    fPosition := NewSize;
end;

function TRawByteStringStream.Write(const Buffer; Count: Integer): Longint;
begin
  if Count<=0 then
    Result := 0 else begin
    Result := Count;
    SetLength(fDataString,fPosition+Result);
    MoveFast(Buffer,PByteArray(fDataString)[fPosition],Result);
    inc(FPosition,Result);
  end;
end;


{ TFakeWriterStream }

function TFakeWriterStream.Read(var Buffer; Count: Longint): Longint;
begin // do nothing
  result := Count;
end;

function TFakeWriterStream.Write(const Buffer; Count: Longint): Longint;
begin // do nothing
  result := Count;
end;

function TFakeWriterStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  result := Offset;
end;


{ TSynNameValue }

procedure TSynNameValue.Add(const aName, aValue: RawUTF8; aTag: PtrInt);
var added: boolean;
    i: Integer;
begin
  i := DynArray.FindHashedForAdding(aName,added);
  with List[i] do begin
    if added then
      Name := aName;
    Value := aValue;
    Tag := aTag;
  end;
  if Assigned(fOnAdd) then
    fOnAdd(List[i],i);
end;

procedure TSynNameValue.InitFromIniSection(Section: PUTF8Char;
  OnTheFlyConvert: TOnSynNameValueConvertRawUTF8; OnAdd: TOnSynNameValueNotify);
var s: RawUTF8;
    i: integer;
begin
  Init(false);
  fOnAdd := OnAdd;
  while (Section<>nil) and (Section^<>'[') do begin
    s := GetNextLine(Section,Section);
    i := PosExChar('=',s);
    if (i>1) and not(s[1] in [';','[']) then
      if Assigned(OnTheFlyConvert) then
        Add(copy(s,1,i-1),OnTheFlyConvert(copy(s,i+1,1000))) else
        Add(copy(s,1,i-1),copy(s,i+1,1000));
  end;
end;

procedure TSynNameValue.InitFromCSV(CSV: PUTF8Char; NameValueSep,ItemSep: AnsiChar);
var n,v: RawUTF8;
begin
  Init(false);
  while CSV<>nil do begin
    GetNextItem(CSV,NameValueSep,n);
    if ItemSep=#10 then
      GetNextItemTrimedCRLF(CSV,v) else
      GetNextItem(CSV,ItemSep,v);
    if n='' then
      break;
    Add(n,v);
  end;
end;

procedure TSynNameValue.InitFromNamesValues(const Names, Values: array of RawUTF8);
var i: integer;
begin
  Init(false);
  if high(Names)<>high(Values) then
    exit;
  DynArray.SetCapacity(length(Names));
  for i := 0 to high(Names) do
    Add(Names[i],Values[i]);
end;

function TSynNameValue.InitFromJSON(JSON: PUTF8Char; aCaseSensitive: boolean): boolean;
var N,V: PUTF8Char;
    nam,val: RawUTF8;
    Nlen, Vlen, c: integer;
    EndOfObject: AnsiChar;
begin
  result := false;
  Init(aCaseSensitive);
  if JSON=nil then
    exit;
  while (JSON^<=' ') and (JSON^<>#0) do inc(JSON);
  if JSON^<>'{' then
    exit;
  repeat inc(JSON) until (JSON^=#0) or (JSON^>' ');
  c := JSONObjectPropCount(JSON);
  if c<=0 then
    exit;
  DynArray.SetCapacity(c);
  repeat
    N := GetJSONPropName(JSON,@Nlen);
    if N=nil then
      exit;
    V := GetJSONFieldOrObjectOrArray(JSON,nil,@EndOfObject,true,true,@Vlen);
    if V=nil then
      exit;
    FastSetString(nam,N,Nlen);
    FastSetString(val,V,Vlen);
    Add(nam,val);
  until EndOfObject='}';
  result := true;
end;

procedure TSynNameValue.Init(aCaseSensitive: boolean);
begin
  // release dynamic arrays memory before FillcharFast()
  List := nil;
  DynArray.fHash.Clear;
  // initialize hashed storage
  FillCharFast(self,SizeOf(self),0);
  DynArray.InitSpecific(TypeInfo(TSynNameValueItemDynArray),List,
    djRawUTF8,@Count,not aCaseSensitive);
end;

function TSynNameValue.Find(const aName: RawUTF8): integer;
begin
  result := DynArray.FindHashed(aName);
end;

function TSynNameValue.FindStart(const aUpperName: RawUTF8): integer;
begin
  for result := 0 to Count-1 do
    if IdemPChar(pointer(List[result].Name),pointer(aUpperName)) then
      exit;
  result := -1;
end;

function TSynNameValue.FindByValue(const aValue: RawUTF8): integer;
begin
  for result := 0 to Count-1 do
    if List[result].Value=aValue then
      exit;
  result := -1;
end;

function TSynNameValue.Delete(const aName: RawUTF8): boolean;
begin
 result := DynArray.FindHashedAndDelete(aName)>=0;
end;

function TSynNameValue.DeleteByValue(const aValue: RawUTF8; Limit: integer): integer;
var ndx: integer;
begin
  result := 0;
  if Limit<1 then
    exit;
  for ndx := Count-1 downto 0 do
    if List[ndx].Value=aValue then begin
      DynArray.Delete(ndx);
      inc(result);
      if result>=Limit then
        break;
    end;
  if result>0 then
    DynArray.ReHash;
end;

function TSynNameValue.Value(const aName: RawUTF8; const aDefaultValue: RawUTF8): RawUTF8;
var i: integer;
begin
  if @self=nil then
    i := -1 else
    i := DynArray.FindHashed(aName);
  if i<0 then
    result := aDefaultValue else
    result := List[i].Value;
end;

function TSynNameValue.ValueInt(const aName: RawUTF8; const aDefaultValue: Int64): Int64;
var i,err: integer;
begin
  i := DynArray.FindHashed(aName);
  if i<0 then
    result := aDefaultValue else begin
    result := {$ifdef CPU64}GetInteger{$else}GetInt64{$endif}(pointer(List[i].Value),err);
    if err<>0 then
      result := aDefaultValue;
  end;
end;

function TSynNameValue.ValueBool(const aName: RawUTF8): Boolean;
begin
  result := Value(aName)='1';
end;

function TSynNameValue.ValueEnum(const aName: RawUTF8; aEnumTypeInfo: pointer;
  out aEnum; aEnumDefault: byte): boolean;
var v: RawUTF8;
    err,i: integer;
begin
  result := false;
  byte(aEnum) := aEnumDefault;
  v := trim(Value(aName,''));
  if v='' then
    exit;
  i := GetInteger(pointer(v),err);
  if (err<>0) or (i<0) then
    i := GetEnumNameValue(aEnumTypeInfo,v,true);
  if i>=0 then begin
    byte(aEnum) := i;
    result := true;
  end;
end;

function TSynNameValue.Initialized: boolean;
begin
  result := DynArray.Value=@List;
end;

function TSynNameValue.GetBlobData: RawByteString;
begin
  result := DynArray.SaveTo;
end;

procedure TSynNameValue.SetBlobDataPtr(aValue: pointer);
begin
  DynArray.LoadFrom(aValue);
  DynArray.ReHash;
end;

procedure TSynNameValue.SetBlobData(const aValue: RawByteString);
begin
  DynArray.LoadFromBinary(aValue);
  DynArray.ReHash;
end;

function TSynNameValue.GetStr(const aName: RawUTF8): RawUTF8;
begin
  result := Value(aName,'');
end;

function TSynNameValue.GetInt(const aName: RawUTF8): Int64;
begin
  result := ValueInt(aName,0);
end;

function TSynNameValue.GetBool(const aName: RawUTF8): Boolean;
begin
  result := Value(aName)='1';
end;

function TSynNameValue.AsCSV(const KeySeparator,ValueSeparator,IgnoreKey: RawUTF8): RawUTF8;
var i: integer;
    temp: TTextWriterStackBuffer;
begin
  with TTextWriter.CreateOwnedStream(temp) do
  try
    for i := 0 to Count-1 do
    if (IgnoreKey='') or (List[i].Name<>IgnoreKey) then begin
      AddNoJSONEscapeUTF8(List[i].Name);
      AddNoJSONEscapeUTF8(KeySeparator);
      AddNoJSONEscapeUTF8(List[i].Value);
      AddNoJSONEscapeUTF8(ValueSeparator);
    end;
    SetText(result);
  finally
    Free;
  end;
end;

function TSynNameValue.AsJSON: RawUTF8;
var i: integer;
    temp: TTextWriterStackBuffer;
begin
  with TTextWriter.CreateOwnedStream(temp) do
  try
    Add('{');
    for i := 0 to Count-1 do
    with List[i] do begin
      AddProp(pointer(Name),length(Name));
      Add('"');
      AddJSONEscape(pointer(Value));
      Add('"',',');
    end;
    CancelLastComma;
    Add('}');
    SetText(result);
  finally
    Free;
  end;
end;

procedure TSynNameValue.AsNameValues(out Names,Values: TRawUTF8DynArray);
var i: integer;
begin
  SetLength(Names,Count);
  SetLength(Values,Count);
  for i := 0 to Count-1 do begin
    Names[i] := List[i].Name;
    Values[i] := List[i].Value;
  end;
end;

{$ifndef NOVARIANTS}
function TSynNameValue.ValueVariantOrNull(const aName: RawUTF8): variant;
var i: integer;
begin
  i := Find(aName);
  if i<0 then
    SetVariantNull(result) else
    RawUTF8ToVariant(List[i].Value,result);
end;

procedure TSynNameValue.AsDocVariant(out DocVariant: variant;
  ExtendedJson,ValueAsString,AllowVarDouble: boolean);
var ndx: integer;
begin
  if Count>0 then
  with TDocVariantData(DocVariant) do begin
    Init(JSON_OPTIONS_NAMEVALUE[ExtendedJson],dvObject);
    VCount := self.Count;
    SetLength(VName,VCount);
    SetLength(VValue,VCount);
    for ndx := 0 to VCount-1 do begin
      VName[ndx] := List[ndx].Name;
      if ValueAsString or not GetNumericVariantFromJSON(pointer(List[ndx].Value),
          TVarData(VValue[ndx]),AllowVarDouble) then
        RawUTF8ToVariant(List[ndx].Value,VValue[ndx]);
    end;
  end else
    TVarData(DocVariant).VType := varNull;
end;

function TSynNameValue.AsDocVariant(ExtendedJson,ValueAsString: boolean): variant;
begin
  AsDocVariant(result,ExtendedJson,ValueAsString);
end;

function TSynNameValue.MergeDocVariant(var DocVariant: variant;
  ValueAsString: boolean; ChangedProps: PVariant; ExtendedJson,AllowVarDouble: Boolean): integer;
var DV: TDocVariantData absolute DocVariant;
    i,ndx: integer;
    v: variant;
    intvalues: TRawUTF8Interning;
begin
  if integer(DV.VType)<>DocVariantVType then
    TDocVariant.New(DocVariant,JSON_OPTIONS_NAMEVALUE[ExtendedJson]);
  if ChangedProps<>nil then
    TDocVariant.New(ChangedProps^,DV.Options);
  if dvoInternValues in DV.Options then
    intvalues := DocVariantType.InternValues else
    intvalues := nil;
  result := 0; // returns number of changed values
  for i := 0 to Count-1 do
  if List[i].Name<>'' then begin
    VarClear(v);
    if ValueAsString or not GetNumericVariantFromJSON(pointer(List[i].Value),
        TVarData(v),AllowVarDouble) then
      RawUTF8ToVariant(List[i].Value,v);
    ndx := DV.GetValueIndex(List[i].Name);
    if ndx<0 then
      ndx := DV.InternalAdd(List[i].Name) else
      if SortDynArrayVariantComp(TVarData(v),TVarData(DV.Values[ndx]),false)=0 then
        continue; // value not changed -> skip
    if ChangedProps<>nil then
      PDocVariantData(ChangedProps)^.AddValue(List[i].Name,v);
    SetVariantByValue(v,DV.VValue[ndx]);
    if intvalues<>nil then
      intvalues.UniqueVariant(DV.VValue[ndx]);
    inc(result);
  end;
end;
{$endif NOVARIANTS}


{$ifdef MSWINDOWS}
function IsDebuggerPresent: BOOL; stdcall; external kernel32; // since XP
{$endif}

procedure SetCurrentThreadName(const Format: RawUTF8; const Args: array of const);
begin
  SetThreadName(GetCurrentThreadId,Format,Args);
end;

procedure SetThreadName(ThreadID: TThreadID; const Format: RawUTF8;
  const Args: array of const);
var name: RawUTF8;
begin
  FormatUTF8(Format,Args,name);
  name := StringReplaceAll(name,['TSQLRest','', 'TSQL','', 'TWebSocket','WS',
    'TServiceFactory','SF', 'TSyn','', 'Thread','', 'Process','',
    'Background','Bgd', 'Server','Svr', 'Client','Clt', 'WebSocket','WS',
    'Timer','Tmr', 'Thread','Thd']);
  SetThreadNameInternal(ThreadID,name);
end;

procedure SetThreadNameDefault(ThreadID: TThreadID; const Name: RawUTF8);
{$ifndef FPC}
{$ifndef NOSETTHREADNAME}
var s: RawByteString;
    {$ifndef ISDELPHIXE2}
    {$ifdef MSWINDOWS}
    info: record
      FType: LongWord;     // must be 0x1000
      FName: PAnsiChar;    // pointer to name (in user address space)
      FThreadID: LongWord; // thread ID (-1 indicates caller thread)
      FFlags: LongWord;    // reserved for future use, must be zero
    end;
    {$endif}
    {$endif}
{$endif NOSETTHREADNAME}
{$endif FPC}
begin
{$ifdef FPC}
  {$ifdef LINUX}
  if ThreadID<>MainThreadID then // don't change the main process name
    SetUnixThreadName(ThreadID, Name); // call pthread_setname_np()
  {$endif}
{$else}
{$ifndef NOSETTHREADNAME}
  {$ifdef MSWINDOWS}
  if not IsDebuggerPresent then
    exit;
  {$endif MSWINDOWS}
  s := CurrentAnsiConvert.UTF8ToAnsi(Name);
  {$ifdef ISDELPHIXE2}
  TThread.NameThreadForDebugging(s,ThreadID);
  {$else}
  {$ifdef MSWINDOWS}
  info.FType := $1000;
  info.FName := pointer(s);
  info.FThreadID := ThreadID;
  info.FFlags := 0;
  try
    RaiseException($406D1388,0,SizeOf(info) div SizeOf(LongWord),@info);
  except {ignore} end;
  {$endif MSWINDOWS}
  {$endif ISDELPHIXE2}
{$endif NOSETTHREADNAME}
{$endif FPC}
end;


{ MultiEvent* functions }

function MultiEventFind(const EventList; const Event: TMethod): integer;
var Events: TMethodDynArray absolute EventList;
begin
  if Event.Code<>nil then // callback assigned
    for result := 0 to length(Events)-1 do
      if (Events[result].Code=Event.Code) and
         (Events[result].Data=Event.Data) then
        exit;
  result := -1;
end;

function MultiEventAdd(var EventList; const Event: TMethod): boolean;
var Events: TMethodDynArray absolute EventList;
    n: integer;
begin
  result := false;
  n := MultiEventFind(EventList,Event);
  if n>=0 then
    exit; // already registered
  result := true;
  n := length(Events);
  SetLength(Events,n+1);
  Events[n] := Event;
end;

procedure MultiEventRemove(var EventList; const Event: TMethod);
begin
  MultiEventRemove(EventList,MultiEventFind(EventList,Event));
end;

procedure MultiEventRemove(var EventList; Index: Integer);
var Events: TMethodDynArray absolute EventList;
    max: integer;
begin
  max := length(Events);
  if cardinal(index)<cardinal(max) then begin
    dec(max);
    MoveFast(Events[index+1],Events[index],(max-index)*SizeOf(Events[index]));
    SetLength(Events,max);
  end;
end;

procedure MultiEventMerge(var DestList; const ToBeAddedList);
var Dest: TMethodDynArray absolute DestList;
    New: TMethodDynArray absolute ToBeAddedList;
    d,n: integer;
begin
  d := length(Dest);
  n := length(New);
  if n=0 then
    exit;
  SetLength(Dest,d+n);
  MoveFast(New[0],Dest[d],n*SizeOf(TMethod));
end;

function EventEquals(const eventA,eventB): boolean;
var A: TMethod absolute eventA;
    B: TMethod absolute eventB;
begin
  result := (A.Code=B.Code) and (A.Data=B.Data);
end;

var
  GarbageCollectorFreeAndNilList: TSynList;

procedure GarbageCollectorFree;
var i: integer;
    po: PObject;
begin
  if GarbageCollectorFreeing then
    exit; // when already called before finalization
  GarbageCollectorFreeing := true;
  for i := GarbageCollector.Count-1 downto 0 do // last in, first out
  try
    GarbageCollector.Delete(i); // will call GarbageCollector[i].Free
  except
    on Exception do
      ; // just ignore exceptions in client code destructors
  end;
  for i := GarbageCollectorFreeAndNilList.Count-1 downto 0 do // LIFO
  try
    po := GarbageCollectorFreeAndNilList.List[i];
    if (po<>nil) and (po^<>nil) then
      FreeAndNil(po^);
  except
    on E: Exception do
      ; // just ignore exceptions in client code destructors
  end;
  FreeAndNil(GarbageCollectorFreeAndNilList);
end;

procedure GarbageCollectorFreeAndNil(var InstanceVariable; Instance: TObject);
begin
  TObject(InstanceVariable) := Instance;
  GarbageCollectorFreeAndNilList.Add(@InstanceVariable);
end;

var
  GlobalCriticalSection: TRTLCriticalSection;

procedure GlobalLock;
begin
  EnterCriticalSection(GlobalCriticalSection);
end;

procedure GlobalUnLock;
begin
  LeaveCriticalSection(GlobalCriticalSection);
end;

{$ifdef CPUINTEL}
function IsXmmYmmOSEnabled: boolean; assembler; {$ifdef FPC} nostackframe; assembler; {$endif}
asm // see https://software.intel.com/en-us/blogs/2011/04/14/is-avx-enabled
        xor     ecx, ecx  // specify control register XCR0 = XFEATURE_ENABLED_MASK
        db  $0f, $01, $d0 // XGETBV reads XCR0 into EDX:EAX
        and     eax, 6    // check OS has enabled both XMM (bit 1) and YMM (bit 2)
        cmp     al, 6
        sete    al
end;

procedure TestIntelCpuFeatures;
var regs: TRegisters;
    c: cardinal;
begin
  // retrieve CPUID raw flags
  regs.edx := 0;
  regs.ecx := 0;
  GetCPUID(1,regs);
  PIntegerArray(@CpuFeatures)^[0] := regs.edx;
  PIntegerArray(@CpuFeatures)^[1] := regs.ecx;
  GetCPUID(7,regs);
  PIntegerArray(@CpuFeatures)^[2] := regs.ebx;
  PIntegerArray(@CpuFeatures)^[3] := regs.ecx;
  PIntegerArray(@CpuFeatures)^[4] := regs.edx;
  {$ifdef DISABLE_SSE42} // paranoid execution on Darwin x64 (as reported by alf)
  CpuFeatures := CpuFeatures-[cfSSE42,cfAESNI];
  {$endif DISABLE_SSE42}
  if not(cfOSXS in CpuFeatures) or not IsXmmYmmOSEnabled then
    CpuFeatures := CpuFeatures-[cfAVX,cfAVX2,cfFMA];
  {$ifndef ABSOLUTEPASCAL}
  {$ifdef CPUX64}
  {$ifdef WITH_ERMS}
  if cfERMS in CpuFeatures then // actually slower than our AVX code -> disabled
    include(CPUIDX64,cpuERMS);
  {$endif WITH_ERMS}
  if cfAVX in CpuFeatures then begin
    include(CPUIDX64,cpuAVX);
    if cfAVX2 in CpuFeatures then
      include(CPUIDX64,cpuAVX2);
  end;
  {$endif CPUX64}
  {$endif ABSOLUTEPASCAL}
  // validate accuracy of most used HW opcodes
  if cfRAND in CpuFeatures then
    try
      c := RdRand32;
      if RdRand32=c then // most probably a RDRAND bug, e.g. on AMD Rizen 3000
        exclude(CpuFeatures,cfRAND);
    except // may trigger an illegal instruction exception on some Ivy Bridge
      exclude(CpuFeatures,cfRAND);
    end;
  if cfSSE42 in CpuFeatures then
    try
      if crc32cBy4SSE42(0,1)<>3712330424 then
        raise ESynException.Create('Invalid crc32cBy4SSE42');
    except // disable now on illegal instruction or incorrect result
      exclude(CpuFeatures,cfSSE42);
    end;
end;
{$endif CPUINTEL}

procedure InitFunctionsRedirection;
begin
  {$ifdef CPUINTEL}
  TestIntelCpuFeatures;
  {$endif CPUINTEL}
  {$ifndef MSWINDOWS} // now for RedirectCode (RetrieveSystemInfo is too late)
  SystemInfo.dwPageSize := getpagesize; // use libc for this value
  if SystemInfo.dwPageSize=0 then // should not be 0
    SystemInfo.dwPageSize := 4096;
  {$endif MSWINDOWS}
  {$ifdef PUREPASCAL}
  {$ifndef HASINLINE}
  PosEx := @PosExPas;
  {$endif HASINLINE}
  PosExString := @PosExStringPas; // fast pure pascal process
  {$else not PUREPASCAL}
  {$ifdef UNICODE}
  PosExString := @PosExStringPas; // fast PWideChar process
  {$else}
  PosExString := @PosEx; // use optimized PAnsiChar i386 asm
  {$endif UNICODE}
  {$endif PUREPASCAL}
  crc32c := @crc32cfast; // now to circumvent Internal Error C11715 for Delphi 5
  crc32cBy4 := @crc32cBy4fast;
  {$ifndef CPUX64}
  MoveFast := @System.Move;
  {$endif CPUX64}
  {$ifdef FPC}
  {$ifdef CPUX64}
  {$ifndef ABSOLUTEPASCAL}
  if @System.FillChar<>@FillCharFast then begin
    // force to use our optimized x86_64 asm versions
    RedirectCode(@System.FillChar,@FillcharFast);
    RedirectCode(@System.Move,@MoveFast);
    {$ifdef DOPATCHTRTL}
    PatchCode(@fpc_ansistr_incr_ref,@_ansistr_incr_ref,$17); // fpclen=$2f
    PatchJmp(@fpc_ansistr_decr_ref,@_ansistr_decr_ref,$27);  // fpclen=$3f
    PatchJmp(@fpc_ansistr_assign,@_ansistr_assign,$3f);      // fpclen=$3f
    PatchCode(@fpc_ansistr_compare,@_ansistr_compare,$77);   // fpclen=$12f
    PatchCode(@fpc_ansistr_compare_equal,@_ansistr_compare_equal,$57); // =$cf
    PatchCode(@fpc_unicodestr_incr_ref,@_ansistr_incr_ref,$17); // fpclen=$2f
    PatchJmp(@fpc_unicodestr_decr_ref,@_ansistr_decr_ref,$27);  // fpclen=$3f
    PatchJmp(@fpc_unicodestr_assign,@_ansistr_assign,$3f);      // fpclen=$3f
    PatchCode(@fpc_dynarray_incr_ref,@_dynarray_incr_ref,$17);  // fpclen=$2f
    PatchJmp(@fpc_dynarray_clear,@_dynarray_decr_ref,$2f,PtrUInt(@_dynarray_decr_ref_free));
    RedirectCode(@fpc_dynarray_decr_ref,@fpc_dynarray_clear);
    {$ifdef FPC_HAS_CPSTRING}
    {$ifdef LINUX}
    if (DefaultSystemCodePage=CP_UTF8) or (DefaultSystemCodePage=0) then begin
      RedirectRtl(@_fpc_ansistr_concat,@_ansistr_concat_utf8);
      RedirectRtl(@_fpc_ansistr_concat_multi,@_ansistr_concat_multi_utf8);
    end;
    {$endif LINUX}
    {$ifdef FPC_X64MM}
    RedirectCode(@fpc_ansistr_setlength,@_ansistr_setlength);
    {$endif FPC_X64MM}
    {$endif FPC_HAS_CPSTRING}
    {$ifdef FPC_X64MM}
    RedirectCode(@fpc_getmem,@_Getmem);
    RedirectCode(@fpc_freemem,@_Freemem);
    {$endif FPC_X64MM}
    {$endif DOPATCHTRTL}
  end;
  {$endif ABSOLUTEPASCAL}
  {$else}
  FillCharFast := @System.FillChar; // fallback to FPC cross-platform RTL
  {$endif CPUX64}
  {$else Dephi: }
  {$ifdef CPUARM}
  FillCharFast := @System.FillChar;
  {$else}
  {$ifndef CPUX64}
  Pointer(@FillCharFast) := SystemFillCharAddress;
  {$endif CPUX64}
  {$ifdef DELPHI5OROLDER}
  StrLen := @StrLenX86;
  MoveFast := @MoveX87;
  FillcharFast := @FillCharX87;
  {$else DELPHI5OROLDER}
  {$ifdef CPU64} // x86_64 redirection
    {$ifdef HASAESNI}
    {$ifdef FORCE_STRSSE42}
    if cfSSE42 in CpuFeatures then begin
      StrLen := @StrLenSSE42;
      StrComp := @StrCompSSE42;
    end else
    {$endif FORCE_STRSSE42}
    {$endif HASAESNI}
      StrLen := @StrLenSSE2;
  {$else}       // i386 redirection
    {$ifdef CPUINTEL}
    if cfSSE2 in CpuFeatures then begin
      {$ifdef FORCE_STRSSE42}
      if cfSSE42 in CpuFeatures then
        StrLen := @StrLenSSE42 else
      {$endif FORCE_STRSSE42}
        StrLen := @StrLenSSE2;
      FillcharFast := @FillCharSSE2;
    end else begin
      StrLen := @StrLenX86;
      FillcharFast := @FillCharX87;
    end;
    {$ifdef WITH_ERMS} // disabled by default (much slower for small blocks)
    if cfERMS in CpuFeatures then begin
      MoveFast := @MoveERMSB;
      FillcharFast := @FillCharERMSB;
    end else {$endif}
      MoveFast := @MoveX87; // SSE2 is not faster than X87 version on 32-bit CPU
    {$endif CPUINTEL}
  {$endif CPU64}
  {$endif DELPHI5OROLDER}
  {$ifndef USEPACKAGES}
  // do redirection from RTL to our fastest version
  {$ifdef DOPATCHTRTL}
  if DebugHook=0 then begin // patch only outside debugging
    RedirectCode(SystemFillCharAddress,@FillcharFast);
    RedirectCode(@System.Move,@MoveFast);
    {$ifdef CPUX86}
    RedirectCode(SystemRecordCopyAddress,@RecordCopy);
    RedirectCode(SystemFinalizeRecordAddress,@RecordClear);
    RedirectCode(SystemInitializeRecordAddress,@_InitializeRecord);
    {$ifndef UNICODE} // buggy Delphi 2009+ RTL expects a TMonitor.Destroy call
    RedirectCode(@TObject.CleanupInstance,@TObjectCleanupInstance);
    {$endif UNICODE}
    {$endif}
  end;
  {$endif DOPATCHTRTL}
  {$endif USEPACKAGES}
  {$endif CPUARM}
  {$endif FPC}
  UpperCopy255Buf := @UpperCopy255BufPas;
  DefaultHasher := @xxHash32; // faster than crc32cfast for small content
  {$ifndef ABSOLUTEPASCAL}
  {$ifdef CPUINTEL}
  {$ifdef FPC} // StrLen was set above for Delphi
  {$ifdef CPUX86}
  if cfSSE2 in CpuFeatures then
  {$endif CPUX86}
    StrLen := @StrLenSSE2;
  {$endif FPC}
  if cfSSE42 in CpuFeatures then begin
    crc32c := @crc32csse42; // seems safe on all targets
    crc32cby4 := @crc32cby4sse42;
    crcblock := @crcblockSSE42;
    crcblocks := @crcblocksSSE42;
    {$ifdef FORCE_STRSSE42} // disabled by default: may trigger random GPF
    strspn := @strspnSSE42;
    strcspn := @strcspnSSE42;
    {$ifdef CPU64}
    {$ifdef FPC} // done in InitRedirectCode for Delphi
    {$ifdef HASAESNI}
    StrLen := @StrLenSSE42;
    StrComp := @StrCompSSE42;
    {$endif HASAESNI}
    {$endif FPC}
    {$endif CPU64}
    {$ifndef PUREPASCAL}
    {$ifndef DELPHI5OROLDER}
    UpperCopy255Buf := @UpperCopy255BufSSE42;
    {$endif DELPHI5OROLDER}
    {$endif PUREPASCAL}
    {$ifndef PUREPASCAL}
    StrComp := @StrCompSSE42;
    DYNARRAY_SORTFIRSTFIELD[false,djRawUTF8] := @SortDynArrayAnsiStringSSE42;
    DYNARRAY_SORTFIRSTFIELD[false,djWinAnsi] := @SortDynArrayAnsiStringSSE42;
    {$ifndef UNICODE}
    DYNARRAY_SORTFIRSTFIELD[false,djString] := @SortDynArrayAnsiStringSSE42;
    {$endif}
    DYNARRAY_SORTFIRSTFIELDHASHONLY[true] := @SortDynArrayAnsiStringSSE42;
    {$endif PUREPASCAL}
    {$endif FORCE_STRSSE42}
    DefaultHasher := crc32c;
  end;
  if cfPOPCNT in CpuFeatures then
    GetBitsCountPtrInt := @GetBitsCountSSE42;
  {$endif CPUINTEL}
  {$endif ABSOLUTEPASCAL}
  InterningHasher := DefaultHasher;
end;

procedure InitSynCommonsConversionTables;
var i,n: integer;
    v: byte;
    c: AnsiChar;
    crc: cardinal;
    tmp: array[0..15] of AnsiChar;
    P: PAnsiChar;
{$ifdef OWNNORMTOUPPER}
    d: integer;
const n2u: array[138..255] of byte =
  (83,139,140,141,90,143,144,145,146,147,148,149,150,151,152,153,83,155,140,
   157,90,89,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,
   176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,65,65,65,
   65,65,65,198,67,69,69,69,69,73,73,73,73,68,78,79,79,79,79,79,215,79,85,85,
   85,85,89,222,223,65,65,65,65,65,65,198,67,69,69,69,69,73,73,73,73,68,78,79,
   79,79,79,79,247,79,85,85,85,85,89,222,89);
{$endif OWNNORMTOUPPER}
const HexChars: array[0..15] of AnsiChar = '0123456789ABCDEF';
      HexCharsLower: array[0..15] of AnsiChar = '0123456789abcdef';
begin
  JSON_CONTENT_TYPE_VAR := JSON_CONTENT_TYPE;
  JSON_CONTENT_TYPE_HEADER_VAR := JSON_CONTENT_TYPE_HEADER;
  NULL_STR_VAR := 'null';
  BOOL_UTF8[false] := 'false';
  BOOL_UTF8[true] := 'true';
  {$ifdef FPC}
  {$ifdef ISFPC27}
  {$ifndef MSWINDOWS}
  GetACP := GetSystemCodePage;
  {$endif MSWINDOWS}
  SetMultiByteConversionCodePage(CP_UTF8);
  SetMultiByteRTLFileSystemCodePage(CP_UTF8);
  {$endif ISFPC27}
  {$endif FPC}
  {$ifdef KYLIX3}
  // if default locale is set to *.UTF-8, which is the case in most modern
  // linux default configuration, unicode decode will fail in SysUtils.CheckLocale
  setlocale(LC_CTYPE,'en_US'); // force locale for a UTF-8 server
  {$endif}
{$ifndef EXTENDEDTOSHORT_USESTR}
  {$ifdef ISDELPHIXE}
  SettingsUS := TFormatSettings.Create($0409);
  {$else}
  GetLocaleFormatSettings($0409,SettingsUS);
  {$endif}
  SettingsUS.DecimalSeparator := '.'; // value may have been overriden :(
{$endif}
  for i := 0 to 255 do
    NormToNormByte[i] := i;
  NormToUpperAnsi7Byte := NormToNormByte;
  for i := ord('a') to ord('z') do
    dec(NormToUpperAnsi7Byte[i],32);
  {$ifdef OWNNORMTOUPPER}
  MoveFast(NormToUpperAnsi7,NormToUpper,138);
  MoveFast(n2u,NormToUpperByte[138],SizeOf(n2u));
  for i := 0 to 255 do begin
    d := NormToUpperByte[i];
    if d in [ord('A')..ord('Z')] then
      inc(d,32);
    NormToLowerByte[i] := d;
  end;
  {$endif OWNNORMTOUPPER}
  FillcharFast(ConvertHexToBin[0],SizeOf(ConvertHexToBin),255); // all to 255
  v := 0;
  for i := ord('0') to ord('9') do begin
    ConvertHexToBin[i] := v;
    inc(v);
  end;
  for i := ord('A') to ord('F') do begin
    ConvertHexToBin[i] := v;
    ConvertHexToBin[i+(ord('a')-ord('A'))] := v;
    inc(v);
  end;
  for i := 0 to 255 do begin
    TwoDigitsHex[i][1] := HexChars[i shr 4];
    TwoDigitsHex[i][2] := HexChars[i and $f];
  end;
  for i := 0 to 255 do begin
    TwoDigitsHexLower[i][1] := HexCharsLower[i shr 4];
    TwoDigitsHexLower[i][2] := HexCharsLower[i and $f];
  end;
  MoveFast(TwoDigitLookup[0], TwoDigitByteLookupW[0], SizeOf(TwoDigitLookup));
  for i := 0 to 199 do
    dec(PByteArray(@TwoDigitByteLookupW)[i],ord('0')); // '0'..'9' -> 0..9
  FillcharFast(ConvertBase64ToBin,256,255); // invalid value set to -1
  for i := 0 to high(b64enc) do
    ConvertBase64ToBin[b64enc[i]] := i;
  ConvertBase64ToBin['='] := -2; // special value for '='
  for i := 0 to high(b64urienc) do
    ConvertBase64uriToBin[b64urienc[i]] := i;
  for i := high(Baudot2Char) downto 0 do
    if Baudot2Char[i]<#128 then
      Char2Baudot[Baudot2Char[i]] := i;
  for i := ord('a') to ord('z') do
    Char2Baudot[AnsiChar(i-32)] := Char2Baudot[AnsiChar(i)]; // A-Z -> a-z
  JSON_ESCAPE[0] := 1;         // 1 for #0 end of input
  for i := 1 to 31 do          // 0 indicates no JSON escape needed
    JSON_ESCAPE[i] := 2;       // 2 should be escaped as \u00xx
  JSON_ESCAPE[8] := ord('b');  // others contain the escaped character
  JSON_ESCAPE[9] := ord('t');
  JSON_ESCAPE[10] := ord('n');
  JSON_ESCAPE[12] := ord('f');
  JSON_ESCAPE[13] := ord('r');
  JSON_ESCAPE[ord('\')] := ord('\');
  JSON_ESCAPE[ord('"')] := ord('"');
  include(JSON_CHARS[#0], jcEndOfJSONFieldOr0);
  for c := low(c) to high(c) do begin
    if not (c in [#0,#10,#13]) then
      include(TEXT_CHARS[c], tcNot01013);
    if c in [#10,#13] then
      include(TEXT_CHARS[c], tc1013);
    if c in ['0'..'9','a'..'z','A'..'Z'] then
      include(TEXT_CHARS[c], tcWord);
    if c in ['_','a'..'z','A'..'Z'] then
      include(TEXT_CHARS[c], tcIdentifierFirstChar);
    if c in ['_','0'..'9','a'..'z','A'..'Z'] then
      include(TEXT_CHARS[c], tcIdentifier);
    if c in ['_','-','.','0'..'9','a'..'z','A'..'Z'] then
      // '~' is part of the RFC 3986 but should be escaped in practice
      // see https://blog.synopse.info/?post/2020/08/11/The-RFC%2C-The-URI%2C-and-The-Tilde
      include(TEXT_CHARS[c], tcURIUnreserved);
    if c in [#1..#9,#11,#12,#14..' '] then
      include(TEXT_CHARS[c], tcCtrlNotLF);
    if c in [#1..' ',';'] then
      include(TEXT_CHARS[c], tcCtrlNot0Comma);
    if c in [',',']','}',':'] then begin
      include(JSON_CHARS[c], jcEndOfJSONField);
      include(JSON_CHARS[c], jcEndOfJSONFieldOr0);
    end;
    if c in [#0,#9,#10,#13,' ',',','}',']'] then
      include(JSON_CHARS[c], jcEndOfJSONValueField);
    if c in ['-','0'..'9'] then
      include(JSON_CHARS[c], jcDigitFirstChar);
    if c in ['-','+','0'..'9'] then
      include(JSON_CHARS[c], jcDigitChar);
    if c in ['-','+','0'..'9','.','E','e'] then
      include(JSON_CHARS[c], jcDigitFloatChar);
    if c in ['_','0'..'9','a'..'z','A'..'Z','$'] then
      include(JSON_CHARS[c], jcJsonIdentifierFirstChar);
    if c in ['_','0'..'9','a'..'z','A'..'Z','.','[',']'] then
      include(JSON_CHARS[c], jcJsonIdentifier);
  end;
  TSynAnsiConvert.Engine(0); // define CurrentAnsi/WinAnsi/UTF8AnsiConvert
  for i := 0 to 255 do begin
    crc := i;
    for n := 1 to 8 do
      if (crc and 1)<>0 then // polynom is not the same as with zlib's crc32()
        crc := (crc shr 1) xor $82f63b78 else
        crc := crc shr 1;
    crc32ctab[0,i] := crc; // for crc32cfast() and SymmetricEncrypt/FillRandom
  end;
  for i := 0 to 255 do begin
    crc := crc32ctab[0,i];
    for n := 1 to high(crc32ctab) do begin
      crc := (crc shr 8) xor crc32ctab[0,ToByte(crc)];
      crc32ctab[n,i] := crc;
    end;
  end;
  for i := 0 to high(SmallUInt32UTF8) do begin
    P := StrUInt32(@tmp[15],i);
    FastSetString(SmallUInt32UTF8[i],P,@tmp[15]-P);
  end;
  KINDTYPE_INFO[djRawUTF8] := TypeInfo(RawUTF8); // for TDynArray.LoadKnownType
  KINDTYPE_INFO[djWinAnsi] := TypeInfo(WinAnsiString);
  KINDTYPE_INFO[djString] := TypeInfo(String);
  KINDTYPE_INFO[djRawByteString] := TypeInfo(RawByteString);
  KINDTYPE_INFO[djWideString] := TypeInfo(WideString);
  KINDTYPE_INFO[djSynUnicode] := TypeInfo(SynUnicode);
  {$ifndef NOVARIANTS}KINDTYPE_INFO[djVariant] := TypeInfo(variant);{$endif}
end;

initialization
  // initialization of internal dynamic functions and tables
  InitFunctionsRedirection;
  InitializeCriticalSection(GlobalCriticalSection);
  GarbageCollectorFreeAndNilList := TSynList.Create;
  GarbageCollectorFreeAndNil(GarbageCollector,TSynObjectList.Create);
  InitSynCommonsConversionTables;
  RetrieveSystemInfo;
  SetExecutableVersion(0,0,0,0);
  AlgoSynLZ := TAlgoSynLZ.Create;
  GarbageCollectorFreeAndNil(GlobalCustomJSONSerializerFromTextSimpleType,
    TSynDictionary.Create(TypeInfo(TRawUTF8DynArray),
      TypeInfo(TJSONSerializerFromTextSimpleDynArray),true));
  TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(
    {$ifdef ISDELPHI2010}TypeInfo(TGUID){$else}nil{$endif},'TGUID');
  TTextWriter.RegisterCustomJSONSerializerFromText([
    TypeInfo(TFindFilesDynArray),
     'Name:string Attr:Integer Size:Int64 Timestamp:TDateTime']);
  // some paranoid cross-platform/cross-compiler assertions
  {$ifndef NOVARIANTS}
  Assert(SizeOf(TVarData)={$ifdef CPU64}24{$else}16{$endif}); // for ExchgVariant
  Assert(SizeOf(TDocVariantData)=SizeOf(TVarData));
  DocVariantType := TDocVariant(SynRegisterCustomVariantType(TDocVariant));
  DocVariantVType := DocVariantType.VarType;
  {$endif NOVARIANTS}
  {$ifndef FPC}{$warnings OFF}{$endif}
  Assert((MAX_SQLFIELDS>=64)and(MAX_SQLFIELDS<=256));
  {$ifndef FPC}{$warnings ON}{$endif}
  Assert(SizeOf(THash128Rec)=SizeOf(THash128));
  Assert(SizeOf(THash256Rec)=SizeOf(THash256));
  Assert(SizeOf(TBlock128)=SizeOf(THash128));
  assert(SizeOf(TSynSystemTime)=SizeOf(TSystemTime));
  assert(SizeOf(TSynSystemTime)=SizeOf(THash128));
  Assert(SizeOf(TOperatingSystemVersion)=SizeOf(integer));
  Assert(SizeOf(TSynLocker)>=128,'cpucacheline');
  Assert(SizeOf(TJsonChar)=1);
  Assert(SizeOf(TTextChar)=1);
  {$ifdef MSWINDOWS}
  {$ifndef CPU64}
  Assert(SizeOf(TFileTime)=SizeOf(Int64)); // see e.g. FileTimeToInt64
  {$endif CPU64}
  {$endif MSWINDOWS}

finalization
  {$ifndef NOVARIANTS}
  DocVariantType.Free;
  {$endif NOVARIANTS}
  GarbageCollectorFree;
  DeleteCriticalSection(GlobalCriticalSection);
  //writeln('TDynArrayHashedCollisionCount=',TDynArrayHashedCollisionCount); readln;
end.