mormot.core.base.pas

/// Framework Core Shared Types and RTL-like Functions
// - this unit is a part of the Open Source Synopse mORMot framework 2,
// licensed under a MPL/GPL/LGPL three license - see LICENSE.md
unit mormot.core.base;

{
  *****************************************************************************

   Basic types and reusable stand-alone functions shared by all framework units
    - Framework Version and Information
    - Common Types Used for Compatibility Between Compilers and CPU
    - Numbers (floats and integers) Low-level Definitions
    - Integer Arrays Manipulation
    - ObjArray PtrArray InterfaceArray Wrapper Functions
    - Low-level Types Mapping Binary or Bits Structures
    - Buffers (e.g. Hashing and SynLZ compression) Raw Functions
    - Efficient Variant Values Conversion
    - Sorting/Comparison Functions
    - Some Convenient TStream descendants and File access functions
    - Faster Alternative to RTL Standard Functions
    - Raw Shared Constants / Types Definitions

   Aim of those types and functions is to be cross-platform and cross-compiler,
  without any dependency but the main FPC/Delphi RTL. It also detects the
  kind of CPU it runs on, to adapt to the fastest asm version available.
   It is the main unit where x86_64 or i386 asm stubs are included.

  *****************************************************************************
}

interface

{$I ..\mormot.defines.inc}

uses
  variants,
  classes,
  contnrs,
  types,
  sysutils;


{ ************ Framework Version and Information }

const
  /// the full text of the Synopse mORMot framework
  // - note: we don't supply full version number with build revision for
  // HTTP servers, to reduce potential attack surface
  SYNOPSE_FRAMEWORK_NAME = 'mORMot';

  /// the corresponding version of the mORMot framework, as '2.#.#'
  // - 2nd digit is minor version, increased at each framework release,
  // when adding functionality in a stable enough manner
  // - 3rd digit is a globally increasing git commit number (as generated by the
  // commit.sh script) - so won't be reset when minor is up
  // - specific branches may have prefixes, e.g. 'lts-2.3.#'
  SYNOPSE_FRAMEWORK_VERSION = {$I ..\mormot.commit.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_LIBCMM}   + ' CM'   {$endif}
      {$endif FPC_X64MM}
    {$else}
      {$ifdef FullDebugMode}         + ' FDM'  {$endif}
    {$endif FPC};


{ ************ Common Types Used for Compatibility Between Compilers and CPU }

const
  /// internal Code Page for UTF-8 Unicode encoding
  // - as used by RawUtf8 and all our internal framework text process
  CP_UTF8 = 65001;

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

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

  /// fake code page used to recognize RawBlob
  // - RawBlob internal code page will be CP_RAWBYTESTRING = 65535, but our ORM
  // will identify the RawBlob type and unserialize it using CP_RAWBLOB instead
  // - TJsonWriter.AddAnyAnsiBuffer will recognize it and use Base-64 encoding
  CP_RAWBLOB = 65534;

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

  /// Latin-1 ISO/IEC 8859-1 Code Page
  // - map low 8-bit Unicode CodePoints
  CP_LATIN1 = 819;

  /// internal Code Page for System AnsiString encoding
  CP_ACP = 0;

  /// internal Code Page for System Console encoding
  CP_OEM = 1;

  /// use rather CP_WINANSI with mORMot 2
  CODEPAGE_US = CP_WINANSI;

  /// use rather CP_LATIN1 with mORMot 2
  CODEPAGE_LATIN1 = CP_LATIN1;

{$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 CPU64}
  /// 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
  // - use UInt64 explicitly in your computation (like in mormot.crypt.ecc),
  // 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 = type Int64;
  {$endif UNICODE}
  /// points to an unsigned Int64
  PQWord = ^QWord;
  
  // redefined here to not use the unexpected PWord definition from Windows unit
  PWord = System.PWord;
  // redefined here to not use the unexpected PSingle definition from Windows unit
  PSingle = System.PSingle;

  // this pointer is not defined on older Delphi revisions
  PMethod = ^TMethod;

  {$ifndef ISDELPHIXE2}
  /// used to store the handle of a system Thread
  TThreadID = cardinal;
  /// compatibility definition with FPC and newer Delphi
  PUInt64 = ^UInt64;
  {$endif ISDELPHIXE2}

{$endif FPC}

type
  /// RawUtf8 is an UTF-8 String stored in an AnsiString, alias to System.UTF8String
  // - all conversion to/from string or WinAnsiString must be explicit on
  // Delphi 7/2007, and it will be faster anyway to use our optimized functions
  // from mormot.core.unicode.pas unit like StringToUtf8/Utf8ToString
  RawUtf8 = System.UTF8String; // CP_UTF8 Codepage

  /// a RawUtf8 value which may contain Sensitive Personal Information
  // (e.g. a bank card number or a plain password)
  // - identified as a specific type e.g. to be hidden in the logs - when the
  // woHideSensitivePersonalInformation TTextWriterWriteObjectOption is set
  SpiUtf8 = type RawUtf8;

  /// 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 string or RawUtf8/UTF8String must be explicit on
  // Delphi 7/2007, and it will be faster anyway to use our optimized functions
  // from mormot.core.unicode.pas unit like StringToUtf8/Utf8ToString
  {$ifdef HASCODEPAGE}
  WinAnsiString = type AnsiString(CP_WINANSI); // WinAnsi 1252 Codepage
  {$else}
  WinAnsiString = type AnsiString;
  {$endif HASCODEPAGE}

  {$ifdef HASCODEPAGE}
  {$ifdef FPC}
  // missing declaration
  PRawByteString = ^RawByteString;
  {$endif FPC}
  {$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 HASCODEPAGE}

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

  /// a RawByteString sub-type used to store the BLOB content in our ORM
  // - equals RawByteString for byte storage
  // - TRttiInfo.AnsiStringCodePage will identify this type, and return
  // CP_RAWBLOB fake codepage for such a published property, even if it is
  // just an alias to CP_RAWBYTESTRING
  // - our ORM will therefore identify such properties as BLOB
  // - by default, the BLOB fields are not retrieved or updated with raw
  // TRest.Retrieve() method, that is "Lazy loading" is enabled by default
  // for blobs, unless TRestClientUri.ForceBlobTransfert property is TRUE
  // (for all tables), or ForceBlobTransfertTable[] (for a particular table);
  // so use RetrieveBlob() methods for handling BLOB fields
  // - could be defined as value in a TOrm property as such:
  // ! property Blob: RawBlob read fBlob write fBlob;
  // - is defined here for proper TRttiProp.WriteAsJson serialization
  RawBlob = type RawByteString;

  /// 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 the faster UnicodeString type, which
  // allow Copy On Write, Reference Counting and fast heap memory allocation
  // - on recent FPC, HASVARUSTRING is defined and native UnicodeString is set
  {$ifdef HASVARUSTRING}
  SynUnicode = UnicodeString;
  {$else}
  SynUnicode = WideString;
  {$endif HASVARUSTRING}

  {$ifndef PUREMORMOT2}
  /// low-level RawUnicode as an Unicode String stored in an AnsiString
  // - DEPRECATED TYPE, introduced in Delphi 7/2007 days: SynUnicode is to be used
  // - 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 may not be able to perform implicit conversions on CP_UTF16
  {$ifdef HASCODEPAGE}
  RawUnicode = type AnsiString(CP_UTF16); // Codepage for an "Unicode" String
  {$else}
  RawUnicode = type AnsiString;
  {$endif HASCODEPAGE}
  PRawUnicode = ^RawUnicode;
  {$endif PUREMORMOT2}

  /// store one 32-bit UCS-4 CodePoint (with a better naming than UCS-4 "Char")
  // - RTL's Ucs4Char is buggy, especially on oldest Delphi
  Ucs4CodePoint = cardinal;
  /// pointer to one 32-bit UCS-4 CodePoint
  PUcs4CodePoint = ^Ucs4CodePoint;

  /// low-level storage of UCS-4 CodePoints, stored as 32-bit integers
  RawUcs4 = array of Ucs4CodePoint;

  {$ifdef CPU64}
  HalfInt = integer;
  HalfUInt = cardinal;
  {$else}
  /// a CPU-dependent signed integer type cast of half a pointer
  HalfInt = smallint;
  /// a CPU-dependent unsigned integer type cast of half a pointer
  HalfUInt = word;
  {$endif CPU64}
  /// a CPU-dependent signed integer type cast of a pointer to half a pointer
  PHalfInt = ^HalfInt;
  /// a CPU-dependent unsigned integer type cast of a pointer to half a pointer
  PHalfUInt = ^HalfUInt;

  PRawJson = ^RawJson;
  PPRawJson = ^PRawJson;
  PRawUtf8 = ^RawUtf8;
  PPRawUtf8 = ^PRawUtf8;
  PWinAnsiString = ^WinAnsiString;
  PWinAnsiChar = type PAnsiChar;
  PSynUnicode = ^SynUnicode;
  PFileName = ^TFileName;

  /// 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 internally stored and expected to be UTF-8 encoded
  PUtf8Char = type PAnsiChar;
  PPUtf8Char = ^PUtf8Char;
  PPPUtf8Char = ^PPUtf8Char;

  /// 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;

  /// a TVarData values array
  // - is not called TVarDataArray to avoid confusion with the corresponding
  // type already defined in RTL 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;
  PPVarData = ^PVarData;

  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;
  THalfUIntDynArray = array of HalfUInt;
  PDoubleDynArray = ^TDoubleDynArray;
  TDoubleDynArray = array of double;
  PCurrencyDynArray = ^TCurrencyDynArray;
  TCurrencyDynArray = array of currency;
  PExtendedDynArray = ^TExtendedDynArray;
  TExtendedDynArray = array of Extended;
  TWordDynArray = array of word;
  PWordDynArray = ^TWordDynArray;
  TByteDynArray = array of byte;
  PByteDynArray = ^TByteDynArray;
  {$ifndef ISDELPHI2007ANDUP}
  TBytes = array of byte;
  {$endif ISDELPHI2007ANDUP}
  TBytesDynArray = array of TBytes;
  PBytesDynArray = ^TBytesDynArray;
  TObjectDynArray = array of TObject;
  PObjectDynArray = ^TObjectDynArray;
  TPersistentDynArray = array of TPersistent;
  PPersistentDynArray = ^TPersistentDynArray;
  TPointerDynArray = array of pointer;
  PPointerDynArray = ^TPointerDynArray;
  TPointerDynArrayDynArray = array of 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;
  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;
  TRawByteStringDynArray = array of RawByteString;
  PRawByteStringDynArray = ^TRawByteStringDynArray;
  {$ifdef HASVARUSTRING}
  TUnicodeStringDynArray = array of UnicodeString;
  PUnicodeStringDynArray = ^TUnicodeStringDynArray;
  {$endif HASVARUSTRING}
  TRawJsonDynArray = array of RawJson;
  PRawJsonDynArray = ^TRawJsonDynArray;
  TGuidDynArray = array of TGuid;
  PGuidDynArray = array of PGuid;

  PObject = ^TObject;
  PClass = ^TClass;
  PList = ^TList;
  PObjectList = ^TObjectList;
  PCollection = ^TCollection;
  PStrings = ^TStrings;
  PPByte = ^PByte;
  PPPByte = ^PPByte;
  PPInteger = ^PInteger;
  PPCardinal = ^PCardinal;
  PPPointer = ^PPointer;
  PByteArray = ^TByteArray;
  TByteArray = array[ 0 .. MaxInt - 1 ] of byte; // redefine here with {$R-}
  PBooleanArray = ^TBooleanArray;
  TBooleanArray = array[ 0 .. MaxInt - 1 ] of boolean;
  PPWord = ^PWord;
  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;
  TGuidArray = array[ 0 .. MaxInt div SizeOf(TGuid) - 1 ] of TGuid;
  PGuidArray = ^TGuidArray;
  TPtrUIntArray = array[ 0 .. MaxInt div SizeOf(PtrUInt) - 1 ] of PtrUInt;
  PPtrUIntArray = ^TPtrUIntArray;
  THalfUIntArray = array[ 0 .. MaxInt div SizeOf(HalfUInt) - 1 ] of HalfUInt;
  PHalfUIntArray = ^THalfUIntArray;
  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;
  TPointerArray = array[ 0 .. MaxInt div SizeOf(pointer) - 1 ] of pointer;
  PPointerArray = ^TPointerArray;
  TClassArray = array[ 0 .. MaxInt div SizeOf(TClass) - 1 ] of TClass;
  PClassArray = ^TClassArray;
  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;
  PLongRec = ^LongRec;
  PPShortString = ^PShortString;
  PTextFile = ^TextFile;

  PInterface = ^IInterface;
  TInterfaceDynArray = array of IInterface;
  PInterfaceDynArray = ^TInterfaceDynArray;

  TListClass = class of TList;
  TStreamClass = class of TStream;
  TStringsClass = class of TStrings;
  TObjectListClass = class of TObjectList;
  TCollectionClass = class of TCollection;
  TCollectionItemClass = class of TCollectionItem;
  TInterfacedObjectClass = class of TInterfacedObject;

  /// meta-class of all Exception class types
  ExceptionClass = class of Exception;

  {$M+}
  /// a parent Exception class with RTTI generated for its published properties
  // - not as good as ESynException, but could be used without mormot.core.text
  ExceptionWithProps = class(Exception);

  /// a parent TObject class with a virtual constructor and RTTI generated
  // for its published properties
  // - lighter than TPersistent, TObjectWithRttiMethods or TClonable if you just
  // want to persist some published properties, e.g. into JSON
  TSynPersistent = class(TObject)
  public
    /// virtual constructor called at instance creation
    // - inherited classes would have a root constructor to override
    // - is recognized by our RTTI initialization / JSON serialization process
    constructor Create; overload; virtual;
  end;

  /// a parent TInterfacedObject class with a virtual constructor and RTTI
  // generated for its published properties and its methods
  // - so class instances published properties could be serialized as JSON,
  // and its methods could match IInvokable RTTI
  TInterfacedPersistent = class(TInterfacedObject)
  public
    /// virtual constructor called at instance creation
    // - inherited classes would have a root constructor to override
    // - is recognized by our RTTI initialization / JSON serialization process
    constructor Create; overload; virtual;
  end;

  /// used to determine the exact class type of a TSynPersistent
  // - allow to create instances using its virtual constructor
  TSynPersistentClass = class of TSynPersistent;
  /// used to determine the exact class type of a TInterfacedPersistent
  // - allow to create instances using its virtual constructor
  TInterfacedPersistentClass = class of TInterfacedPersistent;
  {$M-}

type
  /// used e.g. to serialize up to 256-bit as hexadecimal
  TShort64 = string[64];
  PShort64 = ^TShort64;

  /// a shortstring which only takes 48 bytes of memory
  TShort47 = string[47];
  PShort47 = ^TShort47;

  /// used e.g. for SetThreadName/GetCurrentThreadName
  TShort31 = string[31];
  PShort31 = ^TShort31;

  /// used e.g. by Int64ToHttpEtag
  TShort23 = string[23];
  PShort23 = ^TShort23;

  /// 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;

  /// used e.g. by TSynSystemTime.ToTextDateShort
  TShort15 = string[15];
  PShort15 = ^TShort15;

  /// used e.g. for TTextWriter.AddShorter small text constants
  TShort8 = string[8];
  PShort8 = ^TShort8;

  /// stack-allocated ASCII string, used by GuidToShort() function
  TGuidShortString = string[38];

  /// cross-compiler type used for string length
  // - FPC uses PtrInt/SizeInt, Delphi uses longint even on CPU64
  TStrLen = {$ifdef FPC} SizeInt {$else} longint {$endif};
  /// pointer to cross-compiler type used for string length
  PStrLen = ^TStrLen;
  
  /// cross-compiler type used for dynamic array length
  // - both FPC and Delphi uses PtrInt/NativeInt for dynamic array high/length
  TDALen = PtrInt;
  /// pointer to cross-compiler type used for dynamic array length
  PDALen = ^TDALen;

  /// cross-compiler type used for string reference counter
  // - FPC and Delphi don't always use the same type
  TStrCnt = {$ifdef STRCNT32} integer {$else} SizeInt {$endif};
  /// pointer to cross-compiler type used for string reference counter
  PStrCnt = ^TStrCnt;

  /// cross-compiler type used for dynarray reference counter
  // - FPC uses PtrInt/SizeInt, Delphi uses longint even on CPU64
  TDACnt = {$ifdef DACNT32} integer {$else} SizeInt {$endif};
  /// pointer to cross-compiler type used for dynarray reference counter
  PDACnt = ^TDACnt;

  /// cross-compiler return type of IUnknown._AddRef/_Release methods
  // - used to reduce the $ifdef when implementing interfaces in Delphi and FPC
  TIntCnt = {$ifdef FPC} longint {$else} integer {$endif};
  /// cross-compiler return type of IUnknown.QueryInterface method
  // - used to reduce the $ifdef when implementing interfaces in Delphi and FPC
  TIntQry = {$ifdef FPC} longint {$else} HRESULT {$endif};

  {$ifdef FPC}

  TStrRec = record // see TAnsiRec/TUnicodeRec in astrings/ustrings.inc
  case integer of
    0: (
        {$ifdef HASCODEPAGE}
        codePage: TSystemCodePage; // =Word
        elemSize: Word;
        {$ifndef STRCNT32}
        {$ifdef CPU64}
        _PaddingToQWord: DWord;
        {$endif CPU64}
        {$endif STRCNT32}
        {$endif HASCODEPAGE}
        refCnt: TStrCnt; // =SizeInt on older FPC, =longint since FPC 3.4
        length: TStrLen;
      );
    {$ifdef HASCODEPAGE}
    1: (
        codePageElemSize: cardinal;
      );
    {$endif HASCODEPAGE}
  end;

  TDynArrayRec = record
    refCnt: TDACnt; // =SizeInt
    high: TDALen;   // =SizeInt (differs from Delphi: equals length-1)
    function GetLength: TDALen; inline;
    procedure SetLength(len: TDALen); inline;
    property length: TDALen // Delphi compatibility wrapper
      read GetLength write SetLength;
  end;

  {$else not FPC}

  /// map the Delphi/FPC string header (stored before each instance)
  TStrRec = packed record
  {$ifdef HASCODEPAGE}
    {$ifdef CPU64}
    /// padding bytes for 16 byte alignment of the header
    _Padding: cardinal;
    {$endif CPU64}
    /// the string code page - e.g. CP_UTF8 for RawUtf8
    codePage: Word;
    /// 1 for AnsiString/RawByteString/RawUtf8, 2 for UnicodeString
    elemSize: Word;
  {$endif HASCODEPAGE}
    /// string reference count (basic garbage memory mechanism)
    refCnt: TStrCnt; // 32-bit longint with Delphi
    /// equals length(s) - i.e. size in AnsiChar/WideChar, not bytes
    length: TStrLen; // 32-bit longint with Delphi
  end;

  /// 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: cardinal;
    {$endif}
    /// dynamic array reference count (basic garbage memory mechanism)
    refCnt: TDACnt; // 32-bit longint with Delphi
    /// length in element count
    // - size in bytes = length*ElemSize
    length: TDALen; // PtrInt/NativeInt
  end;

  {$endif FPC}

  PStrRec = ^TStrRec;
  PDynArrayRec = ^TDynArrayRec;

const
  /// codePage offset = string header size
  // - used to calc the beginning of memory allocation of a string
  _STRRECSIZE = SizeOf(TStrRec);

  /// 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 PStrCnt(p - _STRCNT)^
  _STRCNT = SizeOf(TStrCnt) + _STRLEN;

  /// used to calc the beginning of memory allocation of a dynamic array
  _DARECSIZE = SizeOf(TDynArrayRec);

  /// cross-compiler negative offset to TDynArrayRec.high/length field
  // - to be used inlined e.g. as
  // ! PDALen(PAnsiChar(Values) - _DALEN)^ + _DAOFF
  // - both FPC and Delphi uses PtrInt/NativeInt for dynamic array high/length
  _DALEN = SizeOf(TDALen);

  /// cross-compiler adjuster to get length from TDynArrayRec.high/length field
  _DAOFF = {$ifdef FPC} 1 {$else} 0 {$endif};
  
  /// cross-compiler negative offset to TDynArrayRec.refCnt field
  // - to be used inlined e.g. as PDACnt(PAnsiChar(Values) - _DACNT)^
  _DACNT = SizeOf(TDACnt) + _DALEN;

  /// in-memory string process will allow up to 800 MB
  // - used as high limit e.g. for TBufferWriter over a TRawByteStringStream
  // - Delphi strings have a 32-bit length so you should change your algorithm
  // - even if FPC on CPU64 can handle bigger strings, consider other patterns
  _STRMAXSIZE = $5fffffff;

  /// in-memory TBytes process will allow up to 800 MB
  // - used as high limit e.g. for TBufferWriter.FlushToBytes
  // - even if a dynamic array can handle PtrInt length, consider other patterns
  _DAMAXSIZE = $5fffffff;

/// like SetLength() but without any memory resize - WARNING: len should be > 0
procedure DynArrayFakeLength(arr: pointer; len: TDALen);
  {$ifdef HASINLINE} inline; {$endif}

/// low-level deletion of one dynamic array item
// - Last=high(Values) should be > 0 - caller should set Values := nil for Last<=0
// - caller should have made Finalize(Values[Index]) before calling
// - used e.g. by TSecurityDescriptor.Delete()
procedure DynArrayFakeDelete(var Values; Index, Last, ValueSize: PtrUInt);

{$ifndef CPUARM}
type
  /// used as ToByte() to properly truncate any integer into 8-bit
  // - is defined as an inlined "and 255" function under ARM to work as expected
  ToByte = byte;
{$else}
function ToByte(value: cardinal): cardinal; inline;
{$endif CPUARM}

const
  /// used to point and return a void ASCIIZ buffer or ShortString
  NULCHAR: AnsiChar = #0;

  /// a TGuid containing all zero bytes
  GUID_NULL: TGuid = '{00000000-0000-0000-0000-000000000000}';

  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;

/// fill a TGuid with 0
procedure FillZero(var result: TGuid); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// compare two TGuid values
// - this version is faster than the one supplied by SysUtils
function IsEqualGuid({$ifdef FPC_HAS_CONSTREF}constref{$else}const{$endif}
  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 zero bytes, i.e. GUID_NULL
// - 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;

/// compute a random UUid value from the RandomBytes() generator and RFC 4122
procedure RandomGuid(out result: TGuid); overload;

/// compute a random UUid value from the RandomBytes() generator and RFC 4122
function RandomGuid: TGuid; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast O(log(n)) binary search of a binary (e.g. TGuid) value in a sorted array
function FastFindBinarySorted(P, Value: PByteArray; Size, R: PtrInt): PtrInt;

/// 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
// - initial steps are 4, 8, 12, 28, 40, 56, 72, 88, 104, 120, 136, 170, 212,
// 265, 331, 413, 516, 645, 806, 1007, 1258, 1572, ...
function NextGrow(capacity: integer): integer;

/// compute the next power-of-two of a 32-bit number
function NextPowerOfTwo(number: cardinal): cardinal;

/// equivalence to SetString(s,pansichar,len) function but from a raw pointer
// - so works with both PAnsiChar and PUtf8Char input buffer (or even PByteArray)
// - faster especially under FPC
procedure FastSetString(var s: RawUtf8; p: pointer; len: PtrInt); overload;
  {$ifndef HASCODEPAGE} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// faster equivalence to SetString(s,nil,len) function
procedure FastSetString(var s: RawUtf8; len: PtrInt); overload;
  {$ifndef HASCODEPAGE} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// equivalence to SetString(s,pansichar,len) function but from a raw pointer
// - so works with both PAnsiChar and PUtf8Char input buffer (or even PByteArray)
// - faster especially under FPC
procedure FastSetRawByteString(var s: RawByteString; p: pointer; len: PtrInt);
  {$ifndef HASCODEPAGE} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// equivalence to SetString(s,pwidechar,len) function but from a raw pointer
procedure FastSynUnicode(var s: SynUnicode; p: pointer; len: PtrInt);
  {$ifndef HASVARUSTRING} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// equivalence to SetString(s,nil,len) function to allocate a new RawByteString
// - faster especially under FPC
procedure FastNewRawByteString(var s: RawByteString; len: PtrInt);
  {$ifndef HASCODEPAGE} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// equivalence to SetString(s,pansichar,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}

/// assign any constant or already ref-counted AnsiString/RawUtf8 (or UnicodeString)
// - by default, called with s = nil, is an equivalence to Finalize(d) or d := ''
// - is also called by FastSetString/FastSetStringCP to setup its allocated value
// - faster especially under FPC
procedure FastAssignNew(var d; s: pointer = nil);
  {$ifndef FPC_CPUX64} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// internal function to assign any constant or ref-counted AnsiString/RawUtf8
// - caller should have tested that pointer(d) <> nil
procedure FastAssignNewNotVoid(var d; s: pointer); overload;
  {$ifndef FPC_CPUX64} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// internal function used by FastSetString/FastSetStringCP
function FastNewString(len, codepage: PtrInt): PAnsiChar;
  {$ifdef HASINLINE}inline;{$endif}

/// ensure the supplied variable will have a CP_UTF8 code page
// - making it unique if needed
procedure EnsureRawUtf8(var s: RawByteString); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// ensure the supplied variable will have a CP_UTF8 code page
// - making it unique if needed
procedure EnsureRawUtf8(var s: RawUtf8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// internal function which could be used instead of SetLength() if RefCnt = 1
procedure FakeLength(var s: RawUtf8; len: PtrInt); overload;
  {$ifdef HASINLINE} inline; {$endif}

/// internal function which could be used instead of SetLength() if RefCnt = 1
procedure FakeLength(var s: RawUtf8; endChar: PUtf8Char); overload;
  {$ifdef HASINLINE} inline; {$endif}

/// internal function which could be used instead of SetLength() if RefCnt = 1
procedure FakeLength(var s: RawByteString; len: PtrInt); overload;
  {$ifdef HASINLINE} inline; {$endif}

/// internal function which could be used instead of SetLength() if RefCnt = 1
// - FakeLength() don't handle len = 0, whereas this function will
procedure FakeSetLength(var s: RawUtf8; len: PtrInt); overload;

/// internal function which could be used instead of SetLength() if RefCnt = 1
// - FakeLength() don't handle len = 0, whereas this function will
procedure FakeSetLength(var s: RawByteString; len: PtrInt); overload;

/// internal function which could be used instead of SetCodePage() if RefCnt = 1
// - do nothing if HASCODEPAGE is not defined, e.g. on Delphi 7-2007
// - warning: s should NOT be read-only (i.e. assigned from a constant), but
// a just-allocated string with RefCnt <> -1
procedure FakeCodePage(var s: RawByteString; cp: cardinal);
  {$ifdef HASINLINE} inline; {$endif}

/// internal function which assign src to dest, force CP_UTF8 and set src to ''
// - warning: calls FakeCodePage(CP_UTF8) so requires src to have a RefCnt of 1
procedure FastAssignUtf8(var dest: RawUtf8; var src: RawByteString);
  {$ifdef HASINLINE} inline; {$endif}

{$ifdef HASCODEPAGE}
/// retrieve the code page of a non void string
// - caller should have ensure that s <> ''
function GetCodePage(const s: RawByteString): cardinal; inline;
{$endif HASCODEPAGE}

/// retrieve the code page of a string
// - StringRefCount() is not available on oldest Delphi
function GetRefCount(const s: RawByteString): PtrInt;
  {$ifdef HASINLINE} inline; {$endif}

/// initialize a RawByteString, ensuring returned "aligned" pointer
// is 16-bytes aligned
// - to be used e.g. for proper SIMD process
// - you can specify an alternate alignment, but it should be a power of two
procedure GetMemAligned(var holder: RawByteString; fillwith: pointer; len: PtrUInt;
  out aligned: pointer; alignment: PtrUInt = 16);

/// equivalence to @u[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, @u[1] does not call UniqueString() as it does with Delphi
// - if u is a constant (refcount=-1), will allocate a temporary copy in heap
function UniqueRawUtf8(var u: RawUtf8): pointer;
  {$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
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}

/// direct conversion of an ANSI-7 AnsiString into an ShortString
// - can be used e.g. for names retrieved from RTTI
procedure Ansi7StringToShortString(const source: RawUtf8; var result: ShortString);
  {$ifdef FPC}inline;{$endif}

/// simple concatenation of a 32-bit unsigned integer as text into a shorstring
procedure AppendShortCardinal(value: cardinal; var dest: ShortString);

/// simple concatenation of a signed 64-bit integer as text into a shorstring
procedure AppendShortInt64(value: Int64; var dest: ShortString);

/// simple concatenation of an unsigned 64-bit integer as text into a shorstring
procedure AppendShortQWord(value: QWord; var dest: ShortString);

/// simple concatenation of a character into a @shorstring
// - dest is @shortstring and not shortstring to circumvent a Delphi inlining bug
procedure AppendShortChar(chr: AnsiChar; dest: PAnsiChar);
  {$ifdef HASINLINE} inline; {$endif}

/// simple concatenation of two characters into a @shorstring
// - dest is @shortstring and not shortstring to circumvent a Delphi inlining bug
procedure AppendShortTwoChars(twochars, dest: PAnsiChar);
  {$ifdef HASINLINE} inline; {$endif}

/// simple concatenation of a #0 ending text into a @shorstring
// - dest is @shortstring and not shortstring to circumvent a Delphi inlining bug
procedure AppendShortBuffer(buf: PAnsiChar; len: PtrInt; dest: PAnsiChar);
  {$ifdef HASINLINE} inline; {$endif}

/// simple concatenation of hexadecimal binary buffer into a shorstring
procedure AppendShortHex(value: PByte; len: PtrUInt; var dest: ShortString);

/// simple concatenation of an integer as lowercase hexadecimal into a shorstring
procedure AppendShortIntHex(value: Int64; var dest: ShortString);

/// simple concatenation of a byte as uppercase hexadecimal into a shorstring
procedure AppendShortByteHex(value: byte; var dest: ShortString);

/// simple concatenation of a ShortString text into a shorstring
procedure AppendShort(const src: ShortString; var dest: ShortString);

/// simple concatenation of an ANSI-7 AnsiString into a shorstring
procedure AppendShortAnsi7String(const buf: RawByteString; var dest: ShortString);

/// simple concatenation of a text buffer into a RawUtf8
procedure AppendBufferToUtf8(src: PUtf8Char; srclen: PtrInt; var dest: RawUtf8);

/// simple concatenation of a ShortString text into a RawUtf8
procedure AppendShortToUtf8(const src: ShortString; var dest: RawUtf8);
  {$ifdef HASINLINE}inline;{$endif}

/// 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 vmtClassName to avoid a string conversion
procedure ClassToText(C: TClass; var result: RawUtf8);

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

var
  /// retrieve the unit name where a given class is implemented
  // - is implemented in mormot.core.rtti.pas; so may be nil otherwise
  // - is needed since Delphi 7-2009 do not define TObject.UnitName (because
  // there is no such information available in RTTI)
  ClassUnit: function(C: TClass): PShortString;

/// 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}

/// case-insensitive comparison of two text buffers only containing ASCII 7-bit
// - this is the actual comparison function called by its overloads
// - use e.g. with RTTI property names values only including A..Z,0..9,_ chars
// - will make the "XOR AND $DF" trick to quickly test A-Z / a-z characters
// - behavior is undefined with UTF-8 encoding (some false positive may occur)
// - see IdemPropName/IdemPropNameU functions in mormot.core.unicode for similar
// comparison functions with other kind of input variables
function PropNameEquals(P1, P2: PAnsiChar; P1Len, P2Len: PtrInt): boolean; overload;
  {$ifdef FPC}inline;{$endif} // Delphi has troubles inlining goto/label

/// case-insensitive comparison of two shortstrings only containing ASCII 7-bit
function PropNameEquals(P1, P2: PShortString): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// case-insensitive comparison of two text buffers only containing ASCII 7-bit
function PropNameEquals(P1: PShortString; P2: PAnsiChar; P2Len: PtrInt): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// case-insensitive comparison of two RawUtf8 only containing ASCII 7-bit
function PropNameEquals(const P1, P2: RawUtf8): boolean; overload;

/// case-insensitive comparison of a RawUtf8 only containing ASCII 7-bit
function PropNameEquals(const P1: RawUtf8; P2: PAnsiChar; P2Len: PtrInt): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// raw internal method as published by FindNonVoid[false]
function FindNonVoidRawUtf8(n: PPointerArray; name: pointer; len: TStrLen;
  count: PtrInt): PtrInt;

/// raw internal method as published by FindNonVoid[true]
function FindNonVoidRawUtf8I(n: PPointerArray; name: pointer; len: TStrLen;
  count: PtrInt): PtrInt;

type
  TFindNonVoid =
    function(p: PPointerArray; n: pointer; l: TStrLen; c: PtrInt): PtrInt;
const
  /// raw internal methods for case sensitive (or not) search for a RawUtf8
  // - expects non-void RawUtf8 values, with ASCII-7 encoding, e.g. as with
  // TDocVariantData.GetValueIndex() property names
  FindNonVoid: array[{casesensitive:}boolean] of TFindNonVoid = (
    FindNonVoidRawUtf8I,
    FindNonVoidRawUtf8);

/// return the case-insensitive ASCII 7-bit index of Value in non-void Values[]
// - typical use with a TRawUtf8DynArray is like this:
// ! index := FindPropName(pointer(aDynArray), aValue, length(aDynArray));
// - by design, this function expects Values[] to not contain any void ''
function FindPropName(Values: PRawUtf8Array; const Value: RawUtf8;
  ValuesCount: PtrInt): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// 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;

/// use the RTL to return a date/time as ISO-8601 text
// - slow function, here to avoid linking mormot.core.datetime
function DateTimeToIsoString(dt: TDateTime): string;

/// parse a '0x#####' buffer context into a 32-bit binary
// - jump trailing '0x', then ends at first non hexadecimal character
// - internal function to avoid linking mormot.core.buffers.pas
function ParseHex0x(p: PAnsiChar): cardinal;

/// parse an hexadecimal buffer into its raw binary
// - parse up to n chars from p^, ending in case of not hexadecimal char
// - any '#' char in the input buffer will be handled as '0'
// - caller should ensure p<>nil and b<>nil and n>0
// - internal function to avoid linking mormot.core.buffers.pas
function ParseHex(p: PAnsiChar; b: PByte; n: integer): PAnsiChar;

/// convert a binary into its human-friendly per-byte hexadecimal lowercase text
// - returns e.g. '12:50:b6:1e:c6:aa', i.e. the DN/MAC format
// - used e.g. in mormot.lib.openssl11 and mormot.net.sock
procedure ToHumanHex(var result: RawUtf8; bin: PByte; len: integer;
  reverse: boolean = false);

// backward compatibility types redirections
{$ifndef PUREMORMOT2}
type
  TSqlRawBlob = RawBlob;
{$endif PUREMORMOT2}


{ ************ Numbers (floats and integers) Low-level Definitions }

const
  /// fast lookup table for converting any decimal number from
  // 0 to 99 into their ASCII equivalence
  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');

var
  /// fast lookup table for converting any decimal number from
  // 0 to 99 into their ASCII equivalence
  TwoDigitLookupW: packed array[0..99] of word absolute TwoDigitLookup;

  /// 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;

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;

  {$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;

  TSynExtendedDynArray = array of TSynExtended;
  PSynExtendedDynArray = ^TSynExtendedDynArray;
  PSynExtended = ^TSynExtended;
  {$else}
  /// ARM/Delphi 64-bit does not support 80bit extended -> double is enough
  TSynExtended = double;

  TSynExtendedDynArray = TDoubleDynArray;
  PSynExtendedDynArray = PDoubleDynArray;
  PSynExtended = PDouble;
  {$endif TSYNEXTENDED80}

  /// the non-number values potentially stored in an IEEE floating point
  TFloatNan = (
    fnNumber, fnNan, fnInf, fnNegInf);

  {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  /// unaligned() will be defined and useful only on FPC ARM/Aarch64 plaforms
  unaligned = Double;
  {$endif FPC_REQUIRES_PROPER_ALIGNMENT}

const
  /// used e.g. to convert a currency (via PInt64) into a double
  // - warning: FPC Win64 to Win32 cross-compiler doesn't support currency
  // values properly -> use FPC Win32 compiler only on Windows
  CURR_RES = 10000;

/// convert a currency value into a double
// - using PInt64() division by CURR_RES (=10000)
// - warning: FPC Win64 to Win32 cross-compiler doesn't support currency
// values properly -> use FPC Win32 compiler only on Windows
procedure CurrencyToDouble(const c: currency; out d: double); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a currency value pointer into a double
// - using PInt64() division by CURR_RES (=10000)
// - warning: FPC Win64 to Win32 cross-compiler doesn't support currency
// values properly -> use FPC Win32 compiler only on Windows
procedure CurrencyToDouble(c: PCurrency; out d: double); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a currency value pointer into a double
// - using PInt64() division by CURR_RES (=10000)
// - warning: FPC Win64 to Win32 cross-compiler doesn't support currency
// values properly -> use FPC Win32 compiler only on Windows
function CurrencyToDouble(c: PCurrency): double; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill a variant value from a currency value
// - as compatible with VariantToCurrency/VariantToDouble
// - warning: FPC Win64 to Win32 cross-compiler doesn't support currency
// values properly -> use FPC Win32 compiler only on Windows
procedure CurrencyToVariant(const c: currency; var v: variant);
  {$ifdef HASINLINE}inline;{$endif}

/// convert a double value into a currency
// - using truncated multiplication by CURR_RES (=10000)
// - warning: FPC Win64 to Win32 cross-compiler doesn't support currency
// values properly -> use FPC Win32 compiler only on Windows
procedure DoubleToCurrency(const d: double; out c: currency); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a double value into a currency
// - using truncated multiplication by CURR_RES (=10000)
// - warning: FPC Win64 to Win32 cross-compiler doesn't support currency
// values properly -> use FPC Win32 compiler only on Windows
procedure DoubleToCurrency(const d: double; c: PCurrency); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a double value into a currency
// - using truncated multiplication by CURR_RES (=10000)
// - warning: FPC Win64 to Win32 cross-compiler doesn't support currency
// values properly -> use FPC Win32 compiler only on Windows
function DoubleToCurrency(const d: double): currency; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a currency value into a Int64
// - using PInt64() division by CURR_RES (=10000)
// - warning: FPC Win64 to Win32 cross-compiler doesn't support currency
// values properly -> use FPC Win32 compiler only on Windows
procedure CurrencyToInt64(c: PCurrency; var i: Int64); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a Int64 value into a currency
// - using multiplication by CURR_RES (=10000)
// - warning: FPC Win64 to Win32 cross-compiler doesn't support currency
// values properly -> use FPC Win32 compiler only on Windows
procedure Int64ToCurrency(const i: Int64; out c: currency); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a Int64 value into a currency
// - using multiplication by CURR_RES (=10000)
// - warning: FPC Win64 to Win32 cross-compiler doesn't support currency
// values properly -> use FPC Win32 compiler only on Windows
procedure Int64ToCurrency(const i: Int64; c: PCurrency); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// no banker rounding into two digits after the decimal point
// - #.##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;
  {$ifdef HASINLINE}inline;{$endif}

/// 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);

/// no banker rounding into text, with two digits after the decimal point
// - #.##51 will round to #.##+0.01 and #.##50 will be truncated to #.##
// - this function will only allow 2 digits in the returned text
function TwoDigits(const d: double): TShort23;

/// 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 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}

/// 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 occurred, 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; 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, PEnd: PUtf8Char): PtrUInt; overload;

/// 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, or false if P = nil
// - see relaxed GetInt64Bool() to recognize e.g. 'TRUE' or 'yes'/'YES'
function GetBoolean(P: PUtf8Char): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// get a boolean value stored as 'true'/'false' text in input variable
// - would also recognize any non '0' integer as true, or false if P is ''
function GetBoolean(const value: RawUtf8): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// 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;

/// return 1 if 'TRUE' or 'YES', or 0 otherwise
function GetTrue(P: PUtf8Char): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// get the 64-bit integer value from P^, recognizing true/false/yes/no input
// - return true on correct parsing, false if P is no number or boolean
function GetInt64Bool(P: PUtf8Char; out V: Int64): boolean;

/// 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); overload;
  {$ifdef CPU64}inline;{$endif}

/// get the 64-bit unsigned integer value stored in P^
procedure SetQWord(P, PEnd: PUtf8Char; var result: QWord); overload;
  {$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)
// - this optimized function is consistent on all platforms/compilers and return
// the decoded value even if err is not 0 (e.g. if P^ is not #0 ended)
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}

type
  TPow10 = array[-31..55] of TSynExtended;
  PPow10 = ^TPow10;

const
  /// most common 10 ^ exponent constants, ending with values for HugePower10*()
  POW10: TPow10 = (
    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,{32} -1,{33} 1E0,{34} 1E32, 1E64, 1E96, 1E128,
    1E160, 1E192, 1E224, 1E256, 1E288, 1E320, 1E-0,{45} 1E-32, 1E-64,
    1E-96, 1E-128, 1E-160, 1E-192, 1E-224, 1E-256, 1E-288, 1E-320);

/// low-level computation of 10 ^ positive exponent, if POW10[] is not enough
function HugePower10Pos(exponent: PtrInt; pow10: PPow10): TSynExtended;
  {$ifdef HASINLINE}inline;{$endif}

/// low-level computation of 10 ^ negative exponent, if POW10[] is not enough
function HugePower10Neg(exponent: PtrInt; pow10: PPow10): TSynExtended;
  {$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 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;

/// 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}

/// 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 work with 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 work with 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}

/// add the 4 digits of integer Y to P^ as '0000'..'9999'
procedure YearToPChar(Y: PtrUInt; P: PUtf8Char);
  {$ifndef ASMX86} {$ifdef HASINLINE}inline;{$endif} {$endif}

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;

/// 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}

/// 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}


{ ************ integer Arrays Manipulation }

/// 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 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;

/// 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 32-bit unsigned integer values
function CompareCardinal(const A, B: cardinal): 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/64-bit signed integer values
function ComparePtrInt(const A, B: PtrInt): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// a comparison function for sorting 32/64-bit pointers as unsigned values
function ComparePointer(const A, B: pointer): 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 on Delphi 7-2007
function CompareQWord(const A, B: QWord): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// returns the smallest of two PtrInt signed values
function MinPtrInt(const A, B: PtrInt): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// returns the biggest of two PtrInt signed values
function MaxPtrInt(const A, B: PtrInt): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// returns the smallest of two PtrUInt unsigned values
function MinPtrUInt(const A, B: PtrUInt): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// returns the biggest of two PtrUInt unsigned values
function MaxPtrUInt(const A, B: PtrUInt): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// fast search of an unsigned integer item in a 32-bit integer array
// - Count is the number of cardinal entries in P^
// - returns P where P^=Value
// - returns nil if Value was not found
// - is implemented via IntegerScanIndex() SSE2 asm on i386 and x86_64
function IntegerScan(P: PCardinalArray; Count: PtrInt; Value: cardinal): PCardinal;
  {$ifdef CPUINTEL} {$ifndef HASNOSSE2} {$ifdef HASINLINE}inline;{$endif} {$endif} {$endif}

/// fast search of an unsigned integer position in a 32-bit integer array
// - Count is the number of integer entries in P^
// - return index of P^[index]=Value
// - return -1 if Value was not found
// - is implemented with SSE2 asm on i386 and x86_64
function IntegerScanIndex(P: PCardinalArray; Count: PtrInt; Value: cardinal): PtrInt;
  {$ifndef CPUINTEL}inline;{$endif}

/// fast search of an unsigned integer in a 32-bit integer array
// - returns true if P^=Value within Count entries
// - returns false if Value was not found
// - is implemented via IntegerScanIndex() SSE2 asm on i386 and x86_64
function IntegerScanExists(P: PCardinalArray; Count: PtrInt; Value: cardinal): boolean;
  {$ifdef CPUINTEL} {$ifndef HASNOSSE2} {$ifdef HASINLINE}inline;{$endif} {$endif} {$endif}

/// 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;
  {$ifdef HASSAFEINLINE}inline;{$endif}

/// 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 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, -1 if Value was not found
// - is implemented with SSE2 asm on i386 and x86_64
function ByteScanIndex(P: PByteArray; Count: PtrInt; Value: byte): PtrInt;
  {$ifndef CPUINTEL} 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, -1 if Value was not found
// - is implemented with SSE2 asm on i386 and x86_64
function WordScanIndex(P: PWordArray; Count: PtrInt; Value: word): PtrInt;
  {$ifndef CPUINTEL} inline; {$endif}

/// 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;

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

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

/// sort a double array, low values first
procedure QuickSortDouble(ID: PDoubleArray; L, R: PtrInt);

/// 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
// - use branchless asm on x86_64
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 FPC}inline;{$endif} // GPF on older Delphi

/// fast O(log(n)) binary search of a 16-bit unsigned integer value in a sorted array
// - use branchless asm on x86_64
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
// - use branchless asm on x86_64
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;

/// 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}

/// 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 -(foundindex+1) i.e. <0 if the specified Value was found
function FastLocateIntegerSorted(P: PIntegerArray; R: PtrInt; Value: integer): PtrInt;

/// retrieve the matching index or where to insert an integer value
function FastSearchIntegerSorted(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 -(foundindex+1) i.e. <0 if the specified Value was found
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 -(foundindex+1) i.e. <0 if the specified Value was already present
// - 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);

/// add a pointer-sized integer array at the end of a dynamic array
function AddPtrUInt(var Values: TPtrUIntDynArray;
  var ValuesCount: integer; Value: PtrUInt): PtrInt;

/// 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;

/// 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;

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

/// 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 an Exception 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
  // - ensure Count=0 before use - if not defined as a private member of a class
  {$ifdef USERECORDWITHMETHODS}
  TSortedWordArray = record
  {$else}
  TSortedWordArray = object
  {$endif USERECORDWITHMETHODS}
  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}
    /// save the internal array into a TWordDynArray variable
    procedure SetArray(out aValues: TWordDynArray);
  end;
  PSortedWordArray = ^TSortedWordArray;

  /// used to store and retrieve Integers in a sorted array
  // - ensure Count=0 before use - if not defined as a private member of a class
  {$ifdef USERECORDWITHMETHODS}
  TSortedIntegerArray = record
  {$else}
  TSortedIntegerArray = object
  {$endif USERECORDWITHMETHODS}
  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}
    /// save the internal array into a TWordDynArray variable
    procedure SetArray(out aValues: TIntegerDynArray);
  end;
  PSortedIntegerArray = ^TSortedIntegerArray;

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



{ ************ ObjArray PtrArray InterfaceArray Wrapper Functions }

/// wrapper to add an item to a array of pointer dynamic array storage
function PtrArrayAdd(var aPtrArray; aItem: pointer): integer; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to add an item to a array of pointer dynamic array storage
function PtrArrayAdd(var aPtrArray; aItem: pointer;
  var aPtrArrayCount: integer): PtrInt; overload;

/// wrapper to add once an item to a array of pointer dynamic array storage
function PtrArrayAddOnce(var aPtrArray; aItem: pointer): PtrInt; overload;

/// wrapper to add once an item to a array of pointer dynamic array storage
function PtrArrayAddOnce(var aPtrArray; aItem: pointer;
  var aPtrArrayCount: integer): PtrInt; overload;

/// wrapper to add all items from one array of pointer dynamic array into another
function PtrArrayAddFrom(var aDestArray; const aSourceArray): PtrInt; overload;

/// wrapper to add new items from one array of pointer dynamic array into another
function PtrArrayAddOnceFrom(var aDestArray; const aSourceArray): PtrInt; overload;

/// wrapper to insert an item to a array of pointer dynamic array storage
function PtrArrayInsert(var aPtrArray; aItem: pointer; aIndex: PtrInt;
  var aPtrArrayCount: integer): PtrInt; overload;

type
  /// used by PtrArrayDelete() to finalize an item
  TPtrArrayKind = (
    pakPointer, pakClass, pakClassSafe, pakInterface, pakInterfaceSafe);

/// wrapper to delete an item from a array of pointer dynamic array storage
// - warning: aCount^ should be a 32-bit "integer" variable, not a PtrInt
function PtrArrayDelete(var aPtrArray; aItem: pointer; aCount: PInteger = nil;
  aKind: TPtrArrayKind = pakPointer): PtrInt; overload;

/// wrapper to delete an item from a array of pointer dynamic array storage
// - this function won't ensure aPtrArray is unique - i.e. it expects RefCnt=1
// - warning: aCount^ should be a 32-bit "integer" variable, not a PtrInt
procedure PtrArrayDelete(var aPtrArray; aIndex: PtrInt; aCount: PInteger = nil;
  aKind: TPtrArrayKind = pakPointer); 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 count all nil items in a pointer dynamic array storage
function PtrArrayNotNilCount(const aPtrArray): integer;


/// wrapper to add an item to a T*ObjArray dynamic array storage
// - for proper serialization on Delphi 7-2009, use Rtti.RegisterObjArray()
// - 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; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// 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 a stand-alone array as expected by our ORM/SOA serialziation
// - return the index of the item in the dynamic array
function ObjArrayAddCount(var aObjArray; aItem: TObject;
  var aObjArrayCount: integer): 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 once an item to a T*ObjArray dynamic array storage
// - for proper serialization on Delphi 7-2009, use Rtti.RegisterObjArray()
// - 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
function ObjArrayAddOnce(var aObjArray; aItem: TObject): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to add once an item to a T*ObjArray dynamic array storage and Count
function ObjArrayAddOnce(var aObjArray; aItem: TObject;
  var aObjArrayCount: integer): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

// - 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
// - for proper serialization on Delphi 7-2009, use Rtti.RegisterObjArray()
// - 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
// - for proper serialization on Delphi 7-2009, use Rtti.RegisterObjArray()
// - 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
// - for proper serialization on Delphi 7-2009, use Rtti.RegisterObjArray()
function ObjArrayNotNilCount(const aObjArray): integer;
  {$ifdef HASSAFEINLINE}inline;{$endif}

/// wrapper to delete an item in a T*ObjArray dynamic array storage
// - for proper serialization on Delphi 7-2009, use Rtti.RegisterObjArray()
// - do nothing if the index is out of range in the dynamic array
// - warning: aCount^ should be a 32-bit "integer" variable, not a PtrInt
procedure ObjArrayDelete(var aObjArray; aItemIndex: PtrInt;
  const aContinueOnException: boolean = false; aCount: PInteger = nil); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to delete an item in a T*ObjArray dynamic array storage
// - for proper serialization on Delphi 7-2009, use Rtti.RegisterObjArray()
// - 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
// - for proper serialization on Delphi 7-2009, use Rtti.RegisterObjArray()
// - 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; var aCount: integer; aItem: TObject): PtrInt; overload;
  {$ifdef HASSAFEINLINE}inline;{$endif}

/// wrapper to release all items stored in a T*ObjArray dynamic array
// - for proper serialization on Delphi 7-2009, use Rtti.RegisterObjArray()
// - you should always use ObjArrayClear() before the array storage is released,
// e.g. in the owner class destructor
// - when T*ObjArray are used as SOA parameters, no need to release the values
// - 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
// - for proper serialization on Delphi 7-2009, use Rtti.RegisterObjArray()
// - 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
// - warning: aCount^ should be a 32-bit "integer" variable, not a PtrInt
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
// - for proper serialization on Delphi 7-2009, use Rtti.RegisterObjArray()
procedure ObjArraysClear(const aObjArray: array of pointer);

/// allocate DestObjArray[] to receive SourceObjArray[] items
// - returns the number of items to copy from SourceObjArray[] to DestObjArray[]
// - supports optional external integer counts, to use length() as capacity
// - warning: SourceCount/DestCount should be 32-bit "integer" variable, not PtrInt
function ObjArrayPrepareCopy(const SourceObjArray; var DestObjArray;
  SourceCount: PInteger = nil; DestCount: PInteger = nil): PtrInt;

/// low-level function calling FreeAndNil(o^) successively n times
procedure RawObjectsClear(o: PObject; n: integer);

/// same as FreeAndNil() but catching and ignoring any exception
// - only difference is that aObj is set to nil AFTER being destroyed
procedure FreeAndNilSafe(var aObj);

/// same as aInterface := nil but ignoring any exception
procedure InterfaceNilSafe(var aInterface);

/// same as several aInterface := nil but ignoring any exception
procedure InterfacesNilSafe(const aInterfaces: array of pointer);

/// wrapper to add an item to a T*InterfaceArray dynamic array storage
function InterfaceArrayAdd(var aInterfaceArray; const aItem: IUnknown): PtrInt;

/// wrapper to add an item to a T*InterfaceArray dynamic array storage
function InterfaceArrayAddCount(var aInterfaceArray; var aCount: integer;
  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 HASSAFEINLINE}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;
  {$ifdef HASSAFEINLINE}inline;{$endif}

/// 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;
  const aContinueOnException: boolean = false; aCount: PInteger = nil); overload;
  {$ifdef HASSAFEINLINE}inline;{$endif}


{ ************ Low-level Types Mapping Binary Structures }

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: (
           Li, Hi: integer);
      3: (
           W: array[0..3] of word);
      4: (
           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 224-bit hash value
  // - consumes 28 bytes of memory
  THash224 = array[0..27] of byte;
  /// pointer to a 224-bit hash value
  PHash224 = ^THash224;

  /// 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);
  8: (
      guid: TGuid);
  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);
  9: (
     sha1: THash160);
  end;
  /// pointer to 256-bit hash map variable record
  PHash256Rec = ^THash256Rec;
  /// store several 256-bit hash map variable records
  THash256RecDynArray = array of THash256Rec;

  /// store several 384-bit hash values
  THash384DynArray = array of THash384;

  /// 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: (
       q: array[0..7] of QWord);
  12: (
       r: array[0..3] of THash128Rec);
  13: (
       l, h: THash256Rec);
  end;
  /// pointer to 512-bit hash map variable record
  PHash512Rec = ^THash512Rec;
  /// store several 256-bit hash map variable records
  THash512RecDynArray = array of THash512Rec;

/// 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;

/// add a 128-bit item in an array of such values
function AddHash128(var Arr: THash128DynArray; const V: THash128; var Count: integer): PtrInt;

/// 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}

/// fast O(n) search of a 256-bit item in an array of such values
function Hash256Index(P: PHash256Rec; Count: integer; h: PHash256Rec): integer;

/// 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;

/// 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;

/// 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;

/// 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);

{$ifdef ISDELPHI}
/// this function is an intrinsic in FPC
procedure ReadBarrier; {$ifndef CPUINTEL} inline; {$endif}
{$endif ISDELPHI}

/// fast computation of two 64-bit unsigned integers into a 128-bit value
{$ifdef CPUINTEL}
procedure mul64x64(const left, right: QWord; out product: THash128Rec);
{$else}
procedure mul64x64(constref left, right: QWord; out product: THash128Rec); inline;
{$endif CPUINTEL}


{ ************ Low-level Functions Manipulating Bits }

/// 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}

/// set a particular bit into a bit array, if it has not be already set
// - SetBit() can't be inlined, whereas this pointer-oriented function can
// - return true if aIndex bit has been set for the first time
function TrySetBitPtr(Bits: pointer; aIndex: cardinal): boolean;
  {$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 number of BITS to check, not the 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;

/// compute how many bytes are needed to store a given number of bits
// - e.g. 0 returns 0, 1..8 returns 1, 9..16 returns 2, and so on
function BitsToBytes(bits: byte): byte;
  {$ifdef HASINLINE}inline;{$endif}

const
  /// could be used to compute the index in a pointer list from its byte 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};
  /// could be used to check all bytes on a pointer
  POINTERBYTES =   {$ifdef CPU64}  8 {$else}  4 {$endif};
  /// could be used to compute the index in a pointer list from its bits position
  POINTERSHRBITS = {$ifdef CPU64}  6 {$else}  5 {$endif};

  /// 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
  // - compiler will generate bt/btr/bts opcodes - note: they may be slow when
  // applied on a memory location, but not on a byte value (register)
  TBits8 = set of 0..7;
  PBits8 = ^TBits8;
  TBits8Array = array[ 0 .. MaxInt - 1 ] of TBits8;

  /// fast access to 32-bit integer bits
  // - compiler will generate bt/btr/bts opcodes - note: they may be slow when
  // applied on a memory location, but not on an integer value (register)
  TBits32 = set of 0..31;
  PBits32 = ^TBits32;

  /// fast access to 64-bit integer bits
  // - compiler will generate bt/btr/bts opcodes - note: they may be slow when
  // applied on a memory location, but not on a Int64 value (register)
  // - 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}



{ ************ Faster Alternative to RTL Standard Functions }

type
  /// the potential features, retrieved from an Intel/AMD CPU
  // - cf https://en.wikipedia.org/wiki/CPUID#EAX.3D1:_Processor_Info_and_Feature_Bits
  // - is defined on all platforms, so that e.g. an ARM desktop may browse
  // Intel-generated logs using TSynLogFile from mormot.core.log.pas
  TIntelCpuFeature = (
   { CPUID EAX=1 into EDX, ECX }
   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,
   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 EAX=7,ECX=0 into EBX, ECX, EDX }
   cfFSGS, cfTSCADJ, cfSGX, cfBMI1, cfHLE, cfAVX2, cfFDPEO, cfSMEP,
   cfBMI2, cfERMS, cfINVPCID, cfRTM, cfPQM, cfFPUSEG, cfMPX, cfPQE,
   cfAVX512F, cfAVX512DQ, cfRDSEED, cfADX, cfSMAP, cfAVX512IFMA, cfPCOMMIT,
   cfCLFLUSH, cfCLWB, cfIPT, cfAVX512PF, cfAVX512ER, cfAVX512CD, cfSHA,
   cfAVX512BW, cfAVX512VL, cfPREFW1, cfAVX512VBMI, cfUMIP, cfPKU, cfOSPKE,
   cfWAITPKG, cfAVX512VBMI2, cfCETSS, cfGFNI, cfVAES, cfVCLMUL, cfAVX512NNI,
   cfAVX512BITALG, cfTMEEN, cfAVX512VPC, cf_c15, cfFLP, cfMPX0, cfMPX1,
   cfMPX2, cfMPX3, cfMPX4, cfRDPID, cfKL, cfBUSLOCK, cfCLDEMOTE, cf_c26,
   cfMOVDIRI, cfMOVDIR64B, cfENQCMD, cfSGXLC, cfPKS, cf_d0, cfSGXKEYS,
   cfAVX512NNIW, cfAVX512MAPS, cfFSRM, cfUINTR, cf_d6, cf_d7, cfAVX512VP2I,
   cfSRBDS, cfMDCLR, cfTSXABRT, cf_d12, cfTSXFA, cfSER, cfHYBRID,
   cfTSXLDTRK, cf_d17, cfPCFG, cfLBR, cfIBT, cf_d21, cfAMXBF16, cfAVX512FP16,
   cfAMXTILE, cfAMXINT8, cfIBRSPB, cfSTIBP, cfL1DFL, cfARCAB, cfCORCAB, cfSSBD,
   { extended features CPUID EAX=7,ECX=1 into EAX, EDX }
   cfSHA512, cfSM3, cfSM4, cfRAOINT, cfAVXVNNI, cfAVX512BF16, cfLASS,
   cfCMPCCXADD, cfAPMEL, cf_a9, cfFZLREPM, cfFSREPS, cfFSREPC, cf_a13, cf_a14,
   cf_a15, cf_a16, cfFRED, cfLKGS, cfWRMSRNS, cfNMISRC, cfAMXFP16, cfHRESET,
   cfAVXIFMA, cf_a24, cf_a25, cfLAM, cfMSRLIST, cf_a28, cf_a29, cfINVDDIS, cfMOVRS,
   cf__d0, cf_d1, cf_d2, cf_d3, cfAVXVNN8, cfAVXNECVT, cf__d6, cf__d7, cfAMXCPLX,
   cf_d9, cfAVXVNNI16, cf_d11, cf__d12, cfUTMR, cfPREFETCHI, cfUSERMSR, cf_d16,
   cfUIRETUIF, cfCETSSS, cfAVX10, cf__d20, cf_APXF, cf_d22, cfMWAIT, cf_d24,
   cf_d25, cf_d26, cf_d27, cf_d28, cf_d29, cf_d30, cf_d31);

  /// all CPU features flags, as retrieved from an Intel/AMD CPU
  TIntelCpuFeatures = set of TIntelCpuFeature;

  /// the supported AVX10 Converged Vector ISA bit sizes
  TIntelAvx10Vector = set of (
    av128, av256, av512);
  /// the AVX10 Converged Vector ISA features
  TIntelAvx10Features = record
    /// maximum supported sub-leaf
    MaxSubLeaf: cardinal;
    /// the ISA version (>= 1)
    Version: byte;
    /// bit vector size support
    Vector: TIntelAvx10Vector;
  end;

  /// 32-bit ARM Hardware capabilities
  // - merging AT_HWCAP and AT_HWCAP2 flags as reported by
  // github.com/torvalds/linux/blob/master/arch/arm/include/uapi/asm/hwcap.h
  // - is defined on all platforms for cross-system use
  TArm32HwCap = (
    // HWCAP_* constants
    arm32SWP, arm32HALF, arm32THUMB, arm3226BIT, arm32FAST_MULT, arm32FPA,
    arm32VFP, arm32EDSP, arm32JAVA, arm32IWMMXT, arm32CRUNCH, arm32THUMBEE,
    arm32NEON, arm32VFPv3, arm32VFPv3D16, arm32TLS, arm32VFPv4, arm32IDIVA,
    arm32IDIVT, arm32VFPD32, arm32LPAE, arm32EVTSTRM,
    arm32_22, arm32_23, arm32_24, arm32_25, arm32_26, arm32_27, arm32_28,
    arm32_29, arm32_30, arm32_31,
    // HWCAP2_* constants
    arm32AES, arm32PMULL, arm32SHA1, arm32SHA2, arm32CRC32);
  TArm32HwCaps = set of TArm32HwCap;

  /// 64-bit AARCH64 Hardware capabilities
  // - merging AT_HWCAP and AT_HWCAP2 flags as reported by
  // github.com/torvalds/linux/blob/master/arch/arm64/include/uapi/asm/ahccap.h
  // - is defined on all platforms for cross-system use
  TArm64HwCap = (
    // HWCAP_* constants
    arm64FP, arm64ASIMD, arm64EVTSTRM, arm64AES, arm64PMULL,
    arm64SHA1, arm64SHA2, arm64CRC32, arm64ATOMICS, arm64FPHP, arm64ASIMDHP,
    arm64CPUID, arm64ASIMDRDM, arm64JSCVT, arm64FCMA, arm64LRCPC, arm64DCPOP,
    arm64SHA3, arm64SM3, arm64SM4, arm64ASIMDDP, arm64SHA512, arm64SVE,
    arm64ASIMDFHM, arm64DIT, arm64USCAT, arm64ILRCPC, arm64FLAGM, arm64SSBS,
    arm64SB, arm64PACA, arm64PACG,
    // HWCAP2_* constants
    arm64DCPODP, arm64SVE2, arm64SVEAES, arm64SVEPMULL, arm64SVEBITPERM,
    arm64SVESHA3, arm64SVESM4, arm64FLAGM2, arm64FRINT, arm64SVEI8MM,
    arm64SVEF32MM, arm64SVEF64MM, arm64SVEBF16, arm64I8MM,
    arm64BF16, arm64DGH, arm64RNG, arm64BTI, arm64MTE);
  TArm64HwCaps = set of TArm64HwCap;

{$ifdef CPUARM}
  TArmHwCap = TArm32HwCap;
  TArmHwCaps = TArm32HwCaps;

const
  ahcAES   = arm32AES;
  ahcPMULL = arm32PMULL;
  ahcSHA1  = arm32SHA1;
  ahcSHA2  = arm32SHA2;
  ahcCRC32 = arm32CRC32;
{$endif CPUARM}

{$ifdef CPUAARCH64}
  TArmHwCap = TArm64HwCap;
  TArmHwCaps = TArm64HwCaps;

const
  ahcAES   = arm64AES;
  ahcPMULL = arm64PMULL;
  ahcSHA1  = arm64SHA1;
  ahcSHA2  = arm64SHA2;
  ahcCRC32 = arm64CRC32;
{$endif CPUAARCH64}

{$ifdef CPUARM3264}
var
  /// the low-level ARM/AARCH64 CPU features retrieved from system.envp
  // - text from CpuInfoFeatures may not be accurate on oldest kernels
  CpuFeatures: TArmHwCaps;
{$endif CPUARM3264}

/// cross-platform wrapper function to check AES HW support on Intel or ARM
function HasHWAes: boolean;

{$ifdef CPUINTEL}

var
  /// the available Intel/AMD CPU features, as recognized at program startup
  // - on LINUX, consider CpuInfoArm or the textual CpuInfoFeatures from
  // mormot.core.os.pas
  CpuFeatures: TIntelCpuFeatures;

  /// the detected AVX10 Converged Vector ISA features
  // - only set if cfAVX10 is part of CpuFeatures
  CpuAvx10: TIntelAvx10Features;

/// twelve-character ASCII vendor string returned by Intel/AMD cpuid
// - typical values are 'AuthenticAMD' or 'GenuineIntel'
function IntelManufacturer: RawUtf8;

/// twelve-character ASCII hypervisor string returned by Intel/AMD cpuid
// - returns '' if cfHYP is not part of CpuFeatures
// - typical values are 'Microsoft Hv', 'VMwareVMware' or 'VBoxVBoxVBox'
function IntelHypervisor: RawUtf8;

/// compute 32-bit random number generated by modern Intel CPU hardware
// - using NIST SP 800-90A and FIPS 140-2 compliant RDRAND Intel x86/x64 opcode
// - caller should ensure that cfSSE42 is included in CpuFeatures flags
// - you should rather call XorEntropy() which offers additional sources
function RdRand32: cardinal; overload;

/// XOR a memory buffer with some random generated by modern Intel CPU
// - n is the number of 32-bit slots in the supplied buffer to fill
// - will do nothing if cfSSE42 is not available on this CPU
procedure RdRand32(buffer: PCardinal; n: integer); overload;

/// returns the 64-bit Intel Time Stamp Counter (TSC)
// - could be used as entropy source for randomness - use TPrecisionTimer if
// you expect a cross-platform and cross-CPU high resolution performance counter
function Rdtsc: Int64;

/// compatibility function, to be implemented according to the running CPU
// - expect the same result as the homonymous Win32 API function, i.e.
// returns I + 1, and store I + 1 within I in an atomic/thread-safe way
// - FPC will define this function as intrinsic for non-Intel CPUs
function InterlockedIncrement(var I: integer): integer;

/// compatibility function, to be implemented according to the running CPU
// - expect the same result as the homonymous Win32 API function, i.e.
// returns I - 1, and store I - 1 within I in an atomic/thread-safe way
// - FPC will define this function as intrinsic for non-Intel CPUs
function InterlockedDecrement(var I: integer): integer;

/// slightly faster than InterlockedIncrement() when you don't need the result
procedure LockedInc32(int32: PInteger);

/// slightly faster than InterlockedDecrement() when you don't need the result
procedure LockedDec32(int32: PInteger);

/// slightly faster than InterlockedIncrement64()
procedure LockedInc64(int64: PInt64);

// defined here for mormot.test.base only
function GetBitsCountSSE42(value: PtrInt): PtrInt;

// defined here for mormot.test.base only
// - use instead global crc32c() variable
function crc32csse42(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;

{$else}

/// redirect to FPC InterlockedIncrement() on non Intel CPU
procedure LockedInc32(int32: PInteger); inline;

/// redirect to FPC InterlockedDecrement() on non Intel CPU
procedure LockedDec32(int32: PInteger); inline;

/// redirect to FPC InterlockedIncrement64() on non Intel CPU
procedure LockedInc64(int64: PInt64); inline;

{$endif CPUINTEL}

/// low-level string reference counter increment (do nothing if constant)
procedure FastStringAddRef(str: pointer);

/// low-level string reference counter decrement (do nothing if constant)
procedure FastStringDecRef(str: pointer);
  {$ifdef HASINLINE} {$ifdef ISDELPHI} inline; {$endif} {$endif}

/// low-level string reference counter unprocess
// - caller should have tested that refcnt>=0
// - returns true if the managed variable should be released (i.e. refcnt was 1)
function StrCntDecFree(var refcnt: TStrCnt): boolean;
  {$ifndef CPUINTEL} inline; {$endif}

/// low-level dynarray reference counter unprocess
// - caller should have tested that refcnt>=0
function DACntDecFree(var refcnt: TDACnt): boolean;
  {$ifndef CPUINTEL} inline; {$endif}

/// low-level string reference counter process
procedure StrCntAdd(var refcnt: TStrCnt; increment: TStrCnt);
  {$ifdef HASINLINE} inline; {$endif}

/// low-level dynarray reference counter process
procedure DACntAdd(var refcnt: TDACnt; increment: TDACnt);
  {$ifdef HASINLINE} inline; {$endif}

/// fast atomic compare-and-swap operation on a pointer-sized integer value
// - via Intel/AMD custom asm or FPC RTL InterlockedCompareExchange(pointer)
// - true if Target was equal to Comparand, and Target set to NewValue
// - used e.g. as thread-safe atomic operation for TLightLock/TRWLock
// - Target should be aligned, which is the case when defined as a class field
function LockedExc(var Target: PtrUInt; NewValue, Comperand: PtrUInt): boolean;
  {$ifndef CPUINTEL} inline; {$endif}

/// fast atomic addition operation on a pointer-sized integer value
// - via Intel/AMD custom asm or FPC RTL InterlockedExchangeAdd(pointer)
// - Target should be aligned, which is the case when defined as a class field
procedure LockedAdd(var Target: PtrUInt; Increment: PtrUInt);
  {$ifndef CPUINTEL} inline; {$endif}

/// fast atomic substraction operation on a pointer-sized integer value
// - via Intel/AMD custom asm or FPC RTL InterlockedExchangeAdd(-pointer)
// - Target should be aligned, which is the case when defined as a class field
procedure LockedDec(var Target: PtrUInt; Decrement: PtrUInt);
  {$ifndef CPUINTEL} inline; {$endif}

/// fast atomic addition operation on a 32-bit integer value
// - via Intel/AMD custom asm or FPC RTL InterlockedExchangeAdd(pointer)
// - Target should be aligned, which is the case when defined as a class field
procedure LockedAdd32(var Target: cardinal; Increment: cardinal);
  {$ifndef CPUINTEL} inline; {$endif}

{$ifdef ISDELPHI}

/// return the position of the leftmost set bit in a 32-bit value
// - returns 255 if c equals 0
// - this function is an intrinsic on FPC
function BSRdword(c: cardinal): cardinal;

/// return the position of the leftmost set bit in a 64-bit value
// - returns 255 if q equals 0
// - this function is an intrinsic on FPC
function BSRqword(const q: Qword): cardinal;

{$endif ISDELPHI}

{$ifdef ASMINTEL}

{$ifdef ASMX64} // will define its own self-dispatched SSE2/AVX functions

type
  /// most common x86_64 CPU abilities, used e.g. by FillCharFast/MoveFast
  // - cpuHaswell identifies Intel/AMD AVX2+BMI support at Haswell level
  // as expected e.g. by IsValidUtf8Avx2/Base64EncodeAvx2 dedicated asm
  // - won't include ERMSB flag because it is not propagated within some VMs
  TX64CpuFeatures = set of (
    cpuAVX, cpuAVX2, cpuHaswell);

var
  /// internal flags used by FillCharFast - easier from asm that CpuFeatures
  X64CpuFeatures: TX64CpuFeatures;

{$ifdef ASMX64AVXNOCONST}
/// simdjson asm as used by mormot.core.unicode on Haswell for FPC IsValidUtf8()
function IsValidUtf8Avx2(source: PUtf8Char; sourcelen: PtrInt):  boolean;
// avx2 asm as used by mormot.core.buffers for Base64EncodeMain/Base64DecodeMain
procedure Base64EncodeAvx2(var b: PAnsiChar; var blen: PtrUInt; var b64: PAnsiChar);
procedure Base64DecodeAvx2(var b64: PAnsiChar; var b64len: PtrInt; var b: PAnsiChar);
{$endif ASMX64AVXNOCONST}

{$endif ASMX64}

/// our fast version of FillChar() on Intel/AMD
// - on Intel i386/x86_64, will use fast SSE2/AVX instructions (if available)
// - on non-Intel CPUs, it will fallback to the default RTL FillChar()
// - note: Delphi RTL is far from efficient: on i386 the FPU is slower/unsafe,
// and on x86_64, ERMS is wrongly used even for small blocks
// - on ARM/AARCH64 POSIX, mormot.core.os would redirect to optimized libc
procedure FillcharFast(var dst; cnt: PtrInt; value: byte);

/// our fast version of move() on Intel/AMD
// - on Delphi Intel i386/x86_64, will use fast SSE2 instructions (if available)
// - FPC i386 has fastmove.inc which is faster than our SSE2/ERMS version
// - FPC x86_64 RTL is slower than our SSE2/AVX asm
// - on non-Intel CPUs, it will fallback to the default RTL Move()
// - on ARM/AARCH64 POSIX, mormot.core.os would redirect to optimized libc
{$ifdef FPC_X86}
var MoveFast: procedure(const Source; var Dest; Count: PtrInt) = Move;
{$else}
procedure MoveFast(const src; var dst; cnt: PtrInt);
{$endif FPC_X86}

{$else}

// fallback to RTL versions on non-INTEL or PIC platforms by default
// and mormot.core.os.posix.inc redirects them to libc memset/memmove
var FillcharFast: procedure(var Dest; count: PtrInt; Value: byte) = FillChar;
var MoveFast: procedure(const Source; var Dest; Count: PtrInt) = Move;

{$endif ASMINTEL}

/// Move() with one-by-one byte copy
// - never redirect to MoveFast() so could be used when data overlaps
procedure MoveByOne(Source, Dest: pointer; Count: PtrUInt);
  {$ifdef HASINLINE} inline; {$endif}

/// perform a MoveFast then fill the Source buffer with zeros
// - could be used e.g. to quickly move a managed record content into a newly
// allocated stack variable with no reference counting
procedure MoveAndZero(Source, Dest: pointer; Count: PtrUInt);

/// 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}

/// fill first bytes of a memory buffer with zero
// - Length is expected to be not 0, typically in 1..8 range
// - when inlined, is slightly more efficient than regular FillZero/FillCharFast
procedure FillZeroSmall(P: pointer; Length: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// binary comparison of buffers, returning <0, 0 or >0 results
// - caller should ensure that P1<>nil, P2<>nil and L>0
// - on x86_64, will use a fast SSE2 asm version of the C function memcmp()
// (which is also used by CompareMem and CompareBuf)
// - on other platforms, run a simple but efficient per-byte comparison
function MemCmp(P1, P2: PByteArray; L: PtrInt): integer;
  {$ifndef CPUX64} {$ifdef HASINLINE} inline; {$endif} {$endif}

/// our fast version of CompareMem()
// - tuned asm for x86, call MemCmpSse2 for x64, or fallback to tuned pascal
function CompareMem(P1, P2: pointer; Length: PtrInt): boolean;
  {$ifdef CPUX64}inline;{$endif}

/// overload wrapper of MemCmp() to compare a RawByteString vs a memory buffer
// - will first check length(P1)=P2Len then call MemCmp()
function CompareBuf(const P1: RawByteString; P2: pointer; P2Len: PtrInt): integer;
  overload; {$ifdef HASINLINE}inline;{$endif}

/// overload wrapper to SortDynArrayRawByteString(P1, P2)
// - won't involve any code page - so may be safer e.g. on FPC
function CompareBuf(const P1, P2: RawByteString): integer;
  overload; {$ifdef HASINLINE}inline;{$endif}

/// overload wrapper to SortDynArrayRawByteString(P1, P2) = 0
// - won't involve any code page - so may be safer e.g. on FPC
function EqualBuf(const P1, P2: RawByteString): boolean;
  overload; {$ifdef HASINLINE}inline;{$endif}

/// 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
function CompareMemFixed(P1, P2: pointer; Length: PtrInt): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// a CompareMem()-like function designed for small (a few bytes) content
// - to be efficiently inlined in processing code
function CompareMemSmall(P1, P2: pointer; Length: PtrInt): boolean;
  {$ifdef HASINLINE}inline;{$endif}

{$ifndef CPUX86}
/// low-level efficient pure pascal function used when inlining PosEx()
// - not to be called directly
function PosExPas(sub, p: PUtf8Char; offset: PtrUInt): PtrInt;
{$endif CPUX86}

{$ifdef UNICODE}
/// low-level efficient pure pascal function used when inlining PosExString()
// - not to be called directly
function PosExStringPas(sub, p: PChar; offset: PtrUInt): PtrInt;
{$endif UNICODE}

/// faster RawUtf8 Equivalent of standard StrUtils.PosEx
function PosEx(const SubStr, S: RawUtf8; Offset: PtrUInt = 1): PtrInt;
  {$ifndef CPUX86}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// our own PosEx() function dedicated to RTL string process
// - Delphi XE or older don't support Pos() with an Offset
function PosExString(const SubStr, S: string; Offset: PtrUInt = 1): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// optimized version of PosEx() with search text as one AnsiChar
// - will use fast SSE2 asm on i386 and x86_64
function PosExChar(Chr: AnsiChar; const Str: RawUtf8): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// fast retrieve the position of a given character in a #0 ended buffer
// - will use fast SSE2 asm on x86_64
function PosChar(Str: PUtf8Char; Chr: AnsiChar): PUtf8Char; overload;
  {$ifndef CPUX64}{$ifdef FPC}inline;{$endif}{$endif}

/// fast retrieve the position of a given character in a #0 ended buffer
// - will use fast SSE2 asm on i386 and x86_64
function PosChar(Str: PUtf8Char; StrLen: PtrInt; Chr: AnsiChar): PUtf8Char; overload;
  {$ifdef HASINLINE}inline;{$endif}

{$ifndef PUREMORMOT2}
/// fast dedicated RawUtf8 version of Trim()
// - in the middle of UI code, consider using TrimU() which won't have name
// collision ambiguity as with SysUtils' homonymous function
function Trim(const S: RawUtf8): RawUtf8;
  {$ifdef HASINLINE}inline;{$endif}
{$endif PUREMORMOT2}

/// fast dedicated RawUtf8 version of Trim()
// - should be used for RawUtf8 instead of SysUtils' Trim() which is ambiguous
// with the main String/UnicodeString type of Delphi 2009+
// - in mORMot 1.18, there was a Trim() function but it was confusing
function TrimU(const S: RawUtf8): RawUtf8;

/// fast dedicated RawUtf8 version of s := Trim(s)
procedure TrimSelf(var S: RawUtf8);

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

/// 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: PtrInt = 1): RawUtf8; overload;

/// buffer-overflow safe version of StrComp(), to be used with PUtf8Char/PAnsiChar
function StrComp(Str1, Str2: pointer): PtrInt;
  {$ifndef CPUX86}{$ifdef HASINLINE}inline;{$endif}{$endif}

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

/// simple 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 e.g. with valgrid
// - SSE2 StrLen() versions would never read outside a memory page boundary,
// so are safe to use in practice, but may read outside the string buffer
// itself, so may not please paranoid tools like valgrid
function StrLenSafe(S: pointer): PtrInt;
  {$ifdef CPU64}inline;{$endif}

/// our fast version of StrLen(), to be used with PUtf8Char/PAnsiChar
// - under x86, will detect SSE2 and use it if available, reaching e.g.
// 37.5 GB/s on a Core i5-13500 under Linux x86_64
// - on ARM/AARCH64 POSIX, mormot.core.os would redirect to optimized libc
{$ifdef CPUX64}
function StrLen(S: pointer): PtrInt;
{$else}
var StrLen: function(S: pointer): PtrInt = StrLenSafe;
{$endif CPUX64}

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

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

/// fast go to the first char <= #13
// - source is expected to be not nil
function GotoNextControlChar(source: PUtf8Char): PUtf8Char;
  {$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 buffer only contains 7-bits Ansi characters
function IsAnsiCompatible(PC: PAnsiChar; Len: PtrUInt): 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 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;

type
  /// 32-bit Pierre L'Ecuyer software (random) generator
  // - cross-compiler and cross-platform efficient randomness generator, very
  // fast with a much better distribution than Delphi system's Random() function
  // see https://www.gnu.org/software/gsl/doc/html/rng.html#c.gsl_rng_taus2
  // - used by thread-safe Random32/RandomBytes, storing 16 bytes per thread - a
  // stronger algorithm like Mersenne Twister (as used by FPC RTL) requires 5KB
  // - SeedGenerator() makes it a sequence generator - or encryptor via Fill()
  // - when used as random generator (default when initialized with 0), Seed()
  // will gather and hash some system entropy to initialize the internal state
  {$ifdef USERECORDWITHMETHODS}
  TLecuyer = record
  {$else}
  TLecuyer = object
  {$endif USERECORDWITHMETHODS}
  public
    rs1, rs2, rs3, seedcount: cardinal;
    /// force a random seed of the generator from current system state
    // - as executed by the Next method at thread startup, and after 2^32 values
    // - calls XorEntropy(), so RdRand32/Rdtsc opcodes on Intel/AMD CPUs
    procedure Seed(entropy: PByteArray = nil; entropylen: PtrInt = 0);
    /// force a well-defined seed of the generator from a fixed initial point
    // - to be called before Next/Fill to generate the very same output
    // - will generate up to 16GB of predictable output, then switch to random
    procedure SeedGenerator(fixedseed: QWord); overload;
    /// force a well-defined seed of the generator from a buffer initial point
    // - apply crc32c() over the fixedseed buffer to initialize the generator
    procedure SeedGenerator(fixedseed: pointer; fixedseedbytes: integer); overload;
    /// compute the next 32-bit generated value with no Seed - internal call
    function RawNext: cardinal;
    /// compute the next 32-bit generated value
    // - will automatically reseed after around 2^32 generated values, which is
    // huge but very conservative since this generator has a period of 2^88
    function Next: cardinal; overload;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// compute the next 32-bit generated value, in range [0..max-1]
    function Next(max: cardinal): cardinal; overload;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// compute a 64-bit integer value
    function NextQWord: QWord;
    /// compute a 64-bit floating point value
    function NextDouble: double;
    /// XOR some memory buffer with random bytes
    // - when used as sequence generator after SeedGenerator(), dest buffer
    // should be filled with zeros before the call if you want to use it as
    // generator, but could be applied on any memory buffer for encryption
    procedure Fill(dest: pointer; bytes: integer);
    /// fill some string[0..size] with 7-bit ASCII random text
    procedure FillShort(var dest: ShortString; size: PtrUInt = 255);
    /// fill some string[0..31] with 7-bit ASCII random text
    procedure FillShort31(var dest: TShort31);
  end;
  PLecuyer = ^TLecuyer;

/// return the 32-bit Pierre L'Ecuyer software generator for the current thread
// - can be used as an alternative to several Random32 function calls
function Lecuyer: PLecuyer;

/// internal function used e.g. by TLecuyer.FillShort/FillShort31
procedure FillAnsiStringFromRandom(dest: PByteArray; size: PtrUInt);

/// fast compute of some 32-bit random value, using the gsl_rng_taus2 generator
// - this function will use well documented and proven Pierre L'Ecuyer software
// generator - which happens to be faster (and safer) than RDRAND opcode (which
// is used for seeding anyway)
// - consider using TAesPrng.Main.Random32(), which offers cryptographic-level
// randomness, but is twice slower (even with AES-NI)
// - thread-safe and non-blocking function: each thread will maintain its own
// TLecuyer table (note that RTL's system.Random function is not thread-safe)
function Random32: cardinal; overload;

/// compute of a 32-bit random value <> 0, using the gsl_rng_taus2 generator
// - thread-safe function: each thread will maintain its own TLecuyer table
function Random32Not0: cardinal;

/// fast compute of some 31-bit random value, using the gsl_rng_taus2 generator
// - thread-safe function: each thread will maintain its own TLecuyer table
function Random31: integer;

/// compute of a 31-bit random value <> 0, using the gsl_rng_taus2 generator
// - thread-safe function: each thread will maintain its own TLecuyer table
function Random31Not0: integer;

/// fast compute of a 64-bit random value, using the gsl_rng_taus2 generator
// - thread-safe function: each thread will maintain its own TLecuyer table
function Random64: QWord;

/// fast compute of bounded 32-bit random value, using the gsl_rng_taus2 generator
// - calls internally the overloaded Random32 function, ensuring Random32(max)<max
// - consider using TAesPrng.Main.Random32(), which offers cryptographic-level
// randomness, but is twice slower (even with AES-NI)
// - thread-safe and non-blocking function using a per-thread TLecuyer engine
function Random32(max: cardinal): cardinal; overload;

/// fast compute of a 64-bit random floating point, using the gsl_rng_taus2 generator
// - thread-safe and non-blocking function using a per-thread TLecuyer engine
// - returns a random value in range [0..1)
function RandomDouble: double;

/// fill a memory buffer with random bytes from the gsl_rng_taus2 generator
// - will actually XOR the Dest buffer with Lecuyer numbers
// - consider also the cryptographic-level TAesPrng.Main.FillRandom() method
// - thread-safe and non-blocking function using a per-thread TLecuyer engine
procedure RandomBytes(Dest: PByte; Count: integer);

/// fill some string[31] with 7-bit ASCII random text
// - thread-safe and non-blocking function using a per-thread TLecuyer engine
procedure RandomShort31(var dest: TShort31);

{$ifndef PUREMORMOT2}
/// fill some 32-bit memory buffer with values from the gsl_rng_taus2 generator
// - the destination buffer is expected to be allocated as 32-bit items
procedure FillRandom(Dest: PCardinal; CardinalCount: integer);
{$endif PUREMORMOT2}

/// seed the thread-specific gsl_rng_taus2 Random32 generator
// - by default, gsl_rng_taus2 generator is re-seeded every 2^32 values, which
// is very conservative against 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
// - calls XorEntropy(), so RdRand32/Rdtsc opcodes on Intel/AMD CPUs
// - thread-safe and non-blocking function using a per-thread TLecuyer engine
procedure Random32Seed(entropy: pointer = nil; entropylen: PtrInt = 0);

/// cipher/uncipher some memory buffer using a 64-bit seed and Pierre L'Ecuyer's
// algorithm, and its gsl_rng_taus2 generator
procedure LecuyerEncrypt(key: Qword; var data: RawByteString);

/// retrieve 512-bit of entropy, from system time and current execution state
// - entropy is gathered over several sources like RTL Now(), CreateGuid(),
// current gsl_rng_taus2 Lecuyer state, and RdRand32/Rdtsc low-level Intel opcodes
// - the resulting output is to be hashed - e.g. with DefaultHasher128
// - execution is fast, but not enough as unique seed for a cryptographic PRNG:
// TAesPrng.GetEntropy will call it as one of its entropy sources, in addition
// to system-retrieved randomness from mormot.core.os.pas' XorOSEntropy()
procedure XorEntropy(var e: THash512Rec);

/// convert the endianness of a given unsigned 16-bit integer into BigEndian
function bswap16(a: cardinal): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// 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);

/// copy one memory buffer to another, swapping the bytes order
// - used e.g. by TBigInt.Load/Save to follow DER big-endian encoding
// - warning: src and dst should not overlap
procedure MoveSwap(dst, src: PByte; n: PtrInt);

/// 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 TJsonWriter as such:
// ! ...
// !   fEchos: array of TOnTextWriterEcho;
// ! ...
// !   procedure EchoAdd(const aEcho: TOnTextWriterEcho);
// ! ...
// ! procedure TEchoWriter.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 TJsonWriter as such:
// ! ...
// !   fEchos: array of TOnTextWriterEcho;
// ! ...
// !   procedure EchoRemove(const aEcho: TOnTextWriterEcho);
// ! ...
// ! procedure TJsonWriter.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: PtrInt); 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): PtrInt;

/// 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;
  {$ifdef HASINLINE}inline;{$endif}


{ ************ Buffers (e.g. Hashing and SynLZ compression) Raw Functions }

type
  /// implements a 4KB stack-based storage of some (UTF-8 or binary) content
  // - 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
  // - will avoid temporary memory allocation via the heap for up to 4KB of data
  // - can be used as string/buffer generator via Add/AddShort/Done methods
  // - all Init() methods will allocate 16 more bytes, for a #0 terminator 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 USERECORDWITHMETHODS}
  private
    procedure AddRealloc(new: PtrInt);
  public
    /// the text/binary length, in bytes, excluding the #0 terminator
    // - is the current capacity when Add()/AddShort() are used
    len: integer;
    /// how many bytes have been stored with Add()/AddShort() overloaded methods
    added: integer;
    /// where the text/binary is available (and any Source has been copied)
    // - equals nil if len=0
    buf: pointer;
    /// default 4KB buffer allocated on stack - after the len/buf main fields
    // - 16 last bytes are reserved to prevent potential buffer overflow,
    // so usable length is 4080 bytes
    tmp: array[0..4095] of AnsiChar;
    /// 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
    // - also include ending #0 at SourceLen position
    procedure Init(Source: pointer; SourceLen: PtrInt); overload;
    /// initialize a new temporary buffer of a given number of bytes
    // - also include ending #0 at SourceLen position
    function Init(SourceLen: PtrInt): pointer; overload;
    /// initialize a local buffer, returning the buffer address for direct use
    function InitOnStack: pointer;
      {$ifdef HASINLINE}inline;{$endif}
    /// initialize a local buffer, returning the internal buffer size (4080 bytes)
    // - could be used e.g. for an OS 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 returns an insufficient buffer error
    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 RandomBytes() call
    function InitRandom(RandomLen: integer): 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
    // - if ZeroLen=0, will initialize the whole tmp[] stack buffer to 0
    function InitZero(ZeroLen: PtrInt): pointer;
    /// inlined wrapper around buf + len
    function BufEnd: pointer;
      {$ifdef HASINLINE}inline;{$endif}
    /// 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;
    /// prepare to append some bytes to the internal buffer
    // - returns the destination buffer where l bytes should be written
    function Add(l: PtrInt): pointer; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// append some bytes to the internal buffer
    // - making a buffer reallocation if needed
    procedure Add(p: pointer; l: PtrInt); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// append some bytes to the internal buffer
    // - making a buffer reallocation if needed
    procedure Add(const s: RawByteString); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// append some bytes to the internal buffer
    // - making a buffer reallocation if needed
    procedure AddShort(const s: ShortString); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// add one AnsiChar just after another Add() within trailing 16 bytes margin
    procedure AddDirect(c: AnsiChar); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// add two AnsiChar just after another Add() within trailing 16 bytes margin
    procedure AddDirect(const c1, c2: AnsiChar); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// append an unsigned number as text to the internal buffer
    procedure AddU(v: PtrUInt);
    /// finalize the Add() temporary storage, and create a RawByteString from it
    procedure Done(var Dest; CodePage: cardinal = CP_RAWBYTESTRING); overload;
  end;
  PSynTempBuffer = ^TSynTempBuffer;

/// 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}

/// compute the line length from a size-delimited source array of chars
// - will use fast SSE2 assembly on x86-64 CPU
// - is likely to read some bytes after the TextEnd buffer, so GetLineSize()
// from mormot.core.text may be preferred, e.g. on memory mapped files
// - expects Text and TextEnd to be not nil - see GetLineSize() instead
function BufferLineLength(Text, TextEnd: PUtf8Char): PtrInt;
  {$ifndef CPUX64}{$ifdef HASINLINE}inline;{$endif}{$endif}
  
type
  TCrc32tab = array[0..7, byte] of cardinal;
  PCrc32tab = ^TCrc32tab;

  /// function prototype to be used for 32-bit hashing of an element
  // - it must return a cardinal hash, with as less collision as possible
  // - is the function signature of DefaultHasher and InterningHasher
  THasher = function(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;

  /// function prototype to be used for 64-bit hashing of an element
  // - it must return a QWord hash, with as less collision as possible
  // - is the function signature of DefaultHasher64
  THasher64 = function(crc: QWord; buf: PAnsiChar; len: cardinal): QWord;

  /// function prototype to be used for 128-bit hashing of an element
  // - the input hash buffer is used as seed, and contains the 128-bit result
  // - is the function signature of DefaultHasher128
  THasher128 = procedure(hash: PHash128; buf: PAnsiChar; len: cardinal);

var
  /// 8KB 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 and
  // TSynUniqueIdentifierGenerator as 1KB master/reference key tables
  crc32ctab: TCrc32tab;
  /// 8KB tables used by crc32fast() function
  crc32tab: 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 CRC32 checksum on the supplied buffer on processor-neutral code
// - result is compatible with zlib's crc32() but not with crc32c/crc32cfast()
function crc32fast(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, or if you don't want to pollute the CPU L1 cache with
// crc32cfast() bigger lookup tables
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 or ARMv8 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;

/// expand a CRC32C checksum on the supplied buffer for 64-bit hashing
// - will use SSE 4.2 or ARMv8 hardware accelerated instruction, if available
// - is the default implementation of DefaultHasher64
function crc32ctwice(seed: QWord; buf: PAnsiChar; len: cardinal): QWord;

/// 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 or ARMv8 hardware accelerated instruction, if available
// - will combine two crc32c() calls into an unsigned 63-bit Int64 result
// - by design, such combined hashes cannot be cascaded
function crc63c(buf: PAnsiChar; len: cardinal): Int64;

/// compute a 128-bit checksum on the supplied buffer, cascading two crc32c
// - will use SSE 4.2 or ARMv8 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 256-bit checksum on the supplied buffer using crc32c
// - will use SSE 4.2 or ARMv8 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);

/// pure pascal function implementing crc32cBy4()
function crc32cBy4fast(crc, value: cardinal): cardinal;

/// 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 or ARMv8)
procedure crcblocksfast(crc128, data128: PBlock128; count: integer);

/// 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 or ARMv8)
procedure crcblockfast(crc128, data128: PBlock128);

/// compute a 128-bit CRC of any binary buffers
// - combine crcblocks() with 4 parallel crc32c() for 1..15 trailing bytes
procedure crc32c128(hash: PHash128; buf: PAnsiChar; len: cardinal);

var
  /// compute CRC32C checksum on the supplied buffer
  // - result is not compatible with zlib's crc32() - Intel/SCSI CRC32C has not
  // same polynom - but will use the fastest mean available, e.g. SSE 4.2 or ARMv8,
  // achieve up to 16GB/s with the optimized implementation from mormot.crypt.core
  // - you should use this function instead of crc32cfast() or crc32csse42()
  crc32c: THasher = crc32cfast;

  /// 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 or ARMv8
  crc32cBy4: function(crc, value: cardinal): cardinal = crc32cBy4fast;

  /// 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 or ARMv8 hardware accelerated instruction, if available
  // - is used e.g. by mormot.crypt.core's TAesCfc/TAesOfc/TAesCtc to 
  // check for data integrity
  crcblock: procedure(crc128, data128: PBlock128)  = crcblockfast;

  /// 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 or ARMv8 hardware accelerated instruction, if available
  // - is used e.g. by crc32c128 or mormot.crypt.ecc's TEcdheProtocol.ComputeMAC
  // for macCrc128c or TAesAbstractAead.MacCheckError
  crcblocks: procedure(crc128, data128: PBlock128; count: integer) = crcblocksfast;

  /// compute CRC32 checksum on the supplied buffer
  // -  mormot.lib.z.pas will replace with its official (may be faster) version
  crc32: THasher = crc32fast;

  /// compute ADLER32 checksum on the supplied buffer
  // - is only available if mormot.lib.z.pas unit is included in the project
  adler32: THasher;

/// 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, TRestStorageInMemory
// binary persistence, or CompressSynLZ/StreamSynLZ/FileSynLZ
// - some numbers on Linux x86_64:
// $ 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 hash32 in 707us i.e. 3536067/s or 7.3 GB/s
// $ 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: cardinal): cardinal;

/// shuffle a 32-bit value using the last stage of xxHash32 algorithm
// - is a cascade of binary shifts and multiplications by prime numbers
// - see also (c * KNUTH_HASH32_MUL) shr (32 - bits) as weaker alternative
function xxHash32Mixup(crc: cardinal): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

const
  /// Knuth's magic number for hashing a 32-bit value, using the golden ratio
  // - then use the result high bits, i.e. via "shr" not via "and"
  // - for instance, mormot.core.log uses it to hash the TThreadID:
  // $ hash := cardinal(cardinal(id) * KNUTH_HASH32_MUL) shr (32 - MAXLOGTHREADBITS);
  KNUTH_HASH32_MUL = $9E3779B1;

  /// Knuth's magic number for hashing a 64-bit value, using the golden ratio
  KNUTH_HASH64_MUL = $9E3779B97F4A7C15;

  /// Knuth's magic number for hashing a PtrUInt, using the golden ratio
  {$ifdef CPU32}
  KNUTH_HASHPTR_MUL = KNUTH_HASH32_MUL;
  KNUTH_HASHPTR_SHR = 32;
  {$else}
  KNUTH_HASHPTR_MUL = KNUTH_HASH64_MUL;
  KNUTH_HASHPTR_SHR = 64;
  {$endif CPU32}

var
  /// the 32-bit default hasher used by TDynArrayHashed
  // - set to crc32csse42() if SSE4.2 or ARMv8 are available on this CPU,
  // or fallback to xxHash32() which is faster than crc32cfast() e.g. on ARM
  // - mormot.crypt.core may assign safer and faster AesNiHash32() if available
  // - so the hash value may change on another computer or after program restart
  DefaultHasher: THasher = xxHash32;

  /// the 32-bit hash function used by TRawUtf8Interning
  // - set to crc32csse42() if SSE4.2 or ARMv8 are available on this CPU,
  // or fallback to xxHash32() which performs better than crc32cfast()
  // - mormot.crypt.core may assign safer and faster AesNiHash32() if available
  // - so the hash value may change on another computer or after program restart
  InterningHasher: THasher = xxHash32;

  /// a 64-bit hasher function
  // - crc32cTwice() by default, but mormot.crypt.core may assign AesNiHash64()
  // - so the hash value may change on another computer or after program restart
  DefaultHasher64: THasher64 = crc32cTwice;

  /// a 128-bit hasher function
  // - crc32c128() by default, but mormot.crypt.core may assign AesNiHash128()
  // - so the hash value may change on another computer or after program restart
  DefaultHasher128: THasher128 = crc32c128;

/// compute a 32-bit hash of any string using DefaultHasher()
// - so the hash value may change on another computer or after program restart
function DefaultHash(const s: RawByteString): cardinal; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// compute a 32-bit hash of any array of bytes using DefaultHasher()
// - so the hash value may change on another computer or after program restart
function DefaultHash(const b: TBytes): cardinal; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// compute a 32-bit hash of any string using the CRC32C checksum
// - the returned hash value will be stable on all platforms, and use HW opcodes
// if available on the current CPU
function crc32cHash(const s: RawByteString): cardinal; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// compute a 32-bit hash of any array of bytes using the CRC32C checksum
// - the returned hash value will be stable on all platforms, and use HW opcodes
// if available on the current CPU
function crc32cHash(const b: TBytes): cardinal; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// combine/reduce a 128-bit hash into a 64-bit hash
// - e.g. from non cryptographic 128-bit hashers with linked lower/higher 64-bit
function Hash128To64(const b: THash128): QWord;
  {$ifdef HASINLINE}inline;{$endif}

/// get maximum possible (worse) SynLZ compressed size
function SynLZcompressdestlen(in_len: integer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// get exact uncompressed size from SynLZ-compressed buffer (to reserve memory, e.g.)
function SynLZdecompressdestlen(in_p: PAnsiChar): integer;

/// raw SynLZ compression algorithm implemented in pascal
// - you should rather call SynLZcompress1() which is likely to be much faster
function SynLZcompress1pas(src: PAnsiChar; size: integer; dst: PAnsiChar): integer;

/// raw SynLZ decompression algorithm implemented in pascal
// - you should rather call SynLZdecompress1() which is likely to be much faster
function SynLZdecompress1pas(src: PAnsiChar; size: integer; dst: PAnsiChar): integer;

/// SynLZ decompression algorithm with memory boundaries check
// - this function is slower, but will allow to uncompress only the start
// of the content (e.g. to read some metadata header)
// - it will also check for dst buffer overflow, so will be more secure than
// other functions, which expect the content to be verified (e.g. via CRC)
function SynLZdecompress1partial(src: PAnsiChar; size: integer; dst: PAnsiChar;
  maxDst: integer): integer;

/// raw SynLZ compression algorithm
// - includes optimized x86/x64 asm version on Intel/AMD
// - just redirects to SynLZcompress1pas on other CPUs
// - note that SynLZ is not very good at compressing a lot of zeros: it excels
// with somewhat already pre-encoded data like text, JSON or our mormot.core.data
// binary serialization
function SynLZcompress1(src: PAnsiChar; size: integer; dst: PAnsiChar): integer;
  {$ifndef CPUINTEL} inline; {$endif}

/// raw SynLZ decompression algorithm
// - includes optimized x86/x64 asm version on Intel/AMD
// - just redirects to SynLZcompress1pas on other CPUs
function SynLZdecompress1(src: PAnsiChar; size: integer; dst: PAnsiChar): integer;
  {$ifndef CPUINTEL} inline; {$endif}

/// 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 Data: RawByteString; Compress: boolean): RawUtf8;

/// return the Hash32() 32-bit CRC of CompressSynLZ() uncompressed data
// - will first check the CRC of the supplied compressed Data
// - returns 0 if the CRC of the compressed Data is not correct
function CompressSynLZGetHash32(const Data: RawByteString): cardinal;

/// simple Run-Length-Encoding compression of a memory buffer
// - SynLZ is not good with input of a lot of redundant bytes, e.g. chunks of
// zeros: you could pre-process RleCompress/RleUnCompress such data before SynLZ
// - see AlgoRleLZ as such a RLE + SynLZ algorithm
// - returns the number of bytes written to dst, or -1 on dstsize overflow
function RleCompress(src, dst: PByteArray; srcsize, dstsize: PtrUInt): PtrInt;

/// simple Run-Length-Encoding uncompression of a memory buffer
// - SynLZ is not good with input of a lot of redundant bytes, e.g. chunks of
// zeros: you could pre-process RleCompress/RleUnCompress such data before SynLZ
// - see AlgoRleLZ as such a RLE + SynLZ algorithm
function RleUnCompress(src, dst: PByteArray; size: PtrUInt): PtrUInt;

/// partial Run-Length-Encoding uncompression of a memory buffer
function RleUnCompressPartial(src, dst: PByteArray; size, max: PtrUInt): PtrUInt;

/// internal hash table adjustment as called from TDynArrayHasher.HashDelete
// - decrement any integer greater or equal to a deleted value
// - brute force O(n) indexes fix after deletion (much faster than full ReHash)
// - we offer very optimized SSE2 and AVX2 versions on x86_64 - therefore is
// defined in this unit to put this asm code in mormot.core.base.asmx64.inc
procedure DynArrayHashTableAdjust(P: PIntegerArray; deleted: integer; count: PtrInt);

/// DynArrayHashTableAdjust() version for 16-bit HashTable[] - SSE2 asm on x86_64
procedure DynArrayHashTableAdjust16(P: PWordArray; deleted: cardinal; count: PtrInt);


{ ************ Efficient Variant Values Conversion }

type
  PVarType = ^TVarType;

  /// a variant/TVarData overlapped structure with a 32-bit VType field
  // - 32-bit VType is faster for initialization than 16-bit TVarData.VType
  // - it is safe to transtype this as plain variant or TVarData
  TSynVarData = packed record
    case integer of
      0: (
        VType: cardinal;
        case padding: cardinal of // access the most used TVarData value members
          varInteger: (VInteger: integer);
          varDouble:  (VDouble:  double);
          varDate:    (VDate:    TDateTime);
          varInt64:   (VInt64:   Int64);
          varString:  (VString:  pointer);
          varAny:     (VAny:     pointer);
          );
      1: (
        Data: TVarData); // access to all standard value members
  end;
  PSynVarData = ^TSynVarData;

const
  /// unsigned 64bit integer variant type
  // - currently called varUInt64 in Delphi (not defined in older versions),
  // and varQWord in FPC
  varWord64 = 21;
  /// map the Windows VT_INT extended VARENUM, i.e. a 32-bit signed integer
  // - also detected and handled by VariantToInteger/VariantToInt64
  varOleInt = 22;
  /// map the Windows VT_UINT extended VARENUM, i.e. a 32-bit unsigned integer
  // - also detected and handled by VariantToInteger/VariantToInt64
  varOleUInt = 23;
  /// map the Windows VT_LPSTR extended VARENUM, i.e. a PAnsiChar
  // - also detected and handled by VariantToUtf8
  varOlePAnsiChar = 30;
  /// map the Windows VT_LPWSTR extended VARENUM, i.e. a PWideChar
  // - also detected and handled by VariantToUtf8
  varOlePWideChar = 31;
  /// map the Windows VT_FILETIME extended VARENUM, i.e. a 64-bit TFileTime
  // - also detected and handled by VariantToDateTime
  varOleFileTime = 64;
  /// map the Windows VT_CLSID extended VARENUM, i.e. a by-reference PGuid
  varOleClsid = 72;

  varVariantByRef = varVariant or varByRef;
  varStringByRef  = varString  or varByRef;
  varOleStrByRef  = varOleStr  or varByRef;

  /// this variant type will map the current SynUnicode type
  // - depending on the compiler version
  {$ifdef HASVARUSTRING}
  varSynUnicode   = varUString;
  varUStringByRef = varUString or varByRef;
  {$else}
  varSynUnicode = varOleStr;
  {$endif HASVARUSTRING}

  /// this variant type will map the current string type
  // - depending on the compiler string definition (UnicodeString or AnsiString)
  {$ifdef UNICODE}
  varNativeString = varUString;
  {$else}
  varNativeString = varString;
  {$endif UNICODE}

  {$ifdef ISDELPHI}
  CFirstUserType = $10F;
  {$endif ISDELPHI}

  /// those TVarData.VType values are meant to be direct values
  VTYPE_SIMPLE = [varEmpty..varDate, varBoolean, varShortInt..varWord64
    {$ifdef OSWINDOWS} , varOleInt, varOleUInt, varOlePAnsiChar, varOlePWideChar,
      varOleFileTime {$endif OSWINDOWS}];
  /// those TVarData.VType values are meant to be number values and need no escape
  VTYPE_NUMERIC = [varSmallInt .. varDouble, varCurrency, varBoolean .. varOleUInt];
  /// bitmask used by our inlined VarClear() to avoid unneeded VarClearProc()
  VTYPE_STATIC = $BFE8;

  /// a slightly faster alternative to Variants.Null function with TVarData
  NullVarData:  TVarData = (VType: varNull{%H-});
  FalseVarData: TVarData = (VType: varBoolean{%H-});
  TrueVarData:  TVarData = (VType: varBoolean; VInteger: {%H-}1);

var
  /// a slightly faster alternative to Variants.Null function
  Null:     variant absolute NullVarData;
  /// a slightly faster alternative to false constant when assigned to a variant
  VarFalse: variant absolute FalseVarData;
  /// a slightly faster alternative to true constant when assigned to a variant
  VarTrue:  variant absolute TrueVarData;

{$ifdef HASINLINE}
/// overloaded function which can be properly inlined to clear a variant
procedure VarClear(var v: variant); inline;
{$endif HASINLINE}

/// overloaded function which can be properly inlined to clear a variant
procedure VarClearAndSetType(var v: variant; vtype: integer);
  {$ifdef HASINLINE}inline;{$endif}

/// internal efficient wrapper of VarClear() + set VType=varString and VAny=nil
// - used e.g. by RawUtf8ToVariant() functions
// - could also be used as a faster alternative to Value := ''
procedure ClearVariantForString(var Value: variant);
  {$ifdef HASINLINE}inline;{$endif}

/// same as Value := Null, but slightly faster
procedure SetVariantNull(var Value: variant);
  {$ifdef HASINLINE}inline;{$endif}

/// 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);

/// get the root PVarData of a variant, redirecting any varByRef
// - if result^.VPointer=nil, returns varEmpty
function VarDataFromVariant(const Value: variant): PVarData;
  {$ifdef HASINLINE}inline;{$endif}

/// same as VarIsEmpty(V) or VarIsNull(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 VarIsStr() but handling varVariantByRef weak references
function VarIsString(const V: Variant): boolean;

/// same as VarIsEmpty(PVariant(V)^) or VarIsNull(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}

/// 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}

/// 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-sensitive '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 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 an UTF-8 encoded string into a variant RawUtf8 varString
function RawUtf8ToVariant(const Txt: RawUtf8): variant; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a Variant varString value into RawUtf8 encoded String
// - works as the exact reverse of RawUtf8ToVariant() function
// - non varString variants (e.g. UnicodeString, WideString, numbers, empty and
// null) will be returned as ''
// - use VariantToUtf8() instead if you need to convert numbers or other strings
// - use VariantSaveJson() instead if you need a conversion to JSON with
// custom parameters
procedure VariantStringToUtf8(const V: Variant; var result: RawUtf8); overload;

/// convert Variant string values into RawUtf8 encoded String
// - works as the exact reverse of RawUtf8ToVariant() function
// - non varString variants (e.g. UnicodeString, WideString, numbers, empty and
// null) will be returned as ''
function VariantStringToUtf8(const V: Variant): RawUtf8; overload;

var
  /// efficient finalization of successive variant items from a (dynamic) array
  // - this unit will include a basic version calling VarClear()
  // - mormot.core.variants will assign a more efficient implementation
  VariantClearSeveral: procedure(V: PVarData; n: integer);

  /// compare two variant/TVarData values, with or without case sensitivity
  // - this unit registers the basic VariantCompSimple() case-sensitive comparer
  // - mormot.core.variants will assign the much better FastVarDataComp()
  // - called e.g. by SortDynArrayVariant/SortDynArrayVariantI functions
  SortDynArrayVariantComp: function(
    const A, B: TVarData; caseInsensitive: boolean): integer;

/// basic default case-sensitive variant comparison function
// - try as VariantToInt64/VariantToDouble, then RTL VarCompareValue()
function VariantCompSimple(const A, B: variant): integer;


{ ************ Sorting/Comparison Functions }

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
  // - simple types are compared within this unit (with proper optimized asm
  // if possible), whereas more complex types are implemented in other units -
  // e.g. SortDynArrayVariant/SortDynArrayVariantI are in mormot.core.variants
  // and SortDynArrayPUtf8CharI/SortDynArrayStringI in mormot.core.text
  TDynArraySortCompare = function(const A, B): integer;

  /// the recognized operators for comparison functions results match
  TCompareOperator = (
    coEqualTo,
    coNotEqualTo,
    coLessThan,
    coLessThanOrEqualTo,
    coGreaterThan,
    coGreaterThanOrEqualTo);

/// fast search if a comparison function result (<0,0,>0) match an operator
function SortMatch(CompareResult: integer; CompareOperator: TCompareOperator): boolean;
  {$ifdef HASINLINE} inline; {$endif}

/// compare two "array of boolean" 8-bit elements
function SortDynArrayBoolean(const A, B): integer;

/// compare two "array of shortint" 8-bit elements
function SortDynArrayShortint(const A, B): integer;

/// compare two "array of byte" 8-bit elements
function SortDynArrayByte(const A, B): integer;

/// compare two "array of smallint" 16-bit elements
function SortDynArraySmallint(const A, B): integer;

/// compare two "array of word" 16-bit elements
function SortDynArrayWord(const A, B): integer;

/// compare two "array of integer" 32-bit elements
function SortDynArrayInteger(const A, B): integer;

/// compare two "array of cardinal" 32-bit elements
function SortDynArrayCardinal(const A, B): integer;

/// compare two "array of Int64" or "array of Currency" 64-bit elements
function SortDynArrayInt64(const A, B): integer;

/// compare two "array of QWord" 64-bit 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" 128-bit elements
function SortDynArray128(const A, B): integer;

/// compare two "array of THash256" 256-bit elements
function SortDynArray256(const A, B): integer;

/// compare two "array of THash512" 512-bit 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" 32-bit elements
function SortDynArraySingle(const A, B): integer;

/// compare two "array of double" 64-bit elements
function SortDynArrayDouble(const A, B): integer;

/// compare two "array of TSynExtended" 64/80-bit elements
function SortDynArrayExtended(const A, B): integer;

/// compare two "array of AnsiString" elements, with case sensitivity
// - on Intel/AMD will use efficient i386/x86_64 assembly using length
// - on other CPU, will redirect to inlined StrComp() using #0 trailing char
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
// - on Intel/AMD, the more efficient SortDynArrayAnsiString asm is used instead
{$ifdef CPUINTEL}
var SortDynArrayRawByteString: TDynArraySortCompare = SortDynArrayAnsiString;
{$else}
function SortDynArrayRawByteString(const A, B): integer;
{$endif CPUINTEL}

/// compare two "array of PUtf8Char/PAnsiChar" elements, with case sensitivity
function SortDynArrayPUtf8Char(const A, B): integer;

/// compare two "array of WideString/UnicodeString" elements, with case sensitivity
function SortDynArrayUnicodeString(const A, B): integer;

/// compare two "array of RTL string" elements, with case sensitivity
// - the expected string type is the RTL string
function SortDynArrayString(const A, B): integer;

/// compare two "array of shortstring" elements, with case sensitivity
function SortDynArrayShortString(const A, B): integer;

/// compare two "array of variant" elements, with case sensitivity
// - just a wrapper around SortDynArrayVariantComp(A,B,false)
function SortDynArrayVariant(const A, B): integer;

/// compare two "array of variant" elements, with no case sensitivity
// - just a wrapper around SortDynArrayVariantComp(A,B,true)
function SortDynArrayVariantI(const A, B): integer;

/// low-level inlined function for exchanging two pointers
// - used e.g. during sorting process
procedure ExchgPointer(n1, n2: PPointer);
  {$ifdef HASINLINE}inline;{$endif}

/// low-level inlined function for exchanging two sets of pointers
// - used e.g. during sorting process
procedure ExchgPointers(n1, n2: PPointer; count: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// low-level inlined function for exchanging two variants
// - used e.g. during sorting process
procedure ExchgVariant(v1, v2: PPtrIntArray);
  {$ifdef CPU64} inline;{$endif}

/// low-level inlined function for exchanging two memory buffers
// - used e.g. during sorting process
procedure Exchg(P1, P2: PAnsiChar; count: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}


{ ************ Some Convenient TStream descendants and File access functions }

type
  /// a dynamic array of TStream instances
  TStreamDynArray = array of TStream;

  {$M+}
  /// TStream with a protected fPosition field
  TStreamWithPosition = class(TStream)
  protected
    fPosition: Int64;
    {$ifdef FPC}
    function GetPosition: Int64; override;
    {$endif FPC}
  public
    /// change the current Read/Write position, within current GetSize
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    /// call the 64-bit Seek() overload
    function Seek(Offset: Longint; Origin: Word): Longint; override;
  end;
  {$M-}

  /// TStream with two protected fPosition/fSize fields
  TStreamWithPositionAndSize = class(TStreamWithPosition)
  protected
    fSize: Int64;
    function GetSize: Int64; override;
  end;

  /// TStream using a RawByteString as internal storage
  // - default TStringStream uses UTF-16 WideChars since Delphi 2009, so it is
  // not compatible with previous versions or FPC, and it makes more sense to
  // work with RawByteString/RawUtf8 in our UTF-8 oriented framework
  // - just like TStringStream, is designed for appending data, not modifying
  // in-place, as requested e.g. by TJsonWriter or TBufferWriter classes
  TRawByteStringStream = class(TStreamWithPosition)
  protected
    fDataString: RawByteString;
    function GetSize: Int64; override;
    procedure SetSize(NewSize: Longint); override;
  public
    /// initialize the storage, optionally with some RawByteString content
    // - to be used for Read() from this memory buffer
    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;
    /// 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;
    /// retrieve the stored content from a given position, as UTF-8 text
    // - warning: may directly return DataString and reset its value to ''
    procedure GetAsText(StartPos, Len: PtrInt; var Text: RawUtf8);
    /// reset the internal DataString content and the current position
    procedure Clear;
      {$ifdef HASINLINE}inline;{$endif}
    /// direct low-level access to the internal RawByteString storage
    property DataString: RawByteString
      read fDataString write fDataString;
  end;

  /// TStream pointing to some existing 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;

/// raise a EStreamError exception - e.g. from TSynMemoryStream.Write
function RaiseStreamError(Caller: TObject; const Context: shortstring): PtrInt;


{ ************ Raw Shared Constants / Types Definitions }

  { some types defined here, but implemented in mormot.core.datetime or
    mormot.core.log, so that they may be used and identified by
    mormot.core.rtti or mormot.core.os }

type
  /// the available logging events, as handled by mormot.core.log
  // - defined in mormot.core.base so that it may be used by the core units,
  // even if mormot.core.log is not explicitely linked
  // - limited to 32 items, to efficiently fit in a 32-bit set
  // - 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 (in MB units)
  // - 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
  TSynLogLevel = (
    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 - stored as 32-bit
  // - e.g. use LOG_VERBOSE constant to log all events, or LOG_STACKTRACE
  // to log all errors and exceptions
  TSynLogLevels = set of TSynLogLevel;

  /// a dynamic array of logging event levels
  TSynLogLevelDynArray = array of TSynLogLevel;

  /// callback definition used to abstractly log some events
  // - defined as TMethod to avoid dependency with the mormot.core.log unit
  // - match class procedure TSynLog.DoLog
  // - used e.g. by global variables like WindowsServiceLog in mormot.core.os
  // or TCrtSocket.OnLog in mormot.net.sock
  TSynLogProc = procedure(Level: TSynLogLevel; const Fmt: RawUtf8;
     const Args: array of const; Instance: TObject = nil) of object;

{$ifndef PUREMORMOT2}
  TSynLogInfo  = TSynLogLevel;
  TSynLogInfos = TSynLogLevels;
  TSynLogInfoDynArray = TSynLogLevelDynArray;
{$endif PUREMORMOT2}

type
  /// fast bit-encoded date and time value
  // - see TTimeLog helper functions and types in mormot.core.datetime
  // - faster than Iso-8601 text and TDateTime, e.g. can be used as published
  // property field in mORMot's TOrm (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
  // - recognized e.g. by TDynArray JSON serialization
  TTimeLogDynArray = array of TTimeLog;

  /// 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;
  /// pointer to a dynamic array of TDateTimeMS values
  PDateTimeMSDynArray = ^TDateTimeMSDynArray;

  /// a 64-bit identifier, as used for our ORM primary key, i.e. TOrm.ID
  // - also maps the SQLite3 64-bit RowID definition
  TID = type Int64;
  /// a pointer to TOrm.ID, i.e. our ORM primary key
  PID = ^TID;
  /// used to store a dynamic array of ORM primary keys, i.e. TOrm.ID
  TIDDynArray = array of TID;
  /// pointer to a dynamic array of ORM primary keys, i.e. TOrm.ID
  PIDDynArray = ^TIDDynArray;

  /// timestamp stored as second-based Unix Time
  // - see Unix Time helper functions and types in mormot.core.datetime
  // - 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;
  /// pointer to a timestamp stored as second-based Unix Time
  PUnixTime = ^TUnixTime;
  /// dynamic array of timestamps stored as second-based Unix Time
  TUnixTimeDynArray = array of TUnixTime;

  /// timestamp stored as millisecond-based Unix Time
  // - see Unix Time helper functions and types in mormot.core.datetime
  // - 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 millisecond-based Unix Time
  PUnixMSTime = ^TUnixMSTime;
  /// dynamic array of timestamps stored as millisecond-based Unix Time
  TUnixMSTimeDynArray = array of TUnixMSTime;

const
  /// may be used to log as Trace or Warning event, depending on an Error: boolean
  LOG_TRACEWARNING: array[boolean] of TSynLogLevel = (
    sllTrace,
    sllWarning);


implementation

{$ifdef ISDELPHI20062007}
uses
  Windows; // circumvent unexpected warning about inlining (WTF!)
{$endif ISDELPHI20062007}

{$ifdef FPC}
  // globally disable some FPC paranoid warnings - rely on x86_64 as reference
  {$WARN 4056 off : Conversion between ordinals and pointers is not portable }
{$endif FPC}


{ ************ Common Types Used for Compatibility Between Compilers and CPU }

procedure VarClearAndSetType(var v: variant; vtype: integer);
begin
  if (TSynVarData(v).VType and VTYPE_STATIC) <> 0 then
    VarClearProc(TVarData(v));
  TSynVarData(v).VType := vtype;
end;

{$ifdef HASINLINE}
procedure VarClear(var v: variant); // defined here for proper inlining
begin
  if (TSynVarData(v).VType and VTYPE_STATIC) <> 0 then
    VarClearProc(TVarData(v))
  else
    TSynVarData(v).VType := 0;
end;
{$endif HASINLINE}

{$ifdef CPUARM}
function ToByte(value: cardinal): cardinal;
begin
  result := value and $ff;
end;
{$endif CPUARM}

{$ifdef CPUX86} // directly use the x87 FPU stack

procedure CurrencyToDouble(const c: currency; out d: double);
begin
  d := c;
end;

procedure CurrencyToDouble(c: PCurrency; out d: double);
begin
  d := c^;
end;

function CurrencyToDouble(c: PCurrency): double;
begin
  result := c^;
end;

procedure DoubleToCurrency(const d: double; out c: currency);
begin
  c := d;
end;

procedure DoubleToCurrency(const d: double; c: PCurrency);
begin
  c^ := d;
end;

function DoubleToCurrency(const d: double): currency;
begin
  result := d;
end;

{$else} // efficient inlined 64-bit integer version

procedure CurrencyToDouble(const c: currency; out d: double);
begin
  unaligned(d{%H-}) := PInt64(@c)^ / CURR_RES;
end;

procedure CurrencyToDouble(c: PCurrency; out d: double);
begin
  unaligned(d{%H-}) := PInt64(c)^ / CURR_RES;
end;

function CurrencyToDouble(c: PCurrency): double;
begin
  result := PInt64(c)^ / CURR_RES;
end;

procedure DoubleToCurrency(const d: double; out c: currency);
begin
  PInt64(@c)^ := trunc(d * CURR_RES);
end;

procedure DoubleToCurrency(const d: double; c: PCurrency);
begin
  PInt64(c)^ := trunc(d * CURR_RES);
end;

function DoubleToCurrency(const d: double): currency;
begin
  result := trunc(d * CURR_RES);
end;

{$endif CPUX86}

procedure CurrencyToInt64(c: PCurrency; var i: Int64);
begin
  i := PInt64(c)^ div CURR_RES;
end;

procedure CurrencyToVariant(const c: currency; var v: variant);
begin
  VarClearAndSetType(v, varCurrency);
  PVarData(@v).VCurrency := c;
end;

function SimpleRoundTo2Digits(Value: Currency): Currency;
begin
  SimpleRoundTo2DigitsCurr64(PInt64(@Value)^);
  result := Value;
end;

procedure SimpleRoundTo2DigitsCurr64(var Value: Int64);
var
  spare: PtrInt;
begin
  spare := Value mod 100;
  if spare <> 0 then
    if spare > 50 then
      {%H-}inc(Value, 100 - spare)
    else if spare < -50 then
      {%H-}dec(Value, 100 + spare)
    else
      dec(Value, spare);
end;

function TwoDigits(const d: double): TShort23;
var
  v: Int64;
  m, L: PtrInt;
  tmp: array[0..23] of AnsiChar;
  p: PAnsiChar;
begin
  v := trunc(d * CURR_RES);
  m := v mod 100;
  if m <> 0 then
    if m > 50 then
      {%H-}inc(v, 100 - m)
    else if m < -50 then
      {%H-}dec(v, 100 + m)
    else
      dec(v, m);
  p := {%H-}StrInt64(@tmp[23], v);
  L := @tmp[22] - p;
  m := PWord(@tmp[L - 2])^;
  if m = ord('0') or ord('0') shl 8 then
    // '300' -> '3'
    dec(L, 3)
  else
  begin
    // '301' -> '3.01'
    PWord(@tmp[L - 1])^ := m;
    tmp[L - 2] := '.';
  end;
  SetString(result, p, L);
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;

procedure Int64ToCurrency(const i: Int64; out c: currency);
begin
  PInt64(@c)^ := i * CURR_RES;
end;

procedure Int64ToCurrency(const i: Int64; c: PCurrency);
begin
  PInt64(c)^ := i * CURR_RES;
end;


function IsEqualGuid({$ifdef FPC_HAS_CONSTREF}constref{$else}const{$endif}
  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) {$ifdef CPU32} and
            (a[2] = 0) and
            (a[3] = 0) {$endif CPU32};
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;

procedure FillZero(var result: TGuid);
var
  d: TInt64Array absolute result;
begin
  d[0] := 0;
  d[1] := 0;
end;

function RandomGuid: TGuid;
begin
  RandomGuid(result);
end;

procedure RandomGuid(out result: TGuid);
begin // see https://datatracker.ietf.org/doc/html/rfc4122#section-4.4
  RandomBytes(@result, SizeOf(TGuid));
  PCardinal(@result.D3)^ := (PCardinal(@result.D3)^ and $ff3f0fff) + $00804000;
  // version bits 12-15 = 4 (random) and reserved bits 6-7 = 1
end;

function FastFindBinarySorted(P, Value: PByteArray; Size, R: PtrInt): PtrInt;
var
  L, s: PtrInt;
  v: PByteArray;
  cmp: integer;
begin
  Value := @Value[Size]; // adjust once for -Size below
  L := 0;
  if 0 <= R then
    repeat
      result := (L + R) shr 1;
      v := @P^[(result + 1) * Size]; // inlined sort-optimized MemCmp()
      s := -Size;
      repeat
        cmp := v[s] - Value[s];
        if cmp <> 0 then
          break; // first byte(s) differs most of the time on sorted data
        inc(s);
        if s = 0 then
          exit; // found whole Value[] bytes
      until false;
      {$ifdef CPUX86}
      if cmp < 0 then
        L := result + 1
      else
        R := result - 1;
      {$else}
      s := result - 1;
      inc(result);
      if cmp < 0 then // compile as 2 branchless cmovl/cmovge on FPC
        L := result
      else
        R := s;
      {$endif CPUX86}
    until L > R;
  result := -1
end;

function NextGrow(capacity: integer): integer;
begin
  // algorithm similar to TFPList.Expand for the increasing ranges
  result := capacity;
  if result < 8 then
    inc(result, 4) // faster for smaller capacity (called often)
  else if result <= 128 then
    inc(result, 16)           // increase by 16 bytes up to 128 bytes
  else if result < 8 shl 20 then
    inc(result, result shr 2) // increase by 25% up to 8MB
  else if result < 128 shl 20 then
    inc(result, result shr 3) // increase by 12.5% up to 128MB
  else
    inc(result, 16 shl 20);   // increase by 16MB chunks
end;

function NextPowerOfTwo(number: cardinal): cardinal;
begin // O(1) branchless algorithm for 32-bit values
  result := number - cardinal(number <> 0);
  result := result or (result shr 1);
  result := result or (result shr 2);
  result := result or (result shr 4);
  result := result or (result shr 8);
  result := (result or (result shr 16)) + 1;
end;

{$ifndef FPC_CPUX64} // dedicated asm on x86_64 only

procedure FastAssignNew(var d; s: pointer);
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
     StrCntDecFree(sr^.refcnt) then
    FreeMem(sr);
end;

procedure FastAssignNewNotVoid(var d; s: pointer);
var
  sr: PStrRec; // local copy to use register
begin
  sr := pointer(d);
  pointer(d) := s;
  dec(sr);
  if (sr^.refcnt >= 0) and
     StrCntDecFree(sr^.refcnt) then
    FreeMem(sr);
end;

{$endif FPC_CPUX64}

function FastNewString(len, codepage: PtrInt): PAnsiChar;
var
  rec: PStrRec;
begin
  result := nil;
  if len > 0 then
  begin
    {$ifdef FPC}
    rec := GetMem(len + (_STRRECSIZE + 4));
    result := PAnsiChar(rec) + _STRRECSIZE;
    {$else}
    GetMem(result, len + (_STRRECSIZE + 4));
    rec := pointer(result);
    inc(PStrRec(result));
    {$endif FPC}
    {$ifdef HASCODEPAGE} // also set elemSize := 1
    {$ifdef FPC}
    rec^.codePageElemSize := codepage + (1 shl 16);
    {$else}
    PCardinal(@rec^.codePage)^ := codepage + (1 shl 16);
    {$endif FPC}
    {$endif HASCODEPAGE}
    rec^.refCnt := 1;
    rec^.length := len;
    PCardinal(PAnsiChar(rec) + len + _STRRECSIZE)^ := 0; // ends with four #0
  end;
end;

{$ifdef HASCODEPAGE}

procedure EnsureRawUtf8(var s: RawByteString);
begin
  if s <> '' then
    with PStrRec(PAnsiChar(pointer(s)) - _STRRECSIZE)^ do
      if CodePage <> CP_UTF8 then
        if refCnt <> 1 then
          FastSetString(RawUtf8(s), pointer(s), length) // make copy
        else
          CodePage := CP_UTF8; // just replace in-place
end;

procedure EnsureRawUtf8(var s: RawUtf8);
begin
  EnsureRawUtf8(RawByteString(s));
end;

procedure FakeCodePage(var s: RawByteString; cp: cardinal);
var
  p: PAnsiChar;
begin
  p := pointer(s);
  if p <> nil then
    PStrRec(p - _STRRECSIZE)^.CodePage := cp;
end;

function GetCodePage(const s: RawByteString): cardinal;
begin
  result := PStrRec(PAnsiChar(pointer(s)) - _STRRECSIZE)^.CodePage;
end;

procedure FastAssignUtf8(var dest: RawUtf8; var src: RawByteString);
begin
  FakeCodePage(RawByteString(src), CP_UTF8);
  FastAssignNew(dest, pointer(src));
  pointer(src) := nil; // was assigned with no ref-counting involved
end;

{$else} // do nothing on Delphi 7-2007
procedure FakeCodePage(var s: RawByteString; cp: cardinal);
begin
end;
procedure EnsureRawUtf8(var s: RawByteString);
begin
end;
procedure EnsureRawUtf8(var s: RawUtf8);
begin
end;
procedure FastAssignUtf8(var dest: RawUtf8; var src: RawByteString);
begin
  FastAssignNew(dest, pointer(src));
  pointer(src) := nil; // was assigned with no ref-counting involved
end;
{$endif HASCODEPAGE}

function GetRefCount(const s: RawByteString): PtrInt;
begin
  result := PtrUInt(pointer(s));
  if result <> 0 then
    result := PStrCnt(PtrUInt(result) - _STRCNT)^;
end;

procedure FakeLength(var s: RawUtf8; len: PtrInt);
var
  p: PAnsiChar; // faster with a temp variable
begin
  p := pointer(s);
  p[len] := #0;
  PStrLen(p - _STRLEN)^ := len; // in-place SetLength()
end;

procedure FakeLength(var s: RawUtf8; endChar: PUtf8Char);
var
  p: PAnsiChar;
begin
  p := pointer(s);
  endChar^ := #0;
  PStrLen(p - _STRLEN)^ := endChar - p;
end;

procedure FakeLength(var s: RawByteString; len: PtrInt);
var
  p: PAnsiChar;
begin
  p := pointer(s);
  p[len] := #0;
  PStrLen(p - _STRLEN)^ := len; // in-place SetLength()
end;

procedure FakeSetLength(var s: RawUtf8; len: PtrInt);
begin
  if len <= 0 then
    FastAssignNew(s)
  else
    FakeLength(s, len);
end;

procedure FakeSetLength(var s: RawByteString; len: PtrInt);
begin
  if len <= 0 then
    FastAssignNew(s)
  else
    FakeLength(s, len);
end;

procedure FastSetStringCP(var s; p: pointer; len, codepage: PtrInt);
var
  r: pointer;
begin
  r := FastNewString(len, codepage);
  if (p <> nil) and
     (r <> nil) then
    MoveFast(p^, r^, len);
  if pointer(s) = nil then
    pointer(s) := r
  else
    FastAssignNewNotVoid(s, r);
end;

procedure FastSetString(var s: RawUtf8; p: pointer; len: PtrInt);
var
  r: pointer;
begin
  r := FastNewString(len, CP_UTF8); // FPC will do proper constant propagation
  if (p <> nil) and
     (r <> nil) then
    MoveFast(p^, r^, len);
  if pointer(s) = nil then
    pointer(s) := r
  else
    FastAssignNewNotVoid(s, r);
end;

procedure FastSetString(var s: RawUtf8; len: PtrInt);
var
  r: pointer;
begin
  r := FastNewString(len, CP_UTF8);
  if pointer(s) = nil then
    pointer(s) := r
  else
    FastAssignNewNotVoid(s, r);
end;

procedure FastSetRawByteString(var s: RawByteString; p: pointer; len: PtrInt);
var
  r: pointer;
begin
  r := FastNewString(len, CP_RAWBYTESTRING); // FPC does constant propagation
  if (p <> nil) and
     (r <> nil) then
    MoveFast(p^, r^, len);
  if pointer(s) = nil then
    pointer(s) := r
  else
    FastAssignNewNotVoid(s, r);
end;

procedure FastNewRawByteString(var s: RawByteString; len: PtrInt);
var
  r: pointer;
begin
  r := FastNewString(len, CP_RAWBYTESTRING);
  if pointer(s) = nil then
    pointer(s) := r
  else
    FastAssignNewNotVoid(s, r);
end;

{$ifdef HASVARUSTRING}
procedure FastSynUnicode(var s: SynUnicode; p: pointer; len: PtrInt);
var
  rec: PStrRec; // same header than AnsiString, but with elemSize=2
begin
  if pointer(s) <> nil then
    FastAssignNew(s); // works also for UnicodeString
  if len <= 0 then
    exit;
  len := len * 2; // from WideChar count to bytes
  GetMem(pointer(s), len + (_STRRECSIZE + 4));
  rec := pointer(s);
  rec^.codePage := CP_UTF16;
  rec^.elemSize := SizeOf(WideChar);
  rec^.refCnt := 1;
  rec^.length := len shr 1; // length as WideChar count
  inc(rec);
  pointer(s) := rec;
  PCardinal(PAnsiChar(rec) + len)^ := 0; // ends with two WideChar #0
  if p <> nil then
    MoveFast(p^, pointer(s)^, len);
end;
{$else}
procedure FastSynUnicode(var s: SynUnicode; p: pointer; len: PtrInt);
begin
  SetString(s, PWideChar(p), len); // use RTL for slow WideString
end;
{$endif HASVARUSTRING}

procedure GetMemAligned(var holder: RawByteString; fillwith: pointer;
  len: PtrUInt; out aligned: pointer; alignment: PtrUInt);
begin
  dec(alignment); // expected to be a power of two
  FastNewRawByteString(holder, len + alignment);
  aligned := pointer(holder);
  while PtrUInt(aligned) and alignment <> 0 do
    inc(PByte(aligned));
  if fillwith <> nil then
    MoveFast(fillwith^, aligned^, len);
end;

// CompareMemSmall/MoveByOne defined now for proper inlining below

// warning: Delphi has troubles inlining goto/label
function CompareMemSmall(P1, P2: pointer; Length: PtrInt): boolean;
var
  c: AnsiChar;
begin
  result := false;
  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
        exit;
      inc(Length);
    until Length = 0;
  result := true;
end;

procedure MoveByOne(Source, Dest: pointer; Count: PtrUInt);
var
  c: AnsiChar; // better code generation on FPC
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;

function UniqueRawUtf8(var u: RawUtf8): pointer;
begin
  {$ifdef FPC}
  UniqueString(u); // @u[1] won't call UniqueString() under FPC :(
  {$endif FPC}
  result := @u[1];
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 Ansi7StringToShortString(const source: RawUtf8; var result: ShortString);
begin
  SetString(result, PAnsiChar(pointer(source)), length(source));
end;

procedure AppendShortChar(chr: AnsiChar; dest: PAnsiChar);
begin
  if dest[0] = #255 then
    exit;
  inc(dest[0]);
  dest[ord(dest[0])] := chr;
end;

procedure AppendShortTwoChars(twochars, dest: PAnsiChar);
begin
  if dest[0] >= #254 then
    exit;
  PWord(dest + ord(dest[0]) + 1)^ := PWord(twochars)^;
  inc(dest[0], 2);
end;

procedure AppendShortBuffer(buf: PAnsiChar; len: PtrInt; dest: PAnsiChar);
begin
  if len + ord(dest[0]) > 255 then
    exit;
  MoveFast(buf^, dest[ord(dest[0]) + 1], len);
  inc(dest[0], len);
end;

procedure AppendShortAnsi7String(const buf: RawByteString; var dest: ShortString);
begin
  if buf <> '' then
    AppendShortBuffer(pointer(buf), PStrLen(PtrUInt(buf) - _STRLEN)^, @dest);
end;

procedure AppendShort(const src: ShortString; var dest: ShortString);
begin
  AppendShortBuffer(@src[1], ord(src[0]), @dest);
end;

procedure AppendShortTemp(value, temp: PAnsiChar; dest: PAnsiChar);
  {$ifdef HASINLINE} inline; {$endif}
begin
  AppendShortBuffer(value, temp - value, dest);
end;

const
  HexCharsUpper: array[0..15] of AnsiChar = '0123456789ABCDEF';
  HexCharsLower: array[0..15] of AnsiChar = '0123456789abcdef';

procedure AppendShortByteHex(value: byte; var dest: ShortString);
var
  len: PtrInt;
begin
  len := ord(dest[0]);
  if len >= 254 then
    exit;
  dest[len + 1] := HexCharsUpper[value shr 4];
  inc(len, 2);
  value := value and $0f;
  dest[len] := HexCharsUpper[value];
  dest[0] := AnsiChar(len);
end;

procedure AppendShortHex(value: PByte; len: PtrUInt; var dest: ShortString);
var
  dlen, v: PtrUInt;
  tab: PAnsiChar;
begin
  dlen := ord(dest[0]);
  if (len > 0) and
     (dlen + len * 2 < 254) then
  begin
    tab := @HexCharsLower;
    repeat
      v := value^;
      inc(value);
      dest[dlen + 1] := tab[v shr 4]; // hexadecimal output in natural order
      inc(dlen, 2);
      v := v and $0f;
      dest[dlen] := tab[v];
      dec(len);
    until len = 0;
  end;
  dest[0] := AnsiChar(dlen);
end;

procedure AppendShortIntHex(value: Int64; var dest: ShortString);
var
  tmp: array[0..23] of AnsiChar; // output in display/reversed order
  i: PtrInt;
  tab: PAnsiChar;
begin
  i := SizeOf(value) * 2;
  tab := @HexCharsLower;
  repeat
    tmp[i - 1] := tab[value and 15];
    value := value shr 4;
    tmp[i - 2] := tab[value and 15];
    dec(i, 2);
    if i = 0 then
      break;
    value := value shr 4;
  until value = 0; // truncate to significant digits
  AppendShortTemp(@tmp[i], @tmp[SizeOf(value) * 2], @dest);
end;

procedure AppendShortCardinal(value: cardinal; var dest: ShortString);
var
  tmp: array[0..23] of AnsiChar;
begin
  AppendShortTemp(StrUInt32(@tmp[23], value), @tmp[23], @dest);
end;

procedure AppendShortInt64(value: Int64; var dest: ShortString);
var
  tmp: array[0..23] of AnsiChar;
begin
  AppendShortTemp(StrInt64(@tmp[23], value), @tmp[23], @dest);
end;

procedure AppendShortQWord(value: QWord; var dest: ShortString);
var
  tmp: array[0..23] of AnsiChar;
begin
  AppendShortTemp(StrUInt64(@tmp[23], value), @tmp[23], @dest);
end;

procedure AppendBufferToUtf8(src: PUtf8Char; srclen: PtrInt; var dest: RawUtf8);
var
  n: PtrInt;
begin
  if srclen = 0 then
    exit;
  n := length(dest);
  SetLength(dest, n + srclen);
  MoveFast(src^, PByteArray(dest)[n], srclen);
end;

procedure AppendShortToUtf8(const src: ShortString; var dest: RawUtf8);
begin
  AppendBufferToUtf8(@src[1], ord(src[0]), dest);
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
  if Instance = nil then
    result := @NULCHAR // avoid GPF
  else
    result := PPointer(PPtrInt(Instance)^ + vmtClassName)^;
end;

procedure ClassToText(C: TClass; var result: RawUtf8);
var
  P: PShortString;
begin
  if C = nil then
    result := '' // avoid GPF
  else
  begin
    P := PPointer(PtrInt(PtrUInt(C)) + vmtClassName)^;
    FastSetString(result, @P^[1], ord(P^[0]));
  end;
end;

function ToText(C: TClass): RawUtf8;
begin
  ClassToText(C, result);
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 PropNameEquals(P1, P2: PAnsiChar; P1Len, P2Len: PtrInt): boolean;
label
  zero;
begin
  if P1Len <> P2Len then
    goto zero;
  P2Len := PtrInt(@PByteArray(P1)[P2Len - SizeOf(cardinal)]); // 32-bit end
  if P2Len >= 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(PCardinal(P1));
      inc(PCardinal(P2));
    until P2Len < PtrInt(PtrUInt(P1));
  inc(PCardinal(P2Len));
  dec(PtrUInt(P2), PtrUInt(P1));
  if PtrInt(PtrUInt(P1)) < P2Len then
    repeat
      if (PByte(P1)^ xor PByteArray(P2)[PtrUInt(P1)]) and $df <> 0 then
        goto zero;
      inc(PByte(P1));
    until PtrInt(PtrUInt(P1)) >= P2Len;
  result := true;
  exit;
zero:
  result := false;
end;

function PropNameEquals(P1, P2: PShortString): boolean;
begin
  result := PropNameEquals(@P1^[1], @P2^[1], ord(P1^[0]), ord(P2^[0]));
end;

function PropNameEquals(P1: PShortString; P2: PAnsiChar; P2Len: PtrInt): boolean;
begin
  result := PropNameEquals(@P1^[1], P2, ord(P1^[0]), P2Len);
end;

function PropNameEquals(const P1, P2: RawUtf8): boolean;
begin
  result := PropNameEquals(pointer(P1), pointer(P2), length(P1), length(P2));
end;

function PropNameEquals(const P1: RawUtf8; P2: PAnsiChar; P2Len: PtrInt): boolean;
begin
  result := PropNameEquals(pointer(P1), P2, length(P1), P2Len);
end;

function FindNonVoidRawUtf8(n: PPointerArray; name: pointer; len: TStrLen;
  count: PtrInt): PtrInt;
var
  p1, p2, l: PUtf8Char;
label
  no;
begin
  result := 0;
  p2 := name;
  repeat // inlined CompareMemFixed()
    p1 := n[result]; // all VName[]<>'' so p1<>nil
    if (PStrLen(p1 - _STRLEN)^ = len) and // same length
       (p1^ = p2^) then // we can safely compare the first char
    begin
      if len = 1 then
        exit;
      l := @p1[len - SizeOf(PtrInt)];
      inc(p1);
      inc(p2);
      dec(p2, PtrUInt(p1));
      while PtrUInt(l) >= PtrUInt(p1) do // compare 4/8 bytes per loop
        if PPtrInt(p1)^ <> PPtrInt(@p2[PtrUInt(p1)])^ then
          goto no
        else
          inc(PPtrInt(p1));
      inc(PPtrInt(l));
      while PtrUInt(p1) < PtrUInt(l) do  // remaining bytes
        if p1^ <> p2[PtrUInt(p1)] then
          goto no
        else
          inc(PByte(p1));
      exit; // match found
no:   p2 := name;
    end;
    inc(result);
    dec(count);
  until count = 0;
  result := -1;
end;

function FindNonVoidRawUtf8I(n: PPointerArray; name: pointer; len: TStrLen;
  count: PtrInt): PtrInt;
var
  p1, p2, l: PUtf8Char;
label
  no;
begin
  result := 0;
  p2 := name;
  repeat // inlined IdemPropNameUSameLenNotNull(p, name, len)
    p1 := n[result]; // all VName[]<>'' so p1<>nil
    if (PStrLen(p1 - _STRLEN)^ = len) and          // same length
       ((ord(p1^) xor ord(p2^)) and $df = 0) then  // same first char
    begin
      if len = 1 then
        exit;
      l := @p1[len - SizeOf(cardinal)];
      inc(p1);
      inc(p2);
      dec(p2, PtrUInt(p1));
      while PtrUInt(l) >= PtrUInt(p1) do  // compare 4 bytes per loop
        if (PCardinal(p1)^ xor PCardinal(@p2[PtrUInt(p1)])^) and $dfdfdfdf <> 0 then
          goto no
        else
          inc(PCardinal(p1));
      inc(PCardinal(l));
      while PtrUInt(p1) < PtrUInt(l) do   // remaining bytes
        if (ord(p1^) xor ord(p2[PtrUInt(p1)])) and $df <> 0 then
          goto no
        else
          inc(PByte(p1));
      exit; // match found
no:   p2 := name;
    end;
    inc(result);
    dec(count);
  until count = 0;
  result := -1;
end;

function FindPropName(Values: PRawUtf8Array; const Value: RawUtf8;
  ValuesCount: PtrInt): PtrInt;
begin
  if (Values <> nil) and
     (ValuesCount > 0) and
     (Value <> '') then
    result := FindNonVoidRawUtf8I(pointer(Values), pointer(Value),
      PStrLen(PAnsiChar(pointer(Value)) - _STRLEN)^, ValuesCount)
  else
    result := -1;
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 DateTimeToIsoString(dt: TDateTime): string;
begin
  // avoid to link mormot.core.datetime
  DateTimeToString(result, 'yyyy-mm-dd hh:nn:ss', dt);
end;

function Hex2Dec(c: AnsiChar): ShortInt; {$ifdef HASINLINE} inline; {$endif}
begin
  result := ord(c);
  case c of
    '#':
      result := 0; // handle # as 0 char within an hexadecimal buffer
    '0'..'9':
      dec(result, ord('0'));
    'A'..'Z':
      dec(result, ord('A') - 10);
    'a'..'z':
      dec(result, ord('a') - 10);
  else
    result := -1;
  end;
end;

function ParseHex0x(p: PAnsiChar): cardinal;
var
  v0, v1: integer;
begin
  result := 0;
  if p = nil then
    exit;
  while p^ <> 'x' do
    if p^ = #0 then
      exit
    else
      inc(p);
  repeat
    inc(p); // points to trailing 'x' at start
    v0 := Hex2Dec(p^);
    if v0 < 0 then
      break; // not in '0'..'9','a'..'f'
    inc(p);
    v1 := Hex2Dec(p^);
    if v1 < 0 then
    begin
      result := (result shl 4) or cardinal(v0); // only one char left
      break;
    end;
    result := (result shl 8) or (cardinal(v0) shl 4) or cardinal(v1);
  until false;
end;

function ParseHex(p: PAnsiChar; b: PByte; n: integer): PAnsiChar;
var
  v0, v1: integer;
begin
  repeat
    v0 := Hex2Dec(p^);
    if v0 < 0 then
      break; // not in '0'..'9','a'..'f'
    inc(p);
    v1 := Hex2Dec(p^);
    if v1 < 0 then
      break;
    inc(p);
    b^ := (v0 shl 4) or v1;
    inc(b);
    dec(n);
  until n = 0;
  result := p;
end;

procedure ToHumanHex(var result: RawUtf8; bin: PByte; len: integer; reverse: boolean);
var
  p: PAnsiChar;
  c: PtrInt;
  tab: PAnsichar;
begin
  if len <= 0 then
  begin
    result := '';
    exit;
  end;
  FastSetString(result, (len * 3) - 1);
  tab := @HexCharsLower;
  p := pointer(result);
  if reverse then
    inc(bin, len - 1);
  repeat
    c := bin^;
    p[0] := tab[c shr 4];
    c := c and 15;
    p[1] := tab[c];
    dec(len);
    if len = 0 then
      break;
    p[2] := ':'; // to please (most) human limited hexadecimal capabilities
    inc(p, 3);
    if reverse then
      dec(bin)
    else
      inc(bin);
  until false;
end;


{ TSynPersistent}

constructor TSynPersistent.Create;
begin // do nothing by default but may be overriden
end;

{ TInterfacedPersistent}

constructor TInterfacedPersistent.Create;
begin // do nothing by default but may be overriden
end;


{ ************ Numbers (floats and integers) Low-level Definitions }

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 GetBoolean(P: PUtf8Char): boolean;
begin
  result := (P <> nil) and
            (PInteger(P)^ <> FALSE_LOW) and
            ((PInteger(P)^ = TRUE_LOW) or
             ((PInteger(P)^ and $ffff) <> ord('0')));
end;

function GetBoolean(const value: RawUtf8): boolean;
begin
  result := GetBoolean(pointer(value));
end;

function GetTrue(P: PUtf8Char): integer;
begin
  result := PInteger(P)^ and $dfdfdfdf;
  if (result = ord('T') + ord('R') shl 8 + ord('U') shl 16 + ord('E') shl 24) or
     (result = ord('Y') + ord('E') shl 8 + ord('S') shl 16) then
    result := 1
  else
    result := 0;
end;

function GetInt64Bool(P: PUtf8Char; out V: Int64): boolean;
var
  err, c: integer;
begin
  result := P <> nil;
  if not result then
    exit;
  V := GetInt64(P, err);
  if err = 0 then
    exit;
  c := PInteger(P)^ and $dfdfdfdf;
  if (c = ord('F') + ord('A') shl 8 + ord('L') shl 16 + ord('S') shl 24) or
     (c and $ffffff = ord('N') + ord('O') shl 8) then
    V := 0
  else if (c = ord('T') + ord('R') shl 8 + ord('U') shl 16 + ord('E') shl 24) or
          (c = ord('Y') + ord('E') shl 8 + ord('S') shl 16) then
    V := 1
  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 GetCardinal(P, PEnd: PUtf8Char): PtrUInt;
var
  c: byte;
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;
  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 + 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;

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}
// PtrInt/PtrUInt are already Int64/QWord

procedure SetInt64(P: PUtf8Char; var result: Int64);
begin
  result := GetInteger(P);
end;

procedure SetQWord(P: PUtf8Char; var result: QWord);
begin
  result := GetCardinal(P);
end;

procedure SetQWord(P, PEnd: PUtf8Char; var result: QWord);
begin
  result := GetCardinal(P, PEnd);
end;

function GetInt64(P: PUtf8Char): Int64;
begin
  result := GetInteger(P);
end;

function GetInt64(P: PUtf8Char; var err: integer): Int64;
begin
  result := GetInteger(P, err);
end;

function StrUInt64(P: PAnsiChar; const val: QWord): PAnsiChar;
begin
  result := StrUInt32(P, val); // StrUInt32 converts PtrUInt=QWord on 64-bit CPU
end;

function StrInt64(P: PAnsiChar; const val: Int64): PAnsiChar;
begin
  result := StrInt32(P, val); // StrInt32 converts PtrInt=Int64 on 64-bit CPU
end;

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;
  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
end;

{$else}
// 32-bit dedicated code - use integer/cardinal as much as possible

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;

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;

procedure SetQWord(P, PEnd: PUtf8Char; var result: QWord);
var
  c: cardinal;
begin
  result := 0;
  if (P = nil) or
     (P >= PEnd) then
    exit;
  while P^ <= ' ' do
    if P = PEnd then
      exit
    else
      inc(P);
  if P^ = '+' then
    repeat
      inc(P);
      if P = PEnd then
        exit;
    until P^ <> ' ';
  c := byte(P^) - 48;
  if c > 9 then
    exit;
  PCardinal(@result)^ := c;
  inc(P);
  repeat // fast 32-bit loop
    if P = PEnd then
      break;
    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
        if P = PEnd then
          exit;
        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;

function GetInt64(P: PUtf8Char): Int64;
begin
  SetInt64(P, result);
end;

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 CPU32DELPHI}
          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;

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;
  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 CPU32DELPHI}
          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;
end;

function StrUInt64(P: PAnsiChar; const val: QWord): PAnsiChar;
var
  c, c100: QWord;
  {$ifdef CPUX86NOTPIC}
  tab: TWordArray absolute TwoDigitLookupW;
  {$else}
  tab: PWordArray;
  {$endif CPUX86NOTPIC}
begin
  if PCardinalArray(@val)^[1] = 0 then
    P := StrUInt32(P, PCardinal(@val)^)
  else
  begin
    {$ifndef CPUX86NOTPIC}
    tab := @TwoDigitLookupW;
    {$endif CPUX86NOTPIC}
    c := val;
    repeat
      {$ifdef CPUX86}
      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;
      {$else}
      c100 := c div 100;   // one div by two digits
      dec(c, c100 * 100);  // fast c := c mod 100
      {$endif CPUX86}
      dec(P, 2);
      PWord(P)^ := tab[c];
      c := c100;
      if (PCardinalArray(@c)^[1] = 0) then
      begin
        if PCardinal(@c)^ <> 0 then
          P := StrUInt32(P, PCardinal(@c)^);
        break;
      end;
    until false;
  end;
  result := P;
end;

function StrInt64(P: PAnsiChar; const val: Int64): PAnsiChar;
begin
  if val < 0 then
  begin
    P := StrUInt64(P, -val) - 1;
    P^ := '-';
  end
  else
    P := StrUInt64(P, val);
  result := P;
end;

{$endif CPU64}

function GetExtended(P: PUtf8Char): TSynExtended;
var
  err: integer;
begin
  result := GetExtended(P, err);
  if err <> 0 then
    result := 0;
end;

function HugePower10Pos(exponent: PtrInt; pow10: PPow10): TSynExtended;
begin
  result := pow10[(exponent and not 31) shr 5 + 34] * pow10[exponent and 31];
end;

function HugePower10Neg(exponent: PtrInt; pow10: PPow10): TSynExtended;
begin
  exponent := -exponent;
  result := pow10[(exponent and not 31) shr 5 + 45] / pow10[exponent and 31];
end;

{$ifndef CPU32DELPHI}

function GetExtended(P: PUtf8Char; out err: integer): TSynExtended;
var
  remdigit: integer;
  frac, exp: PtrInt;
  c: AnsiChar;
  flags: set of (fNeg, fNegExp, fValid);
  v64: Int64; // allows 64-bit resolution for the digits (match 80-bit extended)
label
  e;
begin
  byte(flags) := 0;
  v64 := 0;
  frac := 0;
  if P = nil then
    goto e; // will return 0 but err=1
  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;
  remdigit := 19; // max Int64 resolution
  repeat
    inc(P);
    if (c >= '0') and
       (c <= '9') then
    begin
      dec(remdigit);
      if remdigit >= 0 then // over-required digits are just ignored
      begin
        dec(c, ord('0'));
        {$ifdef CPU64}
        v64 := v64 * 10;
        {$else}
        v64 := v64 shl 3 + v64 + v64;
        {$endif CPU64}
        inc(v64, byte(c));
        c := P^;
        include(flags, fValid);
        if frac <> 0 then
          dec(frac); // digits after '.'
        continue;
      end;
      if frac >= 0 then
        inc(frac); // handle #############00000
      c := P^;
      continue;
    end;
    if c <> '.' then
      break;
    if frac > 0 then
      goto e; // will return partial value but err=1
    dec(frac);
    c := P^;
  until false;
  if frac < 0 then
    inc(frac); // adjust digits after '.'
  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);
    if (frac <= -324) or
       (frac >= 308) then
    begin
      frac := 0;
      goto e; // limit to 5.0 x 10^-324 .. 1.7 x 10^308 double range
    end;
  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
  exp := PtrUInt(@POW10);
  if frac >= -31 then
    if frac <= 31 then
      result := PPow10(exp)[frac] // -31 .. + 31
    else
      result := HugePower10Pos(frac, PPow10(exp)) // +32 ..
  else
    result := HugePower10Neg(frac, PPow10(exp));  // .. -32
  if fNeg in flags then
    result := result * PPow10(exp)[33]; // * -1
  result := result * v64;
end;

{$endif CPU32DELPHI}

function Utf8ToInteger(const value: RawUtf8; Default: PtrInt): PtrInt;
var
  err: integer;
begin
  result := GetInteger(pointer(value), err);
  if err <> 0 then
    result := Default;
end;

function Utf8ToInteger(const value: RawUtf8; min, max, default: PtrInt): 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
  v, err: integer;
begin
  v := GetInteger(pointer(text), err);
  result := err = 0;
  if result then
    value := v;
end;

function ToCardinal(const text: RawUtf8; out value: cardinal; minimal: cardinal): boolean;
var
  v: cardinal;
begin
  v := GetCardinalDef(pointer(text), cardinal(-1));
  result := (v <> cardinal(-1)) and
            (v >= minimal);
  if result then
    value := v;
end;

function ToInt64(const text: RawUtf8; out value: Int64): boolean;
var
  err: integer;
  v: Int64;
begin
  v := GetInt64(pointer(text), err);
  result := err = 0;
  if result then
    value := v;
end;

function ToDouble(const text: RawUtf8; out value: double): boolean;
var
  err: integer;
  v: double;
begin
  v := GetExtended(pointer(text), err);
  result := err = 0;
  if result then
    value := v;
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;


{ ************ integer arrays manipulation }

function IsZero(const Values: TIntegerDynArray): boolean;
var
  i: PtrInt;
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: PtrInt;
begin
  result := false;
  for i := 0 to length(Values) - 1 do
    if Values[i] <> 0 then
      exit;
  result := true;
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 CompareInteger(const A, B: integer): 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;

function ComparePtrInt(const A, B: PtrInt): integer;
begin
  result := ord(A > B) - ord(A < B);
end;

function ComparePointer(const A, B: pointer): integer;
begin
  result := ord(PtrUInt(A) > PtrUInt(B)) - ord(PtrUInt(A) < PtrUInt(B));
end;

{$ifdef FPC_OR_UNICODE} // recent compilers are able to generate correct code

function CompareInt64(const A, B: Int64): integer;
begin
  result := ord(A > B) - ord(A < B);
end;

function CompareQword(const A, B: QWord): integer;
begin
  result := ord(A > B) - ord(A < B);
end;

{$else}

function CompareInt64(const A, B: Int64): integer;
begin
  // Delphi x86 compiler is not efficient at compiling Int64 comparisons
  result := SortDynArrayInt64(A, B);
end;

function CompareQword(const A, B: QWord): integer;
begin
  // Delphi x86 compiler is not efficient, and oldest even incorrect
  result := SortDynArrayQWord(A, B);
end;

{$endif FPC_OR_UNICODE}

function MinPtrInt(const A, B: PtrInt): PtrInt;
begin
  result := A;
  if B < A then
    result := B;
end;

function MaxPtrInt(const A, B: PtrInt): PtrInt;
begin
  result := A;
  if B > A then
    result := B;
end;

function MinPtrUInt(const A, B: PtrUInt): PtrUInt;
begin
  result := A;
  if B < A then
    result := B;
end;

function MaxPtrUInt(const A, B: PtrUInt): PtrUInt;
begin
  result := A;
  if B > A then
    result := B;
end;

function Int64ScanExists(P: PInt64Array; Count: PtrInt; const Value: Int64): boolean;
begin
  if P <> nil then
  begin
    result := true;
    Count := PtrUInt(@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;
      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 := PtrUInt(@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;
    inc(result);
  until false;
  result := nil;
end;

function Int64ScanIndex(P: PInt64Array; Count: PtrInt; const Value: Int64): PtrInt;
begin
  result := PtrUInt(Int64Scan(P, Count, Value));
  if result = 0 then
    dec(result)
  else
  begin
    dec(result, PtrUInt(P));
    result := result shr 3;
  end;
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;

{$ifdef CPU64}
// PtrInt = Int64 and PtrUInt = QWord

function PtrUIntScan(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): pointer;
begin
  result := Int64Scan(pointer(P), Count, Value);
end;

function PtrUIntScanExists(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): boolean;
begin
  result := Int64ScanExists(pointer(P), Count, Value);
end;

function PtrUIntScanIndex(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): PtrInt;
begin
  result := Int64ScanIndex(pointer(P), Count, Value);
end;

procedure QuickSortPtrInt(P: PPtrIntArray; L, R: PtrInt);
begin
  QuickSortInt64(PInt64Array(P), L, R);
end;

procedure QuickSortPointer(P: PPointerArray; L, R: PtrInt);
begin
  QuickSortInt64(PInt64Array(P), L, R);
end;

function FastFindPtrIntSorted(P: PPtrIntArray; R: PtrInt; Value: PtrInt): PtrInt;
begin
  result := FastFindInt64Sorted(PInt64Array(P), R, Value);
end;

function FastFindPointerSorted(P: PPointerArray; R: PtrInt; Value: pointer): PtrInt;
begin
  result := FastFindInt64Sorted(PInt64Array(P), R, Int64(Value));
end;

{$else}
// PtrInt = integer and PtrUInt = cardinal

function PtrUIntScan(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): pointer;
begin
  result := IntegerScan(pointer(P), Count, Value);
end;

function PtrUIntScanExists(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): boolean;
begin
  result := IntegerScanExists(pointer(P), Count, Value);
end;

function PtrUIntScanIndex(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): PtrInt;
begin
  result := IntegerScanIndex(pointer(P), Count, Value);
end;

procedure QuickSortPtrInt(P: PPtrIntArray; L, R: PtrInt);
begin
  QuickSortInteger(PIntegerArray(P), L, R);
end;

procedure QuickSortPointer(P: PPointerArray; L, R: PtrInt);
begin
  QuickSortInteger(PIntegerArray(P), L, R);
end;

function FastFindPtrIntSorted(P: PPtrIntArray; R: PtrInt; Value: PtrInt): PtrInt;
begin
  result := FastFindIntegerSorted(PIntegerArray(P), R, Value);
end;

function FastFindPointerSorted(P: PPointerArray; R: PtrInt; Value: pointer): PtrInt;
begin
  result := FastFindIntegerSorted(PIntegerArray(P), R, integer(Value));
end;

{$endif CPU64}

procedure DynArrayFakeLength(arr: pointer; len: TDALen);
begin
  PDALen(PAnsiChar(arr) - _DALEN)^ := len - _DAOFF;
end;

procedure DynArrayFakeDelete(var Values; Index, Last, ValueSize: PtrUInt);
var
  p: PAnsiChar;
begin // ensured (Last > 0) and (Index <= Last) and made Finalize(Values[Index])
  DynArrayFakeLength(pointer(Values), Last); // dec(length) in header no realloc
  dec(Last, Index);
  if Last = 0 then
    exit; // nothing to move
  p := PAnsiChar(Values) + Index * ValueSize;
  MoveFast(p[ValueSize], p[0], Last * ValueSize);
end;

{$ifdef FPC} // some FPC-specific low-level code due to diverse compiler or RTL

// redirect to FPC compilerproc - maybe patched by mormot.core.rtti.fpc.inc
procedure FastStringAddRef(str: pointer); external name 'FPC_ANSISTR_INCR_REF';
procedure FastStringDecRef(str: pointer); external name 'FPC_ANSISTR_DECR_REF';

function TDynArrayRec.GetLength: TDALen;
begin
  result := high + 1;
end;

procedure TDynArrayRec.SetLength(len: TDALen);
begin
  high := len - 1;
end;

procedure Div100(Y: cardinal; var res: TDiv100Rec); // Delphi=asm, FPC=inlined
var
  Y100: cardinal;
begin
  Y100 := Y div 100; // FPC will use fast reciprocal
  res.D := Y100;
  res.M := Y {%H-}- Y100 * 100; // avoid div twice
end;

{$else}

procedure FastStringDecRef(str: pointer);
begin
  if str = nil then
    exit;
  dec(PStrRec(str));
  if (PStrRec(str)^.refCnt >= 0) and
     StrCntDecFree(PStrRec(str)^.refCnt) then
    Freemem(str); // works for both rkLString + rkUString
end;

{$endif FPC}

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;

function AddPtrUInt(var Values: TPtrUIntDynArray;
  var ValuesCount: integer; Value: PtrUInt): PtrInt;
begin
  result := ValuesCount;
  if result = Length(Values) then
    SetLength(Values, NextGrow(result));
  Values[result] := Value;
  inc(ValuesCount);
end;

procedure AddInt64Sorted(var Values: TInt64DynArray; Value: Int64);
var
  last: PtrInt;
begin
  last := high(Values);
  if FastFindInt64Sorted(pointer(Values), last, Value) >= 0 then
    exit; // found
  inc(last);
  SetLength(Values, last + 1);
  Values[last] := Value;
  QuickSortInt64(pointer(Values), 0, last);
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 UnmanagedDynArrayUnique(var old: PDynArrayRec; ItemSize: TDALen);
var
  new: PDynArrayRec;
  n: PtrInt;
begin
  dec(old);
  dec(old^.refCnt);
  n := (old^.length * ItemSize) + SizeOf(new^);
  new := AllocMem(n);
  MoveFast(old^, new^, n); // copy header + all ordinal values
  new^.refCnt := 1;
  inc(new);
  old := new; // replace
end;

procedure UnmanagedDynArrayDelete(var v; Count, Index, ItemSize: PtrUInt);
var
  p: PAnsiChar;
begin
  dec(Count, Index);
  if Count = 0 then
    exit; // no data to move
  if PDACnt(PAnsiChar(v) - _DACNT)^ > 1 then
    UnmanagedDynArrayUnique(PDynArrayRec(v), ItemSize);
  p := PAnsiChar(v) + Index * ItemSize;
  MoveFast(p[ItemSize], p[0], Count * ItemSize);
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);
  UnmanagedDynArrayDelete(Values, n, Index, SizeOf(Values[0]));
  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);
  UnmanagedDynArrayDelete(Values, n, Index, SizeOf(Values[0]));
  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);
  ValuesCount := n;
  UnmanagedDynArrayDelete(Values, n, Index, SizeOf(Values[0]));
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);
  UnmanagedDynArrayDelete(Values, n, Index, SizeOf(Values[0]));
  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);
  ValuesCount := n;
  UnmanagedDynArrayDelete(Values, n, Index, SizeOf(Values[0]));
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 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 // use recursion only for smaller range
      begin
        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 // use recursion only for smaller range
      begin
        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 // use recursion only for smaller range
      begin
        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 CPU64}
        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 // use recursion only for smaller range
      begin
        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 CompareQWord(ID[i], ID[p]) < 0 do
          inc(i);
        while CompareQWord(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 CPUX86}
        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 // use recursion only for smaller range
      begin
        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 QuickSortDouble(ID: PDoubleArray; L, R: PtrInt);
var
  i, j, p: PtrInt;
  tmp: double;
begin
  if L < R then
    repeat
      i := L;
      j := R;
      p := (L + R) shr 1;
      repeat
        tmp := ID[p];
        while ID[i] < tmp do
          inc(i);
        while ID[j] > tmp do
          dec(j);
        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 // use recursion only for smaller range
      begin
        if L < j then
          QuickSortDouble(ID, L, j);
        L := i;
      end
      else
      begin
        if i < R then
          QuickSortDouble(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 CPU64}
        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 // use recursion only for smaller range
      begin
        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;

function FastFindIntegerSorted(const Values: TIntegerDynArray; Value: integer): PtrInt;
begin
  result := FastFindIntegerSorted(pointer(Values), Length(Values) - 1, Value);
end;

{$ifndef CPUX64} // x86_64 has fast branchless asm for those functions

function FastFindWordSorted(P: PWordArray; R: PtrInt; Value: Word): PtrInt;
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
      else if cmp < 0 then
        L := result + 1
      else
        R := result - 1;
    until L > R;
  result := -1
end;

function FastFindIntegerSorted(P: PIntegerArray; R: PtrInt; Value: integer): PtrInt;
var
  L: PtrInt;
  v: integer;
begin
  L := 0;
  if 0 <= R then
    repeat
      result := (L + R) shr 1;
      v := P^[result];
      if v = Value then
        exit
      else if v < Value then
        L := result + 1
      else
        R := result - 1;
    until L > R;
  result := -1
end;

function FastFindInt64Sorted(P: PInt64Array; R: PtrInt; const Value: Int64): PtrInt;
var
  L: PtrInt;
  cmp: integer;
begin
  L := 0;
  if 0 <= R then
    repeat
      result := (L + R) shr 1;
      cmp := CompareInt64(P^[result], Value);
      if cmp = 0 then
        exit
      else if cmp < 0 then
        L := result + 1
      else
        R := result - 1;
    until L > R;
  result := -1
end;

{$endif CPUX64}

function FastFindQWordSorted(P: PQWordArray; R: PtrInt; const Value: QWord): PtrInt;
var
  L: PtrInt;
  cmp: integer;
begin
  L := 0;
  if 0 <= R then
    repeat
      result := (L + R) shr 1;
      cmp := CompareQWord(P^[result], Value);
      if cmp = 0 then
        exit
      else if cmp < 0 then
        L := result + 1
      else
        R := result - 1;
    until L > R;
  result := -1
end;

function FastLocateIntegerSorted(P: PIntegerArray; R: PtrInt; Value: integer): PtrInt;
var
  L {$ifndef CPUX86}, ll, rr{$endif CPUX86}: PtrInt;
  cmp: integer;
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;
      {$ifdef CPUX86}   // less registers on good old i386 target
      if cmp < 0 then
        L := result + 1
      else
        R := result - 1;
      {$else}
      rr := result + 1; // compile as 2 branchless cmovl/cmovge on FPC
      ll := result - 1;
      if cmp < 0 then
        L := rr
      else
        R := ll;
      {$endif CPUX86}
    until L > R;
    while (result >= 0) and
          (P^[result] >= Value) do
      dec(result);
    inc(result); // return the index where to insert
  end;
end;

function FastSearchIntegerSorted(P: PIntegerArray; R: PtrInt; Value: integer): PtrInt;
var
  L {$ifndef CPUX86}, ll, rr{$endif CPUX86}: PtrInt;
  cmp: integer;
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
        exit; // return exact matching index
      {$ifdef CPUX86}
      if cmp < 0 then
        L := result + 1
      else
        R := result - 1;
      {$else}
      rr := result + 1; // compile as 2 branchless cmovl/cmovge on FPC
      ll := result - 1;
      if cmp < 0 then
        L := rr
      else
        R := ll;
      {$endif CPUX86}
    until L > R;
    while (result >= 0) and
          (P^[result] >= Value) do
      dec(result);
    inc(result); // return the index where to insert
  end;
end;

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);
    inc(result); // 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 and return -(foundindex+1)
    result := InsertInteger(Values, ValuesCount, Value, result, CoValues);
end;

function AddSortedInteger(var Values: TIntegerDynArray; Value: integer;
  CoValues: PIntegerDynArray): PtrInt;
var
  n: integer; // not PtrInt
begin
  n := Length(Values);
  result := FastLocateIntegerSorted(pointer(Values), n - 1, Value);
  if result < 0 then
    exit; // Value exists -> fails and return -(foundindex+1)
  SetLength(Values, n + 1); // manual size increase
  result := InsertInteger(Values, n, Value, result, CoValues);
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 Exception.CreateFmt('TIntegerDynArrayFrom64: Values[%d]=%d>%d',
          [i, Values[i], MaxInt])
      else
        result[i] := MaxInt
    else if Values[i] < MinInt then
      if raiseExceptionOnOverflow then
        raise Exception.CreateFmt('TIntegerDynArrayFrom64: Values[%d]=%d<%d',
          [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 gcd(a, b: PtrUInt): PtrUInt;
begin
  result := 0;
  if a <> 0 then
    while b <> 0 do
    begin
      result := b;
      b := a mod b;
      a := result;
    end;
end;


{ TSortedWordArray }

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 TSortedWordArray.SetArray(out aValues: TWordDynArray);
begin
  if Count = 0 then
    exit;
  DynArrayFakeLength(pointer(Values), Count); // no realloc needed
  aValues := Values;
end;


{ TSortedIntegerArray }

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;

procedure TSortedIntegerArray.SetArray(out aValues: TIntegerDynArray);
begin
  if Count = 0 then
    exit;
  DynArrayFakeLength(pointer(Values), Count); // no realloc needed
  aValues := Values;
end;


{ ************ ObjArray PtrArray InterfaceArray Wrapper Functions }

{ PtrArr* wrapper functions }

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 PtrArrayAdd(var aPtrArray; aItem: pointer; var aPtrArrayCount: integer): PtrInt;
var
  a: TPointerDynArray absolute aPtrArray;
begin
  result := aPtrArrayCount;
  if result = length(a) then
    SetLength(a, NextGrow(result));
  a[result] := aItem;
  inc(aPtrArrayCount);
end;

function PtrArrayAddOnce(var aPtrArray; aItem: pointer): PtrInt;
var
  a: TPointerDynArray absolute aPtrArray;
  n: PtrInt;
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;

function PtrArrayAddOnce(var aPtrArray; aItem: pointer;
  var aPtrArrayCount: integer): PtrInt;
begin
  result := PtrUIntScanIndex(pointer(aPtrArray), aPtrArrayCount, PtrUInt(aItem));
  if result < 0 then
    result := PtrArrayAdd(aPtrArray, aItem, aPtrArrayCount);
end;

function PtrArrayAddFrom(var aDestArray; const aSourceArray): PtrInt;
var
  n: PtrInt;
  s: TPointerDynArray absolute aSourceArray;
  d: TPointerDynArray absolute aDestArray;
begin
  result := length(d);
  n := length(s);
  SetLength(d, result + n);
  MoveFast(s[0], d[result], n * SizeOf(pointer));
  inc(result, n);
end;

function PtrArrayAddOnceFrom(var aDestArray; const aSourceArray): PtrInt;
var
  n, i: PtrInt;
  s: TPointerDynArray absolute aSourceArray;
  d: TPointerDynArray absolute aDestArray;
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;
  SetLength(d, result);
end;

function PtrArrayInsert(var aPtrArray; aItem: pointer; aIndex: PtrInt;
  var aPtrArrayCount: integer): PtrInt;
var
  a: TPointerDynArray absolute aPtrArray;
  n: PtrInt;
begin
  n := aPtrArrayCount;
  if length(a) = n then
    SetLength(a, NextGrow(n));
  if PtrUInt(aIndex) < PtrUInt(n) then
    MoveFast(a[aIndex], a[aIndex + 1], (n - aIndex) * SizeOf(pointer))
  else
    aIndex := n;
  a[aIndex] := aItem;
  inc(aPtrArrayCount);
  result := aIndex;
end;

procedure PtrArrayDelete(var aPtrArray; aIndex: PtrInt; aCount: PInteger;
  aKind: TPtrArrayKind);
var
  a: TPointerDynArray absolute aPtrArray;
  v: PPointerArray;
  n: PtrInt;
begin
  if aCount = nil then
    n := length(a)
  else
    n := aCount^;
  if PtrUInt(aIndex) >= PtrUInt(n) then
    exit; // out of range
  v := @a[aIndex];
  case aKind of
    pakPointer:
      ; // nothing to release (faster if explicit)
    pakClass:
      TObject(v^[0]).Free;
    pakClassSafe:
      FreeAndNilSafe(v^[0]);
    pakInterface:
      IInterface(v^[0])._Release;
    pakInterfaceSafe:
      InterfaceNilSafe(v^[0]);
  end;
  dec(n);
  if n > aIndex then
    MoveFast(v^[1], v^[0], (n - aIndex) * SizeOf(pointer));
  a[n] := nil; // better safe than sorry
  if aCount = nil then
    if (n and 127 <> 0) then // call ReallocMem() once every 128 deletions
      DynArrayFakeLength(pointer(a), n)
    else
      SetLength(a, n) // ReallocMem() or finalize if n = 0
  else
  begin
    aCount^ := n; // no ReallocMem()
    if n = 0 then
      Finalize(a);
  end;
end;

function PtrArrayDelete(var aPtrArray; aItem: pointer; aCount: PInteger;
  aKind: TPtrArrayKind): PtrInt;
var
  a: TPointerDynArray absolute aPtrArray;
  n: PtrInt;
begin
  if aCount = nil then
    n := length(a)
  else
    n := aCount^;
  result := PtrUIntScanIndex(pointer(a), n, PtrUInt(aItem));
  if result >= 0 then
    PtrArrayDelete(aPtrArray, result, aCount, aKind);
end;

function PtrArrayFind(var aPtrArray; aItem: pointer): integer;
var
  a: TPointerDynArray absolute aPtrArray;
begin
  result := PtrUIntScanIndex(pointer(a), length(a), PtrUInt(aItem));
end;

function PtrArrayNotNilCount(const aPtrArray): integer;
var
  i: PtrInt;
  a: TPointerDynArray absolute aPtrArray;
begin
  result := 0;
  for i := 0 to length(a) - 1 do
    inc(result, ord(a[i] <> nil));
end;


{ wrapper functions to T*ObjArr types }

function ObjArrayAdd(var aObjArray; aItem: TObject): PtrInt;
begin
  result := PtrArrayAdd(aObjArray, aItem);
end;

function ObjArrayAddCount(var aObjArray; aItem: TObject; var aObjArrayCount: integer): PtrInt;
begin
  result := PtrArrayAdd(aObjArray, aItem, aObjArrayCount);
end;

function ObjArrayAddFrom(var aDestObjArray; const aSourceObjArray): PtrInt;
begin
  result := PtrArrayAddFrom(aDestObjArray, aSourceObjArray);
end;

function ObjArrayAppend(var aDestObjArray, aSourceObjArray): PtrInt;
begin
  result := ObjArrayAddFrom(aDestObjArray, aSourceObjArray);
  TObjectDynArray(aSourceObjArray) := nil; // aSourceObjArray[] changed ownership
end;

function ObjArrayAddOnce(var aObjArray; aItem: TObject): PtrInt;
begin
  result := PtrArrayAddOnce(aObjArray, aItem);
end;

function ObjArrayAddOnce(var aObjArray; aItem: TObject;
  var aObjArrayCount: integer): PtrInt;
begin
  result := PtrArrayAddOnce(aObjArray, aItem, aObjArrayCount);
end;

function ObjArrayAddOnceFrom(var aDestObjArray; const aSourceObjArray): PtrInt;
begin
  result := PtrArrayAddOnceFrom(aDestObjArray, aSourceObjArray);
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 ObjArrayNotNilCount(const aObjArray): integer;
begin
  result := PtrArrayNotNilCount(aObjArray);
end;

procedure ObjArrayDelete(var aObjArray; aItemIndex: PtrInt;
  const aContinueOnException: boolean; aCount: PInteger);
var
  pak: TPtrArrayKind;
begin
  if aContinueOnException then
    pak := pakClassSafe
  else
    pak := pakClass;
  PtrArrayDelete(aObjArray, aItemIndex, aCount, pak);
end;

function ObjArrayDelete(var aObjArray; aItem: TObject): PtrInt;
var
  a: TObjectDynArray absolute aObjArray;
begin
  result := PtrUIntScanIndex(pointer(a), length(a), PtrUInt(aItem));
  if result >= 0 then
    PtrArrayDelete(a, result, nil, pakClass);
end;

function ObjArrayDelete(var aObjArray; var aCount: integer; aItem: TObject): PtrInt;
begin
  result := PtrArrayDelete(aObjArray, aItem, @aCount, pakClass);
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 FreeAndNilSafe(var aObj);
begin
  if TObject(aObj) = nil then
    exit;
  try // slower but paranoidically safe
    TObject(aObj).Destroy;
  except
  end;
  TObject(aObj) := nil; // we could do it AFTER destroy
end;

procedure InterfaceNilSafe(var aInterface);
begin
  if IInterface(aInterface) <> nil then
    try // slower but paranoidically safe
      IInterface(aInterface) := nil;
    except
      pointer(aInterface) := nil; // force variable to nil
    end;
end;

procedure InterfacesNilSafe(const aInterfaces: array of pointer);
var
  i: PtrInt;
begin
  for i := 0 to high(aInterfaces) do
    InterfaceNilSafe(aInterfaces[i]^);
end;

procedure ObjArrayClear(var aObjArray);
var
  a: TObjectDynArray absolute aObjArray;
begin
  if a = nil then
    exit;
  // release all owned TObject instances
  RawObjectsClear(pointer(aObjArray), PDALen(PAnsiChar(a) - _DALEN)^ + _DAOFF);
  // release the dynamic array itself
  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
  begin
    i := 0;
    while i < n do
      try
        while i < n do
        begin
          a[i].Free;
          inc(i);
        end;
      except
        inc(i); // just catch exception and go to next instance
      end;
  end
  else
    RawObjectsClear(pointer(a), n);
  a := nil; // finalize the dynamic array itself
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;

function ObjArrayPrepareCopy(const SourceObjArray; var DestObjArray;
  SourceCount, DestCount: PInteger): PtrInt;
var
  s: TPointerDynArray absolute SourceObjArray;
  d: TPointerDynArray absolute DestObjArray;
  sc, dc, dn: PtrInt;
begin
  sc := length(s);  // sc = s[] capacity
  result := sc;     // result = s[] length
  if SourceCount <> nil then
    result := SourceCount^;
  dc := length(d);  // dc = d[] capacity
  dn := dc;         // dn = d[] length
  if DestCount <> nil then
    dn := DestCount^;
  if dn <> 0 then
    RawObjectsClear(pointer(d), dn);
  if DestCount <> nil then
    DestCount^ := result;
  if result = 0 then
    d := nil // ensure d[] is void
  else if dc < result then // we can not reuse existing d[]
  begin
    if dc <> 0 then
      d := nil; // full allocate - no need to move existing pointers
    SetLength(d, result);
  end
  else if DestCount = nil then
    DynArrayFakeLength(pointer(d), result); // d[] capacity = count
end;


{ wrapper functions to array of interface types }

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;

function InterfaceArrayAddCount(var aInterfaceArray; var aCount: integer;
  const aItem: IUnknown): PtrInt;
var
  a: TInterfaceDynArray absolute aInterfaceArray;
begin
  result := aCount;
  if result = length(a) then
    SetLength(a, NextGrow(result));
  a[result] := aItem;
  inc(aCount);
end;

procedure InterfaceArrayAddOnce(var aInterfaceArray; const aItem: IUnknown);
begin
  if not PtrUIntScanExists(pointer(aInterfaceArray),
      length(TInterfaceDynArray(aInterfaceArray)), PtrUInt(aItem)) then
    InterfaceArrayAdd(aInterfaceArray, 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;
  const aContinueOnException: boolean; aCount: PInteger);
var
  pak: TPtrArrayKind;
begin
  if aContinueOnException then
    pak := pakInterfaceSafe
  else
    pak := pakInterface;
  PtrArrayDelete(aInterfaceArray, aItemIndex, aCount, pak);
end;

function InterfaceArrayDelete(var aInterfaceArray; const aItem: IUnknown): PtrInt;
begin
  result := PtrArrayDelete(aInterfaceArray, pointer(aItem), nil, pakInterface);
end;



{ ************ low-level types mapping binary structures }

function IsZero(const dig: THash128): boolean;
var
  a: TPtrIntArray absolute dig;
begin
  result := a[0] or a[1] {$ifdef CPU32} 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]) {$ifdef CPU32} 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;

{$ifdef CPU64}

function Hash128Index(P: PHash128Rec; Count: integer; h: PHash128Rec): integer;
var
  _0, _1: PtrInt; // is likely to use CPU registers
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;

function Hash256Index(P: PHash256Rec; Count: integer; h: PHash256Rec): integer;
var
  _0, _1: PtrInt;
begin
  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}

function Hash128Index(P: PHash128Rec; Count: integer; h: PHash128Rec): integer;
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) then
        exit
      else
        inc(P);
  result := -1; // not found
end;

function Hash256Index(P: PHash256Rec; Count: integer; h: PHash256Rec): integer;
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}

function AddHash128(var Arr: THash128DynArray; const V: THash128;
  var Count: integer): PtrInt;
begin
  result := Count;
  if result = length(Arr) then
    SetLength(Arr, NextGrow(result));
  Arr[result] := V;
  inc(Count);
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;

function IsZero(const dig: THash256): boolean;
var
  a: TPtrIntArray absolute dig;
begin
  result := a[0] or a[1] or a[2] or a[3] {$ifdef CPU32} 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]) {$ifdef CPU32}  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;

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] {$ifdef CPU32} 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]) {$ifdef CPU32} 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] {$ifdef CPU32}
    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]) {$ifdef CPU32} 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;

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;

{$ifdef ISDELPHI} // intrinsic in FPC
{$ifdef CPUINTEL}
procedure ReadBarrier;
asm
        {$ifdef CPUX86}
        lock add dword ptr [esp], 0
        {$else}
        .noframe
        lfence // lfence requires an SSE CPU, which is OK on x86-64
        {$endif CPUX86}
end;
{$else}
procedure ReadBarrier;
begin
  MemoryBarrier; // modern Delphi intrinsic
end;
{$endif CPUINTEL}
{$endif ISDELPHI}

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
      MoveByOne(@src, @dst, len); // per-byte inlined copy
      ReadBarrier;
    until CompareMemSmall(@src, @dst, len);
end;


{ ************ low-level functions manipulating bits }

// naive code gives the best performance - bts [Bits] has an overhead
// we tried with PPtrIntArray but PIntegerArray seems to generate better code

function GetBit(const Bits; aIndex: PtrInt): boolean;
begin
  result := TIntegerArray(Bits)[aIndex shr 5] and (1 shl (aIndex and 31)) <> 0;
end;

procedure SetBit(var Bits; aIndex: PtrInt);
begin
  TIntegerArray(Bits)[aIndex shr 5] :=
    TIntegerArray(Bits)[aIndex shr 5] or (1 shl (aIndex and 31));
end;

procedure UnSetBit(var Bits; aIndex: PtrInt);
begin
  PIntegerArray(@Bits)^[aIndex shr 5] :=
    PIntegerArray(@Bits)^[aIndex shr 5] and not (1 shl (aIndex and 31));
end;

function GetBitPtr(Bits: pointer; aIndex: PtrInt): boolean;
begin
  result := PIntegerArray(Bits)[aIndex shr 5] and (1 shl (aIndex and 31)) <> 0;
end;

procedure SetBitPtr(Bits: pointer; aIndex: PtrInt);
begin
  PIntegerArray(Bits)[aIndex shr 5] :=
    PIntegerArray(Bits)[aIndex shr 5] or (1 shl (aIndex and 31));
end;

function TrySetBitPtr(Bits: pointer; aIndex: cardinal): boolean;
begin
  Bits := @PCardinalArray(Bits)[aIndex shr 5];
  aIndex := 1 shl (aIndex and 31);
  if PCardinal(Bits)^ and aIndex = 0 then
  begin
    PCardinal(Bits)^ := PCardinal(Bits)^ or aIndex; // set
    result := true;     // first time seen
  end
  else
    result := false; // already seen
end;

procedure UnSetBitPtr(Bits: pointer; aIndex: PtrInt);
begin
  PIntegerArray(Bits)^[aIndex shr 5] :=
    PIntegerArray(Bits)^[aIndex shr 5] and not (1 shl (aIndex and 31));
end;

function GetBit64(const Bits: Int64; aIndex: PtrInt): boolean;
begin
  result := byte(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;

function GetAllBits(Bits, BitCount: cardinal): boolean;
begin
  if (BitCount >= low(ALLBITS_CARDINAL)) and
     (BitCount <= high(ALLBITS_CARDINAL)) then
  begin
    BitCount := ALLBITS_CARDINAL[BitCount];
    result := (Bits and BitCount) = BitCount;
  end
  else
    result := false;
end;

function BitsToBytes(bits: byte): byte;
begin
  result := (bits + 7) shr 3;
end;


{ ************ Faster alternative to RTL standard functions }

{$ifndef CPUX86} // those functions have their own PIC-compatible x86 asm version

function StrLenSafe(S: pointer): PtrInt;
begin
  result := PtrUInt(S);
  if S <> nil then
    repeat
      if PAnsiChar(result)[0] <> #0 then
        if PAnsiChar(result)[1] <> #0 then
          if PAnsiChar(result)[2] <> #0 then
            if PAnsiChar(result)[3] <> #0 then
            begin
              inc(result, 4);
              continue;
            end
            else
            begin
              dec(result, PtrUInt(S) - 3);
              exit;
            end
          else
          begin
            dec(result, PtrUInt(S) - 2);
            exit;
          end
        else
          dec(PtrUInt(S));
      dec(result, PtrUInt(S));
      exit;
    until false;
end;

function StrComp(Str1, Str2: pointer): PtrInt;
var
  c: byte;
begin
  result := 0;
  if Str1 <> nil then
    if Str2 <> nil then
    begin
      dec(PtrUInt(Str1), PtrUInt(Str2));
      if Str1 = nil then
        exit; // Str1=Str2
      repeat
        c := PByteArray(Str1)[PtrUInt(Str2)];
        if c <> PByte(Str2)^ then
          break
        else if c = 0 then
          exit // Str1 = Str2
        else
          inc(PByte(Str2));
      until false;
      result := PByteArray(Str1)[PtrUInt(Str2)] - PByte(Str2)^;
      exit;
    end
    else
      inc(result) // Str2=''
  else if Str2 <> nil then
    dec(result);  // Str1=''
end;

// from A. Sharahov's PosEx_Sha_Pas_2() - refactored for cross-platform/compiler
function PosExPas(sub, p: PUtf8Char; offset: PtrUInt): PtrInt;
var
  len, lenSub: PtrInt;
  ch: AnsiChar;
  start, stop: PUtf8Char;
label
  s2, s6, tt, t0, t1, t2, t3, t4, s0, s1, fnd, quit;
begin
  result := 0;
  if (p = nil) or
     (sub = nil) or
     (PtrInt(offset) <= 0) then
    goto quit;
  len := PStrLen(p - _STRLEN)^;
  lenSub := PStrLen(sub - _STRLEN)^ - 1;
  if (len < lenSub + PtrInt(offset)) or
     (lenSub < 0) then
    goto quit;
  stop := p + len;
  inc(p, lenSub);
  inc(sub, lenSub);
  start := p;
  p := @p[offset + 3];
  ch := sub[0];
  lenSub := -lenSub;
  if p < stop then
    goto s6;
  dec(p, 4);
  goto s2;
s6: // check 6 chars per loop iteration
  if ch = p[-4] then
    goto t4;
  if ch = p[-3] then
    goto t3;
  if ch = p[-2] then
    goto t2;
  if ch = p[-1] then
    goto t1;
s2:if ch = p[0] then
    goto t0;
s1:if ch = p[1] then
    goto tt;
s0:inc(p, 6);
  if p < stop then
    goto s6;
  dec(p, 4);
  if p >= stop then
    goto quit;
  goto s2;
t4:dec(p, 2);
t2:dec(p, 2);
  goto t0;
t3:dec(p, 2);
t1:dec(p, 2);
tt:len := lenSub;
  if lenSub <> 0 then
    repeat
      if (sub[len] <> p[len + 1]) or
         (sub[len + 1] <> p[len + 2]) then
        goto s0;
      inc(len, 2);
    until len >= 0;
  inc(p, 2);
  if p <= stop then
    goto fnd;
  goto quit;
t0:len := lenSub;
  if lenSub <> 0 then
    repeat
      if (sub[len] <> p[len]) or
         (sub[len + 1] <> p[len + 1]) then
        goto s1;
      inc(len, 2);
    until len >= 0;
  inc(p);
fnd:
  result := p - start;
quit:
end;

function PosEx(const SubStr, S: RawUtf8; Offset: PtrUInt): PtrInt;
begin
  result := PosExPas(pointer(SubStr), pointer(S), Offset); // inlined call
end;

{$endif CPUX86}

function StrCompW(Str1, Str2: PWideChar): PtrInt;
var
  c: word;
begin
  result := 0;
  if Str1 <> Str2 then
    if Str1 <> nil then
      if Str2 <> nil then
      begin
        repeat
          c := PWord(Str1)^;
          if c <> PWord(Str2)^ then
            break
          else if c = 0 then
            exit; // Str1 = Str2
          inc(Str1);
          inc(Str2);
        until false;
        result := PWord(Str1)^ - PWord(Str2)^;
      end
      else
        inc(result) // Str2=''
    else
      dec(result);  // Str1=''
end;

function PosExChar(Chr: AnsiChar; const Str: RawUtf8): PtrInt;
begin
  if Str <> '' then
    result := ByteScanIndex(pointer(Str), PStrLen(PtrUInt(Str) - _STRLEN)^, byte(Chr)) + 1
  else
    result := 0;
end;

function PosChar(Str: PUtf8Char; StrLen: PtrInt; Chr: AnsiChar): PUtf8Char;
begin
  if StrLen <> 0 then
  begin
    StrLen := ByteScanIndex(pointer(Str), StrLen, byte(Chr));
    if StrLen >= 0 then
      result := Str + StrLen
    else
      result := nil;
  end
  else
    result := nil;
end;

{$ifdef UNICODE}

function PosExString(const SubStr, S: string; Offset: PtrUInt): PtrInt;
begin
  result := PosExStringPas(pointer(SubStr), pointer(S), Offset);
end;

function PosExStringPas(sub, p: PChar; offset: PtrUInt): PtrInt;
var
  len, lenSub: PtrInt;
  ch: char;
  start, stop: PChar;
label
  Loop2, Loop6, TestT, Test0, Test1, Test2, Test3, Test4,
  AfterTestT, AfterTest0, Ret, Exit;
begin
  result := 0;
  if (p = nil) or
     (sub = nil) or
     (PtrInt(offset) <= 0) then
    goto Exit;
  len := PStrLen(PtrUInt(p) - _STRLEN)^;
  lenSub := PStrLen(PtrUInt(sub) - _STRLEN)^ - 1;
  if (len < lenSub + PtrInt(offset)) or
     (lenSub < 0) then
    goto Exit;
  stop := p + len;
  inc(p, lenSub);
  inc(sub, lenSub);
  start := p;
  inc(p, offset + 3);
  ch := sub[0];
  lenSub := -lenSub;
  if p < stop 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 < stop then
    goto Loop6;
  dec(p, 4);
  if p >= stop 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 (sub[len] <> p[len + 1]) or
         (sub[len + 1] <> p[len + 2]) then
        goto AfterTestT;
      inc(len, 2);
    until len >= 0;
  inc(p, 2);
  if p <= stop then
    goto Ret;
  goto Exit;
Test0:
  len := lenSub;
  if lenSub <> 0 then
    repeat
      if (sub[len] <> p[len]) or
         (sub[len + 1] <> p[len + 1]) then
        goto AfterTest0;
      inc(len, 2);
    until len >= 0;
  inc(p);
Ret:
  result := p - start;
Exit:
end;

{$else}

function PosExString(const SubStr, S: string; Offset: PtrUInt): PtrInt;
begin
  {$ifdef CPUX86}
  result := PosEx(SubStr, S, Offset); // call x86 asm
  {$else}
  result := PosExPas(pointer(SubStr), pointer(S), Offset);
  {$endif CPUX86}
end;

{$endif UNICODE}

function TrimU(const S: RawUtf8): RawUtf8;
var
  i, len: PtrInt;
begin
  len := Length(S);
  i := 1;
  while (i <= len) and
        (S[i] <= ' ') do
    inc(i);
  if i > len then
    FastAssignNew(result) // void string
  else if (i = 1) and
          (S[len] > ' ') then
    result := S // nothing to trim: reference counted copy
  else
  begin
    while S[len] <= ' ' do
      dec(len);
    dec(i);
    FastSetString(result, @PByteArray(S)[i], len - i); // trim and allocate
  end;
end;

procedure TrimSelf(var S: RawUtf8);
var
  i, len: PtrInt;
begin
  if S = '' then
    exit;
  len := PStrLen(PAnsiChar(pointer(S)) - _STRLEN)^;
  i := 1;
  while (i <= len) and
        (S[i] <= ' ') do
    inc(i);
  if i > len then
    FastAssignNew(S) // void string
  else if (i = 1) and
          (S[len] > ' ') then
    exit // nothing to trim
  else
  begin
    // trim the UTF-8 string
    while S[len] <= ' ' do
      dec(len);
    dec(i);
    dec(len, i);
    if (len <> 0) and
       (PStrCnt(PAnsiChar(pointer(S)) - _STRCNT)^ = 1) then
    begin
      if i <> 0 then
        MoveFast(PByteArray(S)[i], pointer(S)^, len); // trim left: move in place
      FakeLength(S, len); // after move, to properly set ending #0
    end
    else
      FastSetString(S, @PByteArray(S)[i], len); // allocate
  end;
end;

{$ifndef PUREMORMOT2}
function Trim(const S: RawUtf8): RawUtf8;
begin
  result := TrimU(S);
end;
{$endif PUREMORMOT2}

procedure TrimCopy(const S: RawUtf8; start, count: PtrInt;
  var result: RawUtf8); // faster alternative to TrimU(copy())
var
  len: PtrInt;
begin
  if count > 0 then
  begin
    if start <= 0 then
      start := 1;
    len := Length(S);
    while (start <= len) and
          (S[start] <= ' ') do
    begin
      inc(start);
      dec(count);
    end;
    dec(start);
    dec(len,start);
    if count < len then
      len := count;
    while len > 0 do
      if S[start + len] <= ' ' then
        dec(len)
      else
        break;
    if len > 0 then
    begin
      FastSetString(result, @PByteArray(S)[start], len);
      exit;
    end;
  end;
  result := '';
end;

function Split(const Str, SepStr: RawUtf8; StartPos: PtrInt): RawUtf8;
var
  len, i: PtrInt;
begin
  len := length(Str);
  if len = 0 then
  begin
    result := '';
    exit;
  end;
  if StartPos > len then
    StartPos := len
  else if StartPos <= 0 then
    StartPos := 1;
  if (length(SepStr) = 1) and
     (StartPos <= 1) then
    i := PosExChar(SepStr[1], Str) // may use SSE2 on i386/x86_64
  else
    i := PosEx(SepStr, Str, StartPos);
  if i > 0 then
    FastSetString(result, @PByteArray(Str)[StartPos - 1], i - StartPos)
  else if StartPos = 1 then
    result := Str
  else
    FastSetString(result, @PByteArray(Str)[StartPos - 1], len - StartPos + 1);
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 GotoNextControlChar(source: PUtf8Char): PUtf8Char;
label
  _1, _2, _3; // ugly but faster
begin
  result := source;
  repeat
    if result[0] < #13 then
      exit
    else if result[1] < #13 then
      goto _1
    else if result[2] < #13 then
      goto _2
    else if result[3] < #13 then
      goto _3
    else
    begin
      inc(result, 4);
      continue;
    end;
_3: inc(result);
_2: inc(result);
_1: inc(result);
    exit;
  until false;
end;

function GotoNextLine(source: PUtf8Char): PUtf8Char;
label
  _0, _1, _2, _3; // ugly but faster
begin
  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: if source[0] = #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 source[0] = #0 then
    begin
      result := nil; // premature ending
      exit;
    end
    else if source[0] <> #10 then
    begin
      inc(source);
      continue; // e.g. #9
    end;
    result := source + 1;
    exit;
  until false;
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
        // 7-bit chars are always OK, whatever codepage/charset is used
        inc(PC)
      else
        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-bit chars are always OK, whatever codepage/charset is used
        exit;
  result := true;
end;

function IsAnsiCompatibleW(PW: PWideChar; Len: PtrInt): boolean;
begin
  result := false;
  if (PW <> nil) and
     (Len > 0) then
    repeat
      if ord(PW^) > 127 then
        exit;
      inc(PW);
      dec(Len);
    until Len = 0;
  result := true;
end;

procedure StrCntAdd(var refcnt: TStrCnt; increment: TStrCnt);
begin
  {$ifdef STRCNT32}
  LockedAdd32(cardinal(refcnt), increment);
  {$else}
  LockedAdd(PtrUInt(refcnt), increment);
  {$endif STRCNT32}
end;

procedure DACntAdd(var refcnt: TDACnt; increment: TDACnt);
begin
  {$ifdef DACNT32}
  LockedAdd32(cardinal(refcnt), increment);
  {$else}
  LockedAdd(PtrUInt(refcnt), increment);
  {$endif DACNT32}
end;

procedure FillZero(var dest; count: PtrInt);
begin
  FillCharFast(dest, count, 0);
end;

procedure MoveAndZero(Source, Dest: pointer; Count: PtrUInt);
begin
  if Count = 0 then
    exit;
  MoveFast(Source^, Dest^, Count);
  FillCharFast(Source^, Count, 0);
end;

procedure FillZeroSmall(P: pointer; Length: PtrInt);
begin
  inc(PtrUInt(P), PtrUInt(Length));
  Length := -Length;
  repeat
    PByteArray(P)[Length] := 0;
    inc(Length);
  until Length = 0;
end;

threadvar // do not publish for compilation within Delphi packages
  _Lecuyer: TLecuyer; // uses only 16 bytes per thread

function Lecuyer: PLecuyer;
begin
  result := @_Lecuyer;
end;

{$ifdef OSDARWIN} // FPC CreateGuid calls /dev/urandom which is not advised
function mach_absolute_time: Int64;   cdecl external 'c';
function mach_continuous_time: Int64; cdecl external 'c';

procedure CreateGuid(var guid: TGuid); // sysutils version is slow
begin
  PInt64Array(@guid)^[0] := mach_absolute_time;  // monotonic time (in ns)
  PInt64Array(@guid)^[1] := mach_continuous_time;
  crc128c(@guid, SizeOf(guid), THash128(guid)); // good enough diffusion
end;
{$endif OSDARWIN}

var
  // cascaded 128-bit random to avoid replay attacks - shared by all threads
  _EntropyGlobal: THash128Rec;

procedure XorEntropy(var e: THash512Rec);
var
  lec: PLecuyer;
  guid: THash128Rec;
begin
  // note: we don't use RTL Random() here because it is not thread-safe
  if _EntropyGlobal.L = 0 then
    sysutils.CreateGuid(_EntropyGlobal.guid); // slow but rich initial value
  e.r[0].L := e.r[0].L xor _EntropyGlobal.L;
  e.r[0].H := e.r[0].H xor _EntropyGlobal.H;
  lec := @_Lecuyer; // lec^.rs#=0 at thread startup, but won't hurt
  e.r[1].c0 := e.r[1].c0 xor lec^.RawNext; // perfect forward security
  e.r[1].c1 := e.r[1].c1 xor lec^.RawNext; // but don't expose rs1,rs2,rs3
  e.r[1].c2 := e.r[1].c2 xor lec^.RawNext;
  // any threadvar is thread-specific, so PtrUInt(lec) identifies this thread
  {$ifdef CPUINTELARM}
  e.r[1].c3 := e.r[1].c3 xor crc32c(PtrUInt(lec), @CpuFeatures, SizeOf(CpuFeatures));
  {$else}
  e.r[1].c3 := e.r[1].c3 xor PtrUInt(lec);
  {$endif CPUINTELARM}
  // Windows CoCreateGuid, Linux /proc/sys/kernel/random/uuid, FreeBSD syscall,
  // then fallback to /dev/urandom or RTL mtwist_u32rand
  CreateGuid(guid.guid); // not from sysutils: redefined above for OSDARWIN
  e.r[2].L := e.r[2].L xor guid.L;
  e.r[2].H := e.r[2].H xor guid.H;
  // no mormot.core.os yet, so we can't use QueryPerformanceMicroSeconds()
  unaligned(PDouble(@e.r[3].Lo)^) := Now * 2123923447; // cross-platform time
  {$ifdef CPUINTEL} // use low-level Intel/AMD opcodes
  e.r[3].Lo := e.r[3].Lo xor Rdtsc;
  RdRand32(@e.r[0].c, length(e.r[0].c));
  e.r[3].Hi := e.r[3].Hi xor Rdtsc; // has slightly changed in-between
  {$else}
  {$ifdef OSDARWIN} // fallback to known OS API on Mac M1/M2
  e.r[3].Lo := e.r[3].Lo xor mach_absolute_time; // as defined above
  e.r[3].Hi := e.r[3].Hi xor mach_continuous_time;
  {$endif OSDARWIN}
  e.r[3].Hi := e.r[3].Hi xor GetTickCount64; // always defined in FPC RTL
  {$endif CPUINTEL}
  crc128c(@e, SizeOf(e), _EntropyGlobal.b); // simple diffusion to move forward
end;

function bswap16(a: cardinal): cardinal; // inlining is good enough
begin
  result := ((a and 255) shl 8) or (a shr 8);
end;

procedure MoveSwap(dst, src: PByte; n: PtrInt);
begin
  if n <= 0 then
    exit;
  inc(dst, n);
  repeat
    dec(dst);
    dst^ := src^;
    inc(src);
    dec(n);
  until n = 0;
end;

procedure TLecuyer.Seed(entropy: PByteArray; entropylen: PtrInt);
var
  e: THash512Rec;
  h: THash128Rec;
  i, j: PtrInt;
begin
  if entropy <> nil then
    for i := 0 to entropylen - 1 do
    begin
      j := i and (SizeOf(e) - 1); // insert into the 64 bytes of e.b[]
      e.b[j] := {%H-}e.b[j] xor entropy^[i];
    end;
  repeat
    XorEntropy(e); // 512-bit from RdRand32 + Rdtsc + Now + CreateGuid
    DefaultHasher128(@h, @e, SizeOf(e)); // may be AesNiHash128
    rs1 := rs1 xor h.c0;
    rs2 := rs2 xor h.c1;
    rs3 := rs3 xor h.c2;
  until (rs1 > 1) and
        (rs2 > 7) and
        (rs3 > 15);
  seedcount := h.c3 shr 24; // may seed slightly before 2^32 of output data
  for i := 1 to h.i3 and 7 do
    RawNext; // warm up
end;

procedure TLecuyer.SeedGenerator(fixedseed: QWord);
begin
  SeedGenerator(@fixedseed, SizeOf(fixedseed));
end;

procedure TLecuyer.SeedGenerator(fixedseed: pointer; fixedseedbytes: integer);
begin
  rs1 := crc32c(0,   fixedseed, fixedseedbytes);
  rs2 := crc32c(rs1, fixedseed, fixedseedbytes);
  rs3 := crc32c(rs2, fixedseed, fixedseedbytes);
  if rs1 < 2 then
    rs1 := 2;
  if rs2 < 8 then
    rs2 := 8;
  if rs3 < 16 then
    rs3 := 16;
  seedcount := 1; // will reseed after 16 GB, i.e. 2^32 of output data
end;

function TLecuyer.RawNext: cardinal;
begin // not inlined for better code generation
  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: cardinal;
begin
  if seedcount = 0 then
    Seed // seed at startup, and after 2^32 of output data = 16 GB
  else
    inc(seedcount);
  result := RawNext;
end;

function TLecuyer.Next(max: cardinal): cardinal;
begin
  result := (QWord(Next) * max) shr 32;
end;

function TLecuyer.NextQWord: QWord;
begin
  PQWordRec(@result)^.L := Next;
  PQWordRec(@result)^.H := RawNext; // no need to check the Seed twice
end;

function TLecuyer.NextDouble: double;
const
  COEFF32: double = 1.0 / (Int64(1) shl 32);
begin
  result := Next * COEFF32; // 32-bit resolution is enough for our purpose
end;

procedure TLecuyer.Fill(dest: pointer; bytes: integer);
var
  c: cardinal;
begin
  if bytes <= 0 then
    exit;
  c := seedcount;
  inc(seedcount, cardinal(bytes) shr 2);
  if (c = 0) or           // first use = seed at startup
     (c > seedcount) then // check for 32-bit overflow, i.e. after 16 GB
    Seed;
  repeat
    if bytes < 4 then
      break;
    PCardinal(dest)^ := PCardinal(dest)^ xor RawNext; // inlining won't change
    inc(PCardinal(dest));
    dec(bytes, 4);
    if bytes = 0 then
      exit;
  until false;
  c := RawNext;
  repeat
    PByte(dest)^ := PByte(dest)^ xor c;
    inc(PByte(dest));
    c := c shr 8;
    dec(bytes);
  until bytes = 0;
end;

procedure FillAnsiStringFromRandom(dest: PByteArray; size: PtrUInt);
var
  len: PtrUInt;
begin
  dec(size);
  len := dest[0];  // first random byte will make length
  if size = 31 then
    size := len and 31 // optimized for FillShort31()
  else if size = 255 then
    size := ToByte(len)
  else
    size := len mod size;
  dest[0] := size;
  if size <> 0 then
    repeat
      dest[size] := (cardinal(dest[size]) and 63) + 32;
      dec(size);
    until size = 0;
end;

procedure TLecuyer.FillShort(var dest: ShortString; size: PtrUInt);
begin
  if size = 0 then
  begin
    dest[0] := #0;
    exit;
  end;
  if size > 255 then
    size := 256
  else
    inc(size);
  Fill(@dest, size);
  FillAnsiStringFromRandom(@dest, size);
end;

procedure TLecuyer.FillShort31(var dest: TShort31);
begin
  Fill(@dest, 32);
  FillAnsiStringFromRandom(@dest, 32);
end;

procedure Random32Seed(entropy: pointer; entropylen: PtrInt);
begin
  _Lecuyer.Seed(entropy, entropylen);
end;

function Random32: cardinal;
begin
  result := _Lecuyer.Next;
end;

function Random32Not0: cardinal;
begin
  with _Lecuyer do
    repeat
      result := Next;
    until result <> 0;
end;

function Random31: integer;
begin
  result := _Lecuyer.Next shr 1;
end;

function Random31Not0: integer;
begin
  with _Lecuyer do
    repeat
      result := Next shr 1;
    until result <> 0;
end;

function Random32(max: cardinal): cardinal;
begin
  result := (QWord(_Lecuyer.Next) * max) shr 32;
end;

function Random64: QWord;
begin
  result := _Lecuyer.NextQWord;
end;

function RandomDouble: double;
begin
  result := _Lecuyer.NextDouble;
end;

procedure RandomBytes(Dest: PByte; Count: integer);
begin
  if Count > 0 then
    _Lecuyer.Fill(pointer(Dest), Count);
end;

procedure RandomShort31(var dest: TShort31);
begin
  _Lecuyer.FillShort31(dest);
end;

procedure LecuyerEncrypt(key: Qword; var data: RawByteString);
var
  gen: TLecuyer;
begin
  if data = '' then
    exit;
  {$ifdef FPC}
  UniqueString(data); // @data[1] won't call UniqueString() under FPC :(
  {$endif FPC}
  gen.SeedGenerator(key);
  gen.Fill(@data[1], length(data));
  FillZero(THash128(gen)); // to avoid forensic leak
end;

{$ifndef PUREMORMOT2}
procedure FillRandom(Dest: PCardinal; CardinalCount: integer);
begin
  if CardinalCount > 0 then
    _Lecuyer.Fill(pointer(Dest), CardinalCount shl 2);
end;
{$endif PUREMORMOT2}


{ MultiEvent* functions }

function MultiEventFind(const EventList; const Event: TMethod): PtrInt;
var
  events: TMethodDynArray absolute EventList;
  e: PMethod;
begin
  e := pointer(events);
  if Event.Code <> nil then // callback assigned
    for result := 0 to length(events) - 1 do
      if (e^.Code = Event.Code) and
         (e^.Data = Event.Data) then
        exit
      else
        inc(e);
  result := -1;
end;

function MultiEventAdd(var EventList; const Event: TMethod): boolean;
var
  events: TMethodDynArray absolute EventList;
  n: PtrInt;
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: PtrInt);
var
  events: TMethodDynArray absolute EventList;
  max: PtrUInt;
begin
  max := length(events);
  if PtrUInt(Index) < max then
    exit;
  dec(max);
  if max = 0 then
    events := nil
  else
    DynArrayFakeDelete(events, Index, max, SizeOf(TMethod));
end;

procedure MultiEventMerge(var DestList; const ToBeAddedList);
var
  dst: TMethodDynArray absolute DestList;
  new: TMethodDynArray absolute ToBeAddedList;
  d, n: PtrInt;
begin
  d := length(dst);
  n := length(new);
  if n = 0 then
    exit;
  SetLength(dst, d + n);
  MoveFast(new[0], dst[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;


type
  // 16KB/32KB hash table used by SynLZ - as used by the asm .inc files
  TOffsets = array[0..4095] of PAnsiChar;

{$ifdef CPUINTEL}

// optimized asm for x86 and x86_64 is located in include files

{$ifndef HASNOSSE2}

function IntegerScan(P: PCardinalArray; Count: PtrInt; Value: cardinal): PCardinal;
begin
  Count := IntegerScanIndex(P, Count, Value); // SSE2 asm on Intel/AMD
  if Count >= 0 then
    result := @P[Count]
  else
    result := nil;
end;

function IntegerScanExists(P: PCardinalArray; Count: PtrInt; Value: cardinal): boolean;
begin
  result := IntegerScanIndex(P, Count, Value) >= 0; // SSE2 asm on Intel/AMD
end;

{$endif HASNOSSE2}

function HasHWAes: boolean;
begin
  result := cfAESNI in CpuFeatures;
end;

procedure RdRand32(buffer: PCardinal; n: integer);
begin
  if (n > 0) and
     (cfRAND in CpuFeatures) then
    repeat
      buffer^ := buffer^ xor RdRand32;
      inc(buffer);
      dec(n);
    until n = 0;
end;

type
  TIntelRegisters = record
    eax, ebx, ecx, edx: cardinal;
  end;

{$ifdef CPUX64}
  {$include mormot.core.base.asmx64.inc}
{$endif CPUX64}

{$ifdef CPUX86}
  {$include mormot.core.base.asmx86.inc}
{$endif CPUX86}

function IntelManufacturer: RawUtf8;
var
  regs: TIntelRegisters;
  id: array[0..12] of AnsiChar;
begin
  GetCpuid(0, 0, regs);
  PCardinalArray(@id)[0] := regs.ebx; // 12-character ID in EBX,EDX,ECX
  PCardinalArray(@id)[1] := regs.edx;
  PCardinalArray(@id)[2] := regs.ecx;
  id[12] := #0;
  FastSetString(result, @id, StrLen(@id));
end;

function IntelHypervisor: RawUtf8;
var
  regs: TIntelRegisters;
  id: array[0..12] of AnsiChar;
begin
  result := '';
  if not(cfHYP in CpuFeatures) then
    exit;
  GetCpuid($40000000, 0, regs);
  PCardinalArray(@id)[0] := regs.ebx; // 12-character ID in EBX,ECX,EDX
  PCardinalArray(@id)[1] := regs.ecx;
  PCardinalArray(@id)[2] := regs.edx;
  id[12] := #0;
  FastSetString(result, @id, StrLen(@id));
end;

procedure TestCpuFeatures;
var
  regs: TIntelRegisters;
  c: cardinal;
begin
  // retrieve CPUID raw flags
  GetCpuid({eax=}1, {ecx=}0, regs);
  PIntegerArray(@CpuFeatures)^[0] := regs.edx;
  PIntegerArray(@CpuFeatures)^[1] := regs.ecx;
  GetCpuid(7, 0, regs);
  PIntegerArray(@CpuFeatures)^[2] := regs.ebx;
  PIntegerArray(@CpuFeatures)^[3] := regs.ecx;
  PIntegerArray(@CpuFeatures)^[4] := regs.edx;
  if regs.eax in [1..9] then // returned the maximum ecx value for eax=7 in eax
  begin
    GetCpuid(7, 1, regs);
    PIntegerArray(@CpuFeatures)^[5] := regs.eax; // just ignore regs.ebx
    PIntegerArray(@CpuFeatures)^[6] := regs.edx;
    if cfAVX10 in CpuFeatures then
    begin
      GetCpuid($24, 0, regs);
      CpuAvx10.MaxSubLeaf := regs.eax;
      CpuAvx10.Version := ToByte(regs.ebx);
      PByte(@CpuAvx10.Vector)^ := (regs.ebx shr 16) and 7;
    end;
  end;
  // validate accuracy of most used HW opcodes
  {$ifdef DISABLE_SSE42}
  // force fallback on Darwin x64 (as reported by alf) - clang asm bug?
  CpuFeatures := CpuFeatures -
    [cfSSE3, cfSSE42, cfPOPCNT, cfAESNI, cfCLMUL, cfAVX, cfAVX2, cfFMA];
  {$else}
  if not (cfOSXS in CpuFeatures) or
     not IsXmmYmmOSEnabled then
    // AVX is available on the CPU, but not supported at OS context switch
    CpuFeatures := CpuFeatures - [cfAVX, cfAVX2, cfFMA];
  {$endif DISABLE_SSE42}
  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
        exclude(CpuFeatures, cfSSE42);
    except // disable now on illegal instruction or incorrect result
      exclude(CpuFeatures, cfSSE42);
    end;
  if cfPOPCNT in CpuFeatures then
    try
      if GetBitsCountSse42(7) = 3 then
        GetBitsCountPtrInt := @GetBitsCountSse42;
    except // clearly invalid opcode
      exclude(CpuFeatures, cfPOPCNT);
    end;
  {$ifdef ASMX64}
  // note: cfERMS has no cpuid within some VMs -> ignore and assume present
  if cfAVX in CpuFeatures then
  begin
    include(X64CpuFeatures, cpuAVX);
    if cfAVX2 in CpuFeatures then
      include(X64CpuFeatures, cpuAVX2);
    if CpuFeatures * CPUAVX2HASWELL = CPUAVX2HASWELL then
      include(X64CpuFeatures, cpuHaswell);
  end;
  {$endif ASMX64}
  // redirect some CPU-aware functions
  {$ifdef ASMX86} 
  {$ifndef HASNOSSE2}
  {$ifdef WITH_ERMS}
  if not (cfSSE2 in CpuFeatures) then
  begin
    ERMSB_MIN_SIZE_FWD := 0; // FillCharFast fallbacks to rep stosb on older CPU
    {$ifndef FPC_X86}
    ERMSB_MIN_SIZE_BWD := 0; // in both directions to bypass the SSE2 code
    {$endif FPC_X86}
  end
  // but MoveFast/SynLz are likely to abort -> recompile with HASNOSSE2 conditional
  // note: mormot.core.os.pas InitializeSpecificUnit will notify it on console
  else if cfERMS in CpuFeatures then
    ERMSB_MIN_SIZE_FWD := 4096; // "on 32-bit strings have to be at least 4KB"
    // backward rep movsd has no ERMS optimization so degrades performance
  {$endif WITH_ERMS}
  {$endif HASNOSSE2}
  if cfSSE2 in CpuFeatures then
    StrLen := @StrLenSSE2;
  {$endif ASMX86}
  if cfSSE42 in CpuFeatures then // for both i386 and x86_64
  begin
    crc32c          := @crc32csse42;
    crc32cby4       := @crc32cby4sse42;
    crcblock        := @crcblocksse42;
    crcblocks       := @crcblockssse42;
    DefaultHasher   := @crc32csse42;
    InterningHasher := @crc32csse42;
  end;
end;

{$else not CPUINTEL}

// fallback to pure pascal version for non-Intel CPUs

function Hash32(Data: PCardinalArray; Len: integer): cardinal;
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;

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}
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;
{$endif FPC}

function xxHash32(crc: cardinal; P: PAnsiChar; len: cardinal): 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); // inlined xxHash32Mixup()
  result := result * PRIME32_2;
  result := result xor (result shr 13);
  result := result * PRIME32_3;
  result := result xor (result shr 16);
end;

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 := StrComp(pointer(A), pointer(B));
end;

function SortDynArrayRawByteString(const A, B): integer;
var
  p1, p2: PByteArray;
  l1, l2: 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
        result := p1[0] - p2[0]; // compare first char for quicksort
        if result <> 0 then
          exit;
        l1 := PStrLen(PtrUInt(p1) - _STRLEN)^;
        l2 := PStrLen(PtrUInt(p2) - _STRLEN)^;
        result := l1;
        if l1 > l2 then
          l1 := l2;
        dec(result, l2);
        p1 := @p1[l1];
        p2 := @p2[l1];
        dec(l1); // we already compared the first char
        if l1 = 0 then
          exit;
        l1 := -l1;
        repeat
          if p1[l1] <> p2[l1] then
            break;
          inc(l1);
          if l1 = 0 then
            exit;
        until false;
        result := p1[l1] - p2[l1];
      end
      else
        result := 1  // p2=''
    else
      result := -1   // p1=''
  else
    result := 0;     // p1=p2
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 }

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;

procedure mul64x64(constref left, right: QWord; out product: THash128Rec);
var
  l: TQWordRec absolute left;
  r: TQWordRec absolute right;
  t1, t2: TQWordRec;
begin
  // CPU-neutral implementation
  t1.V := QWord(l.L) * r.L;
  product.c0 := t1.L;
  t2.V := QWord(l.H) * r.L + t1.H;
  t1.V := QWord(l.L) * r.H + t2.L;
  product.H := QWord(l.H) * r.H + t2.H + t1.H;
  product.c1 := t1.V;
end;

function SynLZcompress1(src: PAnsiChar; size: integer; dst: PAnsiChar): integer;
begin
  result := SynLZcompress1pas(src, size, dst);
end;

function SynLZdecompress1(src: PAnsiChar; size: integer; dst: PAnsiChar): integer;
begin
  result := SynLZdecompress1pas(src, size, dst);
end;

procedure LockedInc32(int32: PInteger);
begin
  InterlockedIncrement(int32^);
end;

procedure LockedDec32(int32: PInteger);
begin
  InterlockedDecrement(int32^);
end;

procedure LockedInc64(int64: PInt64);
begin
  {$ifdef FPC_64}
  InterlockedIncrement64(int64^); // we can use the existing 64-bit RTL function
  {$else}
  with PInt64Rec(int64)^ do
    if InterlockedIncrement(Lo) = 0 then
      InterlockedIncrement(Hi); // collission is highly unprobable
  {$endif FPC_64}
end;

function StrCntDecFree(var refcnt: TStrCnt): boolean;
begin
  // fallback to RTL asm e.g. for ARM
  {$ifdef STRCNT32}
  result := InterLockedDecrement(refcnt) <= 0;
  {$else}
  result := InterLockedDecrement64(refcnt) <= 0;
  {$endif STRCNT32}
end; // we don't check for ismultithread global

function DACntDecFree(var refcnt: TDACnt): boolean;
begin
  // fallback to RTL asm e.g. for ARM
  {$ifdef DACNT32}
  result := InterLockedDecrement(refcnt) <= 0;
  {$else}
  result := InterLockedDecrement64(refcnt) <= 0;
  {$endif DACNT32}
end;

function LockedExc(var Target: PtrUInt; NewValue, Comperand: PtrUInt): boolean;
begin
  result := InterlockedCompareExchange(
    pointer(Target), pointer(NewValue), pointer(Comperand)) = pointer(Comperand);
end;

procedure LockedAdd(var Target: PtrUInt; Increment: PtrUInt);
begin
  InterlockedExchangeAdd(pointer(Target), pointer(Increment));
end;

procedure LockedAdd32(var Target: cardinal; Increment: cardinal);
begin
  InterlockedExchangeAdd(Target, Increment);
end;

procedure LockedDec(var Target: PtrUInt; Decrement: PtrUInt);
begin
  InterlockedExchangeAdd(pointer(Target), pointer(-PtrInt(Decrement)));
end;

procedure bswap64array(a,b: PQWordArray; n: PtrInt);
var
  i: PtrInt;
begin
  for i := 0 to n - 1 do
    b^[i] := {$ifdef FPC}SwapEndian{$else}bswap64{$endif}(a^[i]);
end;

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;

function ByteScanIndex(P: PByteArray; Count: PtrInt; Value: byte): PtrInt;
begin
  result := IndexByte(P^, Count, Value); // use FPC RTL
end;

function WordScanIndex(P: PWordArray; Count: PtrInt; Value: word): PtrInt;
begin
  result := IndexWord(P^, Count, Value); // use FPC RTL
end;

function IntegerScan(P: PCardinalArray; Count: PtrInt; Value: cardinal): PCardinal;
begin
  result := nil;
  if P = nil then
    exit;
  Count := PtrUInt(@P[Count - 4]); // per-four loop is faster than FPC RTL
  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;
    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;
      P := @P[1];
    until false;
  end;
  result := false;
end;

function IntegerScanIndex(P: PCardinalArray; Count: PtrInt; Value: cardinal): PtrInt;
begin
  result := PtrUInt(IntegerScan(P, Count, Value));
  if result = 0 then
    dec(result)
  else
  begin
    dec(result, PtrUInt(P));
    result := result shr 2;
  end;
end;

{$ifdef CPUARM3264} // ARM-specific code

{$ifdef OSLINUXANDROID} // read CpuFeatures from Linux envp

const
  AT_HWCAP  = 16;
  AT_HWCAP2 = 26;

procedure TestCpuFeatures;
var
  p: PPChar;
  caps: TArmHwCaps;
begin
  // C library function getauxval() is not always available -> use system.envp
  caps := [];
  try
    p := system.envp;
    while p^ <> nil do
      inc(p);
    inc(p); // auxv is located after the last textual environment variable
    repeat
      if PtrUInt(p[0]) = AT_HWCAP then // 32-bit or 64-bit entries = PtrUInt
        PCardinalArray(@caps)[0] := PtrUInt(p[1])
      else if PtrUInt(p[0]) = AT_HWCAP2 then
        PCardinalArray(@caps)[1] := PtrUInt(p[1]);
      p := @p[2];
    until p[0] = nil;
  except
    // may happen on some untested Operating System
    caps := []; // is likely to be invalid
  end;
  CpuFeatures := caps;
end;

{$else}

{$ifdef OSWINDOWS} // use WinAPI on aarch64-win64

function IsProcessorFeaturePresent(ProcessorFeature: cardinal): boolean;
  stdcall; external 'kernel32';

const
  PF_ARM_V8_CRYPTO_INSTRUCTIONS_AVAILABLE = 30;
  PF_ARM_V8_CRC32_INSTRUCTIONS_AVAILABLE  = 31;

procedure TestCpuFeatures;
begin
  if IsProcessorFeaturePresent(PF_ARM_V8_CRYPTO_INSTRUCTIONS_AVAILABLE) then
    CpuFeatures := CpuFeatures + [ahcAES, ahcSHA1, ahcSHA2];
  if IsProcessorFeaturePresent(PF_ARM_V8_CRC32_INSTRUCTIONS_AVAILABLE) then
    include(CpuFeatures, ahcCRC32);
end;

{$else}

procedure TestCpuFeatures;
begin
  // perhaps system.envp would work somewhat, but the HWCAP items don't match
end;

{$endif OSWINDOWS}

{$endif OSLINUXANDROID}

function HasHWAes: boolean;
begin
  result := ahcAES in CpuFeatures;
end;

{$else}  // non Intel nor ARM CPUs

procedure TestCpuFeatures;
begin
end;

function HasHWAes: boolean;
begin
  result := false;
end;

{$endif CPUARM3264}

{$endif CPUINTEL}

{$ifndef ASMINTEL}

// fallback to pure pascal version for ARM or Intel PIC
function crc32fasttab(crc: cardinal; buf: PAnsiChar; len: cardinal;
  tab: PCrc32tab): cardinal; inline;
begin
  // on ARM, we use slicing-by-4 to avoid polluting smaller L1 cache
  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;

function StrInt32(P: PAnsiChar; val: PtrInt): PAnsiChar;
begin
  if val < 0 then
  begin
    result := StrUInt32(P, PtrUInt(-val)) - 1;
    result^ := '-';
  end
  else
    result := StrUInt32(P, val);
end;

function StrUInt32(P: PAnsiChar; val: PtrUInt): PAnsiChar;
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; // FPC will use fast reciprocal
    dec(val, c100 * 100);
    PWord(P)^ := tab[val];
    val := c100;
    if c100 = 0 then
      break;
  until false;
  result := P;
end;

{$endif ASMINTEL}


{ ************ Buffers (e.g. Hashing and SynLZ compression) Raw Functions }

{$ifndef CPUX64} // there is fast branchless SSE2 assembly on x86-64

function BufferLineLength(Text, TextEnd: PUtf8Char): PtrInt;
var
  c: byte;
begin
  result := PtrUInt(Text) - 1;
  repeat
    inc(result);
    if PtrUInt(result) < PtrUInt(TextEnd) then
    begin
      c := PByte(result)^;
      if (c > 13) or
         ((c <> 10) and
          (c <> 13)) then
        continue;
    end;
    break;
  until false;
  dec(result, PtrInt(Text)); // returns length
end;

function PosChar(Str: PUtf8Char; Chr: AnsiChar): PUtf8Char;
var
  c: AnsiChar;
begin
  result := nil;
  if Str = nil then
    exit;
  repeat
    c := Str^;
    if c = #0 then
      exit
    else if c = Chr then
      break;
    inc(Str);
  until false;
  result := Str;
end;

function MemCmp(P1, P2: PByteArray; L: PtrInt): integer;
begin
  // caller ensured that P1<>nil, P2<>nil and L>0 -> aggressively inlined asm
  result := 0;
  if L <= 0 then
    exit;
  inc(PtrUInt(P1), PtrUInt(L));
  inc(PtrUInt(P2), PtrUInt(L));
  L := -L;
  repeat
    if P1[L] <> P2[L] then
      break;
    inc(L);
    if L <> 0 then
      continue;
    exit;
  until false;
  result := P1[L] - P2[L];
end;

{$endif CPUX64}

function SynLZcompressdestlen(in_len: integer): integer;
begin
  // get maximum possible (worse) compressed size for out_p
  result := in_len + in_len shr 3 + 16;
end;

function SynLZdecompressdestlen(in_p: PAnsiChar): integer;
begin
  // get uncompressed size from lz-compressed buffer (to reserve memory, e.g.)
  result := PWord(in_p)^;
  if result and $8000 <> 0 then
    result := (result and $7fff) or (integer(PWord(in_p + 2)^) shl 15);
end;

function SynLZcompress1pas(src: PAnsiChar; size: integer; dst: PAnsiChar): integer;
var
  dstbeg,          // initial dst value
  srcend,          // real last byte available in src
  srcendmatch,     // last byte to try for hashing
  o: PAnsiChar;
  cwbit: byte;
  cwpoint: PCardinal;
  v, h, cached, t, tmax: PtrUInt;
  offset: TOffsets;
  cache: array[0..4095] of cardinal; // 16KB+16KB=32KB on stack (48KB for cpu64)
begin
  dstbeg := dst;
  // 1. store in_len
  if size >= $8000 then
  begin
    // size in 32KB..2GB -> stored as integer
    PWord(dst)^ := $8000 or (size and $7fff);
    PWord(dst + 2)^ := size shr 15;
    inc(dst, 4);
  end
  else
  begin
    PWord(dst)^ := size; // size<32768 -> stored as word
    if size = 0 then
    begin
      result := 2;
      exit;
    end;
    inc(dst, 2);
  end;
  // 2. compress
  srcend := src + size;
  srcendmatch := srcend - (6 + 5);
  cwbit := 0;
  cwpoint := pointer(dst);
  PCardinal(dst)^ := 0;
  inc(dst, SizeOf(cwpoint^));
  FillCharFast(offset, SizeOf(offset), 0); // fast 16KB reset to 0
  // 1. main loop to search using hash[]
  if src <= srcendmatch then
    repeat
      v := PCardinal(src)^;
      h := ((v shr 12) xor v) and 4095;
      o := offset[h];
      offset[h] := src;
      cached := v xor {%H-}cache[h]; // o=nil if cache[h] is uninitialized
      cache[h] := v;
      if (cached and $00ffffff = 0) and
         (o <> nil) and
         (src - o > 2) then
      begin
        cwpoint^ := cwpoint^ or (cardinal(1) shl cwbit);
        inc(src, 2);
        inc(o, 2);
        t := 1;
        tmax := srcend - src - 1;
        if tmax >= (255 + 16) then
          tmax := (255 + 16);
        while (o[t] = src[t]) and
              (t < tmax) do
          inc(t);
        inc(src, t);
        h := h shl 4;
        // here we have always t>0
        if t <= 15 then
        begin
          // mark 2 to 17 bytes -> size=1..15
          PWord(dst)^ := integer(t or h);
          inc(dst, 2);
        end
        else
        begin
          // mark 18 to (255+16) bytes -> size=0, next byte=t
          dec(t, 16);
          PWord(dst)^ := h; // size=0
          dst[2] := ansichar(t);
          inc(dst, 3);
        end;
      end
      else
      begin
        dst^ := src^;
        inc(src);
        inc(dst);
      end;
      if cwbit < 31 then
      begin
        inc(cwbit);
        if src <= srcendmatch then
          continue
        else
          break;
      end
      else
      begin
        cwpoint := pointer(dst);
        PCardinal(dst)^ := 0;
        inc(dst, SizeOf(cwpoint^));
        cwbit := 0;
        if src <= srcendmatch then
          continue
        else
          break;
      end;
    until false;
  // 2. store remaining bytes
  if src < srcend then
    repeat
      dst^ := src^;
      inc(src);
      inc(dst);
      if cwbit < 31 then
      begin
        inc(cwbit);
        if src < srcend then
          continue
        else
          break;
      end
      else
      begin
        PCardinal(dst)^ := 0;
        inc(dst, 4);
        cwbit := 0;
        if src < srcend then
          continue
        else
          break;
      end;
    until false;
  result := dst - dstbeg;
end;

// better code generation with sub-functions for raw decoding
procedure SynLZdecompress1passub(src, src_end, dst: PAnsiChar; var offset: TOffsets);
var
  last_hashed: PAnsiChar; // initial src and dst value
  {$ifdef CPU64}
  o: PAnsiChar;
  {$endif CPU64}
  cw, cwbit: cardinal;
  v, t, h: PtrUInt;
label
  nextCW;
begin
  last_hashed := dst - 1;
nextCW:
  cw := PCardinal(src)^;
  inc(src, 4);
  cwbit := 1;
  if src < src_end then
    repeat
      if cw and cwbit = 0 then
      begin
        dst^ := src^;
        inc(src);
        inc(dst);
        if src >= src_end then
          break;
        if last_hashed < dst - 3 then
        begin
          inc(last_hashed);
          v := PCardinal(last_hashed)^;
          offset[((v shr 12) xor v) and 4095] := last_hashed;
        end;
        cwbit := cwbit shl 1;
        if cwbit <> 0 then
          continue
        else
          goto nextCW;
      end
      else
      begin
        h := PWord(src)^;
        inc(src, 2);
        t := (h and 15) + 2;
        if t = 2 then
        begin
          t := ord(src^) + (16 + 2);
          inc(src);
        end;
        h := h shr 4;
        {$ifdef CPU64}
        o := offset[h];
        if PtrUInt(dst - o) < t then // overlap -> move byte-by-byte
          MoveByOne(o, dst, t)
        else if t <= 8 then
          PInt64(dst)^ := PInt64(o)^ // much faster in practice
        else
          MoveFast(o^, dst^, t);     // safe since src_endmatch := src_end-(6+5)
        {$else}
        if PtrUInt(dst - offset[h]) < t then
          MoveByOne(offset[h], dst, t)
        else if t > 8 then
          MoveFast(offset[h]^, dst^, t)
        else
          PInt64(dst)^ := PInt64(offset[h])^;
        {$endif CPU64}
        if src >= src_end then
          break;
        if last_hashed < dst then
          repeat // decompressed bytes should update the hash table
            inc(last_hashed);
            v := PCardinal(last_hashed)^;
            offset[((v shr 12) xor v) and 4095] := last_hashed;
          until last_hashed >= dst;
        inc(dst, t);
        last_hashed := dst - 1;
        cwbit := cwbit shl 1;
        if cwbit <> 0 then
          continue
        else
          goto nextCW;
      end;
    until false;
end;

function SynLZdecompress1pas(src: PAnsiChar; size: integer; dst: PAnsiChar): integer;
var
  offset: TOffsets;
  srcend: PAnsiChar;
begin
  srcend := src + size;
  result := PWord(src)^;
  if result = 0 then
    exit;
  inc(src, 2);
  if result and $8000 <> 0 then
  begin
    result := (result and $7fff) or (integer(PWord(src)^) shl 15);
    inc(src, 2);
  end;
  SynLZdecompress1passub(src, srcend, dst, offset);
end;

procedure SynLZdecompress1partialsub(src, dst, src_end, dst_end: PAnsiChar;
  var offset: TOffsets);
var
  lasthashed: PAnsiChar; // initial src and dst value
  cwbit, cw: integer;
  v, t, h: PtrUInt;
  {$ifdef CPU64}
  o: PAnsiChar;
  {$endif CPU64}
label
  nextCW;
begin
  lasthashed := dst - 1;
nextCW:
  cw := PCardinal(src)^;
  inc(src, 4);
  cwbit := 1;
  if src < src_end then
    repeat
      if cw and cwbit = 0 then
      begin
        dst^ := src^;
        inc(src);
        inc(dst);
        if (src >= src_end) or
           (dst >= dst_end) then
          break;
        if lasthashed < dst - 3 then
        begin
          inc(lasthashed);
          v := PCardinal(lasthashed)^;
          offset[((v shr 12) xor v) and 4095] := lasthashed;
        end;
        cwbit := cwbit shl 1;
        if cwbit <> 0 then
          continue
        else
          goto nextCW;
      end
      else
      begin
        h := PWord(src)^;
        inc(src, 2);
        t := (h and 15) + 2;
        h := h shr 4;
        if t = 2 then
        begin
          t := ord(src^) + (16 + 2);
          inc(src);
        end;
        if dst + t >= dst_end then
        begin
          // avoid buffer overflow by all means
          MoveByOne(offset[h], dst, dst_end - dst);
          break;
        end;
        {$ifdef CPU64}
        o := offset[h];
        if (t <= 8) or
           (PtrUInt(dst - o) < t) then
          MoveByOne(o, dst, t)
        else
          MoveFast(o^, dst^, t);
        {$else}
        if (t <= 8) or
           (PtrUInt(dst - offset[h]) < t) then
          MoveByOne(offset[h], dst, t)
        else
          MoveFast(offset[h]^, dst^, t);
        {$endif CPU64}
        if src >= src_end then
          break;
        if lasthashed < dst then
          repeat
            inc(lasthashed);
            v := PCardinal(lasthashed)^;
            offset[((v shr 12) xor v) and 4095] := lasthashed;
          until lasthashed >= dst;
        inc(dst, t);
        lasthashed := dst - 1;
        cwbit := cwbit shl 1;
        if cwbit <> 0 then
          continue
        else
          goto nextCW;
      end;
    until false;
end;

function SynLZdecompress1partial(src: PAnsiChar; size: integer; dst: PAnsiChar;
  maxDst: integer): integer;
var
  offset: TOffsets;
  srcend: PAnsiChar;
begin
  srcend := src + size;
  result := PWord(src)^;
  if result = 0 then
    exit;
  inc(src, 2);
  if result and $8000 <> 0 then
  begin
    result := (result and $7fff) or (integer(PWord(src)^) shl 15);
    inc(src, 2);
  end;
  if maxDst < result then
    result := maxDst;
  if result > 0 then
    SynLZdecompress1partialsub(src, dst, srcend, dst + result, offset);
end;

function CompressSynLZ(var Data: RawByteString; Compress: boolean): RawUtf8;
var
  datalen, len: integer;
  p: PAnsiChar;
  tmp: TSynTempBuffer;
begin
  datalen := length(Data);
  if datalen <> 0 then // '' is compressed and uncompressed to ''
    if Compress then
    begin
      len := SynLZcompressdestlen(datalen) + 8;
      p := tmp.Init(len);
      PCardinal(p)^ := Hash32(pointer(Data), datalen);
      len := SynLZcompress1(pointer(Data), datalen, p + 8);
      PCardinal(p + 4)^ := Hash32(pointer(p + 8), len);
      FastSetRawByteString(Data, p, len + 8);
      {%H-}tmp.Done;
    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);
      tmp.Init(len);
      if (len = 0) or
         ((SynLZDecompress1(p + 8, datalen - 8, tmp.buf) = len) and
          (Hash32(tmp.buf, len) = PCardinal(p)^)) then
        FastSetRawByteString(Data, tmp.buf, len);
      {%H-}tmp.Done;
    end;
  result := 'synlz';
end;

function CompressSynLZGetHash32(const Data: RawByteString): cardinal;
var
  datalen: integer;
  p: PAnsiChar;
begin
  datalen := length(Data);
  p := pointer(Data);
  if (datalen <= 8) or
     (Hash32(pointer(p + 8), datalen - 8) <> PCardinal(p + 4)^) then
    result := 0
  else
    result := PCardinal(p)^;
end;

const
  RLE_CW = $5a; // any byte would do - this one is nothing special but for me

function RleEncode(dst: PByteArray; v, n: PtrUInt): PByteArray;
  {$ifdef HASINLINE} inline; {$endif}
begin
  if (n > 3) or
     (v = RLE_CW) then // encode as dst[0]=RLE_CW dst[1]=count dst[2]=value
  begin
    v := v shl 16;
    inc(v, RLE_CW);
    while n > 255 do
    begin
      PCardinal(dst)^ := v + 255 shl 8;
      dst := @dst[3];
      dec(n, 255);
    end;
    inc(v, n shl 8);
    result := @dst[3];
  end
  else
  begin
    inc(v, (v shl 8) + (v shl 16)); // append the value n (=1,2,3) times
    result := @dst[n]; // seems faster with branchless move
  end;
  PCardinal(dst)^ := v;
end;

function RleCompress(src, dst: PByteArray; srcsize, dstsize: PtrUInt): PtrInt;
var
  dststart: PAnsiChar;
  c, b, n: PtrUInt;
begin
  dststart := PAnsiChar(dst);
  if srcsize <> 0 then
  begin
    dstsize := PtrUInt(@dst[dstsize - 3]); // pointer(dstsize) = dstmax
    b := src[0];
    n := 0;
    repeat
      c := src[0];
      inc(PByte(src));
      if c = b then
      begin
        inc(n);
        dec(srcsize);
        if (srcsize = 0) or
           (PtrUInt(dst) >= PtrUInt(dstsize)) then
          break;
      end
      else // dedicated if n = 1 then .. branch was slower
      begin
        dst := RleEncode(dst, b, n);
        n := 1;
        b := c;
        dec(srcsize);
        if (srcsize = 0) or
           (PtrUInt(dst) >= PtrUInt(dstsize)) then
          break;
      end;
    until false;
    dst := RleEncode(dst, b, n);
    if PtrUInt(dst) >= PtrUInt(dstsize) then
    begin
      result := -1;
      exit;
    end;
  end;
  result := PAnsiChar(dst) - dststart;
end;

{$ifdef CPUINTEL}
  {$ifndef HASNOSSE2}
    {$define INLINEDSEARCH} // leverage ByteScanIndex() SSE2 asm
  {$endif HASNOSSE2}
{$endif CPUINTEL}
{.$define INLINEDFILL} // actually slower

function RleUnCompress(src, dst: PByteArray; size: PtrUInt): PtrUInt;
var
  dststart: PAnsiChar;
  {$ifdef INLINEDFILL}
  c: PtrInt;
  {$endif INLINEDFILL}
  v: PtrUInt;
begin
  dststart := PAnsiChar(dst);
  if size > 0 then
    repeat
      {$ifdef INLINEDSEARCH}
      if src[0] <> RLE_CW then
      begin
        v := ByteScanIndex(src, size, RLE_CW);
        if PtrInt(v) < 0 then
          v := size;
        MoveFast(src^, dst^, v);
        inc(PByte(src), v);
        inc(PByte(dst), v);
        dec(size, v);
        if size = 0 then
          break;
      end;
      {$else}
      v := src[0];
      if v <> RLE_CW then
      begin
        dst[0] := v;
        inc(PByte(dst));
        inc(PByte(src));
        dec(size);
        if size = 0 then
          break;
      end
      else
      {$endif INLINEDSEARCH}
      begin // here src[0]=RLE_CW src[1]=count src[2]=value
        {$ifdef INLINEDFILL}
        c := src[1];
        v := src[2];
        inc(PByte(dst), c);
        c := -c;
        repeat
          dst[c] := v;
          inc(c);
        until c = 0;
        {$else}
        v := src[1];
        FillCharFast(dst^, v, src[2]);
        inc(PByte(dst), v);
        {$endif INLINEDFILL}
        inc(PByte(src), 3);
        dec(size, 3);
        if PtrInt(size) <= 0 then
          break;
      end
    until false;
  result := PAnsiChar(dst) - dststart;
end;

function RleUnCompressPartial(src, dst: PByteArray; size, max: PtrUInt): PtrUInt;
var
  dststart: PAnsiChar;
  v, m: PtrUInt;
begin
  dststart := PAnsiChar(dst);
  inc(max, PtrUInt(dst));
  while (size > 0) and
        (PtrUInt(dst) < max) do
  begin
    v := src[0];
    if v = RLE_CW then
    begin
      v := src[1];
      m := max - PtrUInt(dst);
      if v > m then
        v := m; // compile as cmov on FPC
      FillCharFast(dst^, v, src[2]);
      inc(PByte(dst), v);
      inc(PByte(src), 3);
      dec(size, 3);
    end
    else
    begin
      dst[0] := v;
      inc(PByte(dst));
      inc(PByte(src));
      dec(size);
    end;
  end;
  result := PAnsiChar(dst) - dststart;
end;


{ TSynTempBuffer }

const
  // TSynTempBuffer allocates +16 bytes for #0 terminator and PInteger() parsing
  SYNTEMPTRAIL = 16;

procedure TSynTempBuffer.Init(Source: pointer; SourceLen: PtrInt);
begin
  len := SourceLen;
  added := 0;
  if SourceLen <= 0 then
    buf := nil
  else
  begin
    if SourceLen <= SizeOf(tmp) - SYNTEMPTRAIL then // max internal tmp is 4080
      buf := @tmp
    else
      GetMem(buf, SourceLen + SYNTEMPTRAIL);
    if Source <> nil then
    begin
      MoveFast(Source^, buf^, len);
      PPtrInt(PAnsiChar(buf) + len)^ := 0; // init last 4/8 bytes (for valgrid)
    end;
  end;
end;

function TSynTempBuffer.InitOnStack: pointer;
begin
  buf := @tmp;
  len := SizeOf(tmp);
  added := 0;
  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;
  added := 0;
  if SourceLen <= 0 then
    buf := nil
  else
  begin
    if SourceLen <= SizeOf(tmp) - SYNTEMPTRAIL then // max internal tmp is 4080
      buf := @tmp
    else
      GetMem(buf, SourceLen + SYNTEMPTRAIL);
    PPtrInt(PAnsiChar(buf) + SourceLen)^ := 0; // init last 4/8 bytes
  end;
  result := buf;
end;

function TSynTempBuffer.Init: integer;
begin
  added := 0;
  buf := @tmp;
  result := SizeOf(tmp) - SYNTEMPTRAIL; // set to 4080 bytes = maximum safe size
  len := result;
end;

function TSynTempBuffer.InitRandom(RandomLen: integer): pointer;
begin
  Init(RandomLen);
  RandomBytes(buf, RandomLen);
  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
  if ZeroLen = 0 then
    ZeroLen := SizeOf(tmp) - SYNTEMPTRAIL;
  Init(ZeroLen);
  FillCharFast(buf^, ZeroLen, 0);
  result := buf;
end;

function TSynTempBuffer.BufEnd: pointer;
begin
  result := PAnsiChar(buf) + len;
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;

procedure TSynTempBuffer.AddRealloc(new: PtrInt);
begin
  len := NextGrow(new);
  if buf = @tmp then
  begin
    GetMem(buf, len + SYNTEMPTRAIL);
    MoveFast(tmp, buf^, added);
  end
  else
    ReAllocMem(buf, len + SYNTEMPTRAIL);
end;

function TSynTempBuffer.Add(l: PtrInt): pointer;
var
  new: PtrInt;
begin
  new := added + l;
  if new > len then // len is capacity here
    AddRealloc(new);
  result := PAnsiChar(buf) + added;
  inc(added, l);
end;

procedure TSynTempBuffer.Add(p: pointer; l: PtrInt);
begin
  if l > 0 then
    MoveFast(p^, Add(l)^, l);
end;

procedure TSynTempBuffer.Add(const s: RawByteString);
var
  l: PtrInt;
begin
  if pointer(s) = nil then
    exit;
  l := PStrLen(PtrUInt(s) - _STRLEN)^;
  MoveFast(pointer(s)^, Add(l)^, l);
end;

procedure TSynTempBuffer.AddShort(const s: ShortString);
begin
  if s[0] <> #0 then
    MoveFast(s[1], Add(ord(s[0]))^, ord(s[0]));
end;

procedure TSynTempBuffer.AddDirect(c: AnsiChar);
begin
  PUtf8Char(buf)[added] := c;
  inc(added); // append directly within SYNTEMPTRAIL bytes
end;

procedure TSynTempBuffer.AddDirect(const c1, c2: AnsiChar);
begin
  PWord(PUtf8Char(buf) + added)^ := ord(c1) + ord(c2) shl 8;
  inc(added, 2); // append directly within SYNTEMPTRAIL bytes
end;

procedure TSynTempBuffer.AddU(v: PtrUint);
var
  t: array[0..23] of AnsiChar;
  P: PAnsiChar;
begin
  P := StrUInt32(@t[23], v);
  Add(P, @t[23] - P);
end;

procedure TSynTempBuffer.Done(var Dest; CodePage: cardinal);
begin
  FastSetStringCP(Dest, buf, added, CodePage);
  if (buf <> @tmp) and
     (buf <> nil) then
    FreeMem(buf);
end;


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;

function IsZero(P: pointer; Length: integer): boolean;
var
  n: integer;
begin
  result := false;
  n := Length shr 4;
  if n <> 0 then
    repeat // 16 bytes (4 DWORD) by loop - aligned read
      {$ifdef CPU64}
      if (PInt64(P)^ <> 0) or
         (PInt64Array(P)^[1] <> 0) then
      {$else}
      if (PCardinal(P)^ <> 0) or
         (PCardinalArray(P)^[1] <> 0) or
         (PCardinalArray(P)^[2] <> 0) or
         (PCardinalArray(P)^[3] <> 0) then
      {$endif CPU64}
          exit
        else
          inc(PByte(P), 16);
      dec(n);
    until n = 0;
  n := (Length shr 2) and 3;
  if n <> 0 then
    repeat // 4 bytes (1 DWORD) by loop
      if PCardinal(P)^ <> 0 then
        exit
      else
        inc(PByte(P), 4);
        dec(n);
    until n = 0;
  n := Length and 3;
  if n <> 0 then
    repeat // remaining content
      if PByte(P)^ <> 0 then
        exit
      else
        inc(PByte(P));
      dec(n);
    until n = 0;
  result := true;
end;

function IsZeroSmall(P: pointer; Length: PtrInt): boolean;
begin
  result := false;
  inc(PtrUInt(P), PtrUInt(Length));
  Length := -Length;
  repeat
    if PByteArray(P)[Length] <> 0 then
      exit;
    inc(Length);
  until Length = 0;
  result := true;
end;

function crc32cfast(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
begin
  result := crc32fasttab(crc, buf, len, @crc32ctab);
end;

function crc32fast(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
begin
  result := crc32fasttab(crc, buf, len, @crc32tab);
end;

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;

{$ifdef HASINLINE}

function crc32cinlined(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
var
  tab: PCrc32tab;
begin
  result := not crc;
  tab := @crc32ctab;
  if len > 0 then
    repeat
      result := tab[0, ToByte(result xor ord(buf^))] xor (result shr 8);
      inc(buf);
      dec(len);
    until len = 0;
  result := not result;
end;

{$else}

function crc32cinlined(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
begin
  result := crc32c(crc, buf, len);
end;

{$endif HASINLINE}

function crc64c(buf: PAnsiChar; len: cardinal): Int64;
var
  lo: PtrInt;
begin
  lo := crc32c(0, buf, len);
  result := Int64(lo) or (Int64(crc32c(lo, buf, len)) shl 32);
end;

function crc32cTwice(seed: QWord; buf: PAnsiChar; len: cardinal): QWord;
begin
  PQWordRec(@result)^.L := crc32c(PQWordRec(@seed)^.L, buf, len);
  PQWordRec(@result)^.H := crc32c(PQWordRec(@seed)^.H, buf, len);
end;

function crc63c(buf: PAnsiChar; len: cardinal): Int64;
var
  lo: PtrInt;
begin
  lo := crc32c(0, buf, len);
  result := Int64(lo) or (Int64(crc32c(lo, buf, len) and $7fffffff) shl 32);
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;

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;

procedure crc32c128(hash: PHash128; buf: PAnsiChar; len: cardinal);
var
  blocks: cardinal;
begin
  blocks := len shr 4; // from bytes to blocks
  if blocks <> 0 then
  begin
    crcblocks(pointer(hash), pointer(buf), blocks);
    blocks := blocks shl 4; // from blocks to bytes
    inc(buf, blocks);
    dec(len, blocks);
  end;
  if len <> 0 then
    with PHash128Rec(hash)^ do
    begin
      c0 := crc32c(c0, buf, len);
      c1 := crc32c(c1, buf, len);
      c2 := crc32c(c2, buf, len);
      c3 := crc32c(c3, buf, len);
    end;
end;

function crc16(Data: PAnsiChar; Len: integer): cardinal;
var
  i, j: PtrInt;
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 DefaultHash(const s: RawByteString): cardinal;
begin
  result := DefaultHasher(0, pointer(s), length(s));
end;

function DefaultHash(const b: TBytes): cardinal;
begin
  result := DefaultHasher(0, pointer(b), length(b));
end;

function crc32cHash(const s: RawByteString): cardinal;
begin
  result := crc32c(0, pointer(s), length(s));
end;

function crc32cHash(const b: TBytes): cardinal;
begin
  result := crc32c(0, pointer(b), length(b));
end;

function Hash128To64(const b: THash128): QWord;
begin
  result := THash128Rec(b).L xor (THash128Rec(b).H * QWord(2685821657736338717));
end;

function xxHash32Mixup(crc: cardinal): cardinal;
begin
  result := crc;
  result := result xor (result shr 15);
  result := result * 2246822519;
  result := result xor (result shr 13);
  result := result * 3266489917;
  result := result xor (result shr 16);
end;

procedure crcblockone(crc128, data128: PBlock128; tab: PCrc32tab);
  {$ifdef HASINLINE} inline; {$endif}
var
  c: cardinal;
begin
  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;

{$ifndef ASMX86} // those functions have their tuned x86 asm version

{$ifdef CPUX64}
function CompareMem(P1, P2: pointer; Length: PtrInt): boolean;
begin
  result := MemCmp(P1, P2, Length) = 0; // use our SSE2 optimized asm
end;
{$else}
function CompareMem(P1, P2: pointer; Length: PtrInt): boolean;
label
  zero;
begin
  // this awfull code compiles well under FPC and Delphi on 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 CPU64}
  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;
{$endif CPUX64}

procedure crcblockfast(crc128, data128: PBlock128);
begin
  crcblockone(crc128, data128, @crc32ctab);
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 YearToPChar(Y: PtrUInt; P: PUtf8Char);
var
  d100: PtrUInt;
  tab: PWordArray;
begin
  tab := @TwoDigitLookupW;
  d100 := Y div 100; // FPC will use fast reciprocal
  PWordArray(P)[0] := tab[d100];
  PWordArray(P)[1] := tab[Y - (d100 * 100)];
end;

{$endif ASMX86}

function CompareBuf(const P1: RawByteString; P2: pointer; P2Len: PtrInt): integer;
begin
  result := ComparePtrInt(length(P1), P2Len);
  if result = 0 then
    result := MemCmp(pointer(P1), P2, P2Len);
end;

function CompareBuf(const P1, P2: RawByteString): integer;
begin
  result := SortDynArrayRawByteString(P1, P2);
end;

function EqualBuf(const P1, P2: RawByteString): boolean;
begin
  result := SortDynArrayRawByteString(P1, P2) = 0;
end;

function CompareMemFixed(P1, P2: pointer; Length: PtrInt): boolean;
begin
  // cut-down version of our pure pascal CompareMem() function
  result := false;
  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
        exit;
      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
        exit;
      inc(PByte(P1));
    until PtrInt(PtrUInt(P1)) >= Length;
  result := true;
end;

procedure crcblocksfast(crc128, data128: PBlock128; count: integer);
var
  tab: PCrc32tab; // good enough or PIC or ARM
begin
  if count <= 0 then
    exit;
  tab := @crc32ctab;
  repeat
    crcblockone(crc128, data128, tab); // properly inlined
    inc(data128);
    dec(count);
  until count = 0;
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;

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;


{ ************ Efficient Variant Values Conversion }

procedure SetVariantNull(var Value: variant);
begin
  VarClearAndSetType(Value, varNull);
end;

procedure ClearVariantForString(var Value: variant);
var
  v: cardinal;
begin
  v := TVarData(Value).VType;
  if v = varString then
    FastAssignNew(TVarData(Value).VAny)
  else
  begin
    VarClearAndSetType(Value, varString);
    TVarData(Value).VAny := nil; // to avoid GPF when assigning the value
  end;
end;

procedure RawByteStringToVariant(Data: PByte; DataLen: integer; var Value: variant);
begin
  ClearVariantForString(Value);
  if (Data = nil) or
     (DataLen <= 0) then
    PCardinal(@Value)^ := varNull
  else
    FastSetRawByteString(RawByteString(TVarData(Value).VAny), Data, DataLen);
end;

procedure RawByteStringToVariant(const Data: RawByteString; var Value: variant);
begin
  ClearVariantForString(Value);
  if Data = '' then
    PCardinal(@Value)^ := varNull
  else
    RawByteString(TVarData(Value).VAny) := Data;
end;

procedure VariantToUtf8(const Value: variant; var Dest: RawByteString);
begin // sub-proc to avoid hidden temp variable in VariantToRawByteString
  Dest := {$ifdef UNICODE}RawByteString{$else}string{$endif}(Value);
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);
    varStringByRef:
      Dest := PRawByteString(TVarData(Value).VAny)^;
    varVariantByRef:
      VariantToRawByteString(PVariant(TVarData(Value).VPointer)^, Dest);
    else // not from RawByteStringToVariant() -> conversion to string
      VariantToUtf8(Value, Dest);
  end;
end;

function VarDataFromVariant(const Value: variant): PVarData;
begin
  result := @Value;
  repeat
    if integer(result^.VType) <> varVariantByRef then
      exit;
    if result^.VPointer <> nil then
      result := result^.VPointer
    else
    begin
      result := @result^.VPointer; // so VType will point to 0=varEmpty
      exit;
    end;
  until false;
end;

function VarDataIsEmptyOrNull(VarData: pointer): boolean;
begin
  with VarDataFromVariant(PVariant(VarData)^)^ do
    result := (cardinal(VType) and cardinal(not varByRef)) <= varNull;
end;

function VarIsEmptyOrNull(const V: Variant): boolean;
begin
  with VarDataFromVariant(V)^ do
    result := (cardinal(VType) and cardinal(not varByRef)) <= varNull;
end;

function VarIsString(const V: Variant): boolean;
begin
  with VarDataFromVariant(V)^ do
    case cardinal(VType) and cardinal(not varByRef) of
      {$ifdef HASVARUSTRING} varUString, {$endif} varString, varOleStr:
     result := true;
    else
      result := false;
    end;
end;

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 cardinal(not varByRef);
  case typ of
    varVariant:
      if cardinal(PVarData(TVarData(Source).VPointer)^.VType) in VTYPE_SIMPLE then
      begin
        Dest := PVarData(TVarData(Source).VPointer)^;
        result := true;
      end;
    varEmpty..varDate,
    varBoolean,
    varShortInt..varWord64:
      begin
        PCardinal(@Dest)^ := typ;
        Dest.VInt64 := PInt64(TVarData(Source).VAny)^;
        result := true;
      end;
  end;
end;

function SetVarDataUnRefSimpleValue(V: PVarData; var tmp: TVarData): PVarData;
  {$ifdef HASINLINE}inline;{$endif}
var
  typ: cardinal;
begin
  typ := V^.VType;
  if typ and cardinal(varByRef) <> 0 then
  begin
    typ := typ and cardinal(not varByRef);
    if typ in VTYPE_SIMPLE then
    begin
      PCardinal(@tmp)^ := typ;
      tmp.VInt64 := PInt64(V^.VAny)^;
      result := @tmp;
      exit;
    end
  end;
  result := nil;
end;

function VariantToInteger(const V: Variant; var Value: integer): boolean;
var
  vd: PVarData;
  tmp: TVarData;
begin
  result := false;
  vd := VarDataFromVariant(V);
  repeat
    case cardinal(vd^.VType) of
      varNull,
      varEmpty:
        Value := 0;
      varBoolean:
        if vd^.VBoolean then
          Value := 1
        else
          Value := 0; // normalize
      varSmallint:
        Value := vd^.VSmallInt;
      varShortInt:
        Value := vd^.VShortInt;
      varWord:
        Value := vd^.VWord;
      varLongWord,
      varOleUInt:
        if vd^.VLongWord <= cardinal(High(integer)) then
          Value := vd^.VLongWord
        else
          exit;
      varByte:
        Value := vd^.VByte;
      varInteger,
      varOleInt:
        Value := vd^.VInteger;
      varWord64:
        if (vd^.VInt64 >= 0) and
           (vd^.VInt64 <= High(integer)) then
          Value := vd^.VInt64
        else
          exit;
      varInt64:
        if (vd^.VInt64 >= Low(integer)) and
           (vd^.VInt64 <= High(integer)) then
          Value := vd^.VInt64
        else
          exit;
      varDouble,
      varDate,
      varSingle,
      varCurrency,
      varString,
      varOleStr:
        exit;
    else
      begin
        vd := SetVarDataUnRefSimpleValue(vd, tmp{%H-});
        if vd <> nil then
          continue; // avoid a goto
        exit;
      end;
    end;
    break;
  until false;
  result := true;
end;

function VariantToDouble(const V: Variant; var Value: double): boolean;
var
  vd: PVarData;
  i64: Int64;
begin
  vd := VarDataFromVariant(V);
  result := true;
  case cardinal(vd^.VType) of
    varEmpty,
    varNull:
      Value := 0;
    varDouble,
    varDate:
      Value := vd^.VDouble;
    varSingle:
      Value := vd^.VSingle;
    varCurrency:
      CurrencyToDouble(@vd^.VCurrency, Value);
    varDouble or varByRef,
    varDate or varByRef:
      Value := unaligned(PDouble(vd^.VAny)^);
    varSingle or varByRef:
      Value := {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}unaligned{$endif}(
        PSingle(vd^.VAny)^);
    varCurrency or varByRef:
      CurrencyToDouble(vd^.VAny, Value);
  else
    if VariantToInt64(PVariant(vd)^, i64) then
      Value := i64
    else
      result := false;
  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
  vd: PVarData;
  tmp: TVarData;
begin
  vd := VarDataFromVariant(V);
  result := true;
  case cardinal(vd^.VType) of
    varDouble,
    varDate:
      DoubleToCurrency(vd^.VDouble, Value);
    varSingle:
      DoubleToCurrency(vd^.VSingle, Value);
    varCurrency:
      Value := PCurrency(@vd^.VCurrency)^;
    varDouble or varByRef,
    varDate or varByRef:
      DoubleToCurrency(PDouble(vd^.VAny)^, Value);
    varSingle or varByRef:
      DoubleToCurrency(PSingle(vd^.VAny)^, Value);
    varCurrency or varByRef:
      Value := PCurrency(vd^.VAny)^;
  else
    if VariantToInt64(PVariant(vd)^, tmp.VInt64) then
      Int64ToCurrency(tmp.VInt64, Value) // also handle varEmpty,varNull
    else
      result := false;
  end;
end;

function VariantToBoolean(const V: Variant; var Value: boolean): boolean;
var
  vd: PVarData;
  tmp: TVarData;
begin
  vd := VarDataFromVariant(V);
  repeat
    case cardinal(vd^.VType) of
      varEmpty,
      varNull:
        begin
          result := false;
          exit;
        end;
      varBoolean: // 16-bit WordBool to 8-bit boolean
        if vd^.VBoolean then
          Value := true // normalize
        else
          Value := false;
      varInteger: // coming e.g. from TGetJsonField
        Value := vd^.VInteger = 1;
      varString:
        Value := GetBoolean(vd^.VAny);
      varOleStr:
        Value := WideString(vd^.VAny) = 'true';
    {$ifdef HASVARUSTRING}
      varUString:
        Value := UnicodeString(vd^.VAny) = 'true';
    {$endif HASVARUSTRING}
    else
      begin
        vd := SetVarDataUnRefSimpleValue(vd, tmp{%H-});
        if vd <> nil then
          continue;
        result := false;
        exit;
      end;
    end;
    break;
  until false;
  result := true;
end;

function VariantToInt64(const V: Variant; var Value: Int64): boolean;
var
  vd: PVarData;
  tmp: TVarData;
begin
  vd := VarDataFromVariant(V);
  repeat
    case cardinal(vd^.VType) of
      varNull,
      varEmpty:
        Value := 0;
      varBoolean:
        if vd^.VBoolean then
          Value := 1
        else
          Value := 0; // normalize
      varSmallint:
        Value := vd^.VSmallInt;
      varShortInt:
        Value := vd^.VShortInt;
      varWord:
        Value := vd^.VWord;
      varLongWord,
      varOleUInt:
        Value := vd^.VLongWord;
      varByte:
        Value := vd^.VByte;
      varInteger,
      varOleInt:
        Value := vd^.VInteger;
      varWord64:
        if vd^.VInt64 >= 0 then
          Value := vd^.VInt64
        else
        begin
          result := false;
          exit;
        end;
      varInt64:
        Value := vd^.VInt64;
    else
      begin
        vd := SetVarDataUnRefSimpleValue(vd, tmp{%H-});
        if vd <> nil then
          continue;
        result := false;
        exit;
      end;
    end;
    break;
  until false;
  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;

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;
  RawUtf8(TVarData(Value).VAny) := Txt;
  EnsureRawUtf8(RawByteString(TVarData(Value).VAny));
end;

function RawUtf8ToVariant(const Txt: RawUtf8): variant;
begin
  RawUtf8ToVariant(Txt, result{%H-});
end;

procedure VariantStringToUtf8(const V: Variant; var result: RawUtf8);
begin
  with VarDataFromVariant(V)^ do
    if cardinal(VType) = varString then
      result := RawUtf8(VString)
    else
      result := '';
end;

function VariantStringToUtf8(const V: Variant): RawUtf8;
begin
  VariantStringToUtf8(V, result{%H-});
end;

procedure _VariantClearSeveral(V: PVariant; n: integer);
begin
  if n > 0 then
    repeat
      VarClear(V^);
      inc(V);
      dec(n);
    until n = 0;
end;

function VariantCompSimple(const A, B: variant): integer;
var
  a64, b64: Int64;
  af, bf: double;
begin
  // directly handle ordinal and floating point values
  if VariantToInt64(A, a64) and
     VariantToInt64(B, b64) then
    result := CompareInt64(a64, b64)
  else if VariantToDouble(A, af) and
          VariantToDouble(B, bf) then
    result := CompareFloat(af, bf)
  else
    // inlined VarCompareValue() for complex/mixed types
    if A = B then
      result := 0
    else if A < B then // both FPC and Delphi RTL require these two comparisons
      result := -1
    else
      result := 1;
end;

function _SortDynArrayVariantComp(const A, B: TVarData;
  {%H-}caseInsensitive: boolean): integer;
// caseInsensitive not supported by the RTL -> include mormot.core.variants
begin
  result := VariantCompSimple(PVariant(@A)^, PVariant(@B)^);
end;


{ ************ Sorting/Comparison Functions }

function SortMatch(CompareResult: integer; CompareOperator: TCompareOperator): boolean;
begin
  case CompareOperator of
    coEqualTo:
      result := CompareResult = 0;
    coNotEqualTo:
      result := CompareResult <> 0;
    coLessThan:
      result := CompareResult < 0;
    coLessThanOrEqualTo:
      result := CompareResult <= 0;
    coGreaterThan:
      result := CompareResult > 0;
  // coGreaterThanOrEqualTo:
  else
    result := CompareResult >= 0;
  end;
end;

function SortDynArrayVariant(const A, B): integer;
begin
  result := SortDynArrayVariantComp(TVarData(A), TVarData(B), {caseins=}false);
end;

function SortDynArrayVariantI(const A, B): integer;
begin
  result := SortDynArrayVariantComp(TVarData(A), TVarData(B), {caseins=}true);
end;

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 SortDynArrayExtended(const A, B): integer;
begin
  result := ord(TSynExtended(A) > TSynExtended(B)) - ord(TSynExtended(A) < TSynExtended(B));
end;

function SortDynArrayString(const A, B): integer;
begin
  {$ifdef UNICODE}
  result := StrCompW(PWideChar(A), PWideChar(B));
  {$else}
  {$ifdef CPUINTEL}
  result := SortDynArrayAnsiString(A, B); // has its own optimized asm
  {$else}
  result := StrComp(PUtf8Char(A), PUtf8Char(B));
  {$endif CPUINTEL}
  {$endif UNICODE}
end;

function SortDynArrayUnicodeString(const A, B): integer;
begin // works for both tkWString and tkUString
  result := StrCompW(PWideChar(A), PWideChar(B));
end;

function CompareHash(A, B: PPointer; Len: integer): integer;
  {$ifdef HASINLINE}inline;{$endif}
begin
  repeat
    result := ComparePointer(A^, B^); // on FPC inlined is better than explicit
    if result <> 0 then
      exit; // trailing register-size memory is seldom equal during sort
    inc(A);
    inc(B);
    dec(Len);
  until Len = 0;
end;

function SortDynArray128(const A, B): integer;
begin
  {$ifdef CPU64}
  result := ord(THash128Rec(A).L > THash128Rec(B).L) -
            ord(THash128Rec(A).L < THash128Rec(B).L);
  if result = 0 then
    result := ord(THash128Rec(A).H > THash128Rec(B).H) -
              ord(THash128Rec(A).H < THash128Rec(B).H);
  {$else}
  result := CompareHash(@A, @B, SizeOf(THash128) div SizeOf(pointer));
  {$endif CPU64}
end;

function SortDynArray256(const A, B): integer;
begin
  result := CompareHash(@A, @B, SizeOf(THash256) div SizeOf(pointer));
end;

function SortDynArray512(const A, B): integer;
begin
  result := CompareHash(@A, @B, SizeOf(THash512) div SizeOf(pointer));
end;

function SortDynArrayPUtf8Char(const A, B): integer;
begin
  result := StrComp(pointer(A), pointer(B));
end;

function SortDynArrayShortString(const A, B): integer;
var
  sa: shortstring absolute A;
  sb: shortstring absolute B;
  la, lb: PtrInt;
begin
  la := ord(sa[0]);
  lb := ord(sb[0]);
  if la < lb then
    la := lb;
  result := MemCmp(@sa[1], @sb[1], la);
  if result = 0 then
    result := ord(sa[0]) - ord(sb[0]);
end;


{$if not defined(CPUX64ASM) and not defined(CPUX86)} // fallback if no asm

procedure DynArrayHashTableAdjust(P: PIntegerArray; deleted: integer; count: PtrInt);
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;

procedure DynArrayHashTableAdjust16(P: PWordArray; deleted: cardinal; count: PtrInt);
begin
  repeat // branchless code is 10x faster than if :)
    dec(count, 8);
    dec(P[0], cardinal(P[0] > deleted));
    dec(P[1], cardinal(P[1] > deleted));
    dec(P[2], cardinal(P[2] > deleted));
    dec(P[3], cardinal(P[3] > deleted));
    dec(P[4], cardinal(P[4] > deleted));
    dec(P[5], cardinal(P[5] > deleted));
    dec(P[6], cardinal(P[6] > deleted));
    dec(P[7], cardinal(P[7] > deleted));
    P := @P[8];
  until count < 8;
  while count > 0 do
  begin
    dec(count);
    dec(P[count], cardinal(P[count] > deleted));
  end;
end;

{$ifend}

procedure ExchgPointer(n1, n2: PPointer);
var
  n: pointer;
begin
  n := n2^;
  n2^ := n1^;
  n1^ := n;
end;

procedure ExchgPointers(n1, n2: PPointer; count: PtrInt);
var
  n: pointer;
begin
  repeat
    n := n2^;
    n2^ := n1^;
    n1^ := n;
    inc(n1);
    inc(n2);
    dec(count);
  until count = 0;
end;

procedure ExchgVariant(v1, v2: PPtrIntArray);
var
  c: PtrInt; // 32-bit: 16 bytes = 4 PtrInt; 64-bit: 24 bytes = 3 PtrInt
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 CPU32}
end;

procedure Exchg(P1, P2: PAnsiChar; count: PtrInt);
var
  i, c: PtrInt;
  u: AnsiChar;
begin
  i := count shr POINTERSHR;
  if i <> 0 then
    repeat
      c := PPtrInt(P1)^;
      PPtrInt(P1)^ := PPtrInt(P2)^;
      PPtrInt(P2)^ := c;
      inc(P1, SizeOf(c));
      inc(P2, SizeOf(c));
      dec(i);
    until i = 0;
  i := count and POINTERAND;
  if i <> 0 then
    repeat
      dec(i);
      u := P1[i];
      P1[i] := P2[i];
      P2[i] := u;
    until i = 0;
end;


{ ************ Some Convenient TStream descendants }

{ TStreamWithPosition }

{$ifdef FPC}
function TStreamWithPosition.GetPosition: Int64;
begin
  result := fPosition;
end;
{$endif FPC}

function TStreamWithPosition.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
var
  size: Int64;
begin
  if (Offset <> 0) or
     (Origin <> soCurrent) then
  begin
    size := GetSize;
    case Origin of
      soBeginning:
        result := Offset;
      soEnd:
        result := size - Offset;
    else
      result := fPosition + Offset; // soCurrent
    end;
    if result > size then
      result := size
    else if result < 0 then
      result := 0;
    fPosition := result;
  end
  else
    // optimize on Delphi when retrieving TStream.Position as Seek(0,soCurrent)
    result := fPosition;
end;

function TStreamWithPosition.Seek(Offset: Longint; Origin: Word): Longint;
begin
  result := Seek(Offset, TSeekOrigin(Origin)); // call the 64-bit version above
end;


{ TStreamWithPositionAndSize }

function TStreamWithPositionAndSize.GetSize: Int64;
begin
  result := fSize;
end;


{ TRawByteStringStream }

constructor TRawByteStringStream.Create(const aString: RawByteString);
begin
  fDataString := aString;
end;

function TRawByteStringStream.Read(var Buffer; Count: Longint): Longint;
begin
  if Count <= 0 then
    result := 0
  else
  begin
    result := Length(fDataString) - fPosition;
    if result = 0 then
      exit;
    if result > Count then
      result := Count;
    MoveFast(PByteArray(fDataString)[fPosition], Buffer, result);
    inc(fPosition, result);
  end;
end;

function TRawByteStringStream.GetSize: Int64;
begin
  // faster than the TStream inherited method calling Seek() twice
  result := length(fDataString);
end;

procedure TRawByteStringStream.SetSize(NewSize: Longint);
begin
  SetLength(fDataString, NewSize);
  if fPosition > NewSize then
    fPosition := NewSize;
end;

function TRawByteStringStream.Write(const Buffer; Count: Longint): Longint;
var
  needed: PtrInt;
begin
  result := Count;
  if result <= 0 then
    exit;
  needed := fPosition + result;
  if needed > length(fDataString) then
    SetLength(fDataString, needed); // resize
  MoveFast(Buffer, PByteArray(fDataString)[fPosition], result);
  fPosition := needed;
end;

procedure TRawByteStringStream.GetAsText(StartPos, Len: PtrInt; var Text: RawUtf8);
var
  L: PtrInt;
begin
  if StartPos < 0 then
    StartPos := 0;
  L := length(fDataString);
  if (L = 0) or
     (StartPos >= L) then
    FastAssignNew(Text) // nothing to return
  else if (StartPos = 0) and
          (Len = L) and
          (PStrCnt(PAnsiChar(pointer(fDataString)) - _STRCNT)^ = 1) then
    FastAssignUtf8(Text, fDataString) // fast return the fDataString instance
  else
  begin
    dec(L, StartPos);
    if Len > L then
      Len := L; // avoid any buffer overflow
    FastSetString(Text, @PByteArray(fDataString)[StartPos], Len);
  end;
end;

procedure TRawByteStringStream.Clear;
begin
  fPosition := 0;
  fDataString := '';
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
  result := RaiseStreamError(self, 'Write');
end;


function {%H-}RaiseStreamError(Caller: TObject; const Context: shortstring): PtrInt;
begin
  raise EStreamError.CreateFmt('Unexpected %s.%s', [ClassNameShort(Caller)^, Context]);
end;

procedure crc32tabInit(polynom: cardinal; var tab: TCrc32tab);
var
  i, n: PtrUInt;
  crc: cardinal;
begin // 256 bytes of code to generate 2 x 8KB lookup tables
  i := 0;
  repeat // unrolled branchless root lookup table generation
    crc := cardinal(-(i and 1) and polynom) xor (i shr 1);
    crc := cardinal(-(crc and 1) and polynom) xor (crc shr 1);
    crc := cardinal(-(crc and 1) and polynom) xor (crc shr 1);
    crc := cardinal(-(crc and 1) and polynom) xor (crc shr 1);
    crc := cardinal(-(crc and 1) and polynom) xor (crc shr 1);
    crc := cardinal(-(crc and 1) and polynom) xor (crc shr 1);
    crc := cardinal(-(crc and 1) and polynom) xor (crc shr 1);
    crc := cardinal(-(crc and 1) and polynom) xor (crc shr 1);
    tab[0, i] := crc;
    if i = 255 then
      break;
    inc(i);
  until false;
  i := 0;
  repeat // expand the root lookup table for by-8 fast computation
    crc := tab[0, i];
    for n := 1 to high(tab) do
    begin
      crc := (crc shr 8) xor tab[0, ToByte(crc)];
      tab[n, i] := crc;
    end;
    inc(i);
  until i > 256;
end;

procedure InitializeUnit;
begin
  assert(ord(high(TSynLogLevel)) = 31);
  assert(@PSynVarData(nil)^.VAny = @PVarData(nil)^.VAny);
  // initialize internal constants
  crc32tabInit(2197175160, crc32ctab); // crc32c() reversed polynom
  crc32tabInit(3988292384, crc32tab);  // crc32() = zlib's reversed polynom
  // setup minimalistic global functions - overriden by other core units
  VariantClearSeveral     := @_VariantClearSeveral;
  SortDynArrayVariantComp := @_SortDynArrayVariantComp;
  // initialize CPU-specific asm
  TestCpuFeatures;
end;


initialization
  InitializeUnit;

end.