delphimvcframework/lib/dmustache/mormot.core.rtti.pas

/// Framework Core Low-Level Cross-Compiler RTTI Definitions
// - 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.rtti;

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

   Cross-Compiler RTTI Definitions shared by all framework units
    - Low-Level Cross-Compiler RTTI Definitions
    - Enumerations RTTI
    - Published Class Properties and Methods RTTI
    - IInvokable Interface RTTI
    - Efficient Dynamic Arrays and Records Process
    - Managed Types Finalization, Random or Copy
    - RTTI Value Types used for JSON Parsing
    - RTTI-based Registration for Custom JSON Parsing
    - High Level TObjectWithID and TObjectWithCustomCreate Class Types
    - Redirect Most Used FPC RTL Functions to Optimized x86_64 Assembly

     Purpose of this unit is to avoid any direct use of TypInfo.pas RTL unit,
    which is not exactly compatible between compilers, and lack of direct
    RTTI access with no memory allocation. We define pointers to RTTI
    record/object to access TypeInfo() via a set of explicit methods.
     Here fake record/objects are just wrappers around pointers defined in
    Delphi/FPC RTL's TypInfo.pas with the magic of inlining.
     We redefined all RTTI definitions as TRtti* types to avoid confusion
    with type names as published by the TypInfo unit.
     TRttiCustom class is the main cached entry of our customizable RTTI,
    accessible from the global Rtti.* methods.

    See mormot.core.rtti.fpc.inc and mormot.core.rtti.delphi.inc for
    compiler-specific code.

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


interface

{$I mormot.defines.inc}

uses
  sysutils,
  classes,
  contnrs,
  typinfo,  // use official RTL for accurate layouts (especially FPC unaligned)
  mormot.core.base,
  mormot.core.os,
  mormot.core.unicode,
  mormot.core.text; // ESynException, and text process (e.g. for enums)


{ ************* Low-Level Cross-Compiler RTTI Definitions }

type
  /// the kind of Exception raised by this unit
  ERttiException = class(ESynException);

  /// map TOrdType, to specify ordinal (rkInteger and rkEnumeration) storage size and sign
  // - note: on FPC, Int64 is stored as its own TRttiKind, not as rkInteger
  TRttiOrd = (
    roSByte,
    roUByte,
    roSWord,
    roUWord,
    roSLong,
    roULong
    {$ifdef FPC_NEWRTTI} ,
    roSQWord,
    roUQWord
    {$endif FPC_NEWRTTI});

  /// map TFloatType, to specify floating point (ftFloat) storage size and precision
  TRttiFloat = (
    rfSingle,
    rfDouble,
    rfExtended,
    rfComp,
    rfCurr);

{$ifdef FPC}

  /// map TTypeKind, to specify available type families for FPC RTTI values
  // - FPC types differs from Delphi, and are taken from FPC typinfo.pp unit
  // - here below,  we defined rkLString instead of rkAString to match Delphi -
  // see https://lists.freepascal.org/pipermail/fpc-devel/2013-June/032360.html
  // "Compiler uses internally some LongStrings which is not possible to use
  // for variable declarations" so rkLStringOld seems never used in practice
  TRttiKind = (
    rkUnknown,
    rkInteger,
    rkChar,
    rkEnumeration,
    rkFloat,
    rkSet,
    rkMethod,
    rkSString,
    rkLStringOld {=rkLString},
    rkLString    {=rkAString},
    rkWString,
    rkVariant,
    rkArray,
    rkRecord,
    rkInterface,
    rkClass,
    rkObject,
    rkWChar,
    rkBool,
    rkInt64,
    rkQWord,
    rkDynArray,
    rkInterfaceRaw,
    rkProcVar,
    rkUString,
    rkUChar,
    rkHelper,
    rkFile,
    rkClassRef,
    rkPointer);

const
  /// potentially managed types in TRttiKind enumerates
  rkManagedTypes = [rkLStringOld,
                    rkLString,
                    rkWString,
                    rkUString,
                    rkArray,
                    rkObject,
                    rkRecord,
                    rkDynArray,
                    rkInterface,
                    rkVariant];

  /// maps record or object in TRttiKind enumerates
  rkRecordTypes = [rkObject,
                   rkRecord];

type
  ///  TTypeKind enumerate as defined in Delphi 6 and up
  // - dkUString and following appear only since Delphi 2009
  TDelphiType = (
    dkUnknown,
    dkInteger,
    dkChar,
    dkEnumeration,
    dkFloat,
    dkString,
    dkSet,
    dkClass,
    dkMethod,
    dkWChar,
    dkLString,
    dkWString,
    dkVariant,
    dkArray,
    dkRecord,
    dkInterface,
    dkInt64,
    dkDynArray,
    dkUString,
    dkClassRef,
    dkPointer,
    dkProcedure,
    dkMRecord);

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

  /// convert Delphi's TTypeKind to our TRttiKind enumerate
  DELPHITOFPC: array[TDelphiType] of TRttiKind = (
    rkUnknown,     //  dkUnknown
    rkInteger,     //  dkInteger
    rkChar,        //  dkChar
    rkEnumeration, //  dkEnumeration
    rkFloat,       //  dkFloat
    rkSString,     //  dkString
    rkSet,         //  dkSet
    rkClass,       //  dkClass
    rkMethod,      //  dkMethod
    rkWChar,       //  dkWChar
    rkLString,     //  dkLString
    rkWString,     //  dkWString
    rkVariant,     //  dkVariant
    rkArray,       //  dkArray
    rkRecord,      //  dkRecord
    rkInterface,   //  dkInterface
    rkInt64,       //  dkInt64
    rkDynArray,    //  dkDynArray
    rkUString,     //  dkUString
    rkClassRef,    //  dkClassRef
    rkPointer,     //  dkPointer
    rkProcVar,     //  dkProcedure
    rkRecord);     //  dkMRecord

{$else}

  /// available type families for Delphi 6 and up, similar to typinfo.pas
  // - redefined here to leverage FPC and Delphi compatibility as much as possible
  TRttiKind = (
    rkUnknown,
    rkInteger,
    rkChar,
    rkEnumeration,
    rkFloat,
    rkSString,
    rkSet,
    rkClass,
    rkMethod,
    rkWChar,
    rkLString,
    rkWString,
    rkVariant,
    rkArray,
    rkRecord,
    rkInterface,
    rkInt64,
    rkDynArray
    {$ifdef UNICODE},
    rkUString,
    rkClassRef,
    rkPointer,
    rkProcedure,
    rkMRecord // managed records from newest Delphi are partially supported
    {$endif UNICODE});

const
  /// potentially managed types in TRttiKind enumerates
  rkManagedTypes = [rkLString,
                    rkWstring,
                    {$ifdef UNICODE}
                    rkUstring,
                    rkMRecord,
                    {$endif UNICODE}
                    rkArray,
                    rkRecord,
                    rkDynArray,
                    rkInterface,
                    rkVariant
                   ];
  /// maps record or object in TTypeKind RTTI enumerates
  rkRecordTypes = [rkRecord
                   {$ifdef UNICODE},
                   rkMRecord
                   {$endif UNICODE}];

{$endif FPC}

  /// maps string/text types in TRttiKind RTTI enumerates, excluding shortstring
  rkStringTypes =
    [rkLString,
     {$ifdef FPC}
     rkLStringOld,
     {$endif FPC}
     {$ifdef HASVARUSTRING}
     rkUString,
     {$endif HASVARUSTRING}
     rkWString
    ];

  /// maps UTF-16 string in TRttiKind RTTI enumerates
  rkWideStringTypes =
    [{$ifdef HASVARUSTRING}
     rkUString,
     {$endif HASVARUSTRING}
     rkWString
    ];

  /// maps types with proper TRttiProp.RttiOrd field
  // - i.e. rkOrdinalTypes excluding the 64-bit values
  rkHasRttiOrdTypes =
    [rkInteger,
     rkChar,
     rkWChar,
     {$ifdef FPC}
     rkBool,
     rkUChar,
     {$endif FPC}
     rkEnumeration,
     rkSet
    ];

  /// types which are considerated as non-simple values
  rkComplexTypes = [rkClass, rkDynArray, rkInterface];

  /// types which are stored as pointers so are always accessed by reference
  rkPerReference = rkStringTypes + rkComplexTypes;

  /// maps 1, 8, 16, 32 and 64-bit ordinal in TRttiKind RTTI enumerates
  rkOrdinalTypes =
    rkHasRttiOrdTypes + [ {$ifdef FPC} rkQWord, {$endif} rkInt64 ];

  /// maps integer and floating point types in TRttiKind RTTI enumerates
  rkNumberTypes = rkOrdinalTypes + [ rkFloat ];

  /// maps enumeration types in TRttiKind RTTI
  rkEnumerationTypes = [rkEnumeration {$ifdef FPC}, rkBool {$endif}];

  /// maps values which expect TRttiProp.GetOrdProp/SetOrdProp
  // - includes 32-bit ordinals and pointers
  rkGetOrdPropTypes = rkHasRttiOrdTypes + rkComplexTypes;

  /// maps ordinal values which expect TRttiProp.GetInt64Prop/SetInt64Prop
  // - includes 64-bit ordinals
  rkGetInt64PropTypes =
     [rkInt64 {$ifdef FPC} , rkQWord {$endif} ];

  /// maps value which are integer or Int64/QWord, but not ordinal char/enum/set
  rkGetIntegerPropTypes = rkGetInt64PropTypes + [rkInteger];

  /// maps records or dynamic arrays
  rkRecordOrDynArrayTypes = rkRecordTypes + [rkDynArray];

  /// maps records or static arrays
  rkRecordOrArrayTypes = rkRecordTypes + [rkArray];

  /// all recognized TRttiKind enumerates, i.e. all but rkUnknown
  rkAllTypes = [succ(low(TRttiKind))..high(TRttiKind)];

  /// quick retrieve how many bytes an ordinal consist in
  ORDTYPE_SIZE: array[TRttiOrd] of byte = (
    1,                                      // roSByte
    1,                                      // roUByte
    2,                                      // roSWord
    2,                                      // roUWord
    4,                                      // roSLong
    4                                       // roULong
    {$ifdef FPC_NEWRTTI} , 8, 8 {$endif} ); // roSQWord, roUQWord

  /// quick retrieve how many bytes a floating-point consist in
  FLOATTYPE_SIZE: array[TRttiFloat] of byte = (
    4,                                             // rfSingle
    8,                                             // rfDouble
    {$ifdef TSYNEXTENDED80} 10 {$else} 8 {$endif}, // rfExtended
    8,                                             // rfComp
    8 );                                           // rfCurr


type
  PRttiKind = ^TRttiKind;
  TRttiKinds = set of TRttiKind;
  PRttiOrd = ^TRttiOrd;
  PRttiFloat = ^TRttiFloat;

type
  /// pointer to low-level RTTI of a type definition, as returned by TypeInfo()
  // system function
  // - equivalency to PTypeInfo as defined in TypInfo RTL unit and old mORMot.pas
  // - this is the main entry point of all the information exposed by this unit
  PRttiInfo = ^TRttiInfo;

  /// double-reference to RTTI type definition
  // - Delphi and newer FPC do store all nested TTypeInfo as pointer to pointer,
  // to ease linking of the executable
  PPRttiInfo = ^PRttiInfo;

  /// dynamic array of low-level RTTI type definitions
  PRttiInfoDynArray = array of PRttiInfo;

  /// pointer to a RTTI class property definition as stored in PRttiProps.PropList
  // - equivalency to PPropInfo as defined in TypInfo RTL unit and old mORMot.pas
  PRttiProp = ^TRttiProp;

  /// used to store a chain of properties RTTI
  // - could be used e.g. by TOrmPropInfo to handled flattened properties
  PRttiPropDynArray = array of PRttiProp;

  /// pointer to all RTTI class properties definitions
  // - as returned by PRttiInfo.RttiProps() or GetRttiProps()
  PRttiProps = ^TRttiProps;

  /// a wrapper to published properties of a class, as defined by compiler RTTI
  // - access properties for only a given class level, not inherited properties
  // - start enumeration by getting a PRttiProps with PRttiInfo.RttiProps(), then
  // use P := PropList to get the first PRttiProp, and iterate with P^.Next
  // - this enumeration is very fast and doesn't require any temporary memory,
  //  as in the TypInfo.GetPropInfos() PPropList usage
  // - for TOrm, you should better use the Properties.Fields[] array,
  // which is faster and contains the properties published in parent classes
  {$ifdef USERECORDWITHMETHODS}
  TRttiProps = record
  {$else}
  TRttiProps = object
  {$endif USERECORDWITHMETHODS}
  public
    /// number of published properties in this object
    function PropCount: integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// point to a TPropInfo packed array
    // - layout is as such, with variable TPropInfo storage size:
    // ! PropList: array[1..PropCount] of TPropInfo
    // - use TPropInfo.Next to get the next one:
    // ! P := PropList;
    // ! for i := 1 to PropCount do
    // ! begin
    // !   // ... do something with P
    // !   P := P^.Next;
    // ! end;
    function PropList: PRttiProp;
      {$ifdef HASINLINE}inline;{$endif}
    /// retrieve a Field property RTTI information from a Property Name
    function FieldProp(const PropName: ShortString): PRttiProp;
  end;

  /// pointer to TClassType, as returned by PRttiInfo.RttiClass()
  // - as returned by PRttiInfo.RttiClass() or GetRttiClass()
  // - equivalency to PClassData/PClassType as defined in old mORMot.pas
  PRttiClass = ^TRttiClass;

  /// a wrapper to class type information, as defined by the compiler RTTI
  // - get a PRttiClass with PRttiInfo.RttiClass() or GetRttiClass()
  {$ifdef USERECORDWITHMETHODS}
  TRttiClass = record
  {$else}
  TRttiClass = object
  {$endif USERECORDWITHMETHODS}
  public
    /// the class type
    function RttiClass: TClass;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// the parent class type information
    function ParentInfo: PRttiInfo;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// the number of published properties of this class and all parents
    // - use RttiProps if you want to properties only published in this class 
    function PropCount: integer;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// the name (without .pas extension) of the unit were the class was defined
    // - then the PRttiProps information follows: use the method
    // RttiProps to retrieve its address
    function UnitName: PShortString;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// get the information about the published properties of this class
    // - stored after UnitName memory
    function RttiProps: PRttiProps;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// fast and easy find if this class inherits from a specific class type
    // - you should rather consider using TRttiInfo.InheritsFrom directly
    function InheritsFrom(AClass: TClass): boolean;
  end;

  /// pointer to TEnumType, as returned by PRttiInfo.EnumBaseType/SetEnumType
  // - equivalency to PEnumType as defined in old mORMot.pas
  PRttiEnumType = ^TRttiEnumType;

  /// a wrapper to enumeration type information, as defined by the compiler RTTI
  // and returned by PRttiInfo.EnumBaseType/SetEnumType
  // - we use this to store the enumeration values as integer, but easily provide
  // a text equivalent, translated if necessary, from the enumeration type
  // definition itself
  {$ifdef USERECORDWITHMETHODS}
  TRttiEnumType = record
  {$else}
  TRttiEnumType = object
  {$endif USERECORDWITHMETHODS}
  private
    // as used by TRttiInfo.EnumBaseType/SetBaseType
    function EnumBaseType: PRttiEnumType;
      {$ifdef HASINLINE}inline;{$endif}
    function SetBaseType: PRttiEnumType;
      {$ifdef HASINLINE}inline;{$endif}
  public
    /// specify ordinal storage size and sign
    // - is prefered to MaxValue to identify the number of stored bytes
    function RttiOrd: TRttiOrd;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// first value of enumeration type, typicaly 0
    // - may be < 0 e.g. for boolean
    function MinValue: PtrInt;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// same as ord(high(type)): not the enumeration count, but the highest index
    function MaxValue: PtrInt;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// a concatenation of shortstrings, containing the enumeration names
    // - those shortstrings are not aligned whatsoever (even if
    // FPC_REQUIRES_PROPER_ALIGNMENT is set)
    function NameList: PShortString;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// get the corresponding enumeration name
    // - return a void '' ShortString if Value is invalid (>MaxValue)
    function GetEnumNameOrd(Value: cardinal): PShortString;
      {$ifdef FPC} inline; {$endif}
    /// get the corresponding enumeration name
    // - return the first one if Value is invalid (>MaxValue)
    // - Value will be converted to the matching ordinal value (byte or word)
    function GetEnumName(const Value): PShortString;
    /// get the caption text corresponding to a enumeration name
    // - return the first one if Value is invalid (>MaxValue)
    // - Value will be converted to the matching ordinal value (byte or word)
    function GetCaption(const Value): string;
    /// get all caption names, ready to be display, as lines separated by #13#10
    // - return "string" type, i.e. UnicodeString for Delphi 2009+
    // - if UsedValuesBits is not nil, only the corresponding bits set are added
    function GetCaptionStrings(UsedValuesBits: pointer = nil): string;
    /// add caption names, ready to be display, to a TStrings class
    // - add pointer(ord(element)) as Objects[] value
    // - if UsedValuesBits is not nil, only the corresponding bits set are added
    // - can be used e.g. to populate a combo box as such:
    // ! PTypeInfo(TypeInfo(TMyEnum))^.EnumBaseType^.AddCaptionStrings(ComboBox.Items);
    procedure AddCaptionStrings(Strings: TStrings;
      UsedValuesBits: pointer = nil);
    /// retrieve all element names as a dynamic array of RawUtf8
    // - names could be optionally trimmed left from their initial lower chars
    procedure GetEnumNameAll(var result: TRawUtf8DynArray;
      TrimLeftLowerCase: boolean); overload;
    /// retrieve all element names as CSV, with optional quotes
    procedure GetEnumNameAll(out result: RawUtf8; const Prefix: RawUtf8 = '';
      quotedValues: boolean = false; const Suffix: RawUtf8 = '';
      trimedValues: boolean = false; unCamelCased: boolean = false); overload;
    /// retrieve all trimed element names as CSV
    procedure GetEnumNameTrimedAll(var result: RawUtf8; const Prefix: RawUtf8 = '';
      quotedValues: boolean = false; const Suffix: RawUtf8 = '');
    /// get all enumeration names as a JSON array of strings
    function GetEnumNameAllAsJsonArray(TrimLeftLowerCase: boolean;
      UnCamelCased: boolean = false): RawUtf8;
    /// get the corresponding enumeration ordinal value, from its name
    // - if EnumName does start with lowercases 'a'..'z', they will be searched:
    // e.g. GetEnumNameValue('sllWarning') will find sllWarning item
    // - if Value does not start with lowercases 'a'..'z', they will be ignored:
    // e.g. GetEnumNameValue('Warning') will find sllWarning item
    // - return -1 if not found (don't use directly this value to avoid any GPF)
    function GetEnumNameValue(const EnumName: ShortString): integer; overload;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// get the corresponding enumeration ordinal value, from its name
    // - if Value does start with lowercases 'a'..'z', they will be searched:
    // e.g. GetEnumNameValue('sllWarning') will find sllWarning item
    // - if Value does not start with lowercases 'a'..'z', they will be ignored:
    // e.g. GetEnumNameValue('Warning') will find sllWarning item
    // - return -1 if not found (don't use directly this value to avoid any GPF)
    function GetEnumNameValue(Value: PUtf8Char): integer; overload;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// get the corresponding enumeration ordinal value, from its name
    // - if Value does start with lowercases 'a'..'z', they will be searched:
    // e.g. GetEnumNameValue('sllWarning') will find sllWarning item
    // - if AlsoTrimLowerCase is TRUE, and EnumName does not start with
    // lowercases 'a'..'z', they will be ignored: e.g. GetEnumNameValue('Warning')
    // will find sllWarning item
    // - return -1 if not found, or if RTTI's MinValue is not 0
    function GetEnumNameValue(Value: PUtf8Char; ValueLen: integer;
      AlsoTrimLowerCase: boolean = true): integer; overload;
    /// get the corresponding enumeration ordinal value, from its trimmed name
    function GetEnumNameValueTrimmed(Value: PUtf8Char; ValueLen: integer;
      CaseSensitive: boolean): integer;
    /// get the corresponding enumeration name, without the first lowercase chars
    // (otDone -> 'Done')
    // - Value will be converted to the matching ordinal value (byte or word)
    function GetEnumNameTrimed(const Value): RawUtf8;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// get the enumeration names corresponding to a set value as CSV
    function GetSetName(const value; trimmed: boolean = false;
      const sep: RawUtf8 = ','): RawUtf8;
    /// get the enumeration names corresponding to a set value as JSON array
    function GetSetNameJsonArray(Value: cardinal; SepChar: AnsiChar = ',';
      FullSetsAsStar: boolean = false): RawUtf8; overload;
    /// write the enumeration names corresponding to a set value as a JSON array
    procedure GetSetNameJsonArray(W: TTextWriter; Value: cardinal;
      SepChar: AnsiChar = ','; QuoteChar: AnsiChar = #0;
      FullSetsAsStar: boolean = false; ForceTrim: boolean = false); overload;
    /// get the corresponding enumeration ordinal value, from its name without
    // its first lowercase chars ('Done' will find otDone e.g.)
    // - return -1 if not found, or if RTTI's MinValue is not 0
    function GetEnumNameTrimedValue(const EnumName: ShortString): integer; overload;
    /// get the corresponding enumeration ordinal value, from its name without
    // its first lowercase chars ('Done' will find otDone e.g.)
    // - return -1 if not found, or if RTTI's MinValue is not 0
    function GetEnumNameTrimedValue(Value: PUtf8Char; ValueLen: integer = 0): integer; overload;
    /// compute how many bytes this type will use to be stored as a enumerate
    function SizeInStorageAsEnum: integer;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// compute how many bytes (1, 2, 4) this type will use to be stored as a set
    // - consider using TRttiInfo.SetEnumSize if ISFPC32 conditional is defined
    function SizeInStorageAsSet: integer;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// store an enumeration value from its ordinal representation
    procedure SetEnumFromOrdinal(out Value; Ordinal: PtrUInt);
      {$ifdef HASSAFEINLINE}inline;{$endif}
  end;

  /// RTTI of a record/object type definition (managed) field
  // - defined here since this structure is not available in oldest
  // Delphi's TypInfo.pas
  // - maps TRecordElement in FPC rtti.inc or TManagedField in TypInfo
  TRttiRecordField = record
    /// the RTTI of this managed field
    {$ifdef HASDIRECTTYPEINFO}
    TypeInfo: PRttiInfo;
    {$else}
    TypeInfoRef: PPRttiInfo;
    {$endif HASDIRECTTYPEINFO}
    /// where this managed field starts in the record memory layout
    Offset: PtrUInt;
  end;
  /// pointer to the RTTI of a record/object type definition (managed) field
  PRttiRecordField = ^TRttiRecordField;

  /// define the interface abilities
  TRttiIntfFlag = (
    ifHasGuid,
    ifDispInterface,
    ifDispatch
    {$ifdef FPC} ,
    ifHasStrGUID {$endif});

  /// define the set of interface abilities
  TRttiIntfFlags = set of TRttiIntfFlag;

  /// a wrapper to interface type information, as defined by the the compiler RTTI
  {$ifdef USERECORDWITHMETHODS}
  TRttiInterfaceTypeData = record
  {$else}
  TRttiInterfaceTypeData = object
  {$endif USERECORDWITHMETHODS}
  public
    /// ancestor interface type
    function IntfParent: PRttiInfo;
      {$ifdef HASINLINE}inline;{$endif}
    /// interface abilities - not inlined to avoid random trouble on FPC trunk
    function IntfFlags: TRttiIntfFlags;
    /// interface 128-bit Guid
    function IntfGuid: PGuid;
      {$ifdef HASINLINE}inline;{$endif}
    /// where the interface has been defined
    function IntfUnit: PShortString;
      {$ifdef HASINLINE}inline;{$endif}
  end;

  /// pointer to a wrapper to interface type information
  PRttiInterfaceTypeData = ^TRttiInterfaceTypeData;

  /// record RTTI as returned by TRttiInfo.RecordManagedFields
  TRttiRecordManagedFields = record
    /// the record size in bytes
    Size: PtrInt;
    /// how many managed Fields[] are defined in this record
    Count: PtrInt;
    /// points to the first field RTTI
    // - use inc(Fields) to go to the next one
    Fields: PRttiRecordField;
  end;

  /// enhanced RTTI of a record/object type definition
  // - as returned by TRttiInfo.RecordAllFields on Delphi 2010+
  TRttiRecordAllField = record
    /// the field RTTI definition
    TypeInfo: PRttiInfo;
    /// the field offset in the record
    Offset: PtrUInt;
    /// the field property name
    Name: PShortString;
  end;
  PRttiRecordAllField = ^TRttiRecordAllField;

  /// as returned by TRttiInfo.RecordAllFields
  TRttiRecordAllFields = array of TRttiRecordAllField;

  /// quick identification of some RTTI value types
  TRttiCacheFlag = (
    rcfQWord,
    rcfBoolean,
    rcfHasRttiOrd,
    rcfGetOrdProp,
    rcfGetInt64Prop,
    rcfIsRawBlob,
    rcfIsNumber);

  /// as used by TRttiCache.Flags
  // - rcfQWord/rcfBoolean map Info^.IsQWord/IsBoolean
  // - rcfIsRawBlob maps Info^.IsRawBlob
  // - rcfIsNumber is set if Info^.Kind is in rkNumberTypes
  // - set rcfHasRttiOrd/rcfGetOrdProp/rcfGetInt64Prop to access the value
  TRttiCacheFlags = set of TRttiCacheFlag;

  /// convenient wrapper about PRttiInfo content and its more precise information
  // - is cached within TRttiCustom instances for more efficient process
  TRttiCache = record
    /// the associated RTTI TypeInfo()
    Info: PRttiInfo;
    /// the size in bytes of a value of this type - equals Info^.RttiSize
    Size: integer;
    /// equals Info^.Kind
    Kind: TRttiKind;
    /// quick identification of specific types, e.g. rkOrdinalTypes
    Flags: TRttiCacheFlags;
    /// for rkHasRttiOrdTypes/rcfHasRttiOrd, equals Info^.RttiOrd
    RttiOrd: TRttiOrd;
    /// corresponding TRttiVarData.VType
    // - rkEnumeration,rkSet,rkDynArray,rkClass,rkInterface,rkRecord,rkArray are
    // identified as varAny with TVarData.VAny pointing to the actual value, and
    // will be handled as expected by TJsonWriter.AddRttiVarData
    RttiVarDataVType: word;
    /// corresponding TVarData.VType
    // - in respect to RttiVarDataVType, rkEnumeration and rkSet are varInt64
    // since we don't need the RTTI information as for TRttiVarData
    VarDataVType: word;
    /// type-specific information
    case TRttiKind of
      rkFloat: (
        RttiFloat: TRttiFloat;
        IsDateTime: boolean);
      rkLString: ( // from TypeInfo() on older Delphi with no CP RTTI
        CodePage: cardinal; // RawBlob=CP_RAWBYTESTRING not CP_RAWBLOB
        Engine: TSynAnsiConvert);
      rkEnumeration,
      rkSet: (
        EnumMin,
        EnumMax:  cardinal;
        EnumInfo: PRttiEnumType;
        EnumList: PShortString);
      rkDynArray,
      rkArray: (
        ItemInfo: PRttiInfo; // = nil for unmanaged types
        ItemSize: integer;
        ItemCount: integer;  // rkArray only
      );
      rkClass: (
        SerializableInterface: pointer; // = TRttiCustom of the rkInterface
      );
      rkInterface: (
        InterfaceGuid: PGuid;
        SerializableClass: TClass; // = TInterfacedSerializable
        SerializableInterfaceEntryOffset: integer; // resolve once
      );
  end;

  /// map extended PRttiInfo content
  PRttiCache = ^TRttiCache;

  {$A-}

  /// main entry-point wrapper to access RTTI for a given pascal type
  // - as returned by the TypeInfo() low-level compiler function
  // - other RTTI objects can be computed from a pointer to this structure
  // - user types defined as an alias don't have this type information:
  // ! type
  // !   TNewType = TOldType;
  // here TypeInfo(TNewType) = TypeInfo(TOldType)
  // - user types defined as new types have this type information:
  // ! type
  // !   TNewType = type TOldType;
  // here TypeInfo(TNewType) <> TypeInfo(TOldType)
  {$ifdef USERECORDWITHMETHODS}
  TRttiInfo = record
  {$else}
  TRttiInfo = object
  {$endif USERECORDWITHMETHODS}
  public
    /// the value type family
    // - not defined as an inlined function, since first field is always aligned
    Kind: TRttiKind;
    /// the declared name of the type ('String','Word','RawUnicode'...)
    // - won't adjust internal/cardinal names on FPC as with Name method
    RawName: ShortString;
    /// the declared name of the type ('String','Word','RawUnicode'...)
    // - will return '' if @self is nil
    // - on FPC, will adjust 'integer'/'cardinal' from 'longint'/'longword' RTTI
    // - on Delphi and FPC, will adjust weak RawUtf8 = UTF8String as 'RawUtf8'
    function Name: PShortString;
    /// efficiently finalize any (managed) type value
    // - do nothing for unmanaged types (e.g. integer)
    // - if you are sure that your type is managed, you may call directly
    // $ RTTI_FINALIZE[Info^.Kind](Data, Info);
    procedure Clear(Data: pointer);
      {$ifdef HASINLINE}inline;{$endif}
    /// efficiently copy any (managed) type value
    // - do nothing for unmanaged types (e.g. integer)
    // - if you are sure that your type is managed, you may call directly
    // $ RTTI_MANAGEDCOPY[Info^.Kind](Dest, Source, Info);
    procedure Copy(Dest, Source: pointer);
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// compute extended information about this RTTI type
    procedure ComputeCache(var Cache: TRttiCache);
    /// for ordinal types, get the storage size and sign
    function RttiOrd: TRttiOrd;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// return TRUE if the property is an unsigned 64-bit field (QWord/UInt64)
    function IsQWord: boolean;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// return TRUE if the property is a boolean field
    function IsBoolean: boolean;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// return TRUE if the property is a currency field
    function IsCurrency: boolean;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// return TRUE if the property is a TDateTime/TDateTimeMS/TDate
    function IsDate: boolean;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// return true if this property is a BLOB (RawBlob)
    function IsRawBlob: boolean;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// for rkFloat: get the storage size and precision
    // - will also properly detect our currency internal type as rfCurr
    function RttiFloat: TRttiFloat;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// for rkEnumeration: get the enumeration type information
    function EnumBaseType: PRttiEnumType; overload;
      {$ifdef FPC}inline;{$endif} { on Delphi, inline would require typinfo }
    /// for rkEnumeration: get the enumeration values information
    function EnumBaseType(out NameList: PShortString;
      out Min, Max: integer): PRttiEnumType; overload;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// for rkSet: get the type information of its associated enumeration
    function SetEnumType: PRttiEnumType; overload;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// for rkSet: get the associated enumeration values information
    function SetEnumType(out NameList: PShortString;
      out Min, Max: integer): PRttiEnumType; overload;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// for rkSet: in how many bytes this type is stored
    // - is very efficient on latest FPC only - i.e. ifdef ISFPC32
    function SetEnumSize: PtrInt; {$ifdef ISFPC32} inline; {$endif}
    /// compute in how many bytes this type is stored
    // - will use Kind (and RttiOrd/RttiFloat) to return the exact value
    function RttiSize: PtrInt;
    /// check if this type is a managed type, or has any managed field
    // - will also check for the nested fields e.g. for rkRecordTypes
    function IsManaged: boolean;
    /// for rkRecordTypes: get the record size
    // - returns 0 if the type is not a record/object
    function RecordSize: PtrInt;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// for rkRecordTypes: retrieve RTTI information about all managed fields
    // of this record
    // - non managed fields (e.g. integers, double...) are not listed here
    // - also includes the total record size in bytes
    // - caller should ensure the type is indeed a record/object
    // - note: if FPC_OLDRTTI is defined, unmanaged fields are included
    procedure RecordManagedFields(out Fields: TRttiRecordManagedFields);
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// for rkRecordTypes: check if this record as any managed fields
    function RecordManagedFieldsCount: integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// for rkRecordTypes: retrieve enhanced RTTI information about all fields
    // of this record, for JSON serialization without text definition
    // - this information is currently only available since Delphi 2010
    // - if any field has no RTTI (e.g. a static array of unmanaged type), then
    // it will ignore this uncomplete, therefore non-useful RTTI
    // - in practice, it may be a good habit to always define the records used
    // within the SOA (e.g. as DTOs) calling RegisterFromText, and don't rely on
    // this RTTI, since it will be more cross-platform, and more customizable
    function RecordAllFields(out RecSize: PtrInt): TRttiRecordAllFields;
    /// for rkDynArray: get the dynamic array standard RTTI of the stored item
    // - returns nil if the item has no managed field
    // - caller should ensure the type is indeed a dynamic array
    function DynArrayItemType: PRttiInfo; overload;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// for rkDynArray: get the dynamic array deep RTTI of the stored item
    // - works for both managed and unmanaged types, on FPC and Delphi 2010+
    // - caller should ensure the type is indeed a dynamic array
    function DynArrayItemTypeExtended: PRttiInfo;
    /// for rkDynArray: get the dynamic array type information of the stored item
    // - this overloaded method will also return the item size in bytes
    // - caller should ensure the type is indeed a dynamic array
    function DynArrayItemType(out aDataSize: PtrInt): PRttiInfo; overload;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// for rkDynArray: get the dynamic array size (in bytes) of the stored item
    function DynArrayItemSize: PtrInt;
      {$ifdef HASINLINE}inline;{$endif}
    /// for rkArray: get the static array type information of the stored item
    // - returns nil if the array type is unmanaged (i.e. behave like Delphi)
    // - aDataSize is the size in bytes of all aDataCount static items (not
    // the size of each item)
    // - caller should ensure the type is indeed a static array
    function ArrayItemType(out aDataCount, aDataSize: PtrInt): PRttiInfo;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// for rkArray: get the size in bytes of all the static array items
    // - caller should ensure the type is indeed a static array
    function ArraySize: PtrInt;
      {$ifdef HASINLINE}inline;{$endif}
    /// recognize most used string types, returning their code page
    // - will return the exact code page on FPC and since Delphi 2009, from RTTI
    // - for non Unicode versions of Delphi, will recognize WinAnsiString as
    // CP_WINANSI, RawUnicode as CP_UTF16, RawByteString/RawBlob as
    // CP_RAWBYTESTRING, AnsiString as CP_ACP=0, and any other type as RawUtf8
    // - it will also recognize RawBlob as the fake CP_RAWBLOB codepage
    function AnsiStringCodePage: integer;
      {$ifdef HASCODEPAGE}{$ifdef HASSAFEINLINE}inline;{$endif}{$endif}
    {$ifdef HASCODEPAGE}
    /// returning the code page stored in the RTTI
    // - without recognizing e.g. RawBlob
    // - caller should ensure the type is indeed a rkLString
    function AnsiStringCodePageStored: integer;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    {$endif HASCODEPAGE}
    /// retrieve rkLString, rkSString, rkUString, rkWString, rkChar, rkWChar
    // values as RawUtf8, from a pointer to its memory storage
    // - makes heap allocations and encoding conversion, so may be slow
    procedure StringToUtf8(Data: pointer; var Value: RawUtf8);
    /// for rkClass: get the class type information
    function RttiClass: PRttiClass;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// for rkClass: get the class type information
    function RttiNonVoidClass: PRttiClass;
      {$ifdef HASINLINE}inline;{$endif}
    /// for rkClass: return the number of published properties in this class
    // - you can count the plain fields without any getter function, if you
    // do need only the published properties corresponding to some value
    // actually stored, and ignore e.g. any textual conversion
    function ClassFieldCount(onlyWithoutGetter: boolean): integer;
    /// for rkClass: fast and easy check if a class inherits from this RTTI
    function InheritsFrom(AClass: TClass): boolean;
    /// for rkInterface: get the interface type information
    function InterfaceType: PRttiInterfaceTypeData;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// for rkInterface: get the TGuid of a given interface type information
    // - returns nil if this type is not an interface
    function InterfaceGuid: PGuid;
    /// for rkInterface: get the unit name of a given interface type information
    // - returns '' if this type is not an interface
    function InterfaceUnitName: PShortString;
    /// for rkInterface: get the ancestor/parent of a given interface type information
    // - returns nil if this type has no parent
    function InterfaceAncestor: PRttiInfo;
    /// for rkInterface: get all ancestors/parents of a given interface type information
    // - only ancestors with an associated TGuid will be added
    // - if OnlyImplementedBy is not nil, only the interface explicitly
    // implemented by this class will be added, and AncestorsImplementedEntry[]
    // will contain the corresponding PInterfaceEntry values
    procedure InterfaceAncestors(out Ancestors: PRttiInfoDynArray;
      OnlyImplementedBy: TInterfacedObjectClass;
      out AncestorsImplementedEntry: TPointerDynArray);
    /// for rkInterface: check if this type (or ancestor) implements a TGuid
    function InterfaceImplements(const AGuid: TGuid): boolean;
  end;

  {$A+}

  /// how a RTTI property definition access its value
  // - as returned by TPropInfo.Getter/Setter/GetterIs/SetterIs methods
  TRttiPropCall = (
    rpcNone,
    rpcField,
    rpcMethod,
    rpcIndexed);

  /// TRttiProp.IsStoredKind response - default is "stored true"
  TRttiPropStored = (
    rpsTrue,
    rpsFalse,
    rpsGetter);

  /// a wrapper containing a RTTI class property definition
  // - used for direct Delphi / UTF-8 SQL type mapping/conversion
  // - doesn't depend on RTL's TypInfo unit, to enhance cross-compiler support
  {$ifdef USERECORDWITHMETHODS}
  TRttiProp = record
  {$else}
  TRttiProp = object
  {$endif USERECORDWITHMETHODS}
  public
    /// raw retrieval of the property read access definition
    // - note: 'var Call' generated incorrect code on Delphi XE4 -> use PMethod
    function Getter(Instance: TObject; Call: PMethod): TRttiPropCall;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// raw retrieval of the property access definition
    function Setter(Instance: TObject; Call: PMethod): TRttiPropCall;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// raw retrieval of rkInteger,rkEnumeration,rkSet,rkChar,rkWChar,rkBool
    // - rather call GetOrdValue/GetInt64Value
    // - returns an Int64 to properly support cardinal values
    function GetOrdProp(Instance: TObject): Int64;
    /// raw assignment of rkInteger,rkEnumeration,rkSet,rkChar,rkWChar,rkBool
    // - rather call SetOrdValue/SetInt64Value
    procedure SetOrdProp(Instance: TObject; Value: PtrInt);
    /// raw retrieval of rkClass
    function GetObjProp(Instance: TObject): TObject;
    /// raw retrieval of rkDynArray getter as a pointer
    // - caller should then release the instance using e.g. FastDynArrayClear()
    // - do nothing if the property is a field with no getter
    function GetDynArrayPropGetter(Instance: TObject): pointer;
    /// raw retrieval of rkInt64, rkQWord
    // - rather call GetInt64Value
    function GetInt64Prop(Instance: TObject): Int64;
    /// raw assignment of rkInt64, rkQWord
    // - rather call SetInt64Value
    procedure SetInt64Prop(Instance: TObject; const Value: Int64);
    /// raw retrieval of rkLString
    procedure GetLongStrProp(Instance: TObject; var Value: RawByteString);
    /// raw assignment of rkLString
    procedure SetLongStrProp(Instance: TObject; const Value: RawByteString);
    /// raw copy of rkLString
    procedure CopyLongStrProp(Source, Dest: TObject);
    /// raw retrieval of rkString into an Ansi7String
    procedure GetShortStrProp(Instance: TObject; var Value: RawUtf8);
    /// raw retrieval of rkWString
    procedure GetWideStrProp(Instance: TObject; var Value: WideString);
    /// raw assignment of rkWString
    procedure SetWideStrProp(Instance: TObject; const Value: WideString);
    {$ifdef HASVARUSTRING}
    /// raw retrieval of rkUString
    procedure GetUnicodeStrProp(Instance: TObject; var Value: UnicodeString);
    /// raw assignment of rkUString
    procedure SetUnicodeStrProp(Instance: TObject; const Value: UnicodeString);
    {$endif HASVARUSTRING}
    /// raw retrieval of rkFloat/currency
    // - use instead GetCurrencyValue
    procedure GetCurrencyProp(Instance: TObject; var Value: currency);
    /// raw assignment of rkFloat/currency
    procedure SetCurrencyProp(Instance: TObject; const Value: currency);
    /// raw retrieval of rkFloat/double
    function GetDoubleProp(Instance: TObject): double;
    /// raw assignment of rkFloat/double
    procedure SetDoubleProp(Instance: TObject; Value: Double);
    /// raw retrieval of rkFloat - with conversion to 64-bit double
    // - use instead GetDoubleProp if you know the property is a rkFloat/double
    function GetFloatProp(Instance: TObject): double;
    /// raw assignment of rkFloat
    // - use instead SetDoubleProp if you know the property is a rkFloat/double
    procedure SetFloatProp(Instance: TObject; Value: TSynExtended);
    /// raw retrieval of rkVariant
    // - will use varByRef from the field address if SetByRef is true
    procedure GetVariantProp(Instance: TObject; var Result: Variant; SetByRef: boolean);
    /// raw assignment of rkVariant
    procedure SetVariantProp(Instance: TObject; const Value: Variant);
  public
    /// contains the index value of an indexed class data property
    // - outside SQLite3, this can be used to define a VARCHAR() length value
    // for the textual field definition (sftUtf8Text/sftAnsiText); e.g.
    // the following will create a NAME VARCHAR(40) field:
    // ! Name: RawUtf8 index 40 read fName write fName;
    // - is used by a dynamic array property for fast usage of the
    // TOrm.DynArray(DynArrayFieldIndex) method
    function Index: integer;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// contains the default value for an ordinal or set property
    // - NO_DEFAULT=$80000000 indicates none was defined in source code
    // - see also TPropInfo.DefaultOr0
    function Default: integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// return the Default RTTI value defined for this property, or 0 if not set
    function DefaultOr0: integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// index of the property in the current inherited class definition
    // - first name index at a given class level is 0
    // - index is reset to 0 at every inherited class level
    function NameIndex: integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// the property Name, directly returned from RTTI
    function Name: PShortString;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// the property Name, converted as a RawUtf8
    function NameUtf8: RawUtf8;
    /// the type information of this property
    // - will de-reference the PropType pointer on Delphi and newer FPC compilers
    function TypeInfo: PRttiInfo;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// get the next property information
    // - no range check: use RttiProps()^.PropCount to determine the properties count
    // - get the first PRttiProp with RttiProps()^.PropList
    function Next: PRttiProp;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// returns rpsTrue/rpsFalse if was marked as "stored true/false" or
    // rpsGetter if IsStoredGetter(Instance) is to be called at runtime
    function IsStoredKind: TRttiPropStored;
    /// raw retrieval of the 'stored' flag using getter
    /// - called by IsStored or for TRttiPropStored = rpsGetter
    function IsStoredGetter(Instance: TObject): boolean;
    /// return the "stored true/false/method/field" value for a class property
    // - not used internally: for backward compatibility only
    function IsStored(Instance: TObject): boolean;
    /// return true if this property is a BLOB (RawBlob)
    function IsRawBlob: boolean;
      {$ifdef FPC} inline; {$endif}
    /// compute in how many bytes this property is stored
    function FieldSize: PtrInt;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// return TRUE if the property has no getter but direct field read
    // - returns FALSE if no "read" attribute was specified: use GetterCall
    // if you want to mimic how Get*() methods could use the "write" field
    function GetterIsField: boolean;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// return TRUE if the property has no setter but direct field write
    // - returns FALSE if no "write" attribute is specified: use SetterCall
    // if you want to mimic how Set*() methods could use the "read" field
    function SetterIsField: boolean;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// returns how a property should be retrieved
    // - no "read" attribute specified will return rpcField if "write" is a
    // direct field access - just like any Get*() method would do
    function GetterCall: TRttiPropCall;
    /// returns how a property should be set
    // - no "write" attribute specified will return rpcField if "read" is a
    // direct field access - just like any Set*() method would do
    function SetterCall: TRttiPropCall;
    /// return TRUE if the property has a write setter or direct field
    function WriteIsDefined: boolean;
      {$ifdef HASINLINE}inline;{$endif}
    /// returns the low-level field read address, if GetterIsField is TRUE
    function GetterAddr(Instance: pointer): pointer;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// returns the low-level field write address, if SetterIsField is TRUE
    function SetterAddr(Instance: pointer): pointer;
      {$ifdef HASSAFEINLINE}inline;{$endif}
    /// low-level getter of the field value memory pointer
    // - return NIL if both getter and setter are methods
    function GetFieldAddr(Instance: TObject): pointer;
      {$ifdef HASSAFEINLINE}inline;{$endif}

    /// low-level getter of the ordinal property value of a given instance
    // - this method will check if the corresponding property is ordinal
    // - returns an Int64 to properly support cardinal values
    // - return -1 on any error
    function GetOrdValue(Instance: TObject): Int64;
      {$ifdef FPC}inline;{$endif}
    /// low-level getter of the ordinal property value of a given instance
    // - this method will check if the corresponding property is ordinal
    // - ordinal properties smaller than rkInt64 will return an Int64-converted
    // value (e.g. rkInteger)
    // - return 0 on any error
    function GetInt64Value(Instance: TObject): Int64;
    /// low-level getter of the currency property value of a given instance
    // - this method will check if the corresponding property is exactly currency
    // - return 0 on any error
    procedure GetCurrencyValue(Instance: TObject; var Value: currency);
    /// low-level getter of the floating-point property value of a given instance
    // - this method will check if the corresponding property is floating-point
    // - return 0 on any error
    function GetDoubleValue(Instance: TObject): double;
    /// low-level setter of the floating-point property value of a given instance
    // - this method will check if the corresponding property is floating-point
    procedure SetDoubleValue(Instance: TObject; const Value: double);
    /// low-level getter of the long string property content of a given instance
    // - just a wrapper around low-level GetLongStrProp() function
    // - call GetLongStrValue() method if you want a conversion into RawUtf8
    // - will work only for Kind=rkLString
    procedure GetRawByteStringValue(Instance: TObject; var Value: RawByteString);
    /// low-level setter of the ordinal property value of a given instance
    // - this method will check if the corresponding property is ordinal
    procedure SetOrdValue(Instance: TObject; Value: PtrInt);
    /// low-level setter of the ordinal property value of a given instance
    // - this method will check if the corresponding property is ordinal
    procedure SetInt64Value(Instance: TObject; Value: Int64);
    {$ifdef HASVARUSTRING}
    /// low-level setter of the Unicode string property value of a given instance
    // - this method will check if the corresponding property is a Unicode String
    procedure SetUnicodeStrValue(Instance: TObject; const Value: UnicodeString);
    /// low-level getter of the Unicode string property value of a given instance
    // - this method will check if the corresponding property is a Unicode String
    function GetUnicodeStrValue(Instance: TObject): UnicodeString;
    {$endif HASVARUSTRING}
    /// retrieve rkLString, rkSString, rkUString, rkWString, rkChar, rkWChar as RawUtf8
    // - this would make heap allocations and encoding conversion, so may be slow
    function GetAsString(Instance: TObject; var Value: RawUtf8): boolean; overload;
    /// retrieve rkLString, rkSString, rkUString, rkWString, rkChar, rkWChar as RawUtf8
    // - just a wrapper around the overloaded GetAsString() function
    function GetAsString(Instance: TObject): RawUtf8; overload;
      {$ifdef HASINLINE} inline; {$endif}
    /// get a property value into text
    // - handle all kind of fields, e.g. converting ordinal or floats into text
    function GetValueText(Instance: TObject): RawUtf8;
    /// set rkLString, rkSString, rkUString, rkWString, rkChar, rkWChar from
    // a RawUtf8 value
    // - this would make heap allocations and encoding conversion, so may be slow
    function SetAsString(Instance: TObject; const Value: RawUtf8): boolean;
    /// set a property value from a variant value
    // - to be called when a setter is involved - not very fast, but safe
    function SetValue(Instance: TObject; const Value: variant): boolean;
    /// set a property value from a text value
    // - handle simple kind of fields, e.g. converting from text into ordinals
    // or floats, and also enumerates or sets; but won't support complex types
    // like class instances, dynamic arrays or variants
    function SetValueText(Instance: TObject; const Value: RawUtf8): boolean;
  end;

const
  NO_DEFAULT = integer($80000000);

/// retrieve the text name of one TRttiKind enumerate
function ToText(k: TRttiKind): PShortString; overload;

var
  /// convert an ordinal value from its (signed) pointer-sized integer representation
  RTTI_FROM_ORD: array[TRttiOrd] of function(P: pointer): Int64;

  /// convert an ordinal value into its RTTI-defined binary buffer
  RTTI_TO_ORD: array[TRttiOrd] of procedure(P: pointer; Value: PtrInt);

  /// convert a float value into its RTTI-defined binary buffer
  RTTI_TO_FLOAT: array[TRttiFloat] of procedure(P: pointer; Value: TSynExtended);


{$ifdef HASINLINE}
// some functions which should be defined here for proper inlining

{$ifdef FPC}

{$ifndef HASDIRECTTYPEINFO}
function Deref(Info: pointer): pointer; inline;
{$endif HASDIRECTTYPEINFO}

{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
function AlignToPtr(p: pointer): pointer; inline;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}

{$endif FPC}

type
  // redefined here for proper Delphi inlining
  PTypeData = type typinfo.PTypeData;
  TPropInfo = type typinfo.TPropInfo;
  PPropInfo = type typinfo.PPropInfo;

/// efficiently inlined low-level function to retrieve raw RTTI structure
function GetTypeData(TypeInfo: pointer): PTypeData; inline;

{$endif HASINLINE}

{$ifdef ISDELPHI}// Delphi requires those definitions for proper inlining

const
  NO_INDEX = integer($80000000);

  ptField = $ff;
  ptVirtual = $fe;

type
  /// used to map a TPropInfo.GetProc/SetProc and retrieve its kind
  // - defined here for proper Delphi inlining
  PropWrap = packed record
    FillBytes: array [0 .. SizeOf(Pointer) - 2] of byte;
    /// =$ff for a ptField address, or =$fe for a ptVirtual method
    Kind: byte;
  end;

  /// PPropData not defined in Delphi 7/2007 TypInfo
  // - defined here for proper Delphi inlining
  TPropData = packed record
    PropCount: word;
    PropList: record end;
  end;
  PPropData = ^TPropData;

  /// rkRecord RTTI is not defined in Delphi 7/2007 TTypeData
  // - defined here for proper Delphi inlining
  TRecordInfo = packed record
    RecSize: integer;
    ManagedFldCount: integer;
  end;
  PRecordInfo = ^TRecordInfo;

  /// rkArray RTTI not defined in Delphi 7/2007 TTypeData
  // - defined here for proper Delphi inlining
  TArrayInfo = packed record
    ArraySize: integer;
    ElCount: integer;
    ArrayType: PPRttiInfo;
    DimCount: byte;
    Dims: array[0..255 {DimCount-1}] of PPRttiInfo;
  end;
  PArrayInfo = ^TArrayInfo;

{$endif ISDELPHI}


{ **************** Published Class Properties and Methods RTTI }

/// retrieve the class RTTI information for a specific class
function GetRttiClass(RttiClass: TClass): PRttiClass;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the class property RTTI information for a specific class
function GetRttiProps(RttiClass: TClass): PRttiProps;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the class property RTTI information for a specific class
// - will return the number of published properties
// - and set the PropInfo variable to point to the first property
// - typical use to enumerate all published properties could be:
//  !  var i: integer;
//  !      CT: TClass;
//  !      P: PRttiProp;
//  !  begin
//  !    CT := ..;
//  !    repeat
//  !      for i := 1 to GetRttiProp(CT,P) do
// !       begin
//  !        // use P^
//  !        P := P^.Next;
//  !      end;
//  !      CT := GetClassParent(CT);
//  !    until CT=nil;
//  !  end;
// such a loop is much faster than using the RTL's TypeInfo or RTTI units
function GetRttiProp(C: TClass; out PropInfo: PRttiProp): integer;

/// retrieve a Field property RTTI information from a Property Name
function ClassFieldProp(ClassType: TClass; const PropName: ShortString): PRttiProp;

/// retrieve a Field property RTTI information from a Property Name
// - this special version also searches into parent properties
// (TRttiProp search scope is only inside the current class level)
function ClassFieldPropWithParents(aClassType: TClass; const aPropName: ShortString;
  aCaseSensitive: boolean = false): PRttiProp;

/// retrieve an integer/Int64 Field propery value from a Property Name
// - this special version also searches into parent properties
// (TRttiProp search scope is only inside the current class level)
// - returns TRUE and set PropValue if a matching property was found
function ClassFieldInt64(Instance: TObject; const PropName: ShortString;
  out PropValue: Int64): boolean;

/// retrieve a class Field property instance from a Property Name
// - this special version also searches into parent properties
// (TRttiProp search scope is only inside the current class level)
// - returns TRUE and set PropInstance if a matching property was found
function ClassFieldInstance(Instance: TObject; const PropName: ShortString;
  PropClassType: TClass; out PropInstance): boolean; overload;

/// retrieve a Field property RTTI information from a Property Name
// - this special version also searches into parent properties
// (TRttiProp search scope is only inside the current class level)
function ClassFieldPropWithParentsFromUtf8(aClassType: TClass; PropName: PUtf8Char;
  PropNameLen: integer; aCaseSensitive: boolean = false): PRttiProp;

/// retrieve a Field property RTTI information searching for an exact
// Property class type
// - this special version also searches into parent properties
function ClassFieldPropWithParentsFromClassType(aClassType,
  aSearchedClassType: TClass): PRttiProp;

/// retrieve a Field property RTTI information searching for an inherited
// Property class type
// - this special version also searches into parent properties
function ClassFieldPropWithParentsInheritsFromClassType(aClassType,
  aSearchedClassType: TClass): PRttiProp;

/// retrieve a Field property RTTI information searching for an exact
// Property offset address
// - this special version also searches into parent properties
function ClassFieldPropWithParentsFromClassOffset(aClassType: TClass;
  aSearchedOffset: pointer): PRttiProp;

/// retrieve a class Field property instance from a Property class type
// - this version also searches into parent properties
// - returns TRUE and set PropInstance if a matching property was found
function ClassFieldInstance(Instance: TObject; PropClassType: TClass;
  out PropInstance): boolean; overload;

/// retrieve all class Field property instances from a Property class type
// - this version also searches into parent properties
// - returns all matching property instances found
function ClassFieldInstances(Instance: TObject;
  PropClassType: TClass): TObjectDynArray;

/// retrieve a class instance property value matching a class type
// - if aSearchedInstance is aSearchedClassType, will return aSearchedInstance
// - if aSearchedInstance is not aSearchedClassType, it will try all nested
// properties of aSearchedInstance for a matching aSearchedClassType: if no
// exact match is found, will return aSearchedInstance
function ClassFieldPropInstanceMatchingClass(aSearchedInstance: TObject;
  aSearchedClassType: TClass): TObject;

/// retrieve the total number of properties for a class, including its parents
function ClassFieldCountWithParents(ClassType: TClass;
  onlyWithoutGetter: boolean = false): integer;

/// returns TRUE if the class has some published fields, including its parents
function ClassHasPublishedFields(ClassType: TClass): boolean;

/// retrieve all class hierachy types which have some published properties
function ClassHierarchyWithField(ClassType: TClass): TClassDynArray;

/// retrieve the PRttiProp values of all published properties of a class
// - you could select which property types should be included in the list
function ClassFieldAllProps(ClassType: TClass;
  Types: TRttiKinds = [low(TRttiKind)..high(TRttiKind)]): PRttiPropDynArray;

/// retrieve the field names of all published properties of a class
// - will optionally append the property type to the name, e.g 'Age: integer'
// - you could select which property types should be included in the list
function ClassFieldNamesAllProps(
  ClassType: TClass; IncludePropType: boolean = false;
  Types: TRttiKinds = [low(TRttiKind)..high(TRttiKind)]): TRawUtf8DynArray;

/// retrieve the field names of all published properties of a class
// - will optionally append the property type to the name, e.g 'Age: integer'
// - you could select which property types should be included in the list
function ClassFieldNamesAllPropsAsText(
  ClassType: TClass; IncludePropType: boolean = false;
  Types: TRttiKinds = [low(TRttiKind)..high(TRttiKind)]): RawUtf8;


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

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


/// copy object properties
// - copy integer, Int64, enumerates (including boolean), variant, records,
// dynamic arrays, classes and any string properties (excluding ShortString)
// - TCollection items can be copied also, if they are of the same exact class
// - object properties instances are created in aTo if the objects are not
// TOrm children (in this case, these are not class instances, but
// INTEGER reference to records, so only the integer value is copied), that is
// for regular classes
procedure CopyObject(aFrom, aTo: TObject); overload;

/// create a new object instance, from an existing one
// - will create a new instance of the same class, then call the overloaded
// CopyObject() procedure to copy its values
function CopyObject(aFrom: TObject): TObject; overload;

/// copy two TStrings instances
// - will just call Dest.Assign(Source) in practice
procedure CopyStrings(Source, Dest: TStrings);

/// copy two TCollection instances
// - will call CopyObject() in loop to repopulate the Dest collection,
// which will work even if Assign() method was not overriden
procedure CopyCollection(Source, Dest: TCollection);

/// set any default integer or enumerates (including boolean) published
// properties values for a TPersistent/TSynPersistent
// - set only the values set as "property ... default ..." at class type level
// - will also reset the published properties of the nested classes
procedure SetDefaultValuesObject(Instance: TObject);

/// set any (potentially nested) object property by path
// - see also GetValueObject() from mormot.core.json
function SetValueObject(Instance: TObject; const Path: RawUtf8;
  const Value: variant): boolean;

/// returns TRUE on a nil instance or if all its published properties are default/0
// - check nested TRttiCustom.Props and TRttiCustom.ValueIterateCount
function IsObjectDefaultOrVoid(Value: TObject): boolean;

/// will reset all the object properties to their default
// - strings will be set to '', numbers to 0
// - if FreeAndNilNestedObjects is the default FALSE, will recursively reset
// all nested class properties values
// - if FreeAndNilNestedObjects is TRUE, will FreeAndNil() all the nested
// class properties
// - for a TOrm, use its ClearProperties method instead, which will
// handle the ID property, and any nested JOINed instances
procedure ClearObject(Value: TObject; FreeAndNilNestedObjects: boolean = false);

/// release all low-level managed fields of this instance
// - just a wrapper around Value.CleanupInstance
procedure FinalizeObject(Value: TObject);
  {$ifdef HASINLINE} inline; {$endif}

/// fill a class instance properties from command line switches
// - SwitchPrefix + property name will be searched in CommandLine.Names[]
// - is typically used to fill a settings class instance
// - won't include any nested class or dynamic array properties
function SetObjectFromExecutableCommandLine(Value: TObject;
  const SwitchPrefix, DescriptionSuffix: RawUtf8;
  CommandLine: TExecutableCommandLine = nil): boolean;


{ *************** Enumerations RTTI }

/// helper to retrieve low-level RTTI information of an enumeration type
// - just a wrapper around
// $ aTypeInfo^.EnumBaseType(List, result);
function GetEnumType(aTypeInfo: PRttiInfo; out List: PShortString): integer;

/// helper to retrieve the text of an enumerate item
// - just a wrapper around
// $ aTypeInfo^.EnumBaseType.GetEnumNameOrd(aIndex)
function GetEnumName(aTypeInfo: PRttiInfo; aIndex: integer): PShortString;

/// get the corresponding enumeration name, without the first lowercase chars
// - e.g. otDone -> 'Done'
// - this will return the code-based English text; use GetEnumCaption() to
// retrieve the enumeration display text
function GetEnumNameTrimed(aTypeInfo: PRttiInfo; aIndex: integer): RawUtf8;

/// get the enumeration name, without the first lowercase chars, and uncamelcased
// - e.g. otProcessDone -> 'Process done'
function GetEnumNameUnCamelCase(aTypeInfo: PRttiInfo; aIndex: integer): RawUtf8;

/// helper to retrieve all texts of an enumerate
// - may be used as cache for overloaded ToText() content
procedure GetEnumNames(aTypeInfo: PRttiInfo; aDest: PPShortString);

/// helper to retrieve all trimmed texts of an enumerate
// - may be used as cache to retrieve UTF-8 text without lowercase 'a'..'z' chars
procedure GetEnumTrimmedNames(aTypeInfo: PRttiInfo; aDest: PRawUtf8); overload;

/// helper to retrieve all trimmed texts of an enumerate as UTF-8 strings
// - typical usage is the following:
// ! var
// !   TXT: array[TBenchmark] of RawUtf8;
// ! ...
// !   GetEnumTrimmedNames(TypeInfo(TBenchmark), @TXT);
function GetEnumTrimmedNames(aTypeInfo: PRttiInfo): TRawUtf8DynArray; overload;

/// helper to retrieve the index of an enumerate item from its text
// - returns -1 if aValue was not found
// - will search for the exact text and also trim the lowercase 'a'..'z' chars on
// left side of the text if no exact match is found and AlsoTrimLowerCase is TRUE
function GetEnumNameValue(aTypeInfo: PRttiInfo; aValue: PUtf8Char; aValueLen: PtrInt;
  AlsoTrimLowerCase: boolean = false): integer; overload;

/// retrieve the index of an enumerate item from its left-trimmed text
// - text comparison is case-insensitive for A-Z characters
// - will trim the lowercase 'a'..'z' chars on left side of the supplied aValue text
// - returns -1 if aValue was not found
function GetEnumNameValueTrimmed(aTypeInfo: PRttiInfo;
  aValue: PUtf8Char; aValueLen: PtrInt): integer;

/// retrieve the index of an enumerate item from its left-trimmed text
// - text comparison is case-sensitive for A-Z characters
// - will trim the lowercase 'a'..'z' chars on left side of the supplied aValue text
// - returns -1 if aValue was not found
function GetEnumNameValueTrimmedExact(aTypeInfo: PRttiInfo;
  aValue: PUtf8Char; aValueLen: PtrInt): integer;

/// helper to retrieve the index of an enumerate item from its text
function GetEnumNameValue(aTypeInfo: PRttiInfo; const aValue: RawUtf8;
  AlsoTrimLowerCase: boolean = false): integer; overload;

/// store an enumeration value from its ordinal representation
procedure SetEnumFromOrdinal(aTypeInfo: PRttiInfo; out Value; Ordinal: PtrUInt);

/// helper to retrieve the CSV text of all enumerate items defined in a set
function GetSetName(aTypeInfo: PRttiInfo; const value): RawUtf8;

/// helper to retrieve the CSV text of all enumerate items defined in a set
procedure GetSetNameShort(aTypeInfo: PRttiInfo; const value;
  out result: ShortString; trimlowercase: boolean = false);

/// low-level function parsing Value/ValueLen into a set, returned as 64-bit
procedure SetNamesValue(SetNames: PShortString; MinValue, MaxValue: integer;
  Value: PUtf8Char; ValueLen: PtrInt; var Result: QWord);

/// helper to parse some CSV values into a set, returned as 64-bit
// - see also GetSetNameValue() in mormot.core.json.pas for parsing a JSON array
function GetSetCsvValue(aTypeInfo: PRttiInfo; Csv: PUtf8Char;
  Sep: AnsiChar = ','): QWord;

/// helper to retrieve all (translated) caption texts of an enumerate
// - may be used as cache for overloaded ToCaption() content
procedure GetEnumCaptions(aTypeInfo: PRttiInfo; aDest: PString);

/// UnCamelCase and translate the enumeration item
function GetCaptionFromEnum(aTypeInfo: PRttiInfo; aIndex: integer): string;

/// low-level helper to retrieve a (translated) caption from a PShortString
// - as used e.g. by GetEnumCaptions or GetCaptionFromEnum
procedure GetCaptionFromTrimmed(PS: PShortString; var result: string);

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

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

/// defined here to avoid circular dependency in mormot.core.os.pas
function ToText(cmd: TParseCommands): ShortString; overload;

/// defined here to avoid circular dependency in mormot.core.os.pas
function ToText(w: TWellKnownSid): PShortString; overload;


{ ***************** IInvokable Interface RTTI }

type
  /// handled kind of parameters direction for an interface method
  // - IN, IN/OUT, OUT directions can be applied to arguments, e.g. to be
  // available through our JSON-serialized remote access: rmdVar and rmdOut
  // kind of parameters will be returned within the "result": JSON array
  // - rmdResult is used for a function method, to handle the returned value
  TRttiMethodArgDirection = (
    rmdConst,
    rmdVar,
    rmdOut,
    rmdResult);

  /// set of parameter directions e.g. for an interface-based service method
  TRttiMethodArgDirections = set of TRttiMethodArgDirection;

  TRttiMethodArg = record
    /// the argument name, as declared in pascal code
    ParamName: PShortString;
    /// the type name, as declared in pascal code
    TypeName: PShortString;
    /// the low-level RTTI information of this argument
    TypeInfo: PRttiInfo;
    /// how the parameter has been defined (const/var/out/result)
    Direction: TRttiMethodArgDirection;
  end;
  PRttiMethodArg = ^TRttiMethodArg;

  /// store IInvokable method information
  TRttiMethod = record
    /// the method name, e.g. 'Add' for ICalculator.Add
    Name: RawUtf8;
    /// 0 for the root interface, >0 for inherited interfaces
    HierarchyLevel: integer;
    /// the method arguments
    Args: array of TRttiMethodArg;
    /// if this method is a function, i.e. expects a result
    IsFunction: boolean;
  end;
  PRttiMethod = ^TRttiMethod;

  /// store IInvokable methods information
  TRttiInterface = record
    /// the interface name, e.g. 'ICalculator'
    Name: RawUtf8;
    /// the unit where the interface was defined
    UnitName: RawUtf8;
    /// the associated GUID of this interface
    Guid: TGuid;
    /// the interface methods
    Methods: array of TRttiMethod;
  end;
  PRttiInterface = ^TRttiInterface;

/// retrieve methods information of a given IInvokable
// - all methods will be added, also from inherited interface definitions
// - returns the number of methods detected
function GetRttiInterface(aTypeInfo: PRttiInfo;
  out aDefinition: TRttiInterface): integer;

/// check if a pre-computed PInterfaceEntry has a direct IOffset information
function InterfaceEntryIsStandard(Entry: PInterfaceEntry): boolean;
  {$ifdef HASINLINE} inline; {$endif}

/// execute an instance method from its RTTI per-interface information
// - calling this function with a pre-computed PInterfaceEntry value is faster
// than calling the TObject.GetInterface() method, especially when the class
// implements several interfaces, since it avoid a slow GUID lookup
// - if the interface is retrieved using a getter, will fallback to
// the regular TObject.GetInterface RTL method
function GetInterfaceFromEntry(Instance: TObject; Entry: PInterfaceEntry;
  out Obj): boolean;

/// returns all TGuid implemented by a given class
// - TObject.GetInterfaceTable is not consistent on Delphi and FPC
function GetRttiClassGuid(aClass: TClass): PGuidDynArray;

const
  PSEUDO_RESULT_NAME: string[6] = 'Result';
  PSEUDO_SELF_NAME:   string[4] = 'Self';



{ ************* Efficient Dynamic Arrays and Records Process }

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

/// low-level finalization of a dynamic array of any kind
// - faster than RTL Finalize() or setting nil, when you know ElemInfo
// - see also TRttiInfo.Clear if you want to finalize any type
procedure FastDynArrayClear(Value: PPointer; ElemInfo: PRttiInfo);

/// low-level finalization of all dynamic array items of any kind
// - as called by FastDynArrayClear(), after dec(RefCnt) reached 0
procedure FastFinalizeArray(Value: PPointer; ElemTypeInfo: PRttiInfo;
  Count: integer);

/// clear the managed fields of a record content
// - won't reset all values to zero, only managed fields - see RecordZero()
// - caller should ensure the type is indeed a record/object
// - see also TRttiInfo.Clear if you want to finalize any type
// - same as RTTI_FINALIZE[rkRecord]()
function FastRecordClear(Value: pointer; Info: PRttiInfo): PtrInt;

/// efficient finalization of successive record items from a (dynamic) array
procedure RecordClearSeveral(v: PAnsiChar; info: PRttiInfo; n: integer);

/// efficient finalization of successive RawUtf8 items from a (dynamic) array
procedure StringClearSeveral(v: PPointer; n: PtrInt);

/// low-level finalization of a dynamic array of RawUtf8
// - faster than RTL Finalize() or setting nil
procedure RawUtf8DynArrayClear(var Value: TRawUtf8DynArray);
  {$ifdef HASINLINE}inline;{$endif}

/// check if the TypeInfo() points to an "array of RawUtf8"
// - e.g. returns true for TypeInfo(TRawUtf8DynArray) or other sub-types
// defined as "type aNewType = type TRawUtf8DynArray"
function IsRawUtf8DynArray(Info: PRttiInfo): boolean;

/// initialize a record content
// - calls FastRecordClear() and FillCharFast() with 0
// - do nothing if the TypeInfo is not from a record/object
procedure RecordZero(Dest: pointer; Info: PRttiInfo);

/// copy a record content from source to Dest
procedure RecordCopy(var Dest; const Source; Info: PRttiInfo);
  {$ifdef FPC}inline;{$endif}

/// efficiently copy several (dynamic) array items
// - faster than the RTL CopyArray() function
procedure CopySeveral(Dest, Source: PByte; SourceCount: PtrInt;
  ItemInfo: PRttiInfo; ItemSize: PtrInt);

/// low-level initialization of a dynamic array
// - faster than System.DynArraySetLength() function on a void dynamic array,
// when the RTTI is known
// - caller should ensure that Dest is not nil, but Dest^ = nil (i.e. a
// clear/void dynamic array)
function DynArrayNew(Dest: PPointer; Count, ItemSize: PtrInt): pointer;

/// low-level size up of a dynamic array
// - faster than System.DynArraySetLength() function dynamic array with RefCnt=1
// - caller should ensure that Dest is not nil
// - DataBytes is expected to be Count * ItemSize
function DynArrayGrow(Dest: PPointer; Count, ItemSize: PtrInt): PAnsiChar;

/// create a dynamic array from another one
// - same as RTTI_MANAGEDCOPY[rkDynArray] but with an optional external source count
procedure DynArrayCopy(Dest, Source: PPointer; Info: PRttiInfo;
  SourceExtCount: PInteger = nil);

/// same as Value := copy(Value) but faster and with no temporary variable
procedure DynArrayEnsureUnique(Value: PPointer; Info: PRttiInfo);

/// same as Value := copy(Value) but faster and with no temporary variable
procedure EnsureUnique(var Value: TIntegerDynArray); overload;
  {$ifdef HASINLINE} inline; {$endif}

/// same as Value := copy(Value) but faster and with no temporary variable
procedure EnsureUnique(var Value: TRawUtf8DynArray); overload;
  {$ifdef HASINLINE} inline; {$endif}

/// same as Value := copy(Value) but faster and with no temporary variable
procedure EnsureUnique(var Value: TVariantDynArray); overload;
  {$ifdef HASINLINE} inline; {$endif}


{ ************* Managed Types Finalization, Random or Copy }

type
  /// internal function handler for finalizing a managed type value
  // - i.e. the kind of functions called via RTTI_FINALIZE[] lookup table
  // - as used by TRttiInfo.Clear() inlined method
  TRttiFinalizer = function(Data: pointer; Info: PRttiInfo): PtrInt;

  /// the type of RTTI_FINALIZE[] efficient lookup table
  TRttiFinalizers = array[TRttiKind] of TRttiFinalizer;
  PRttiFinalizers = ^TRttiFinalizers;

  /// internal function handler for copying a managed type value
  // - i.e. the kind of functions called via RTTI_MANAGEDCOPY[] lookup table
  TRttiCopier = function(Dest, Source: pointer; Info: PRttiInfo): PtrInt;

  /// the type of RTTI_MANAGEDCOPY[] efficient lookup table
  TRttiCopiers = array[TRttiKind] of TRttiCopier;
  PRttiCopiers = ^TRttiCopiers;

  /// internal function handler for copying a class instance
  // - use TRttiCustom.Props.CopyProperties but may be overriden e.g. for TOrm
  TRttiClassCopier = procedure(Dest, Source: TObject);


var
  /// lookup table of finalization functions for managed types
  // - as used by TRttiInfo.Clear() inlined method
  // - RTTI_FINALIZE[...]=nil for unmanaged types (e.g. rkOrdinalTypes)
  RTTI_FINALIZE: TRttiFinalizers;

  /// lookup table of copy function for managed types
  // - as used by TRttiInfo.Copy() inlined method
  // - RTTI_MANAGEDCOPY[...]=nil for unmanaged types (e.g. rkOrdinalTypes)
  RTTI_MANAGEDCOPY: TRttiCopiers;

/// fill all sensitive fields of this class or record with zeros
// - RawByteString/TBytes with refcount=1 will be zeroed before freed
procedure FillZeroRtti(Info: PRttiInfo; var Value);



{ ************** RTTI Value Types used for JSON Parsing }

type
  /// the kind of variables handled by our RTTI/JSON parser
  // - the last item should be ptCustom, for non simple types
  // - ptOrm is recognized from TID, T*ID, TRecordReference,
  // TRecordReferenceToBeDeleted and TRecordVersion type names
  // - ptTimeLog is recognized from TTimeLog, TCreateTime and TModTime
  // - other types (not ptComplexTypes) are recognized by their genuine type name
  // - ptUnicodeString is defined even if not available prior to Delphi 2009
  // - replace deprecated TJsonCustomParserRTTIType type from old mORMot 1.18
  // - TDynArrayKind is now an alias to this genuine enumerate
  TRttiParserType = (
    ptNone,
    ptArray,
    ptBoolean,
    ptByte,
    ptCardinal,
    ptCurrency,
    ptDouble,
    ptExtended,
    ptInt64,
    ptInteger,
    ptQWord,
    ptRawByteString,
    ptRawJson,
    ptRawUtf8,
    ptRecord,
    ptSingle,
    ptString,
    ptSynUnicode,
    ptDateTime,
    ptDateTimeMS,
    ptGuid,
    ptHash128,
    ptHash256,
    ptHash512,
    ptOrm,
    ptTimeLog,
    ptUnicodeString,
    ptUnixTime,
    ptUnixMSTime,
    ptVariant,
    ptWideString,
    ptWinAnsi,
    ptWord,
    ptEnumeration,
    ptSet,
    ptClass,
    ptDynArray,
    ptInterface,
    ptPUtf8Char,
    ptCustom);

  /// the complex kind of variables for ptTimeLog and ptOrm TRttiParserType
  TRttiParserComplexType = (
    pctNone,
    pctTimeLog,
    pctCreateTime,
    pctModTime,
    pctID,
    pctSpecificClassID,
    pctRecordReference,
    pctRecordReferenceToBeDeleted,
    pctRecordVersion);

  PRttiParserType = ^TRttiParserType;
  TRttiParserTypes = set of TRttiParserType;
  PRttiParserComplexType = ^TRttiParserComplexType;
  TRttiParserComplexTypes = set of TRttiParserComplexType;

const
  /// map a PtrInt type to the TRttiParserType set
  ptPtrInt  = {$ifdef CPU64} ptInt64 {$else} ptInteger {$endif};

  /// map a PtrUInt type to the TRttiParserType set
  ptPtrUInt = {$ifdef CPU64} ptQWord {$else} ptCardinal {$endif};

  /// which TRttiParserType are not simple types
  // - ptTimeLog and ptOrm are complex, since more than one TypeInfo() may
  // map to their TRttiParserType - see also TRttiParserComplexType
  ptComplexTypes =
    [ptArray,
     ptRecord,
     ptCustom,
     ptTimeLog,
     ptOrm,
     ptDynArray,
     ptEnumeration,
     ptSet,
     ptClass,
     ptInterface];

  /// which TRttiParserType types don't need memory management
  ptUnmanagedTypes =
    [ptBoolean..ptQWord,
     ptSingle,
     ptDateTime..ptTimeLog,
     ptUnixTime,
     ptUnixMSTime,
     ptWord..ptClass];

  /// which TRttiParserType types are (usually) serialized as JSON "text"
  // - actual serialization may depend e.g. on TTextWriterWriteObjectOptions
  ptStringTypes =
    [ptRawByteString .. ptRawUtf8,
     ptString .. ptHash512,
     ptTimeLog,
     ptUnicodeString,
     ptWideString,
     ptWinAnsi,
     ptPUtf8Char];

  /// which TRttiParserType types could be serialized as multi-line JSON "text"
  // - e.g. plain RawUtf8 which may include \n line feeds but not RawByteString,
  // TTimeLog or THash128, which never include line breaks within their "value"
  ptMultiLineStringTypes =
    [ptRawUtf8,
     ptString,
     ptSynUnicode,
     ptUnicodeString,
     ptWideString,
     ptWinAnsi];

var
  /// simple lookup to the plain RTTI type of most simple managed types
  // - nil for unmanaged types (e.g. rkOrdinals) or for more complex types
  // requering additional PRttiInfo (rkRecord, rkDynArray, rkArray...)
  // - you can use PT_INFO[] for types with no RTTI before Delphi 2010, for
  // instance PT_INFO[ptGuid], PT_INFO[ptHash128], PT_INFO[ptHash256] and
  // PT_INFO[ptHash512] since oldest compilers refuse to compile TypeInfo(TGuid),
  // TypeInfo(THash128), TypeInfo(THash256) and TypeInfo(THash512)
  PT_INFO: array[TRttiParserType] of PRttiInfo;

  /// simple lookup to the plain RTTI type of most simple managed types
  // - nil if the complex type is not known
  // - mormot.orm.base may set the exact TypeInfo(TRecordReference) value - this
  // unit set plain TypeInfo(QWord) which is enough for JSON Serialization
  PTC_INFO: array[TRttiParserComplexType] of PRttiInfo;

const
  /// simple lookup to the TRttiParserType of a complex type
  PTC_PT: array[TRttiParserComplexType] of TRttiParserType = (
    ptNone,      // pctNone
    ptTimeLog,   // pctTimeLog
    ptTimeLog,   // pctCreateTime
    ptTimeLog,   // pctModTime
    ptOrm,       // pctID
    ptNone,      // pctSpecificClassID
    ptOrm,       // pctRecordReference
    ptOrm,       // pctRecordReferenceToBeDeleted
    ptOrm );     // pctRecordVersion

  /// simple lookup to the size in bytes of TRttiParserType values
  PT_SIZE: array[TRttiParserType] of byte = (
    0,                //  ptNone
    0,                //  ptArray
    1,                //  ptBoolean
    1,                //  ptByte
    4,                //  ptCardinal
    8,                //  ptCurrency
    8,                //  ptDouble
    8,                //  ptExtended
    8,                //  ptInt64
    4,                //  ptInteger
    8,                //  ptQWord
    SizeOf(pointer),  //  ptRawByteString
    SizeOf(pointer),  //  ptRawJson
    SizeOf(pointer),  //  ptRawUtf8
    0,                //  ptRecord
    4,                //  ptSingle
    SizeOf(pointer),  //  ptString
    SizeOf(pointer),  //  ptSynUnicode
    8,                //  ptDateTime
    8,                //  ptDateTimeMS
    16,               //  ptGuid
    16,               //  ptHash128
    32,               //  ptHash256
    64,               //  ptHash512
    8,                //  ptOrm
    8,                //  ptTimeLog
    SizeOf(pointer),  //  ptUnicodeString
    8,                //  ptUnixTime
    8,                //  ptUnixMSTime
    SizeOf(variant),  //  ptVariant
    SizeOf(pointer),  //  ptWideString
    SizeOf(pointer),  //  ptWinAnsi
    2,                //  ptWord
    0,                //  ptEnumeration
    0,                //  ptSet
    SizeOf(pointer),  //  ptClass
    SizeOf(pointer),  //  ptDynArray
    SizeOf(pointer),  //  ptInterface
    SizeOf(pointer),  //  ptPUtf8Char
    0 );              //  ptCustom

  /// type definition name lookup to the TRttiParserType values
  // - ptComplexTypes types should see PTC_NAME[] constant
  PT_NAME: array[TRttiParserType] of RawUtf8 = (
    '',               //  ptNone
    '',               //  ptArray
    'boolean',        //  ptBoolean
    'byte',           //  ptByte
    'cardinal',       //  ptCardinal
    'currency',       //  ptCurrency
    'double',         //  ptDouble
    'extended',       //  ptExtended
    'Int64',          //  ptInt64
    'integer',        //  ptInteger
    'QWord',          //  ptQWord
    'RawByteString',  //  ptRawByteString
    'RawJson',        //  ptRawJson
    'RawUtf8',        //  ptRawUtf8
    '',               //  ptRecord
    'single',         //  ptSingle
    'string',         //  ptString
    'SynUnicode',     //  ptSynUnicode
    'TDateTime',      //  ptDateTime
    'TDateTimeMS',    //  ptDateTimeMS
    'TGuid',          //  ptGuid
    'THash128',       //  ptHash128
    'THash256',       //  ptHash256
    'THash512',       //  ptHash512
    '',               //  ptOrm
    '',               //  ptTimeLog
    'UnicodeString',  //  ptUnicodeString
    'TUnixTime',      //  ptUnixTime
    'TUnixMSTime',    //  ptUnixMSTime
    'variant',        //  ptVariant
    'WideString',     //  ptWideString
    'WinAnsi',        //  ptWinAnsi
    'word',           //  ptWord
    '',               //  ptEnumeration
    '',               //  ptSet
    '',               //  ptClass
    '',               //  ptDynArray
    '',               //  ptInterface
    'PUtf8Char',      //  ptPUtf8Char
    '');              //  ptCustom

  /// type definition name lookup to the TRttiParserComplexType values
  // - for ptComplexTypes types, with PT_NAME[]=''
  // - ptcSpecificClassID returns '' since T....ID types are variable
  PTC_NAME: array[TRttiParserComplexType] of RawUtf8 = (
    '',                            // pctNone
    'TTimeLog',                    // pctTimeLog
    'TCreateTime',                 // pctCreateTime
    'TModTime',                    // pctModTime
    'TID',                         // pctID
    '',                            // pctSpecificClassID
    'TRecordReference',            // pctRecordReference
    'TRecordReferenceToBeDeleted', // pctRecordReferenceToBeDeleted
    'TRecordVersion');             // pctRecordVersion

/// retrieve the text name of one TRttiParserType enumerate
function ToText(t: TRttiParserType): PShortString; overload;

/// retrieve the TypeInfo() from PT_INFO[] PTC_INFO[] constant arrays
function ParserTypeToTypeInfo(pt: TRttiParserType;
  pct: TRttiParserComplexType): PRttiInfo;

/// recognize most simple types and return their known dynamic array RTTI
// - returns nil if we don't know any dynamic array for this type
// - ExpectExactElemInfo=true ensure that result's ArrayRtti.Info = ElemInfo
// - currently not called: IList<T> and IKeyValue<T> just use TypeInfo(T)
function TypeInfoToDynArrayTypeInfo(ElemInfo: PRttiInfo;
  ExpectExactElemInfo: boolean; ParserType: PRttiParserType = nil): PRttiInfo;



{ ************** RTTI-based Registration for Custom JSON Parsing }

const
  /// TRttiCustomList stores its TypeInfo() by Kind + PRttiInfo/Name
  // - optimized "hash table of the poor" (tm) for FindType() and Find(Name)
  // - should be a bit mask (i.e. power of two minus 1)
  RTTIHASH_MAX = {$ifdef NOPATCHVMT} 63 {$else} 31 {$endif};

type
  TRttiCustom = class;

  PRttiCustomProp = ^TRttiCustomProp;
  PPRttiCustomProp = ^PRttiCustomProp;

  /// variant-like value as returned by TRttiCustomProp.GetValueDirect and
  // GetValueGetter methods
  // - simple values (integers, floats, strings or variant) are set into Data
  // - rkEnumeration, rkSet, rkDynArray, rkClass, rkInterface, rkRecord and
  // rkObject are stored as varAny/PropValue pointer to the field value (for
  // GetValueDirect) or Instance (for GetValueGetter if PropValueIsInstance=true),
  // and Prop to the corresponding property RTTI
  // - will be properly handled by TJsonWriter.AddVariant/AddRttiVarData
  // - can be casted as a variant value, but contains RTTI and clear flag:
  // ! if rvd.NeedsClear then VarClearProc(rvd.Data);
  TRttiVarData = packed record
    case integer of
    varUnknown: (
      VType: cardinal);    // maps DataType + NeedsClear + PropValueIsInstance
    varVariant: (
      Data: TVarData);
    varAny: (
      DataType: word;      // matches TVarData.VType
      NeedsClear: boolean;
      PropValueIsInstance: boolean;
      // Assert(@PropValue=@VAny) is done in initialization section below
      {$ifdef CPU32}
      Prop: PRttiCustomProp;
      PropValue: pointer; // TObject if PropValueIsInstance=true, or field addr
      {$else}
      Padding4: cardinal;
      PropValue: pointer; // TObject if PropValueIsInstance=true, or field addr
      Prop: PRttiCustomProp;
      {$endif CPU32});
  end;
  PRttiVarData = ^TRttiVarData;

  /// define specific behavior for a given TypeInfo/PRttIinfo
  // - rcfIsManaged is set if a value of this type expects finalization
  // - rcfObjArray is for T*ObjArray dynamic arrays
  // - rcfBinary is for hexadecimal serialization of integers
  // - rcfJsonString when is to be serialized as text and properly JSON-escaped
  // (ptStringTypes or rcfBinary, but excluding ptRawJson)
  // - rcfWithoutRtti is set if was created purely by text, and uses fake RTTI
  // - rcfSpi identifies types containing Sensitive Personal Information
  // (e.g. a bank card number or a plain password) which should be hidden
  // - rcfHookWrite, rcfHookWriteProperty, rcfHookRead, rcfHookReadProperty for
  // TObjectWithCustomCreate kind of class, to customize JSON serialization
  // calling the set of TObjectWithCustomCreate protected virtual methods -
  // disabled by default not to slow down the serialization process
  // - rcfHasNestedProperties is set e.g. for rkClass or rcfWithoutRtti records,
  // rcfHasNestedManagedProperties if any of the property/field is rcfIsManaged
  // - rcfHasOffsetSetJsonLoadProperties is set if all nested properties can be
  // directly written, i.e. have OffsetSet >= 0 and Assigned(JsonLoad)
  // - rcfArrayItemManaged maps rcfIsManaged flag in ArrayRtti.Flags
  // - rcfReadIgnoreUnknownFields will let JSON unserialization ignore unknown
  // fields for this class/record
  // - rcfAutoCreateFields is defined when AutoCreateFields() has been called
  // - rcfDisableStored is set for TOrm, where "stored AS_UNIQUE" does not mean
  // "not stored" for serialization but "UNIQUE SQL"
  // - rcfClassMayBeID is set e.g. for TOrm classes, which may be storing
  // not instances but IDs in published properties PtrInt
  TRttiCustomFlag = (
    rcfIsManaged,
    rcfObjArray,
    rcfBinary,
    rcfJsonString,
    rcfWithoutRtti,
    rcfSpi,
    rcfHookWrite,
    rcfHookWriteProperty,
    rcfHookRead,
    rcfHookReadProperty,
    rcfHasNestedProperties,
    rcfHasNestedManagedProperties,
    rcfHasOffsetSetJsonLoadProperties,
    rcfArrayItemManaged,
    rcfReadIgnoreUnknownFields,
    rcfAutoCreateFields,
    rcfDisableStored,
    rcfClassMayBeID);

  /// define specific behaviors for a given TypeInfo/PRttIinfo
  // - as stored in TRttiCustom.Flags
  TRttiCustomFlags = set of TRttiCustomFlag;

  /// store information about one property/field of a given TypeInfo/PRttIinfo
  // - used by both rkClass for published properties, and rkRecord/rkObject
  // for nested fields
  {$ifdef USERECORDWITHMETHODS}
  TRttiCustomProp = record
  {$else}
  TRttiCustomProp = object
  {$endif USERECORDWITHMETHODS}
  private
    fOrigName: RawUtf8; // as set by InternalAdd()
    function InitFrom(RttiProp: PRttiProp): PtrInt;
    function ValueIsVoidGetter(Data: pointer): boolean;
    procedure GetValueDirect(Data: PByte; out RVD: TRttiVarData);
    procedure GetValueGetter(Instance: TObject; out RVD: TRttiVarData);
    function CompareValueComplex(Data, Other: pointer;
      OtherRtti: PRttiCustomProp; CaseInsensitive: boolean): integer;
  public
    /// contains standard TypeInfo/PRttiInfo of this field/property
    // - for instance, Value.Size contains its memory size in bytes
    Value: TRttiCustom;
    /// read field/property offset in the record/class instance memory
    // - equals -1 if Prop has a getter
    OffsetGet: PtrInt;
    /// write field/property offset in the record/class instance memory
    // - equals -1 if Prop has a setter
    OffsetSet: PtrInt;
    /// contains Prop^.Name or a customized field/property name
    // - equals '' if Props.NameChange() was set to New='', meaning this field
    // should not be part of the serialized JSON object
    Name: RawUtf8;
    /// store standard RTTI of this published property
    // - equals nil for rkRecord/rkObject nested field
    Prop: PRttiProp;
    /// equals NO_DEFAULT or the default integer value of this property
    OrdinalDefault: integer;
    /// reflect the "stored" property attribute as defined in the source
    Stored: TRttiPropStored;
    /// case-insensitive compare the supplied name/len with the Name property
    function NameMatch(P: PUtf8Char; Len: PtrInt): boolean;
      {$ifdef HASINLINE}inline;{$endif}
    /// very fast retrieval of any field value into a TVarData-like mapping
    // - works if Prop is defined or not, calling any getter method if needed
    // - complex TRttiVarData with varAny pointer will be properly handled by
    // TJsonWriter.AddVariant/AddRttiVarData (e.g. rkEnumeration or rkDynArray)
    // - rvd can be casted to a variant, but contains RTTI Info and clear flag:
    // ! if rvd.NeedsClear then VarClearProc(rvd.Data);
    procedure GetValue(Data: pointer; out RVD: TRttiVarData);
      {$ifdef HASINLINE}inline;{$endif}
    /// set a field value to a given TVarData-like content
    // - optionally check and apply RVD.NeedsClear flag (leave it as true if
    // RVD comes from GetValue)
    // - not implemented for Prop = nil (i.e. rkRecord/rkObject nested field)
    procedure SetValue(Data: pointer; var RVD: TRttiVarData;
      andclear: boolean = true);
    /// retrieve any field vlaue as a variant instance
    // - will generate a stand-alone variant value, not an internal TRttiVarData
    // - complex values can be returned as TDocVariant after JSON conversion,
    // using e.g. @JSON_[mFastFloat] as optional Options parameter
    procedure GetValueVariant(Data: pointer; out Dest: TVarData;
      Options: pointer{PDocVariantOptions} = nil);
    /// set a field value from its UTF-8 text
    // - will convert the Text into proper ordinal or float if needed
    // - also implemented for Prop = nil (i.e. rkRecord/rkObject nested field)
    // - use Prop^.SetValueText() if you want to support enumerates and sets
    function SetValueText(Data: pointer; const Text: RawUtf8): boolean;
    /// check if the Value equals the default property set in source code
    // - caller should have checked that PropDefault <> NO_DEFAULT
    function ValueIsDefault(Data: pointer): boolean;
    /// check if the Value is void (0 / '' / null)
    // - less restrictive function than VarIsVoid() from mormot.core.variants
    function ValueIsVoid(Data: pointer): boolean;
      {$ifdef HASINLINE}inline;{$endif}
    /// compare two properties values with proper getter method call
    // - is likely to call Value.ValueCompare() which requires mormot.core.json
    function CompareValue(Data, Other: pointer; const OtherRtti: TRttiCustomProp;
      CaseInsensitive: boolean): integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// append the field value as JSON with proper getter method call
    // - wrap GetValue() + AddVariant() over a temp TRttiVarData
    procedure AddValueJson(W: TTextWriter; Data: pointer;
      Options: TTextWriterWriteObjectOptions; K: TTextWriterKind = twNone);
    /// a wrapper calling AddValueJson()
    procedure GetValueJson(Data: pointer; out Result: RawUtf8);
  end;

  /// store information about the properties/fields of a given TypeInfo/PRttiInfo
  TRttiCustomPropDynArray = array of TRttiCustomProp;

  PRttiCustomPropDynArray = array of PRttiCustomProp;

  /// store information about all properties/fields of a given TypeInfo/PRttIinfo
  // - includes parent properties when filled by AddFromClass(IncludeParents=true)
  {$ifdef USERECORDWITHMETHODS}
  TRttiCustomProps = record
  {$else}
  TRttiCustomProps = object
  {$endif USERECORDWITHMETHODS}
  public
    /// one List[] item per property/field
    List: TRttiCustomPropDynArray;
    /// how many properties/fields are in List[]
    Count: integer;
    /// how many properties/fields with Name <> '' are in List[]
    CountNonVoid: integer;
    /// total size, in bytes, of all properties/fields
    // - equals the sum of List[].Value.Size
    Size: integer;
    /// List[NotInheritedIndex]..List[Count-1] store the last level of properties
    NotInheritedIndex: integer;
    /// contains List[].Name as a JSON array including a trailing ,
    // - as used by _JS_DynArray() for efficient twoNonExpandedArrays generation
    NamesAsJsonArray: RawUtf8;
    /// points to List[] items which are managed
    Managed: PRttiCustomPropDynArray;
    /// locate a property/field by name
    // - just redirect to FindCustomProp() low-level function
    function Find(const PropName: RawUtf8): PRttiCustomProp; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// locate a property/field by name
    // - just redirect to FindCustomProp() low-level function
    function Find(PropName: PUtf8Char; PropNameLen: PtrInt): PRttiCustomProp; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// locate a property/field index by name
    function FindIndex(PropName: PUtf8Char; PropNameLen: PtrInt): PtrInt;
    /// customize a property/field name
    // - New is expected to be only plain pascal identifier, i.e.
    // A-Z a-z 0-9 and _ characters, up to 63 in length
    // - if New equals '', this published property will be excluded from
    // the JSON serialized object
    function NameChange(const Old, New: RawUtf8): PRttiCustomProp;
    /// customize property/field name, specified as old/new pairs
    // - will first restore all field names from RTTI, then each Old[] field
    // name will be replaced by the corresponding New[] name
    // - so setting both Old=New=[] just set back the default names from RTTI
    // - New[] is expected to be only plain pascal identifier, i.e.
    // A-Z a-z 0-9 and _ characters, up to 63 in length
    // - if any New[] equals '', this published property will be excluded from
    // the JSON serialized object
    // - Rtti.ByClass[TMyClass].Props.NameChanges() replaces deprecated
    // TJsonSerializer.RegisterCustomSerializerFieldNames(TMyClass, ...)
    procedure NameChanges(const Old, New: array of RawUtf8);
    /// reset all properties
    procedure InternalClear;
    /// manual adding of a property/field definition
    // - append as last field, unless AddFirst is set to true
    procedure InternalAdd(Info: PRttiInfo; Offset: PtrInt; const PropName: RawUtf8;
      AddFirst: boolean = false);
    /// register the published properties of a given class
    // - is called recursively if IncludeParents is true
    procedure InternalAddFromClass(ClassInfo: PRttiInfo; IncludeParents: boolean);
    /// prepare List[result].Name from TRttiCustom.SetPropsFromText
    function FromTextPrepare(const PropName: RawUtf8): integer;
    /// register the properties specified from extended RTTI (Delphi 2010+ only)
    // - do nothing on FPC or Delphi 2009 and older
    procedure SetFromRecordExtendedRtti(RecordInfo: PRttiInfo);
    /// called once List[] and Size have been defined
    // - compute the Managed[] internal list and return the matching flags
    function AdjustAfterAdded: TRttiCustomFlags;
    /// retrieve all List[] items as text
    procedure AsText(out Result: RawUtf8; IncludePropType: boolean;
      const Prefix, Suffix: RawUtf8);
    /// finalize and fill with zero all properties of this class instance
    // - it will individually fill the properties, not the whole memory
    // as TRttiCustom.FinalizeAndClear would on a record
    procedure FinalizeAndClearPublishedProperties(Instance: TObject);
    /// finalize the managed properties of this instance
    // - called e.g. when no RTTI is available, i.e. text serialization
    procedure FinalizeManaged(Data: PAnsiChar);
    /// copy the fields of a rkRecordTypes instance
    // - called e.g. when no RTTI is available, i.e. text serialization
    // - will move() all bytes between managed fields
    procedure CopyRecord(Dest, Source: PAnsiChar);
    /// copy the properties of a rkClass instance
    // - called e.g. when no RTTI is available, i.e. text serialization
    // - will copy all published properties one-by-one
    procedure CopyProperties(Dest, Source: PAnsiChar);
  end;

  PRttiCustomProps = ^TRttiCustomProps;

  /// used internally for fast allocation of a rkClass/rkInterface instance
  // - member is properly initialized by TRttiJson from mormot.core.json.pas
  TRttiCustomNewInstance = function(Rtti: TRttiCustom): pointer;

  /// internal function handler for filling a value with some randomness
  TRttiCustomRandom = procedure(Data: pointer; Rtti: TRttiCustom);

  /// used internally by our RTTI text definition
  TRttiCustomFromTextExpectedEnd = (
    eeNothing,
    eeSquare,
    eeCurly,
    eeEndKeyWord);

  /// the recognized raw RTL classes as identified in TRttiCustom.ValueRtlClass
  TRttiValueClass = (
    vcNone,
    vcCollection,
    vcStrings,
    vcObjectList,
    vcList,
    vcSynList,
    vcRawUtf8List,
    vcESynException,
    vcException,
    vcObjectWithID);


  /// allow to customize the process of a given TypeInfo/PRttiInfo
  // - a global list of TRttiCustom instances mapping TypeInfo() is maintained
  // in Rtti: TRttiCustomList
  // - never instantiate this class directly, but call RttiCustom methods
  TRttiCustom = class
  protected
    fCache: TRttiCache;
    fParser: TRttiParserType;
    fParserComplex: TRttiParserComplexType;
    fValueRtlClass: TRttiValueClass;
    fArrayFirstField: TRttiParserType;
    fFlags: TRttiCustomFlags;
    fPrivateSlot: pointer;
    fArrayRtti: TRttiCustom;
    fFinalize: TRttiFinalizer;
    fCopy: TRttiCopier;
    fName: RawUtf8;
    fProps: TRttiCustomProps;
    fOwnedRtti: array of TRttiCustom; // for SetPropsFromText(NoRegister=true)
    fSetRandom: TRttiCustomRandom;
    fPrivateSlots: TObjectDynArray;
    fPrivateSlotsSafe: TLightLock;
    // used by mormot.core.json.pas
    fBinarySize: integer;
    fJsonLoad: pointer; // contains a TRttiJsonLoad - used if fJsonReader=nil
    fJsonSave: pointer; // contains a TRttiJsonSave - used if fJsonWriter=nil
    fJsonReader, fJsonWriter: TMethod; // TOnRttiJsonRead/TOnRttiJsonWrite
    fNewInstance: TRttiCustomNewInstance; // mormot.core.json implemented
    fAutoCreateInstances, // some lists made by RegisterAutoCreateFieldsClass
    fAutoDestroyClasses,
    fAutoCreateObjArrays,
    fAutoResolveInterfaces: PRttiCustomPropDynArray;
    // used by NoRttiSetAndRegister()
    fNoRttiInfo: TByteDynArray;
    // customize class process
    fValueClass: TClass;
    fObjArrayClass: TClass;
    fCollectionItem: TCollectionItemClass;
    fCollectionItemRtti: TRttiCustom;
    fCopyObject: TRttiClassCopier;
    procedure SetValueClass(aClass: TClass; aInfo: PRttiInfo); virtual;
    // for TRttiCustomList.RegisterObjArray/RegisterBinaryType/RegisterFromText
    function SetObjArray(Item: TClass): TRttiCustom;
    function SetBinaryType(BinarySize: integer): TRttiCustom;
    procedure SetPropsFromText(var P: PUtf8Char;
      ExpectedEnd: TRttiCustomFromTextExpectedEnd; NoRegister: boolean);
    // initialize from fProps, with no associated RTTI - and calls DoRegister()
    // - will create a "fake" rkRecord/rkDynArray PRttiInfo (TypeName may be '')
    procedure NoRttiSetAndRegister(ParserType: TRttiParserType;
      const TypeName: RawUtf8; DynArrayElemType: TRttiCustom = nil;
      NoRegister: boolean = false);
    // called by ValueFinalize() for dynamic array defined from text
    procedure NoRttiArrayFinalize(Data: PAnsiChar);
    /// initialize this Value process for Parser and Parser Complex kinds
    // - this default method will set Name and Flags according to Props[]
    // - overriden in mormot.core.json for proper JSON process setup
    // - returns self to allow cascaded calls as a fluent interface
    function SetParserType(aParser: TRttiParserType;
      aParserComplex: TRttiParserComplexType): TRttiCustom; virtual;
  public
    /// initialize the customizer class from known RTTI
    // - is called just after Create
    procedure FromRtti(aInfo: PRttiInfo); virtual;
    /// initialize abstract custom serialization for a given record
    // - not registered in the main TRttiCustomList: caller should free it
    // - in practice, is used only by test.core.data.pas regression tests
    constructor CreateFromText(const RttiDefinition: RawUtf8);
    /// finalize this instance
    destructor Destroy; override;
    /// efficiently finalize a stored value of this type
    // - if rcfObjArray is defined in Flags, will release all nested TObject
    procedure ValueFinalize(Data: pointer);
      {$ifdef HASINLINE}inline;{$endif}
    /// efficiently finalize a stored value of this type, and fill it with zeros
    // - if rcfObjArray is defined in Flags, will release all nested TObject
    procedure ValueFinalizeAndClear(Data: pointer);
      {$ifdef HASINLINE}inline;{$endif}
    /// efficiently copy of a stored value of this type
    // - same behavior as Dest := Source for all types
    procedure ValueCopy(Dest, Source: pointer);
      {$ifdef HASINLINE}inline;{$endif}
    /// return TRUE if the Value is 0 / nil / '' / null
    // - less restrictive function than VarIsVoid() from mormot.core.variants
    function ValueIsVoid(Data: PAnsiChar): boolean;
     // {$ifdef HASINLINE}inline;{$endif}
    /// compare two stored values of this type
    // - not implemented in this class (raise an ERttiException)
    // but in TRttiJson, so that it will use mormot.core.data comparison
    function ValueCompare(Data, Other: pointer;
      CaseInsensitive: boolean): integer; virtual;
    /// fill a variant with a stored value of this type
    // - not implemented in this class (raise an ERttiException)
    // but in TRttiJson, so that it will use mormot.core.variants process
    // - complex values can be returned as TDocVariant after JSON conversion,
    // using e.g. @JSON_[mFast] as optional Options parameter
    // - returns the size of the Data in bytes, i.e. Cache.ItemSize
    function ValueToVariant(Data: pointer; out Dest: TVarData;
      Options: pointer{PDocVariantOptions} = nil): PtrInt; virtual;
    /// fill a value from random - including strings and nested types
    procedure ValueRandom(Data: pointer);
      {$ifdef HASINLINE}inline;{$endif}
    /// TOnDynArrayHashOne callback used as fallback for unsupported items
    // - here DefaultHasher() is always used over Size bytes
    function ValueFullHash(const Elem): cardinal;
    /// TOnDynArraySortCompare callback used as fallback for unsupported items
    // - simple per-byte comparison over Size bytes
    function ValueFullCompare(const A, B): integer;
    /// how many iterations could be done one a given value
    // - returns -1 if the value is not iterable, or length(DynArray) or
    // TRawUtf8List.Count or TList.Count or TSynList.Count
    // - implemented in TRttiJson for proper knowledge of TSynList/TRawUtf8List
    function ValueIterateCount(Data: pointer): integer; virtual;
    /// iterate over one sub-item of a given value
    // - returns nil if the value is not iterable or Index is out of range
    // - returns a pointer to the value, rkClass/rkLString kinds being already
    // resolved (as the TList/TSynList/TRawUtf8List items are returned),
    // so you can directly trans-type the result to TObject() or RawUtf8()
    // - ResultRtti holds the type of the resolved result pointer
    // - note that TStrings values are not supported, because they require a
    // temporary string variable for their getter method
    // - implemented in TRttiJson for proper knowledge of TSynList/TRawUtf8List
    function ValueIterate(Data: pointer; Index: PtrUInt;
      out ResultRtti: TRttiCustom): pointer; virtual;
    /// lookup a value by a path name e.g. 'one.two.three' nested values
    // - for a record/class, will search for a property name
    // - for a TDocVariant/TBsonVariant, calls TSynInvokeableVariantType.IntGet
    // - for an enumeration or set, will return true/false about the enum name
    // - for a string, Data^ will be compared to the name
    // - implemented in TRttiJson for proper knowledge of our variants
    function ValueByPath(var Data: pointer; Path: PUtf8Char; var Temp: TVarData;
      PathDelim: AnsiChar = '.'): TRttiCustom; virtual;
    /// set a property value from a text value
    // - handle all kind of fields, e.g. converting from text into ordinal or floats
    function ValueSetText(Data: pointer; const Text: RawUtf8): boolean;
    /// create a new TObject instance of this rkClass
    // - not implemented here (raise an ERttiException) but in TRttiJson,
    // so that mormot.core.rtti has no dependency to TSynPersistent and such
    function ClassNewInstance: pointer;
      {$ifdef HASINLINE}inline;{$endif}
    /// allow low-level customization of the fClassNewInstance pointer
    procedure SetClassNewInstance(FactoryMethod: TRttiCustomNewInstance);
    /// check if this type has ClassNewInstance information
    function HasClassNewInstance: boolean;
    /// reset all stored Props[] and associated flags
    procedure PropsClear;
    /// recursively search for 'one.two.three' nested properties
    // - returns nil if not found
    // - returns the property information and let Data point to its associated
    // rkClass or rkRecord/rkObject owner
    function PropFindByPath(var Data: pointer; FullName: PUtf8Char;
      PathDelim: AnsiChar = '.'): PRttiCustomProp;
    /// register once an instance of a given class per RTTI
    // - thread-safe returns aObject, or an existing object (freeing aObject)
    // - just like PrivateSlot property, but for as many class as needed
    function SetPrivateSlot(aObject: TObject): pointer;
    /// retrieve an instance of a given class per RTTI
    // - previously registered by SetPrivateSlot
    function GetPrivateSlot(aClass: TClass): pointer;
    /// create a fake TRttiCustom clone with an overloaded ArrayRtti/ObjArrayClass
    function ComputeFakeObjArrayRtti(aItemClass: TClass): TBytes;
    /// low-level RTTI kind, taken from Rtti property
    property Kind: TRttiKind
      read fCache.Kind;
    /// direct access to the low-level RTTI TypeInfo() pointer, from Rtti property
    property Info: PRttiInfo
      read fCache.Info;
    /// the known type name
    // - may be an hexadecimal value of self, if rcfWithoutRtti is in Flags
    property Name: RawUtf8
      read fName;
    /// direct access to the low-level size in bytes used to store a value
    // of this type, as taken from Rtti property
    // - warning: for rkArray/rkDynArray, equals SizeOf(pointer), not the item
    // size, which is hold in Cache.ItemSize
    property Size: integer
      read fCache.Size;
    /// direct access to the ready-to-use RTTI
    property Cache: TRttiCache
      read fCache;
    /// define specific behavior for this type
    property Flags: TRttiCustomFlags
      read fFlags write fFlags;
    /// high-level Parser kind
    property Parser: TRttiParserType
      read fParser;
    /// high-level Parser Complex kind
    property ParserComplex: TRttiParserComplexType
      read fParserComplex;
    /// store information about the properties/fields of this type
    // - only set for rkClass and rkRecord/rkObject
    property Props: TRttiCustomProps
      read fProps;
    /// shortcut to the TRttiCustom of the item of a (dynamic) array
    // - only set for rkArray and rkDynArray
    // - may be set also for unmanaged types - use Cache.ItemInfo if you want
    // the raw PRttiInfo TypeInfo() pointer for rkManagedTypes only
    property ArrayRtti: TRttiCustom
      read fArrayRtti;
    /// best guess of first field type for a rkDynArray
    // - equals ArrayRtti.Parser if ArrayRtti.Kind is not rkRecordTypes
    property ArrayFirstField: TRttiParserType
      read fArrayFirstField;
    /// store the number of bytes for hexadecimal serialization for rcfBinary
    // - used when rcfBinary is defined in Flags; equals 0 if disabled (default)
    property BinarySize: integer
      read fBinarySize;
    /// store the class of this type, i.e. contains Cache.Info.RttiClass.RttiClass
    property ValueClass: TClass
      read fValueClass;
    /// identify most common RTL inherited classes for special handling
    // - recognize TCollection TStrings TObjectList TList parents
    // - TRttiValueClass enumerate is faster than InheritsFrom() call
    property ValueRtlClass: TRttiValueClass
      read fValueRtlClass;
    /// store the class of a T*ObjArray dynamic array
    // - shortcut to ArrayRtti.Info.RttiClass.RttiClass
    // - used when rcfObjArray is defined in Flags
    property ObjArrayClass: TClass
      read fObjArrayClass;
    /// store the Item class for a given TCollection
    // - as previously registered by Rtti.RegisterCollection()
    property CollectionItem: TCollectionItemClass
      read fCollectionItem;
    /// opaque private instance used by mormot.orm.base.pas or mormot.core.log.pas
    // - stores e.g. the TOrmProperties ORM information of a TOrm,
    // or the TSynLogFamily of a TSynLog instance
    // - is owned, as TObject, by this TRttiCustom
    // - assignment is usually protected by the Rtti.RegisterSafe
    property PrivateSlot: pointer
      read fPrivateSlot write fPrivateSlot;
    /// redirect to the low-level value copy - use rather ValueCopy()
    property Copy: TRttiCopier
      read fCopy;
    /// redirect to the low-level class instance copy
    // - nil by default, to use Props.CopyProperties()
    // - is overwritten e.g. by TOrm.RttiCustomSetParser
    property CopyObject: TRttiClassCopier
      read fCopyObject write fCopyObject;
    /// opaque TRttiJsonLoad callback used by mormot.core.json.pas
    property JsonLoad: pointer
      read fJsonLoad write fJsonLoad;
    /// opaque TRttiJsonSave callback used by mormot.core.json.pas
    property JsonSave: pointer
      read fJsonSave write fJsonSave;
    /// opaque TOnRttiJsonRead callback used by mormot.core.json.pas
    property JsonReader: TMethod
      read fJsonReader write fJsonReader;
    /// opaque TOnRttiJsonWrite callback used by mormot.core.json.pas
    property JsonWriter: TMethod
      read fJsonWriter write fJsonWriter;
  end;

  PRttiCustom = ^TRttiCustom;

  /// meta-class of TRttiCustom
  // - is usually a TRttiJson class type once mormot.core.json.pas is linked
  TRttiCustomClass = class of TRttiCustom;

  /// efficient PRttiInfo/TRttiCustom pairs for TRttiCustomList hash table
  // - as stored in TRttiCustomList.fHashTable[RK_TOSLOT[TRttiKind]]
  // - contains hash tables by TypeInfo() and by case-insensitive name
  TRttiCustomListPairs = record
    /// efficient HashInfo/HashName[] pairs thread-safety during Find/AddToPairs
    Safe: TRWLightLock;
    /// speedup search by name e.g. from a loop
    LastName: TRttiCustom;
    /// thread-safe speedup search by PRttiInfo e.g. from a loop
    LastInfo: TRttiCustom;
    /// thread-safe speedup search by PRttiInfo e.g. from a loop
    LastHash: array[0..RTTIHASH_MAX] of TRttiCustom;
    /// CPU L1 cache efficient PRttiInfo/TRttiCustom pairs hashed by PRttiInfo
    HashInfo: array[0..RTTIHASH_MAX] of TPointerDynArray;
    /// CPU L1 cache efficient PRttiInfo/TRttiCustom pairs hashed by Name
    HashName: array[0..RTTIHASH_MAX] of TPointerDynArray;
  end;
  PRttiCustomListPairs = ^TRttiCustomListPairs;

  /// maintain a thread-safe list of PRttiInfo/TRttiCustom/TRttiJson registration
  TRttiCustomList = class
  private
    // store PRttiInfo/TRttiCustom pairs by TRttiKind.Kind+PRttiInfo/Name
    fHashTable: array of TRttiCustomListPairs;
    // used to release memory used by registered customizations
    fInstances: array of TRttiCustom;
    fGlobalClass: TRttiCustomClass;
    function GetByClass(ObjectClass: TClass): TRttiCustom;
      {$ifdef HASINLINE}inline;{$endif}
    // called by FindOrRegister() for proper inlining
    function DoRegister(Info: PRttiInfo): TRttiCustom; overload;
    function DoRegister(ObjectClass: TClass; ToDo: TRttiCustomFlags): TRttiCustom; overload;
    procedure AddToPairs(Instance: TRttiCustom; Info: PRttiInfo);
    procedure SetGlobalClass(RttiClass: TRttiCustomClass); // ensure Count=0
  public
    /// how many TRttiCustom instances have been registered
    Count: integer;
    /// a global lock shared for high-level RTTI registration process
    // - is used e.g. to protect DoRegister() or TRttiCustom.PrivateSlot
    // - should be a reentrant lock, even if seldom called
    RegisterSafe: TOSLock;
    /// how many TRttiCustom instances have been registered for a given type
    // - we include rkUnknown for safety
    Counts: array[TRttiKind] of integer;
    /// initialize the RTTI list
    constructor Create;
    /// finalize the RTTI list
    destructor Destroy; override;
    /// efficient search of TRttiCustom from a given RTTI TypeInfo()
    // - returns nil if Info is not known
    // - call RegisterType() if you want to initialize the type via its RTTI
    // - not inlined since less efficient code is generated
    function FindType(Info: PRttiInfo): TRttiCustom;
    /// efficient search of TRttiCustom from a given TObject class
    // - returns nil if Info is not known
    // - will use the ObjectClass vmtAutoTable slot for very fast O(1) lookup,
    // or use our "hash table of the poor" (tm) if NOPATCHVMT conditional is set
    {$ifdef NOPATCHVMT}
    function FindClass(ObjectClass: TClass): TRttiCustom;
      {$ifdef HASINLINE}inline;{$endif}
    {$else}
    class function FindClass(ObjectClass: TClass): TRttiCustom;
      {$ifdef HASINLINE}static; inline;{$endif}
    {$endif NOPATCHVMT}
    /// efficient search of TRttiCustom from a given type name
    function FindName(Name: PUtf8Char; NameLen: PtrInt;
      Kind: TRttiKind): TRttiCustom; overload;
    /// efficient search of TRttiCustom from a given type name
    function FindName(Name: PUtf8Char; NameLen: PtrInt;
      Kinds: TRttiKinds = []): TRttiCustom; overload;
    /// efficient search of TRttiCustom from a given type name
    function FindName(const Name: ShortString; Kinds: TRttiKinds = []): TRttiCustom;
       overload; {$ifdef HASINLINE}inline;{$endif}
    /// manual search of any matching TRttiCustom.ArrayRtti type
    // - currently not called: IList<T> and IKeyValue<T> just use TypeInfo(T)
    function FindByArrayRtti(ElemInfo: PRttiInfo): TRttiCustom;
    /// register a given RTTI TypeInfo()
    // - returns a new (or existing if it was already registered) TRttiCustom
    // - if Info.Kind is rkDynArray, it will also register the nested rkRecord
    // - match mORMot 1.18 TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType
    function RegisterType(Info: PRttiInfo): TRttiCustom;
      {$ifdef HASINLINE}inline;{$endif}
    /// register one or several RTTI TypeInfo()
    // - to ensure that those types will be recognized by text definition
    // - will just call RegisterType() for each Info[]
    // - match mORMot 1.18 TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType
    procedure RegisterTypes(const Info: array of PRttiInfo);
    /// recognize (and register if needed) a standard simple type
    // - calls Find() to return already registered TRttiCustom instance, and
    // also recognize "array" or "record" keywords as expected by our parser
    // - returns nil if nothing was found
    // - will truncate any 'unitname.typename' into plain 'typename' before Find()
    function RegisterTypeFromName(Name: PUtf8Char; NameLen: PtrInt;
      ParserType: PRttiParserType = nil): TRttiCustom; overload;
    /// recognize (and register if needed) a standard simple type
    // - calls Find() to return already registered TRttiCustom instance, and
    // also recognize "array" or "record" keywords as expected by our parser
    // - returns nil if nothing was found
    // - will truncate any 'unitname.typename' into plain 'typename' before Find()
    function RegisterTypeFromName(const Name: RawUtf8;
      ParserType: PRttiParserType = nil): TRttiCustom; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// register a given class type, using its RTTI
    // - returns existing or new TRttiCustom
    // - please call RegisterCollection for TCollection
    function RegisterClass(ObjectClass: TClass): TRttiCustom; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// register a given class type, using its RTTI
    // - returns existing or new TRttiCustom
    // - please call RegisterCollection for TCollection
    function RegisterClass(aObject: TObject): TRttiCustom; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// low-level registration function called from RegisterClass()
    // - is sometimes called after manual vmtAutoTable slot lookup
    function DoRegister(ObjectClass: TClass): TRttiCustom; overload;
    /// register a given class type, using its RTTI, to auto-create/free its
    // class and dynamic array published fields
    function RegisterAutoCreateFieldsClass(ObjectClass: TClass): TRttiCustom;
      {$ifdef HASINLINE}inline;{$endif}
    /// register one or several RTTI TypeInfo()
    // - to ensure that those classes will be recognized by text definition
    // - will just call RegisterClass() for each ObjectClass[]
    procedure RegisterClasses(const ObjectClass: array of TClass);
    /// define how a given TCollectionClass should instantiate its items
    // - we need to know the CollectionItem to propertly initialize a TCollection
    // - not thread-safe: should be called once from the main thread, at startup,
    // e.g. in the initialization section of your collection definition unit
    function RegisterCollection(Collection: TCollectionClass;
      CollectionItem: TCollectionItemClass): TRttiCustom;
    /// register some TypeInfo() containing unsafe parameter values
    // - i.e. any RTTI type containing Sensitive Personal Information, e.g.
    // a bank card number or a plain password
    // - such values will force associated values to be ignored during loging,
    // as a more tuned alternative to optNoLogInput or optNoLogOutput
    // - not thread-safe: should be called once from the main thread, at startup,
    // e.g. in the initialization section of your types definition unit
    procedure RegisterUnsafeSpiType(const Types: array of PRttiInfo);
    /// register one RTTI TypeInfo() to be serialized as hexadecimal
    // - data will be serialized as BinToHexDisplayLower() JSON hexadecimal
    // string, using BinarySize bytes of the value, i.e. BinarySize*2 hexa chars
    // - you can truncate the original data size (e.g. if all bits of an integer
    // are not used) by specifying the aFieldSize optional parameter
    // - will also ensure that those types will be recognized by text definition
    // - leave BinarySize=0 to write all bytes as hexadecimal
    // - set BinarySize=-1 to unregister the binary serialization for the type
    // - not thread-safe: should be called once from the main thread, at startup,
    // e.g. in the initialization section of your types definition unit
    // - match mORMot 1.18 TTextWriter.RegisterCustomJSONSerializerFromTextBinaryType
    function RegisterBinaryType(Info: PRttiInfo; BinarySize: integer = 0): TRttiCustom;
    /// register one or several RTTI TypeInfo() to be serialized as hexadecimal
    // - TypeInfo() and associated size information will here be defined by pairs:
    // ([TypeInfo(TType1),TYPE1_BYTES,TypeInfo(TType2),TYPE2_BYTES])
    // - a wrapper around the RegisterBinaryType() method
    // - not thread-safe: should be called once from the main thread, at startup,
    // e.g. in the initialization section of your types definition unit
    // - match mORMot 1.18 TTextWriter.RegisterCustomJSONSerializerFromTextBinaryType
    procedure RegisterBinaryTypes(const InfoBinarySize: array of const);
    /// register one dynamic array RTTI TypeInfo() to be serialized as T*ObjArray
    // - not needed on FPC and Delphi 2010+ since "array of TSomeClass" will be
    // recognized directly - see HASDYNARRAYTYPE conditional
    // - allow JSON serialization and unserialization of the registered dynamic
    // array property defined in any TPersistent or TOrm for oldest Delphi
    // - could be used as such (note the T*ObjArray type naming convention):
    // ! TUserObjArray = array of TUser;
    // ! ...
    // ! Rtti.RegisterObjArray(TypeInfo(TUserObjArray), TUser);
    // - then you can use ObjArrayAdd/ObjArrayFind/ObjArrayDelete to manage
    // the stored items, and never forget to call ObjArrayClear to release
    // the memory
    // - set Item=nil to unregister the type as a T*ObjArray - may be needed
    // to bypass the FPC and Delphi 2010+ automatic recognition
    // - may return nil if DynArray is not a rkDynArray
    // - replace deprecated TJsonSerializer.RegisterObjArrayForJson() method
    // - not thread-safe: should be called once from the main thread, at startup,
    // e.g. in the initialization section of your T*ObjArray definition unit
    function RegisterObjArray(DynArray: PRttiInfo; Item: TClass): TRttiCustom;
    /// register one or several dynamic array RTTI TypeInfo() to be serialized
    // as T*ObjArray
    // - not needed on FPC and Delphi 2010+ since "array of TSomeClass" will be
    // recognized directly - see HASDYNARRAYTYPE conditional
    // - will call the RegisterObjArray() class method by pair:
    // ! Rtti.RegisterObjArrays([
    // !   TypeInfo(TAddressObjArray), TAddress,
    // !   TypeInfo(TUserObjArray), TUser]);
    // - not thread-safe: should be called once from the main thread, at startup,
    // e.g. in the initialization section of your T*ObjArray definition unit
    procedure RegisterObjArrays(const DynArrayItem: array of const);
    /// register TypeInfo() custom serialization for a given dynamic array or record
    // - DynArrayOrRecord should be valid TypeInfo() - use overloaded
    // RegisterFromText(TypeName) if the record has no TypeInfo()
    // - the RTTI information will here be defined as plain text
    // - since Delphi 2010, you can call directly RegisterType()
    // - the record where the data will be stored should be defined as PACKED:
    // ! type TMyRecord = packed record
    // !   A,B,C: integer;
    // !   D: RawUtf8;
    // !   E: record; // or array of record/integer/string/...
    // !     E1,E2: double;
    // !   end;
    // ! end;
    // - call this method with RttiDefinition='' to return back to the default
    // serialization, i.e. binary + Base64 or Delphi 2010+ extended RTTI
    // - RTTI textual information shall be supplied as text, with the
    // same format as any pascal record:
    // ! 'A,B,C: integer; D: RawUtf8; E: record E1,E2: double;'
    // ! 'A,B,C: integer; D: RawUtf8; E: array of record E1,E2: double;'
    // ! 'A,B,C: integer; D: RawUtf8; E: array of SynUnicode; F: array of TGuid'
    // or a shorter alternative syntax for records and arrays:
    // ! 'A,B,C: integer; D: RawUtf8; E: {E1,E2: double}'
    // ! 'A,B,C: integer; D: RawUtf8; E: [E1,E2: double]'
    // in fact ; could be ignored:
    // ! 'A,B,C:integer D:RawUtf8 E:{E1,E2:double}'
    // ! 'A,B,C:integer D:RawUtf8 E:[E1,E2:double]'
    // or even : could be ignored:
    // ! 'A,B,C integer D RawUtf8 E{E1,E2 double}'
    // ! 'A,B,C integer D RawUtf8 E[E1,E2 double]'
    // - it will return the cached TRttiCustom instance corresponding to the
    // supplied RTTI text definition - i.e. the rkRecord if TypeInfo(SomeArray)
    // - match mORMot 1.18 TTextWriter.RegisterCustomJSONSerializerFromText()
    function RegisterFromText(DynArrayOrRecord: PRttiInfo;
      const RttiDefinition: RawUtf8): TRttiCustom; overload;
    /// define a custom serialization for several dynamic arrays or records
    // - the TypeInfo() and textual RTTI information will here be defined as
    // ([TypeInfo(TType1),_TType1, TypeInfo(TType2),_TType2]) pairs
    // - a wrapper around the overloaded RegisterFromText() method
    // - match mORMot 1.18 TTextWriter.RegisterCustomJSONSerializerFromText()
    procedure RegisterFromText(
      const TypeInfoTextDefinitionPairs: array of const); overload;
    /// register by name a custom serialization for a given dynamic array or record
    // - use overloaded RegisterFromText(TypeName) if the record has TypeInfo()
    // - the RTTI information will here be defined as plain text
    function RegisterFromText(const TypeName: RawUtf8;
      const RttiDefinition: RawUtf8): TRttiCustom; overload;
    /// default property to access a given RTTI TypeInfo() customization
    // - you can access or register one type by using this default property:
    // ! Rtti[TypeInfo(TMyClass)].Props.NameChange('old', 'new')
    property ByTypeInfo[P: PRttiInfo]: TRttiCustom
      read RegisterType; default;
    /// default property to access a given RTTI customization of a class
    // - you can access or register one type by using this default property:
    // ! Rtti.ByClass[TMyClass].Props.NameChanges(['old', 'new'])
    property ByClass[C: TClass]: TRttiCustom
      read GetByClass;
    /// which kind of TRttiCustom class is to be used for registration
    // - properly set e.g. by mormot.core.json.pas to TRttiJson for JSON support
    property GlobalClass: TRttiCustomClass
      read fGlobalClass write SetGlobalClass;
  end;


/// low-level internal function use when inlining TRttiCustomProps.Find()
// - caller should ensure that namelen <> 0
function FindCustomProp(p: PRttiCustomProp; name: pointer; namelen: TStrLen;
  count: integer): PRttiCustomProp;

/// low-level internal function used e.g. by TRttiCustom.GetPrivateSlot()
// - caller should ensure that slot <> nil
function FindPrivateSlot(c: TClass; slot: PPointer): pointer;

/// retrieve a (possibly nested) class property RTTI and instance by path
// - as used e.g. by GetValueObject/SetValueObject wrapper functions
function GetInstanceByPath(var Instance: TObject; const Path: RawUtf8;
  out Prop: PRttiCustomProp; PathDelim: AnsiChar = '.'): boolean;

var
  /// low-level access to the list of registered PRttiInfo/TRttiCustom/TRttiJson
  Rtti: TRttiCustomList;

  /// direct lookup to the TRttiCustom of TRttiParserType values
  PT_RTTI: array[TRttiParserType] of TRttiCustom;

  /// direct lookup to the TRttiCustom of TRttiParserComplexType values
  PTC_RTTI: array[TRttiParserComplexType] of TRttiCustom;


{ *********** High Level TObjectWithID and TObjectWithCustomCreate Class Types }

type
  {$M+}
  /// abstract parent class with published properties and a virtual constructor
  // - is the parent of both TSynPersistent and TOrm classes
  // - will ensure the class type is registered to the Rtti global list
  // - also features some protected virtual methods for custom RTTI/JSON process
  TObjectWithCustomCreate = class(TObject)
  protected
    /// called by TRttiJson.SetParserType when this class is registered
    // - used e.g. to register TOrm.ID field which is not published as RTTI
    // - in TSynPersistent descendants, can change the Rtti.JsonSave callback
    // if needed, or e.g. set rcfHookWrite flag to call RttiBeforeWriteObject
    // and RttiAfterWriteObject, rcfHookWriteProperty for RttiWritePropertyValue
    // and/or rcfHookRead for RttiBeforeReadObject or RttiAfterReadObject methods
    // (disabled by default not to slow down the serialization process)
    class procedure RttiCustomSetParser(Rtti: TRttiCustom); virtual;
    // called before TJsonWriter.WriteObject() serialize this instance as JSON
    // - triggered if RttiCustomSetParser defined the rcfHookWrite flag
    // - you can return true if your method made the serialization
    // - this default implementation just returns false, to continue serializing
    // - TSynMonitor will change the serialization Options for this instance
    function RttiBeforeWriteObject(W: TTextWriter;
      var Options: TTextWriterWriteObjectOptions): boolean; virtual;
    // called by TJsonWriter.WriteObject() to serialize one published property value
    // - triggered if RttiCustomSetParser defined the rcfHookWriteProperty flag
    // - is e.g. overriden in TOrm/TOrmMany to detect "fake" instances
    // - should return true if a property has been written, false (which is the
    // default) if the property is to be serialized as usual
    function RttiWritePropertyValue(W: TTextWriter; Prop: PRttiCustomProp;
      Options: TTextWriterWriteObjectOptions): boolean; virtual;
    /// called after TJsonWriter.WriteObject() serialized this instance as JSON
    // - triggered if RttiCustomSetParser defined the rcfHookWrite flag
    // - execute just before W.BlockEnd('}')
    procedure RttiAfterWriteObject(W: TTextWriter;
      Options: TTextWriterWriteObjectOptions); virtual;
    /// called to unserialize this instance from JSON
    // - triggered if RttiCustomSetParser defined the rcfHookRead flag
    // - you can return true if your method made the instance unserialization
    // - this default implementation just returns false, to continue processing
    // - opaque Ctxt is a PJsonParserContext instance
    function RttiBeforeReadObject(Ctxt: pointer): boolean; virtual;
    /// called to unserialize of property of this instance from JSON
    // - triggered if RttiCustomSetParser defined the rcfHookReadProperty flag
    // - you can return true if your method made the property unserialization
    // - this default implementation just returns false, to continue processing
    // - opaque Ctxt is a PJsonParserContext instance
    function RttiBeforeReadPropertyValue(Ctxt: pointer;
      Prop: PRttiCustomProp): boolean; virtual;
    /// called after this instance has been unserialized from JSON
    // - triggered if RttiCustomSetParser defined the rcfHookRead flag
    procedure RttiAfterReadObject; virtual;
  public
    /// virtual constructor called at instance creation
    // - is declared as virtual so that inherited classes may have a root
    // constructor to override
    // - is recognized by our RTTI serialization/initialization process
    constructor Create; virtual;
    /// optimized initialization code
    // - will also register the class type to the Rtti global list
    // - somewhat faster than the regular RTL implementation
    // - warning: this optimized version won't initialize the vmtIntfTable
    // for this class hierarchy: as a result, you would NOT be able to
    // implement an interface with a TSynPersistent descendent (but you should
    // not need to, but inherit from TInterfacedObject)
    // - warning: under FPC, it won't initialize fields management operators
    class function NewInstance: TObject; override;
    /// very efficiently retrieve the TRttiCustom associated with this class
    // - since Create did register it, just return the first vmtAutoTable slot
    class function RttiCustom: TRttiCustom;
      {$ifdef HASINLINE}inline;{$endif}
  end;
  {$M-}

  /// used to determine the exact class type of a TObjectWithCustomCreate
  // - allow to create instances using its virtual constructor
  TObjectWithCustomCreateClass = class of TObjectWithCustomCreate;

  /// root class of an object with a 64-bit ID primary key
  // - is the parent of mormot.orm.core's TOrm, but you could use it e.g. on
  // client side to avoid a dependency to all ORM process, but still have the
  // proper published fields and use it in SOA - with a single conditional over
  // your class definition to inherit either from TOrm or from TObjectWithID
  TObjectWithID = class(TObjectWithCustomCreate)
  protected
    fID: TID;
    /// will register the "ID":... field value for proper JSON serialization
    class procedure RttiCustomSetParser(Rtti: TRttiCustom); override;
  public
    /// this constructor initializes the instance with a given ID
    constructor CreateWithID(aID: TID);
    /// this property gives direct access to the class instance ID
    // - not defined as "published" since RttiCustomSetParser did register it
    property IDValue: TID
      read fID write fID;
  end;

  /// used to determine the exact class type of a TObjectWithID
  TObjectWithIDClass = class of TObjectWithID;

/// internal wrapper to protected TObjectWithCustomCreate.RttiCustomSetParser()
// - a local TCCHook was reported to have issues on FPC with class methods
procedure TObjectWithCustomCreateRttiCustomSetParser(
  O: TObjectWithCustomCreateClass; Rtti: TRttiCustom);

/// TDynArraySortCompare compatible function, sorting by TObjectWithID/TOrm.ID
function TObjectWithIDDynArrayCompare(const Item1, Item2): integer;

/// TDynArrayHashOne compatible function, hashing TObjectWithID/TOrm.ID
function TObjectWithIDDynArrayHashOne(const Elem; Hasher: THasher): cardinal;



implementation


{ some inlined definitions which should be declared before $include code }

type
  // local wrapper to retrieve IInvokable Interface RTTI via GetRttiInterface()
  TGetRttiInterface = class
  public
    Level: integer;
    MethodCount, ArgCount: integer;
    CurrentMethod: PRttiMethod;
    Definition: TRttiInterface;
    procedure AddMethod(const aMethodName: ShortString; aParamCount: integer;
      aKind: TMethodKind);
    procedure AddArgument(aParamName, aTypeName: PShortString; aInfo: PRttiInfo;
      aFlags: TParamFlags);
    procedure RaiseError(const Format: RawUtf8; const Args: array of const);
    // this method will be implemented in mormot.core.rtti.fpc/delphi.inc
    procedure AddMethodsFromTypeInfo(aInterface: PTypeInfo);
  end;

{$ifdef FPC}
  {$include mormot.core.rtti.fpc.inc}      // FPC specific RTTI access
{$else}
  {$include mormot.core.rtti.delphi.inc}   // Delphi specific RTTI access
{$endif FPC}


{ ************* Low-Level Cross-Compiler RTTI Definitions }

{ TRttiClass }

function TRttiClass.RttiClass: TClass;
begin
  result := PTypeData(@self)^.ClassType;
end;

function TRttiClass.UnitName: PShortString;
begin
  result := @PTypeData(@self)^.UnitName;
end;

function _ClassUnit(C: TClass): PShortString;
var
  P: PRttiInfo;
begin
  P := PPointer(PAnsiChar(C) + vmtTypeInfo)^;
  if P <> nil then
    result := P^.RttiNonVoidClass^.UnitName
  else
    result := @NULCHAR;
end;

function TRttiClass.InheritsFrom(AClass: TClass): boolean;
var
  P: PRttiInfo;
begin
  result := true;
  if RttiClass = AClass then
    exit;
  P := ParentInfo;
  while P <> nil do
    with P^.RttiNonVoidClass^ do
      if RttiClass = AClass then
        exit
      else
        P := ParentInfo;
  result := false;
end;


{ TRttiProp }

function TRttiProp.Name: PShortString;
begin
  result := @PPropInfo(@self)^.Name;
end;

function TRttiProp.NameUtf8: RawUtf8;
begin
  ShortStringToAnsi7String(PPropInfo(@self)^.Name, result);
end;

function TRttiProp.Next: PRttiProp;
begin
  // this abstract code compiles into 2 asm lines under FPC :)
  with PPropInfo(@self)^ do
    result := AlignToPtr(@PByteArray(@self)[
      (PtrUInt(@PPropInfo(nil).Name) + SizeOf(Name[0])) + Length(Name)]);
end;


{ TRttiProps = TPropData in TypInfo }

function TRttiProps.FieldProp(const PropName: ShortString): PRttiProp;
var
  i: integer;
begin
  if @self<>nil then
  begin
    result := PropList;
    for i := 1 to PropCount do
      if PropNameEquals(result^.Name, @PropName) then
        exit
      else
        result := result^.Next;
  end;
  result := nil;
end;


{ TRttiEnumType }

function TRttiEnumType.RttiOrd: TRttiOrd;
begin
  result := TRttiOrd(PTypeData(@self)^.OrdType);
end;

function TRttiEnumType.MinValue: PtrInt;
begin
  result := PTypeData(@self).MinValue;
end;

function TRttiEnumType.MaxValue: PtrInt;
begin
  result := PTypeData(@self).MaxValue;
end;

function TRttiEnumType.NameList: PShortString;
begin
  result := @PTypeData(@self).NameList;
end;

function TRttiEnumType.SizeInStorageAsEnum: integer;
begin
  if @self = nil then
    result := 0
  else
    result := ORDTYPE_SIZE[RttiOrd]; // MaxValue is wrong e.g. with WordBool
end;

function TRttiEnumType.SizeInStorageAsSet: integer;
begin
  if @self <> nil then
  begin
    result := MaxValue;
    if result < 8 then
      result := SizeOf(byte)
    else if result < 16 then
      result := SizeOf(word)
    else if result < 32 then
      result := SizeOf(cardinal)
    else if result < 64 then
      result := SizeOf(QWord)
    else
      result := 0;
  end
  else
    result := 0;
end;

function TRttiEnumType.GetEnumName(const Value): PShortString;
begin
  if @Value = nil then
    result := @NULCHAR
  else
    result := GetEnumNameOrd(RTTI_FROM_ORD[RttiOrd](@Value));
end;

function TRttiEnumType.GetCaption(const Value): string;
begin
  GetCaptionFromTrimmed(GetEnumNameOrd(RTTI_FROM_ORD[RttiOrd](@Value)), result);
end;

procedure TRttiEnumType.AddCaptionStrings(Strings: TStrings;
  UsedValuesBits: Pointer);
var
  i, L: PtrInt;
  Line: array[byte] of AnsiChar;
  P: PAnsiChar;
  V: PShortString;
  s: string;
begin
  if @self = nil then
    exit;
  Strings.BeginUpdate;
  try
    V := NameList;
    for i := MinValue to MaxValue do
    begin
      if (UsedValuesBits = nil) or
         GetBitPtr(UsedValuesBits, i) then
      begin
        L := ord(V^[0]);
        P := @V^[1];
        while (L > 0) and
              (P^ in ['a'..'z']) do
        begin
          // ignore left lowercase chars
          inc(P);
          dec(L);
        end;
        if L = 0 then
        begin
          L := ord(V^[0]);
          P := @V^[1];
        end;
        Line[L] := #0; // GetCaptionFromPCharLen() expect it as ASCIIZ
        MoveFast(P^, Line, L);
        GetCaptionFromPCharLen(Line, s);
        Strings.AddObject(s, pointer(i));
      end;
      inc(PByte(V), length(V^)+1);
    end;
  finally
    Strings.EndUpdate;
  end;
end;

function TRttiEnumType.GetCaptionStrings(UsedValuesBits: pointer): string;
var
  List: TStringList;
begin
  List := TStringList.Create;
  try
    AddCaptionStrings(List, UsedValuesBits);
    result := List.Text;
  finally
    List.Free;
  end;
end;

procedure TRttiEnumType.GetEnumNameAll(var result: TRawUtf8DynArray;
  TrimLeftLowerCase: boolean);
var
  max, i: PtrInt;
  V: PShortString;
begin
  Finalize(result);
  max := MaxValue - MinValue;
  SetLength(result, max + 1);
  V := NameList;
  for i := 0 to max do
  begin
    if TrimLeftLowerCase then
      result[i] := TrimLeftLowerCaseShort(V)
    else
      ShortStringToAnsi7String(V^, result[i]);
    inc(PByte(V), length(V^) + 1);
  end;
end;

procedure TRttiEnumType.GetEnumNameAll(out result: RawUtf8; const Prefix: RawUtf8;
  quotedValues: boolean; const Suffix: RawUtf8; trimedValues, unCamelCased: boolean);
var
  i: integer;
  V: PShortString;
  uncamel: ShortString;
  temp: TTextWriterStackBuffer;
begin
  with TTextWriter.CreateOwnedStream(temp) do
  try
    AddString(Prefix);
    V := NameList;
    for i := MinValue to MaxValue do
    begin
      if quotedValues then
        AddDirect('"');
      if unCamelCased then
      begin
        TrimLeftLowerCaseToShort(V, uncamel);
        AddShort(uncamel);
      end
      else if trimedValues then
        AddTrimLeftLowerCase(V)
      else
        AddShort(V^);
      if quotedValues then
        AddDirect('"');
      AddComma;
      inc(PByte(V), length(V^) + 1);
    end;
    CancelLastComma;
    AddString(Suffix);
    SetText(result);
  finally
    Free;
  end;
end;

procedure TRttiEnumType.GetEnumNameTrimedAll(var result: RawUtf8;
  const Prefix: RawUtf8; quotedValues: boolean; const Suffix: RawUtf8);
begin
  GetEnumNameAll(result, Prefix, quotedValues, Suffix, {trimed=}true);
end;

function TRttiEnumType.GetEnumNameAllAsJsonArray(TrimLeftLowerCase: boolean;
  UnCamelCased: boolean): RawUtf8;
begin
  GetEnumNameAll(result, '[', {quoted=}true, ']', TrimLeftLowerCase, UnCamelCased);
end;

function TRttiEnumType.GetEnumNameValue(const EnumName: ShortString): integer;
begin
  result := GetEnumNameValue(@EnumName[1], ord(EnumName[0]));
end;

function TRttiEnumType.GetEnumNameValue(Value: PUtf8Char): integer;
begin
  result := GetEnumNameValue(Value, StrLen(Value));
end;

function TRttiEnumType.GetEnumNameValue(Value: PUtf8Char; ValueLen: integer;
  AlsoTrimLowerCase: boolean): integer;
begin
  if (Value <> nil) and
     (ValueLen > 0) and
     (MinValue = 0) then
  begin
    result := FindShortStringListExact(NameList, MaxValue, Value, ValueLen);
    if (result < 0) and
       AlsoTrimLowerCase then
      result := FindShortStringListTrimLowerCase(NameList, MaxValue, Value, ValueLen);
  end
  else
    result := -1;
end;

function TRttiEnumType.GetEnumNameValueTrimmed(Value: PUtf8Char; ValueLen: integer;
  CaseSensitive: boolean): integer;
begin
  if (Value <> nil) and
     (ValueLen > 0) and
     (MinValue = 0) then
    if CaseSensitive then
      result := FindShortStringListTrimLowerCaseExact(NameList, MaxValue, Value, ValueLen)
    else
      result := FindShortStringListTrimLowerCase(NameList, MaxValue, Value, ValueLen)
  else
    result := -1;
end;

function TRttiEnumType.GetEnumNameTrimed(const Value): RawUtf8;
begin
  result := TrimLeftLowerCaseShort(GetEnumName(Value));
end;

function TRttiEnumType.GetSetName(const value; trimmed: boolean;
  const sep: RawUtf8): RawUtf8;
var
  j: PtrInt;
  PS, v: PShortString;
  tmp: shortstring;
begin
  result := '';
  if (@self = nil) or
     (@value = nil) then
    exit;
  PS := NameList;
  for j := MinValue to MaxValue do
  begin
    if GetBitPtr(@value, j) then
    begin
      v := @tmp;
      if trimmed then
        TrimLeftLowerCaseToShort(PS, tmp)
      else
        v := PS;
      Append(result, [v^, sep]);
    end;
    inc(PByte(PS), PByte(PS)^ + 1); // next
  end;
  if result <> '' then
    FakeLength(result, length(result) - length(sep)); // trim last separator
end;

procedure TRttiEnumType.GetSetNameJsonArray(W: TTextWriter; Value: cardinal;
  SepChar, QuoteChar: AnsiChar; FullSetsAsStar, ForceTrim: boolean);
var
  j, max: PtrInt;
  PS: PShortString;
begin
  W.Add('[');
  if FullSetsAsStar and
     (MinValue = 0) and
     GetAllBits(Value, MaxValue + 1) then
    W.AddShorter('"*"')
  else
  begin
    PS := NameList;
    if twoTrimLeftEnumSets in W.CustomOptions then
      ForceTrim := true;
    max := MaxValue;
    if max >= 32 then
      max := 31; // avoid buffer overflow on 32-bit cardinal Value
    for j := MinValue to max do
    begin
      if GetBitPtr(@Value, j) then
      begin
        if QuoteChar <> #0 then
          W.Add(QuoteChar);
        if ForceTrim then
          W.AddTrimLeftLowerCase(PS)
        else
          W.AddShort(PS^);
        if QuoteChar <> #0 then
          W.AddDirect(QuoteChar);
        W.AddDirect(SepChar);
      end;
      inc(PByte(PS), ord(PS^[0]) + 1); // next item
    end;
  end;
  W.CancelLastComma(']');
end;

function TRttiEnumType.GetSetNameJsonArray(Value: cardinal; SepChar: AnsiChar;
  FullSetsAsStar: boolean): RawUtf8;
var
  W: TTextWriter;
  temp: TTextWriterStackBuffer;
begin
  W := TTextWriter.CreateOwnedStream(temp);
  try
    GetSetNameJsonArray(W, Value, SepChar, '"', FullSetsAsStar, {forcetrim=}false);
    W.SetText(result);
  finally
    W.Free;
  end;
end;

function TRttiEnumType.GetEnumNameTrimedValue(const EnumName: ShortString): integer;
begin
  result := GetEnumNameTrimedValue(@EnumName[1], ord(EnumName[0]));
end;

function TRttiEnumType.GetEnumNameTrimedValue(Value: PUtf8Char; ValueLen: integer): integer;
begin
  if (Value = nil) or
     (MinValue <> 0) then
    result := -1
  else
  begin
    if ValueLen = 0 then
      ValueLen := StrLen(Value);
    result := FindShortStringListTrimLowerCase(NameList, MaxValue, Value, ValueLen);
    if result < 0 then
      result := FindShortStringListExact(NameList, MaxValue, Value, ValueLen);
  end;
end;

procedure TRttiEnumType.SetEnumFromOrdinal(out Value; Ordinal: PtrUInt);
begin
  RTTI_TO_ORD[RttiOrd](@Value, Ordinal);
end;



{ TRttiInterfaceTypeData }

function TRttiInterfaceTypeData.IntfFlags: TRttiIntfFlags;
begin
  result := TRttiIntfFlags(PTypeData(@self)^.IntfFlags);
end;

function TRttiInterfaceTypeData.IntfUnit: PShortString;
begin
  result := @PTypeData(@self)^.IntfUnit;
end;


{ TRttiInfo }

procedure TRttiInfo.Clear(Data: pointer);
var
  fin: TRttiFinalizer;
begin
  fin := RTTI_FINALIZE[Kind];
  if Assigned(fin) then
    fin(Data, @self);
end;

procedure TRttiInfo.Copy(Dest, Source: pointer);
var
  cop: TRttiCopier;
begin
  cop := RTTI_MANAGEDCOPY[Kind];
  if Assigned(cop) then
    cop(Dest, Source, @self);
end;

function TRttiInfo.RttiOrd: TRttiOrd;
begin
  result := TRttiOrd(GetTypeData(@self)^.OrdType);
end;

function TRttiInfo.IsCurrency: boolean;
begin
  result := TRttiFloat(GetTypeData(@self)^.FloatType) = rfCurr;
end;

function TRttiInfo.IsDate: boolean;
begin
  result := (@self = TypeInfo(TDate)) or
            (@self = TypeInfo(TDateTime)) or
            (@self = TypeInfo(TDateTimeMS));
end;

function TRttiInfo.IsRawBlob: boolean;
begin
  result := @self = TypeInfo(RawBlob);
end;

function TRttiInfo.RttiFloat: TRttiFloat;
begin
  result := TRttiFloat(GetTypeData(@self)^.FloatType);
end;

{$ifndef ISFPC32}
function TRttiInfo.SetEnumSize: PtrInt;
begin
  result := SetEnumType^.SizeInStorageAsSet;
end;
{$endif ISFPC32}

function TRttiInfo.DynArrayItemSize: PtrInt;
begin
  DynArrayItemType(result); // fast enough (not used internally)
end;

function TRttiInfo.RttiSize: PtrInt;
begin
  case Kind of
    {$ifdef FPC}
    rkBool,
    rkUChar,
    {$endif FPC}
    rkInteger,
    rkEnumeration,
    rkChar,
    rkWChar:
      result := ORDTYPE_SIZE[TRttiOrd(GetTypeData(@self)^.OrdType)];
    rkSet:
      result := SetEnumSize;
    rkFloat:
      result := FLOATTYPE_SIZE[TRttiFloat(GetTypeData(@self)^.FloatType)];
    rkLString,
    {$ifdef FPC}
    rkLStringOld,
    rkInterfaceRaw,
    {$endif FPC}
    {$ifdef HASVARUSTRING}
    rkUString,
    {$endif HASVARUSTRING}
    {$ifdef FPC_OR_UNICODE}
    rkClassRef,
    rkPointer,
    {$endif FPC_OR_UNICODE}
    rkWString,
    rkClass,
    rkInterface,
    rkDynArray:
      result := SizeOf(pointer);
    {$ifdef FPC}
    rkQWord,
    {$endif FPC}
    rkInt64:
      result := 8;
    rkVariant:
      result := SizeOf(variant);
    rkArray:
      result := ArraySize;
    {$ifdef FPC}rkObject,{$else}{$ifdef UNICODE}rkMRecord,{$endif}{$endif}
    rkRecord:
      result := RecordSize;
    rkSString:
      result := GetTypeData(@self)^.MaxLength + 1;
  else
    result := 0;
  end;
end;

function TRttiInfo.IsManaged: boolean;
begin
  if Kind in rkRecordTypes then
    result := RecordManagedFieldsCount > 0
  else
    result := Kind in rkManagedTypes;
  // note: rkArray should be handled specificically: we return true here by now
end;

function TRttiInfo.ClassFieldCount(onlyWithoutGetter: boolean): integer;
begin
  result := ClassFieldCountWithParents(RttiClass^.RttiClass, onlyWithoutGetter);
end;

function TRttiInfo.InheritsFrom(AClass: TClass): boolean;
begin
  result := RttiNonVoidClass^.InheritsFrom(AClass);
end;

function TRttiInfo.EnumBaseType(out NameList: PShortString;
  out Min, Max: integer): PRttiEnumType;
begin
  result := EnumBaseType;
  NameList := result^.NameList;
  Min := result^.MinValue;
  Max := result^.MaxValue;
end;

function TRttiInfo.SetEnumType: PRttiEnumType;
begin
  if (@self = nil) or
     (Kind <> rkSet) then
    result := nil
  else
    result := PRttiEnumType(GetTypeData(@self))^.SetBaseType;
end;

function TRttiInfo.SetEnumType(out NameList: PShortString;
  out Min, Max: integer): PRttiEnumType;
begin
  result := SetEnumType;
  if result <> nil then
  begin
    NameList := result^.EnumBaseType.NameList; // EnumBaseType for partial sets
    Min := result^.MinValue;
    Max := result^.MaxValue;
  end;
end;


var
  /// conversion table from TRttiKind to TRttiVarData.VType
  // - rkEnumeration,rkSet,rkDynArray,rkClass,rkInterface,rkRecord,rkArray are
  // identified as varAny with TVarData.VAny pointing to the actual value
  // - rkChar,rkWChar,rkSString converted into temporary RawUtf8 as varUnknown
  RTTI_TO_VARTYPE: array[TRttiKind] of word;

procedure TRttiInfo.ComputeCache(var Cache: TRttiCache);
var
  enum: PRttiEnumType;
  siz, cnt: PtrInt;
begin
  // caller ensured Cache is filled with zeros (e.g. TRttiCustom.fCache prop)
  FillCharFast(Cache, SizeOf(Cache), 0); // paranoid
  Cache.Info := @self;
  Cache.Size := RttiSize;
  Cache.Kind := Kind;
  if Kind in rkOrdinalTypes then
  begin
    if Kind in rkHasRttiOrdTypes then
    begin
      include(Cache.Flags, rcfHasRttiOrd);
      Cache.RttiOrd := RttiOrd;
    end;
    if IsQWord then
      include(Cache.Flags, rcfQword);
    if IsBoolean then
    begin
      Cache.RttiVarDataVType := varBoolean; // no rkBool on Delphi
      include(Cache.Flags, rcfBoolean);
    end;
  end;
  if Kind in rkNumberTypes then
    include(Cache.Flags, rcfIsNumber);
  if Kind in rkGetOrdPropTypes then
    include(Cache.Flags, rcfGetOrdProp)
  else if Kind in rkGetInt64PropTypes then
    include(Cache.Flags, rcfGetInt64Prop);
  Cache.RttiVarDataVType := RTTI_TO_VARTYPE[Kind];
  Cache.VarDataVType := Cache.RttiVarDataVType;
  case Kind of
    rkFloat:
      begin
        Cache.RttiFloat := RttiFloat;
        if IsCurrency then
        begin
          Cache.RttiVarDataVType := varCurrency;
          Cache.VarDataVType := varCurrency;
        end
        else if IsDate then
        begin
          Cache.RttiVarDataVType := varDate;
          Cache.VarDataVType := varDate;
          Cache.IsDateTime := true;
        end
        else if Cache.RttiFloat = rfSingle then
        begin
          Cache.RttiVarDataVType := varSingle;
          Cache.VarDataVType := varSingle;
        end;
      end;
    rkEnumeration,
    rkSet:
      begin
        Cache.VarDataVType := varInt64; // no need of the varAny TypeInfo marker
        if Kind = rkEnumeration then
          enum := Cache.Info.EnumBaseType
        else
          enum := Cache.Info.SetEnumType;
        Cache.EnumMin := enum.MinValue;
        Cache.EnumMax := enum.MaxValue;
        // EnumBaseType^ is required for partial sets on Delphi
        enum := enum.EnumBaseType;
        Cache.EnumInfo := enum;
        Cache.EnumList := enum.NameList;
      end;
    rkDynArray:
      begin
        Cache.ItemInfo := DynArrayItemType(siz); // nil for unmanaged items
        Cache.ItemSize := siz;
      end;
    rkArray:
      begin
        Cache.ItemInfo := ArrayItemType(cnt, siz);
        if (cnt = 0) or
           (siz mod cnt <> 0) then
          raise ERttiException.CreateUtf8('ComputeCache(%): array siz=% cnt=%',
            [RawName, siz, cnt]);
        Cache.ItemSize := siz div cnt;
        Cache.ItemCount := cnt;
      end;
    rkLString:
      if IsRawBlob then
      begin
        include(Cache.Flags, rcfIsRawBlob);
        Cache.CodePage := CP_RAWBYTESTRING; // CP_RAWBLOB is internal
        Cache.Engine := TSynAnsiConvert.Engine(CP_RAWBYTESTRING);
      end
      else
      begin
        Cache.CodePage := AnsiStringCodePage; // use TypeInfo() on old Delphi
        Cache.Engine := TSynAnsiConvert.Engine(Cache.CodePage);
      end;
    rkInterface:
      Cache.InterfaceGuid := InterfaceGuid;
  end;
end;

function TRttiInfo.InterfaceType: PRttiInterfaceTypeData;
begin
  result := pointer(GetTypeData(@self));
end;

function TRttiInfo.AnsiStringCodePage: integer;
begin
  if @self = TypeInfo(RawBlob) then
    result := CP_RAWBLOB
  else
  {$ifdef HASCODEPAGE}
  if Kind = rkLString then
    // has rkLStringOld any codepage? don't think so -> UTF-8
    result := GetTypeData(@self)^.CodePage
  else
    result := CP_UTF8; // default is UTF-8
  {$else}
  if @self = TypeInfo(RawUtf8) then
    result := CP_UTF8
  else if @self = TypeInfo(WinAnsiString) then
    result := CP_WINANSI
  {$ifndef PUREMORMOT2}
  else if @self = TypeInfo(RawUnicode) then
    result := CP_UTF16
  {$endif PUREMORMOT2}
  else if @self = TypeInfo(RawByteString) then
    result := CP_RAWBYTESTRING // RawBlob has same internal code page
  else if @self = TypeInfo(AnsiString) then
    result := CP_ACP
  else
    result := CP_UTF8; // default is UTF-8
  {$endif HASCODEPAGE}
end;

{$ifdef HASCODEPAGE}

function TRttiInfo.AnsiStringCodePageStored: integer;
begin
  result := GetTypeData(@self)^.CodePage;
end;

{$endif HASCODEPAGE}

procedure TRttiInfo.StringToUtf8(Data: pointer; var Value: RawUtf8);
begin
  case Kind of
    rkChar:
      FastSetString(Value, Data, {ansicharcount=}1);
    rkWChar:
      RawUnicodeToUtf8(Data, {widecharcount=}1, Value);
    rkSString:
      ShortStringToAnsi7String(PShortString(Data)^, Value);
    rkLString:
      Value := PRawUtf8(Data)^;
    rkWString:
      RawUnicodeToUtf8(Data, length(PWideString(Data)^), Value);
    {$ifdef HASVARUSTRING}
    rkUString:
      RawUnicodeToUtf8(Data, length(PUnicodeString(Data)^), Value);
    {$endif HASVARUSTRING}
  else
    Value := '';
  end;
end;

function TRttiInfo.InterfaceGuid: PGuid;
begin
  if (@self = nil) or
     (Kind <> rkInterface) then
    result := nil
  else
    result := InterfaceType^.IntfGuid;
end;

function TRttiInfo.InterfaceUnitName: PShortString;
begin
  if (@self = nil) or
     (Kind <> rkInterface) then
    result := @NULCHAR
  else
    result := InterfaceType^.IntfUnit;
end;

function TRttiInfo.InterfaceAncestor: PRttiInfo;
begin
  if (@self = nil) or
     (Kind <> rkInterface) then
    result := nil
  else
    result := InterfaceType^.IntfParent;
end;

procedure TRttiInfo.InterfaceAncestors(out Ancestors: PRttiInfoDynArray;
  OnlyImplementedBy: TInterfacedObjectClass;
  out AncestorsImplementedEntry: TPointerDynArray);
var
  n: PtrInt;
  nfo: PRttiInfo;
  typ: PRttiInterfaceTypeData;
  entry: pointer;
begin
  if (@self = nil) or
     (Kind <> rkInterface) then
    exit;
  n := 0;
  typ := InterfaceType;
  repeat
    nfo := typ^.IntfParent;
    if (nfo = nil) or
       (nfo = TypeInfo(IInterface)) then
      exit;
    typ := nfo^.InterfaceType;
    if ifHasGuid in typ^.IntfFlags then
    begin
      if OnlyImplementedBy <> nil then
      begin
        entry := OnlyImplementedBy.GetInterfaceEntry(typ^.IntfGuid^);
        if entry = nil then
          continue;
        SetLength(AncestorsImplementedEntry, n + 1);
        AncestorsImplementedEntry[n] := entry;
      end;
      SetLength(Ancestors, n + 1);
      Ancestors[n] := nfo;
      inc(n);
    end;
  until false;
end;

function TRttiInfo.InterfaceImplements(const AGuid: TGuid): boolean;
var
  nfo: PRttiInfo;
  typ: PRttiInterfaceTypeData;
begin
  result := false;
  if (@self = nil) or
     IsNullGuid(AGuid) or
     (Kind <> rkInterface) then
    exit;
  typ := InterfaceType;
  repeat
    nfo := typ^.IntfParent;
    if (nfo = nil) or
       (nfo = TypeInfo(IInterface)) then
      exit;
    typ := nfo^.InterfaceType;
  until (ifHasGuid in typ^.IntfFlags) and
        IsEqualGuid(AGuid, typ^.IntfGuid^);
  result := true; // found
end;


{ TRttiProp }

function TRttiProp.Index: integer;
begin
  result := PPropInfo(@self)^.Index;
end;

function TRttiProp.Default: integer;
begin
  result := PPropInfo(@self)^.Default;
end;

function TRttiProp.NameIndex: integer;
begin
  result := PPropInfo(@self)^.NameIndex;
end;

function TRttiProp.FieldSize: PtrInt;
begin
  result := TypeInfo^.RttiSize;
end;

function TRttiProp.GetterAddr(Instance: pointer): pointer;
begin
  result := Pointer(PtrUInt(Instance) +
    PtrUInt(PPropInfo(@self)^.GetProc) {$ifdef ISDELPHI} and $00ffffff {$endif} );
end;

function TRttiProp.SetterAddr(Instance: pointer): pointer;
begin
  result := Pointer(PtrUInt(Instance) +
    PtrUInt(PPropInfo(@self)^.SetProc) {$ifdef ISDELPHI} and $00ffffff {$endif} );
end;

function TRttiProp.GetFieldAddr(Instance: TObject): pointer;
begin
  if not GetterIsField then
    if not SetterIsField then
      // both are methods -> returns nil
      result := nil
    else
      // field - Setter is the field offset in the instance data
      result := SetterAddr(Instance)
  else
    // field - Getter is the field offset in the instance data
    result := GetterAddr(Instance);
end;

function TRttiProp.GetterCall: TRttiPropCall;
var
  call: TMethod;
begin
  result := Getter(nil, @call);
end;

function TRttiProp.SetterCall: TRttiPropCall;
var
  call: TMethod;
begin
  result := Setter(nil, @call);
end;

function TRttiProp.DefaultOr0: integer;
begin
  result := PPropInfo(@self)^.Default;
  if result = NO_DEFAULT then
    result := 0;
end;

function TRttiProp.IsRawBlob: boolean;
begin
  result := TypeInfo = system.TypeInfo(RawBlob);
end;

function TRttiProp.SetValue(Instance: TObject; const Value: variant): boolean;
var
  k: TRttiKind;
  v: Int64;
  f: double;
  u: RawUtf8;
begin
  result := false; // invalid or unsupported type
  if (@self = nil) or
     (Instance = nil) then
    exit;
  k := TypeInfo^.Kind;
  if k in rkOrdinalTypes then
    if VariantToInt64(Value, v) then
      SetInt64Value(Instance, v)
    else if (k = rkEnumeration) and
            VariantToText(Value, u) and
            SetValueText(Instance, u) then
      // value found from GetEnumNameValue()
    else
      exit
  else if k in rkStringTypes then
    if VarIsEmptyOrNull(Value) then // otherwise would set 'null' text
      SetAsString(Instance, '')
    else if VariantToUtf8(Value, u) then
      SetAsString(Instance, u)
    else
      exit
  else if k = rkFloat then
  begin
    if not VariantToDouble(Value, f) then
      if Assigned(_Iso8601ToDateTime) and
         VariantToText(Value, u) then
        if u = '' then
          f := 0
        else
        begin
          f := _Iso8601ToDateTime(u);
          if f = 0 then
            exit; // not a date
        end
      else
        exit;
    SetFloatProp(Instance, f);
  end
  else if k = rkVariant then
    SetVariantProp(Instance, Value)
  else
    exit;
  result := true;
end;

function TRttiProp.SetValueText(Instance: TObject; const Value: RawUtf8): boolean;
var
  k: TRttiKind;
  v: Int64;
  f: double;
begin
  result := false; // invalid or unsupported type
  if (@self = nil) or
     (Instance = nil) then
    exit;
  k := TypeInfo^.Kind;
  if k in rkOrdinalTypes then
    if ToInt64(Value, v) or // ordinal field from number
       (TypeInfo^.IsBoolean and
        GetInt64Bool(pointer(Value), v)) then // boolean from true/false/yes/no
      SetInt64Value(Instance, v)
    else if Value = '' then
      exit
    else if k = rkEnumeration then // enumertate field from text
    begin
      v := GetEnumNameValue(TypeInfo, Value, {trimlowcase=}true);
      if v < 0 then
        exit; // not a text enum
      SetOrdProp(Instance, v);
    end
    else if k = rkSet then // set field from CSV text
      SetOrdProp(Instance, GetSetCsvValue(TypeInfo, pointer(Value)))
    else
      exit
  else if k in rkStringTypes then
    SetAsString(Instance, Value)
  else if k = rkFloat then
  begin
    if not ToDouble(Value, f) then
      if Value = '' then
        f := 0
      else if Assigned(_Iso8601ToDateTime) then
      begin
        f := _Iso8601ToDateTime(Value);
        if f = 0 then
          exit; // not a date
      end
      else
        exit;
    SetFloatProp(Instance, f);
  end
  else if k = rkVariant then
    SetVariantProp(Instance, Value) // store as text
  else
    exit;
  result := true;
end;

function TRttiProp.GetValueText(Instance: TObject): RawUtf8;
var
  k: TRttiKind;
  v: TRttiVarData;
begin
  result := '';
  if (@self = nil) or
     (Instance = nil) then
    exit;
  k := TypeInfo^.Kind;
  if k in rkOrdinalTypes then
    Int64ToUtf8(GetInt64Value(Instance), result)
  else if k in rkStringTypes then
    GetAsString(Instance, result)
  else if k = rkFloat then
    DoubleToStr(GetFloatProp(Instance), result)
  else if k = rkVariant then
  begin
    v.VType := 0;
    GetVariantProp(Instance, variant(v), {byref=}true);
    VariantToUtf8(variant(v), result);
    VarClearProc(v.Data);
  end;
end;

function TRttiProp.GetOrdProp(Instance: TObject): Int64;
type
  TGetProc = function: Pointer of object; // pointer result is a PtrInt register
  TGetIndexed = function(Index: integer): Pointer of object;
var
  rpc: TRttiPropCall;
  call: TMethod;
begin
  rpc := Getter(Instance, @call);
  if rpc = rpcField then
    call.Code := PPointer({%H-}call.Data)^
  else if TypeInfo^.Kind in [rkDynArray, rkInterface] then
    raise ERttiException.CreateUtf8(
      'TRttiProp.GetOrdProp(%) does not support a getter for %',
      [Instance.ClassType, ToText(TypeInfo^.Kind)^])
  else if rpc = rpcMethod then
    call.Code := TGetProc(call)
  else if rpc = rpcIndexed then
    call.Code := TGetIndexed(call)(Index)
  else
    call.Code := nil; // call.Code is used to store the raw value
  with TypeInfo^ do
    if (Kind = rkClass) or
       (Kind = rkDynArray) or
       (Kind = rkInterface) then
      result := PtrInt(call.Code)
    else
      result := RTTI_FROM_ORD[RttiOrd](@call.Code);
end;

procedure TRttiProp.SetOrdProp(Instance: TObject; Value: PtrInt);
type
  // on all targets, Value is a register for any RttiOrd size
  TSetProc = procedure(Value: PtrInt) of object;
  TSetIndexed = procedure(Index: integer; Value: PtrInt) of object;
var
  call: TMethod;
begin
  case Setter(Instance, @call) of
    rpcField:
      with TypeInfo^ do
        if (Kind = rkClass) or
           (Kind = rkDynArray) or
           (Kind = rkInterface) then
          PPtrInt({%H-}call.Data)^ := Value
        else
          RTTI_TO_ORD[RttiOrd](call.Data, Value);
    rpcMethod:
      TSetProc(call)(Value);
    rpcIndexed:
      TSetIndexed(call)(Index, Value);
  end;
end;

function TRttiProp.GetObjProp(Instance: TObject): TObject;
type
  TGetProc = function: TObject of object;
  TGetIndexed = function(Index: integer): TObject of object;
var
  call: TMethod;
begin
  case Getter(Instance, @call) of
    rpcField:
      result := PObject({%H-}call.Data)^;
    rpcMethod:
      result := TGetProc(call);
    rpcIndexed:
      result := TGetIndexed(call)(Index);
  else
    result := nil;
  end;
end;

function TRttiProp.GetDynArrayPropGetter(Instance: TObject): pointer;
type
  TGetProc = function: TBytes of object;
  TGetIndexed = function(Index: integer): TBytes of object;
var
  call: TMethod;
  tmp: TBytes; // we use TBytes but any dynamic array will do
begin
  case Getter(Instance, @call) of
    rpcMethod:
      tmp := TGetProc({%H-}call);
    rpcIndexed:
      tmp := TGetIndexed(call)(Index);
  end;
  result := pointer(tmp); // weak copy
  pointer(tmp) := nil;    // no dec(refcnt)
end;

function TRttiProp.GetInt64Prop(Instance: TObject): Int64;
type
  TGetProc = function: Int64 of object;
  TGetIndexed = function(Index: integer): Int64 of object;
var
  call: TMethod;
begin
  case Getter(Instance, @call) of
    rpcField:
      result := PInt64({%H-}call.Data)^;
    rpcMethod:
      result := TGetProc(call);
    rpcIndexed:
      result := TGetIndexed(call)(Index);
  else
    result := 0;
  end;
end;

procedure TRttiProp.SetInt64Prop(Instance: TObject; const Value: Int64);
type
  TSetProc = procedure(Value: Int64) of object;
  TSetIndexed = procedure(Index: integer; Value: Int64) of object;
var
  call: TMethod;
begin
  case Setter(Instance, @call) of
    rpcField:
      PInt64({%H-}call.Data)^ := Value;
    rpcMethod:
      TSetProc(call)(Value);
    rpcIndexed:
      TSetIndexed(call)(Index, Value);
  end;
end;

procedure TRttiProp.GetLongStrProp(Instance: TObject; var Value: RawByteString);
var
  rpc: TRttiPropCall;
  call: TMethod;

    procedure SubProc(rpc: TRttiPropCall); // avoid try..finally
    type
      TGetProc = function: RawByteString of object;
      TGetIndexed = function(Index: integer): RawByteString of object;
    begin
      case rpc of
        rpcMethod:
          Value := TGetProc(call);
        rpcIndexed:
          Value := TGetIndexed(call)(Index);
      else
        Value := '';
      end;
    end;

begin
  rpc := Getter(Instance, @call);
  if rpc = rpcField then
    Value := PRawByteString(call.Data)^
  else
    SubProc(rpc);
end;

procedure TRttiProp.SetLongStrProp(Instance: TObject; const Value: RawByteString);
type
  TSetProc = procedure(const Value: RawByteString) of object;
  TSetIndexed = procedure(Index: integer; const Value: RawByteString) of object;
var
  call: TMethod;
begin
  case Setter(Instance, @call) of
    rpcField:
      PRawByteString({%H-}call.Data)^ := Value;
    rpcMethod:
      TSetProc(call)(Value);
    rpcIndexed:
      TSetIndexed(call)(Index, Value);
  end;
end;

procedure TRttiProp.CopyLongStrProp(Source, Dest: TObject);
var
  tmp: RawByteString;
begin
  GetLongStrProp(Source, tmp);
  SetLongStrProp(Dest, tmp);
end;

procedure TRttiProp.GetShortStrProp(Instance: TObject; var Value: RawUtf8);
type
  TGetProc = function: ShortString of object;
  TGetIndexed = function(Index: integer): ShortString of object;
var
  call: TMethod;
  tmp: ShortString;
begin
  case Getter(Instance, @call) of
    rpcField:
      tmp := PShortString({%H-}call.Data)^;
    rpcMethod:
      tmp := TGetProc(call);
    rpcIndexed:
      tmp := TGetIndexed(call)(Index);
  else
    tmp := '';
  end;
  ShortStringToAnsi7String(tmp, Value);
end; // no SetShortStrProp() by now

procedure TRttiProp.GetWideStrProp(Instance: TObject; var Value: WideString);
type
  TGetProc = function: WideString of object;
  TGetIndexed = function(Index: integer): WideString of object;
var
  call: TMethod;
begin
  case Getter(Instance, @call) of
    rpcField:
      Value := PWideString({%H-}call.Data)^;
    rpcMethod:
      Value := TGetProc(call);
    rpcIndexed:
      Value := TGetIndexed(call)(Index);
  else
    Value := '';
  end;
end;

procedure TRttiProp.SetWideStrProp(Instance: TObject; const Value: WideString);
type
  TSetProc = procedure(const Value: WideString) of object;
  TSetIndexed = procedure(Index: integer; const Value: WideString) of object;
var
  call: TMethod;
begin
  case Setter(Instance, @call) of
    rpcField:
      PWideString({%H-}call.Data)^ := Value;
    rpcMethod:
      TSetProc(call)(Value);
    rpcIndexed:
      TSetIndexed(call)(Index, Value);
  end;
end;

{$ifdef HASVARUSTRING}

procedure TRttiProp.GetUnicodeStrProp(Instance: TObject; var Value: UnicodeString);
var
  rpc: TRttiPropCall;
  call: TMethod;

    procedure SubProc(rpc: TRttiPropCall); // avoid try..finally
    type
      TGetProc = function: UnicodeString of object;
      TGetIndexed = function(Index: integer): UnicodeString of object;
    begin
      case rpc of
        rpcMethod:
          Value := TGetProc(call);
        rpcIndexed:
          Value := TGetIndexed(call)(Index);
      else
        Value := '';
      end;
    end;

begin
  rpc := Getter(Instance, @call);
  if rpc = rpcField then
    Value := PUnicodeString(call.Data)^
  else
    SubProc(rpc);
end;

procedure TRttiProp.SetUnicodeStrProp(Instance: TObject; const Value: UnicodeString);
type
  TSetProc = procedure(const Value: UnicodeString) of object;
  TSetIndexed = procedure(Index: integer; const Value: UnicodeString) of object;
var
  call: TMethod;
begin
  case Setter(Instance, @call) of
    rpcField:
      PUnicodeString({%H-}call.Data)^ := Value;
    rpcMethod:
      TSetProc(call)(Value);
    rpcIndexed:
      TSetIndexed(call)(Index, Value);
  end;
end;

{$endif HASVARUSTRING}

procedure TRttiProp.GetCurrencyProp(Instance: TObject; var Value: currency);
type
  TGetProc = function: currency of object;
  TGetIndexed = function(Index: integer): currency of object;
var
  call: TMethod;
begin
  case Getter(Instance, @call) of
    rpcField:
      Value := PCurrency({%H-}call.Data)^;
    rpcMethod:
      Value := TGetProc(call);
    rpcIndexed:
      Value := TGetIndexed(call)(Index);
  else
    PInt64(@Value)^ := 0;
  end;
end;

procedure TRttiProp.SetCurrencyProp(Instance: TObject; const Value: currency);
type
  TSetProc = procedure(const Value: currency) of object;
  TSetIndexed = procedure(Index: integer; const Value: currency) of object;
var
  call: TMethod;
begin
  case Setter(Instance, @call) of
    rpcField:
      PCurrency({%H-}call.Data)^ := Value;
    rpcMethod:
      TSetProc(call)(Value);
    rpcIndexed:
      TSetIndexed(call)(Index, Value);
  end;
end;

function TRttiProp.GetDoubleProp(Instance: TObject): double;
type
  TGetProc = function: double of object;
  TGetIndexed = function(Index: integer): double of object;
var
  call: TMethod;
begin
  case Getter(Instance, @call) of
    rpcField:
      result := unaligned(PDouble({%H-}call.Data)^);
    rpcMethod:
      result := TGetProc(call);
    rpcIndexed:
      result := TGetIndexed(call)(Index);
  else
    result := 0;
  end;
end;

procedure TRttiProp.SetDoubleProp(Instance: TObject; Value: Double);
type
  TSetProc = procedure(const Value: double) of object;
  TSetIndexed = procedure(Index: integer; const Value: double) of object;
var
  call: TMethod;
begin
  case Setter(Instance, @call) of
    rpcField:
      unaligned(PDouble({%H-}call.Data)^) := Value;
    rpcMethod:
      TSetProc(call)(Value);
    rpcIndexed:
      TSetIndexed(call)(Index, Value);
  end;
end;

function TRttiProp.GetFloatProp(Instance: TObject): double;
type
  TSingleProc = function: Single of object;
  TSingleIndexed = function(Index: integer): Single of object;
  TDoubleProc = function: Double of object;
  TDoubleIndexed = function(Index: integer): Double of object;
  TExtendedProc = function: Extended of object;
  TExtendedIndexed = function(Index: integer): Extended of object;
  TCurrencyProc = function: currency of object;
  TCurrencyIndexed = function(Index: integer): currency of object;
var
  call: TMethod;
  rf: TRttiFloat;
begin
  result := 0;
  rf := TypeInfo^.RttiFloat;
  case Getter(Instance, @call) of
    rpcField:
      case rf of
        rfSingle:
          result := PSingle({%H-}call.Data)^;
        rfDouble:
          result := unaligned(PDouble(call.Data)^);
        rfExtended:
          result := PExtended(call.Data)^;
        rfCurr:
          CurrencyToDouble(PCurrency(call.Data), result);
      end;
    rpcMethod:
      case rf of
        rfSingle:
          result := TSingleProc(call);
        rfDouble:
          result := TDoubleProc(call);
        rfExtended:
          result := TExtendedProc(call);
        rfCurr:
          CurrencyToDouble(TCurrencyProc(call), result);
      end;
    rpcIndexed:
      case rf of
        rfSingle:
          result := TSingleIndexed(call)(Index);
        rfDouble:
          result := TDoubleIndexed(call)(Index);
        rfExtended:
          result := TExtendedIndexed(call)(Index);
        rfCurr:
          CurrencyToDouble(TCurrencyIndexed(call)(Index), result);
      end;
  end;
end;

procedure TRttiProp.SetFloatProp(Instance: TObject; Value: TSynExtended);
type
  TSingleProc = procedure(const Value: Single) of object;
  TSingleIndexed = procedure(Index: integer; const Value: Single) of object;
  TDoubleProc = procedure(const Value: double) of object;
  TDoubleIndexed = procedure(Index: integer; const Value: double) of object;
  TExtendedProc = procedure(const Value: Extended) of object;
  TExtendedIndexed = procedure(Index: integer; const Value: Extended) of object;
  TCurrencyProc = procedure(const Value: currency) of object;
  TCurrencyIndexed = procedure(Index: integer; const Value: currency) of object;
var
  call: TMethod;
  rf: TRttiFloat;
begin
  rf := TypeInfo^.RttiFloat;
  case Setter(Instance, @call) of
    rpcField:
      RTTI_TO_FLOAT[rf]({%H-}call.Data, Value);
    rpcMethod:
      case rf of
        rfSingle:
          TSingleProc(call)(Value);
        rfDouble:
          TDoubleProc(call)(Value);
        rfExtended:
          TExtendedProc(call)(Value);
        rfCurr:
          TCurrencyProc(call)(DoubleToCurrency(Value));
      end;
    rpcIndexed:
      case rf of
        rfSingle:
          TSingleIndexed(call)(Index, Value);
        rfDouble:
          TDoubleIndexed(call)(Index, Value);
        rfExtended:
          TExtendedIndexed(call)(Index, Value);
        rfCurr:
          TCurrencyIndexed(call)(Index, DoubleToCurrency(Value));
      end;
  end;
end;

procedure TRttiProp.GetVariantProp(Instance: TObject; var Result: Variant;
  SetByRef: boolean);
var
  rpc: TRttiPropCall;
  call: TMethod;

  procedure SubProc(rpc: TRttiPropCall); // avoid try..finally
  type
    TGetProc = function: variant of object;
    TGetIndexed = function(Index: integer): variant of object;
  begin
    case rpc of
      rpcMethod:
        Result := TGetProc(call);
      rpcIndexed:
        Result := TGetIndexed(call)(Index);
    else
      SetVariantNull(result);
    end;
  end;

begin
  rpc := Getter(Instance, @call);
  if rpc <> rpcField then
    SubProc(rpc)
  else if not SetVariantUnRefSimpleValue(PVariant(call.Data)^, PVarData(@Result)^) then
    if SetByRef then
    begin
      VarClearAndSetType(Result, varVariantByRef);
      TVarData(Result).VPointer := call.Data;
    end
    else
      result := PVariant(call.Data)^;
end;

procedure TRttiProp.SetVariantProp(Instance: TObject; const Value: Variant);
type
  TSetProc = procedure(const Value: variant) of object;
  TSetIndexed = procedure(Index: integer; const Value: variant) of object;
var
  call: TMethod;
  v: PVarData;
begin
  v := VarDataFromVariant(Value); // de-reference any varByRef
  case Setter(Instance, @call) of
    rpcField:
      PVariant({%H-}call.Data)^ := PVariant(v)^;
    rpcMethod:
      TSetProc(call)(PVariant(v)^);
    rpcIndexed:
      TSetIndexed(call)(Index, PVariant(v)^);
  end;
end;

function TRttiProp.GetOrdValue(Instance: TObject): Int64;
begin
  if (Instance <> nil) and
     (@self <> nil) and
     (TypeInfo^.Kind in [rkInteger,
                         rkEnumeration,
                         rkSet,
                         {$ifdef FPC}
                         rkBool,
                         {$endif FPC}
                         rkClass]) then
    result := GetOrdProp(Instance)
  else
    result := -1;
end;

function TRttiProp.GetInt64Value(Instance: TObject): Int64;
begin
  if (Instance <> nil) and
     (@self <> nil) then
    case TypeInfo^.Kind of
      rkInteger,
      rkEnumeration,
      {$ifdef FPC}
      rkBool,
      {$endif FPC}
      rkSet,
      rkChar,
      rkWChar,
      rkClass:
        result := GetOrdProp(Instance);
      {$ifdef FPC}
      rkQWord,
      {$endif FPC}
      rkInt64:
        result := GetInt64Prop(Instance);
    else
      result := 0;
    end
  else
    result := 0;
end;

procedure TRttiProp.GetCurrencyValue(Instance: TObject; var Value: currency);
begin
  if (Instance <> nil) and
     (@self <> nil) then
    with TypeInfo^ do
      if Kind = rkFloat then
        if RttiFloat = rfCurr then
          GetCurrencyProp(Instance, Value)
        else
          DoubleToCurrency(GetFloatProp(Instance), Value)
      else
        PInt64(@Value)^ := 0
  else
    PInt64(@Value)^ := 0;
end;

function TRttiProp.GetDoubleValue(Instance: TObject): double;
begin
  if (Instance <> nil) and
     (@self <> nil) and
     (TypeInfo^.Kind = rkFloat) then
    result := GetFloatProp(Instance)
  else
    result := 0;
end;

procedure TRttiProp.SetDoubleValue(Instance: TObject; const Value: double);
begin
  if (Instance <> nil) and
     (@self <> nil) and
     (TypeInfo^.Kind = rkFloat) then
    SetFloatProp(Instance, Value);
end;

procedure TRttiProp.GetRawByteStringValue(Instance: TObject; var Value: RawByteString);
begin
  if (Instance <> nil) and
     (@self <> nil) and
     (TypeInfo^.Kind in [{$ifdef FPC}rkLStringOld, {$endif} rkLString]) then
    GetLongStrProp(Instance, Value)
  else
    FastAssignNew(Value, nil);
end;

procedure TRttiProp.SetOrdValue(Instance: TObject; Value: PtrInt);
begin
  if (Instance <> nil) and
     (@self <> nil) and
     (TypeInfo^.Kind in [rkInteger, rkEnumeration, rkSet,
                         {$ifdef FPC} rkBool, {$endif} rkClass]) then
    SetOrdProp(Instance, Value);
end;

procedure TRttiProp.SetInt64Value(Instance: TObject; Value: Int64);
begin
  if (Instance <> nil) and
     (@self <> nil) then
    case TypeInfo^.Kind of
      rkInteger,
      rkEnumeration,
      {$ifdef FPC}
      rkBool,
      {$endif FPC}
      rkSet,
      rkChar,
      rkWChar,
      rkClass:
        SetOrdProp(Instance, Value);
      {$ifdef FPC}
      rkQWord,
      {$endif FPC}
      rkInt64:
        SetInt64Prop(Instance, Value);
    end;
end;

{$ifdef HASVARUSTRING}

function TRttiProp.GetUnicodeStrValue(Instance: TObject): UnicodeString;
begin
  if (Instance <> nil) and
     (@self <> nil) and
     (TypeInfo^.Kind = rkUString) then
    GetUnicodeStrProp(Instance, result{%H-})
  else
    result := '';
end;

procedure TRttiProp.SetUnicodeStrValue(Instance: TObject; const Value: UnicodeString);
begin
  if (Instance <> nil) and
     (@self <> nil) and
     (TypeInfo^.Kind = rkUString) then
    SetUnicodeStrProp(Instance, Value);
end;

{$endif HASVARUSTRING}

function TRttiProp.GetAsString(Instance: TObject): RawUtf8;
begin
  GetAsString(Instance, result);
end;

function TRttiProp.GetAsString(Instance: TObject; var Value: RawUtf8): boolean;
var
  v: PtrInt;
  WS: WideString;
  {$ifdef HASVARUSTRING}
  US: UnicodeString;
  {$endif HASVARUSTRING}
begin
  result := true;
  case TypeInfo^.Kind of
    rkChar,
    rkWChar:
      begin
        v := GetOrdProp(Instance);
        if TypeInfo^.Kind = rkChar then
          FastSetString(Value, @v, {ansicharcount=}1)
        else
          RawUnicodeToUtf8(@v, {widecharcount=}1, Value);
      end;
    rkSString:
      GetShortStrProp(Instance, Value);
    rkLString:
      GetLongStrProp(Instance, RawByteString(Value));
    rkWString:
      begin
        GetWideStrProp(Instance, WS);
        RawUnicodeToUtf8(pointer(WS), length(WS), Value);
      end;
    {$ifdef HASVARUSTRING}
    rkUString:
      begin
        GetUnicodeStrProp(Instance, US);
        RawUnicodeToUtf8(pointer(US), length(US), Value);
      end;
    {$endif HASVARUSTRING}
  else
    begin
      Value := '';
      result := false; // unsupported property
    end;
  end;
end;

function TRttiProp.SetAsString(Instance: TObject; const Value: RawUtf8): boolean;
var
  v: PtrInt;
  P: PUtf8Char;
  u: pointer; // to avoid a global hidden try..finally
begin
  result := true;
  case TypeInfo^.Kind of
    rkChar,
    rkWChar:
      begin
        if Value = '' then
          v := 0
        else if TypeInfo^.Kind = rkChar then
          v := ord(Value[1])
        else
        begin
          P := pointer(Value);
          v := NextUtf8Ucs4(P);
        end;
        SetOrdProp(Instance, v);
      end;
    rkLString:
      SetLongStrProp(Instance, Value);
    rkWString:
      begin
        u := nil;
        try
          Utf8ToWideString(pointer(Value), length(Value), WideString(u));
          SetWideStrProp(Instance, WideString(u));
        finally
          WideString(u) := '';
        end;
      end;
    {$ifdef HASVARUSTRING}
    rkUString:
      begin
        u := nil;
        try
          Utf8DecodeToUnicodeString(pointer(Value), length(Value), UnicodeString(u));
          SetUnicodeStrProp(Instance, UnicodeString(u));
        finally
          UnicodeString(u) := '';
        end;
      end;
    {$endif HASVARUSTRING}
  else
    result := false; // unsupported type
  end;
end;

function ToText(k: TRttiKind): PShortString;
begin
  result := GetEnumName(TypeInfo(TRttiKind), ord(k));
end;

function ToText(t: TRttiParserType): PShortString;
begin
  result := GetEnumName(TypeInfo(TRttiParserType), ord(t));
end;

function ToText(w: TWellKnownSid): PShortString;
begin
  result := GetEnumName(TypeInfo(TWellKnownSid), ord(w));
end;


{ **************** Published Class Properties and Methods RTTI }

function GetRttiClass(RttiClass: TClass): PRttiClass;
begin
  result := PRttiInfo(PPointer(PAnsiChar(RttiClass) + vmtTypeInfo)^)^.RttiClass;
end;

function ClassHasPublishedFields(ClassType: TClass): boolean;
var
  cp: PRttiProps;
begin
  result := true;
  while ClassType <> nil do
  begin
    cp := GetRttiProps(ClassType);
    if cp = nil then
      break; // no RTTI information (e.g. reached TObject level)
    if cp^.PropCount > 0 then
      exit;
    ClassType := GetClassParent(ClassType);
  end;
  result := false;
end;

function ClassHierarchyWithField(ClassType: TClass): TClassDynArray;

  procedure InternalAdd(C: TClass; var list: TClassDynArray);
  var
    P: PRttiProps;
  begin
    if C = nil then
      exit;
    InternalAdd(GetClassParent(C), list);
    P := GetRttiProps(C);
    if (P <> nil) and
       (P^.PropCount > 0) then
      PtrArrayAdd(list, pointer(C));
  end;

begin
  result := nil;
  InternalAdd(ClassType, result);
end;

function ClassFieldAllProps(ClassType: TClass; Types: TRttiKinds): PRttiPropDynArray;
var
  CP: PRttiProps;
  P: PRttiProp;
  i, n: integer;
begin
  n := 0;
  result := nil;
  while ClassType <> nil do
  begin
    CP := GetRttiProps(ClassType);
    if CP = nil then
      break; // no RTTI information (e.g. reached TObject level)
    if CP^.PropCount > 0 then
    begin
      SetLength(result, n + CP^.PropCount);
      P := CP^.PropList;
      for i := 1 to CP^.PropCount do
      begin
        if P^.TypeInfo^.Kind in Types then
        begin
          result[n] := P;
          inc(n);
        end;
        P := P^.Next
      end;
    end;
    ClassType := GetClassParent(ClassType);
  end;
  SetLength(result,n);
end;

function ClassFieldNamesAllProps(ClassType: TClass; IncludePropType: boolean;
  Types: TRttiKinds): TRawUtf8DynArray;
var
  props: PRttiPropDynArray;
  n, i: PtrInt;
begin
  result := nil;
  props := ClassFieldAllProps(ClassType, Types); // recursive in-order list
  n := length(props);
  SetLength(result, n);
  for i := 0 to n - 1 do
    with props[i]^ do
      if IncludePropType then
        FormatUtf8('%: %', [Name^, TypeInfo^.Name^], result[i])
      else
        ShortStringToAnsi7String(Name^, result[i]);
end;

function ClassFieldNamesAllPropsAsText(ClassType: TClass; IncludePropType: boolean;
  Types: TRttiKinds): RawUtf8;
begin
  result := RawUtf8ArrayToCsv(
    ClassFieldNamesAllProps(ClassType, IncludePropType, Types), ', ');
end;

function ClassFieldProp(ClassType: TClass; const PropName: ShortString): PRttiProp;
begin
  if ClassType <> nil then
    result := GetRttiProps(ClassType)^.FieldProp(PropName)
  else
    result := nil;
end;

function ClassFieldPropWithParents(aClassType: TClass; const aPropName: ShortString;
  aCaseSensitive: boolean): PRttiProp;
var
  n, i: integer;
begin
  while aClassType <> nil do
  begin
    n := GetRttiProp(aClassType, result);
    if n <> 0 then
      if aCaseSensitive then
        for i := 1 to n do
          if result^.Name^ = aPropName then
            exit
          else
            result := result^.Next
      else
        for i := 1 to n do
          if IdemPropName(result^.Name^, @aPropName[1], ord(aPropName[0])) then
            exit
          else
            result := result^.Next;
    aClassType := GetClassParent(aClassType);
  end;
  result := nil;
end;

function ClassFieldPropWithParentsFromUtf8(aClassType: TClass; PropName: PUtf8Char;
  PropNameLen: integer; aCaseSensitive: boolean): PRttiProp;
var
  n, i: integer;
begin
  if PropNameLen <> 0 then
    while aClassType <> nil do
    begin
      n := GetRttiProp(aClassType, result);
      if n <> 0 then
        if aCaseSensitive then
          for i := 1 to n do
            if (result^.Name^[0] = AnsiChar(PropNameLen)) and
               CompareMemFixed(@result^.Name^[1], PropName, PropNameLen) then
              exit
            else
              result := result^.Next
        else
          for i := 1 to n do
            if IdemPropName(result^.Name^, PropName, PropNameLen) then
              exit
            else
              result := result^.Next;
      aClassType := GetClassParent(aClassType);
    end;
  result := nil;
end;

function ClassFieldPropWithParentsFromClassType(aClassType,
  aSearchedClassType: TClass): PRttiProp;
var
  i: integer;
begin
  if aSearchedClassType <> nil then
    while aClassType <> nil do
    begin
      for i := 1 to GetRttiProp(aClassType, result) do
        with result^.TypeInfo^ do
          if (Kind = rkClass) and
             (RttiNonVoidClass^.RttiClass = aSearchedClassType) then
            exit
          else
            result := result^.Next;
      aClassType := GetClassParent(aClassType);
    end;
  result := nil;
end;

function ClassFieldPropWithParentsInheritsFromClassType(aClassType,
  aSearchedClassType: TClass): PRttiProp;
var
  i: integer;
begin
  if aSearchedClassType <> nil then
    while aClassType <> nil do
    begin
      for i := 1 to GetRttiProp(aClassType, result) do
        with result^.TypeInfo^ do
          if (Kind = rkClass) and
             InheritsFrom(aSearchedClassType) then
            exit
          else
            result := result^.Next;
      aClassType := GetClassParent(aClassType);
    end;
  result := nil;
end;

function ClassFieldPropWithParentsFromClassOffset(aClassType: TClass;
  aSearchedOffset: pointer): PRttiProp;
var
  i: integer;
begin
  if aSearchedOffset <> nil then
    while aClassType <> nil do
    begin
      for i := 1 to GetRttiProp(aClassType, result) do
        if result^.GetFieldAddr(nil) = aSearchedOffset then
          exit
        else
          result := result^.Next;
      aClassType := GetClassParent(aClassType);
    end;
  result := nil;
end;

function ClassFieldInstance(Instance: TObject; const PropName: ShortString;
  PropClassType: TClass; out PropInstance): boolean;
var
  P: PRttiProp;
begin
  result := false;
  if Instance = nil then
    exit;
  P := ClassFieldPropWithParents(PPointer(Instance)^, PropName);
  if P = nil then
    exit;
  with P^.TypeInfo^ do
    if (Kind <> rkClass) or
       not InheritsFrom(PropClassType) then
      exit;
  TObject(PropInstance) := P^.GetObjProp(Instance);
  result := true;
end;

function ClassFieldInstance(Instance: TObject; PropClassType: TClass;
  out PropInstance): boolean;
var
  P: PRttiProp;
begin
  result := false;
  if (Instance = nil) or
     (PropClassType = nil) then
    exit;
  P := ClassFieldPropWithParentsFromClassType(PPointer(Instance)^, PropClassType);
  if P = nil then
    exit;
  TObject(PropInstance) := P^.GetObjProp(Instance);
  result := true;
end;

function ClassFieldInt64(Instance: TObject; const PropName: ShortString;
  out PropValue: Int64): boolean;
var
  P: PRttiProp;
begin
  result := false;
  if Instance = nil then
    exit;
  P := ClassFieldPropWithParents(PPointer(Instance)^, PropName);
  if P = nil then
    exit;
  PropValue := P^.GetInt64Value(Instance);
  result := true;
end;

function ClassFieldInstances(Instance: TObject; PropClassType: TClass): TObjectDynArray;
var
  nested: PRttiPropDynArray;
  i: PtrInt;
begin
  result := nil;
  if (Instance = nil) or
     (PropClassType = nil) then
    exit;
  nested := ClassFieldAllProps(PPointer(Instance)^, [rkClass]);
  for i := 0 to high(nested) do
    with nested[i]^ do
      if TypeInfo^.InheritsFrom(PropClassType) then
        ObjArrayAdd(result, GetObjProp(Instance));
end;

function ClassFieldPropInstanceMatchingClass(
  aSearchedInstance: TObject; aSearchedClassType: TClass): TObject;
var
  P: PRttiProp;
begin
  result := aSearchedInstance;
  if (aSearchedInstance = nil) or
     aSearchedInstance.InheritsFrom(aSearchedClassType) then
    exit;
  P := ClassFieldPropWithParentsFromClassType(
    PPointer(aSearchedInstance)^, aSearchedClassType);
  if P <> nil then
  begin
    result := P^.GetObjProp(aSearchedInstance);
    if result = nil then
      result := aSearchedInstance;
  end;
end;

function ClassFieldCountWithParents(ClassType: TClass; onlyWithoutGetter: boolean): integer;
var
  cp: PRttiProps;
  p: PRttiProp;
  i: integer;
begin
  result := 0;
  while ClassType <> nil do
  begin
    cp := GetRttiProps(ClassType);
    if cp = nil then
      break; // no RTTI information (e.g. reached TObject level)
    p := cp^.PropList;
    for i := 1 to cp^.PropCount do
    begin
      if (not onlyWithoutGetter) or
         p^.GetterIsField then
        inc(result);
      p := p^.Next;
    end;
    ClassType := GetClassParent(ClassType);
  end;
end;


{ *************** Enumerations RTTI }

function GetEnumType(aTypeInfo: PRttiInfo; out List: PShortString): integer;
begin
  with aTypeInfo^.EnumBaseType^ do
  begin
    List := NameList;
    result := MaxValue;
  end;
end;

function GetEnumNameTrimed(aTypeInfo: PRttiInfo; aIndex: integer): RawUtf8;
begin
  result := TrimLeftLowerCaseShort(GetEnumName(aTypeInfo, aIndex));
end;

function GetEnumNameUnCamelCase(aTypeInfo: PRttiInfo; aIndex: integer): RawUtf8;
begin
  result := UnCamelCase(GetEnumNameTrimed(aTypeInfo, aIndex));
end;

procedure GetEnumNames(aTypeInfo: PRttiInfo; aDest: PPShortString);
var
  info: PRttiEnumType;
  p: PShortString;
  i: PtrInt;
begin
  info := aTypeInfo^.EnumBaseType;
  if info <> nil then
  begin
    p := info^.NameList;
    for i := info^.MinValue to info^.MaxValue do
    begin
      aDest^ := p;
      p := @PByteArray(p)^[ord(p^[0]) + 1];
      inc(aDest);
    end;
  end;
end;

procedure GetEnumTrimmedNames(aTypeInfo: PRttiInfo; aDest: PRawUtf8);
var
  info: PRttiEnumType;
  p: PShortString;
  i: PtrInt;
begin
  info := aTypeInfo^.EnumBaseType;
  if info <> nil then
  begin
    p := info^.NameList;
    for i := info^.MinValue to info^.MaxValue do
    begin
      aDest^ := TrimLeftLowerCaseShort(p);
      p := @PByteArray(p)^[ord(p^[0]) + 1];
      inc(aDest);
    end;
  end;
end;

function GetEnumTrimmedNames(aTypeInfo: PRttiInfo): TRawUtf8DynArray;
begin
  aTypeInfo^.EnumBaseType^.GetEnumNameAll(result{%H-}, {trim=}true);
end;

function GetEnumNameValue(aTypeInfo: PRttiInfo; aValue: PUtf8Char;
  aValueLen: PtrInt; AlsoTrimLowerCase: boolean): integer;
begin
  result := aTypeInfo^.EnumBaseType^.
    GetEnumNameValue(aValue, aValueLen, AlsoTrimLowerCase);
end;

function GetEnumNameValueTrimmed(aTypeInfo: PRttiInfo; aValue: PUtf8Char;
  aValueLen: PtrInt): integer;
begin
  result := aTypeInfo^.EnumBaseType^.
    GetEnumNameValueTrimmed(aValue, aValueLen, {casesensitive=}false);
end;

function GetEnumNameValueTrimmedExact(aTypeInfo: PRttiInfo; aValue: PUtf8Char;
  aValueLen: PtrInt): integer;
begin
  result := aTypeInfo^.EnumBaseType^.
    GetEnumNameValueTrimmed(aValue, aValueLen, {casesensitive=}true);
end;

function GetEnumNameValue(aTypeInfo: PRttiInfo; const aValue: RawUtf8;
  AlsoTrimLowerCase: boolean): integer;
begin
  result := aTypeInfo^.EnumBaseType^.
    GetEnumNameValue(pointer(aValue), length(aValue), AlsoTrimLowerCase);
end;

procedure SetEnumFromOrdinal(aTypeInfo: PRttiInfo; out Value; Ordinal: PtrUInt);
begin
  aTypeInfo^.EnumBaseType^.SetEnumFromOrdinal(Value, Ordinal);
end;

function GetSetName(aTypeInfo: PRttiInfo; const value): RawUtf8;
begin
  result := aTypeInfo^.SetEnumType^.EnumBaseType.GetSetName(value);
end;

procedure GetSetNameShort(aTypeInfo: PRttiInfo; const value;
  out result: ShortString; trimlowercase: boolean);
var
  info: PRttiEnumType;
  PS: PShortString;
  i: PtrInt;
begin
  result := '';
  info := aTypeInfo^.SetEnumType;
  if (info = nil) or
     (@value = nil) then
    exit;
  PS := info^.EnumBaseType.NameList;
  for i := info^.MinValue to info^.MaxValue do
  begin
    if GetBitPtr(@value, i) then
      AppendShortComma(@PS^[1], PByte(PS)^, result, trimlowercase);
    inc(PByte(PS), PByte(PS)^ + 1); // next
  end;
  if result[0] <> #0 then
    dec(result[0]);
end;

procedure SetNamesValue(SetNames: PShortString; MinValue, MaxValue: integer;
  Value: PUtf8Char; ValueLen: PtrInt; var Result: QWord);
var
  i: integer;
begin
  if (Value = nil) or
     (ValueLen = 0) then
    exit;
  if Value^ = '*' then
  begin
    if MaxValue < 32 then
      Result := ALLBITS_CARDINAL[MaxValue + 1]
    else
      Result := QWord(-1);
    exit;
  end;
  if MaxValue > 63 then
    MaxValue := 63; // no need to search more than the Result number of bits
  if Value^ in ['a'..'z'] then
    i := FindShortStringListExact(SetNames, MaxValue, Value, ValueLen)
  else
    i := -1;
  if i < 0 then
    i := FindShortStringListTrimLowerCase(SetNames, MaxValue, Value, ValueLen);
  if i >= MinValue then
    SetBitPtr(@Result, i);
  // unknown enum names (i=-1) would just be ignored
end;

function GetSetCsvValue(aTypeInfo: PRttiInfo; Csv: PUtf8Char;
  Sep: AnsiChar): QWord;
var
  v: shortstring;
  names: PShortString;
  min, max: integer;
begin
  result := 0;
  if (aTypeInfo <> nil) and
     (aTypeInfo^.Kind = rkSet) and
     (aTypeInfo^.SetEnumType(names, min, max) <> nil) then
    while Csv <> nil do
    begin
      GetNextItemShortString(Csv, @v, Sep);
      SetNamesValue(names, min, max, @v[1], ord(v[0]), result);
    end;
end;

procedure GetCaptionFromTrimmed(PS: PShortString; var result: string);
var
  tmp: array[byte] of AnsiChar;
  L: integer;
begin
  L := ord(PS^[0]);
  inc(PByte(PS));
  while (L > 0) and
        (PS^[0] in ['a'..'z']) do
  begin
    inc(PByte(PS));
    dec(L);
  end;
  tmp[L] := #0; // as expected by GetCaptionFromPCharLen/UnCamelCase
  if L > 0 then
    MoveFast(PS^, tmp, L);
  GetCaptionFromPCharLen(tmp, result);
end;

procedure GetEnumCaptions(aTypeInfo: PRttiInfo; aDest: PString);
var
  MinValue, MaxValue, i: integer;
  res: PShortString;
begin
  aTypeInfo^.EnumBaseType(res, MinValue, MaxValue);
  if res <> nil then
    for i := MinValue to MaxValue do
    begin
      GetCaptionFromTrimmed(res, aDest^);
      inc(PByte(res), PByte(res)^ + 1); // next
      inc(aDest);
    end;
end;

function GetCaptionFromEnum(aTypeInfo: PRttiInfo; aIndex: integer): string;
begin
  GetCaptionFromTrimmed(GetEnumName(aTypeInfo, aIndex), result{%H-});
end;

function GetDisplayNameFromClass(C: TClass): RawUtf8;
var
  name: PShortString;
  totrim: integer;
begin
  if C = nil then
  begin
    result := '';
    exit;
  end;
  name := ClassNameShort(C);
  totrim := 0;
  if name^[0] > #4 then
    // fast case-insensitive compare
    case PInteger(@name^[1])^ and $DFDFDFDF of
      {$ifndef PUREMORMOT2}
      // backward compatibility trim of left-sided TSql* or TSqlRecord*
      ord('T') + ord('S') shl 8 + ord('Q') shl 16 + ord('L') shl 24:
        if (name^[0] <= #10) or
           (PInteger(@name^[5])^ and $DFDFDFDF <>
            ord('R') + ord('E') shl 8 + ord('C') shl 16 + ord('O') shl 24) or
           (PWord(@name^[9])^ and $DFDF <> ord('R') + ord('D')shl 8) then
          totrim := 4
        else
          totrim := 10;
      {$endif PUREMORMOT2}
      // trim left-sided TOrm* and TSyn* naming conventions
      ord('T') + ord('O') shl 8 + ord('R') shl 16 + ord('M') shl 24,
      ord('T') + ord('S') shl 8 + ord('Y') shl 16 + ord('N') shl 24:
        totrim := 4;
    end;
  if (totrim = 0) and
     (name^[1] = 'T') then
    // trim left-sided T* from regular Delphi/FPC type
    totrim := 1;
  FastSetString(result, @name^[totrim + 1], ord(name^[0]) - totrim);
end;

function GetCaptionFromClass(C: TClass): string;
var
  tmp: RawUtf8;
  P: PUtf8Char;
begin
  if C = nil then
    result := ''
  else
  begin
    tmp := ToText(C);
    P := pointer(tmp);
    if IdemPChar(P, 'TSQL') or
       IdemPChar(P, 'TORM') or
       IdemPChar(P, 'TSYN') then
      inc(P, 4)
    else if P^ = 'T' then
       inc(P);
    GetCaptionFromPCharLen(P, result);
  end;
end;

function ToText(cmd: TParseCommands): ShortString;
begin
  if cmd = [] then
    result[0] := #0
  else
    GetSetNameShort(TypeInfo(TParseCommands), cmd, result, {trim=}true);
end;


{ ***************** IInvokable Interface RTTI }

procedure TGetRttiInterface.AddMethod(const aMethodName: ShortString;
  aParamCount: integer; aKind: TMethodKind);
var
  i: PtrInt;
begin
  CurrentMethod := @Definition.Methods[MethodCount];
  ShortStringToAnsi7String(aMethodName, CurrentMethod^.Name);
  for i := 0 to MethodCount - 1 do
    if PropNameEquals(Definition.Methods[i].Name, CurrentMethod^.Name) then
      RaiseError('duplicated method name', []);
  CurrentMethod^.HierarchyLevel := Level;
  if aKind = mkFunction then
    inc(aParamCount);
  SetLength(CurrentMethod^.Args, aParamCount);
  CurrentMethod^.IsFunction := aKind = mkFunction;
  inc(MethodCount);
  ArgCount := 0;
end;

procedure TGetRttiInterface.AddArgument(aParamName, aTypeName: PShortString;
  aInfo: PRttiInfo; aFlags: TParamFlags);
var
  a: PRttiMethodArg;
begin
  a := @CurrentMethod^.Args[ArgCount];
  inc(ArgCount);
  if {$ifdef FPC} pfSelf in aFlags {$else} ArgCount = 1 {$endif} then
    a^.ParamName := @PSEUDO_SELF_NAME
  else if aParamName = nil then
  begin
    a^.ParamName := @PSEUDO_RESULT_NAME;
    include(aFlags, pfOut); // result is an "out"
  end
  else
    a^.ParamName := aParamName;
  a^.TypeInfo := aInfo;
  if aTypeName = nil then
    aTypeName := aInfo^.Name;
  a^.TypeName := aTypeName;
  if ArgCount > 1 then
    if aInfo^.Kind in rkRecordOrDynArrayTypes then
    begin
      if aFlags * [pfConst, pfVar, pfOut] = [] then
        RaiseError('%: % parameter should be declared as const, var or out',
          [a^.ParamName^, aTypeName^]);
    end
    else if aInfo^.Kind = rkInterface then
      if Rtti.FindType(aInfo).HasClassNewInstance then
      begin // e.g. IDocList/IDocDict with custom JSON serialization
        if aFlags * [pfConst, pfVar, pfOut] = [] then
          RaiseError('%: % parameter should be declared as const, var or out',
            [a^.ParamName^, aTypeName^])
      end
      else if not (pfConst in aFlags) then
        RaiseError('%: % parameter should be declared as const',
          [a^.ParamName^, aTypeName^]);
  if aParamName = nil then
    a^.Direction := rmdResult
  else if pfVar in aFlags then
    a^.Direction := rmdVar
  else if pfOut in aFlags then
    a^.Direction := rmdOut;
end;

procedure TGetRttiInterface.RaiseError(const Format: RawUtf8;
  const Args: array of const);
var
  m: RawUtf8;
begin
  if CurrentMethod <> nil then
    m := '.' + CurrentMethod^.Name;
  raise ERttiException.CreateUtf8('GetRttiInterface(%%) failed - %',
    [Definition.Name, {%H-}m, FormatUtf8(Format, Args)]);
end;

function GetRttiInterface(aTypeInfo: PRttiInfo;
  out aDefinition: TRttiInterface): integer;
var
  getter: TGetRttiInterface;
begin
  getter := TGetRttiInterface.Create;
  try
    getter.AddMethodsFromTypeInfo(pointer(aTypeInfo));
    aDefinition := getter.Definition;
  finally
    getter.Free;
  end;
  result := length(aDefinition.Methods);
end;

function GetInterfaceFromEntry(Instance: TObject; Entry: PInterfaceEntry;
  out Obj): boolean;
begin
  result := false;
  pointer(Obj) := nil;
  if Entry <> nil then
    if InterfaceEntryIsStandard(Entry) then
    begin
      // fast interface retrieval from the interface field instance
      pointer(Obj) := pointer(PAnsiChar(Instance) + Entry^.IOffset);
      if pointer(Obj) = nil then
         exit;
      IInterface(Obj)._AddRef;
      result := true;
    end
    else
      // there is a getter method -> use slower but safe RTL method
      result := Instance.GetInterface(Entry^.IID{$ifdef FPC}^{$endif}, Obj);
end;

function GetRttiClassGuid(aClass: TClass): PGuidDynArray;
var
  T: PInterfaceTable;
  n, i: PtrInt;
begin
  result := nil;
  n := 0;
  while aClass <> nil do
  begin
    T := aClass.GetInterfaceTable;
    if (T <> nil) and
       (T^.EntryCount > 0) then
    begin
      SetLength(result, length(result) + PtrInt(T^.EntryCount));
      for i := 0 to T^.EntryCount - 1 do
      begin
        result[n] := {$ifdef ISDELPHI}@{$endif}T^.Entries[i].IID;
        inc(n);
      end;
    end;
    aClass := GetClassParent(aClass);
  end;
end;


{ ************* Efficient Dynamic Arrays and Records Process }

// defined here for proper inlining in code below
function TRttiCustomList.RegisterType(Info: PRttiInfo): TRttiCustom;
begin
  if Info <> nil then
  begin
    result := FindType(Info);
    if result = nil then
      result := DoRegister(Info);
  end
  else
    result := nil;
end;

procedure VariantDynArrayClear(var Value: TVariantDynArray);
begin
  FastDynArrayClear(@Value, TypeInfo(variant));
end;

procedure RawUtf8DynArrayClear(var Value: TRawUtf8DynArray);
begin
  FastDynArrayClear(@Value, TypeInfo(RawUtf8));
end;

function IsRawUtf8DynArray(Info: PRttiInfo): boolean;
var
  r: TRttiCustom;
begin
  r := Rtti.RegisterType(Info);
  if r <> nil then
    r := r.ArrayRtti;
  result := (r <> nil) and
            (r.Parser = ptRawUtf8) and
            (r.Cache.CodePage = CP_UTF8); // properly detected on Delphi 7/2007
end;

procedure RecordClearSeveral(v: PAnsiChar; info: PRttiInfo; n: integer);
var
  fields: TRttiRecordManagedFields;
  f: PRttiRecordField;
  p: PRttiInfo;
  i: PtrInt;
  fin: PRttiFinalizers;
begin
  info.RecordManagedFields(fields); // retrieve RTTI once for n items
  if fields.Count = 0 then
    exit;
  fin := @RTTI_FINALIZE;
  repeat
    f := fields.Fields;
    i := fields.Count;
    repeat
      p := f^.{$ifdef HASDIRECTTYPEINFO}TypeInfo{$else}TypeInfoRef^{$endif};
      {$ifdef FPC_OLDRTTI}
      if Assigned(fin[p^.Kind]) then
      {$endif FPC_OLDRTTI}
        fin[p^.Kind](v + f^.Offset, p);
      inc(f);
      dec(i);
    until i = 0;
    inc(v, fields.Size);
    dec(n);
  until n = 0;
end;

procedure StringClearSeveral(v: PPointer; n: PtrInt);
var
  p: PStrRec;
begin
  repeat
    p := v^;
    if p <> nil then
    begin
      v^ := nil;
      dec(p);
      if (p^.refCnt >= 0) and
         StrCntDecFree(p^.refCnt) then
        Freemem(p); // works for both rkLString + rkUString
    end;
    inc(v);
    dec(n);
  until n = 0;
end;

procedure FastFinalizeArray(Value: PPointer; ElemTypeInfo: PRttiInfo;
  Count: integer);
var
  fin: TRttiFinalizer;
begin
  // caller ensured ElemTypeInfo<>nil and Count>0
  case ElemTypeInfo^.Kind of
    {$ifdef FPC}rkObject,{$else}{$ifdef UNICODE}rkMRecord,{$endif}{$endif}
    rkRecord:
      // retrieve ElemTypeInfo.RecordManagedFields once
      RecordClearSeveral(pointer(Value), ElemTypeInfo, Count);
    {$ifdef FPC}
    rkLStringOld,
    {$endif FPC}
    {$ifdef HASVARUSTRING}
    rkUString,
    {$endif HASVARUSTRING}
    rkLString:
      // optimized loop for AnsiString / UnicodeString (PStrRec header)
      StringClearSeveral(pointer(Value), Count);
    rkVariant:
      // from mormot.core.variants - supporting custom variants
      // or at least from mormot.core.base calling inlined VarClear()
      VariantClearSeveral(pointer(Value), Count);
    else
      begin
        // regular finalization
        fin := RTTI_FINALIZE[ElemTypeInfo^.Kind];
        if Assigned(fin) then  // e.g. rkWString, rkArray, rkDynArray
          repeat
            inc(PByte(Value), fin(PByte(Value), ElemTypeInfo));
            dec(Count);
          until Count = 0;
      end;
  end;
end;

procedure FastDynArrayClear(Value: PPointer; ElemInfo: PRttiInfo);
var
  p: PDynArrayRec;
begin
  if Value = nil then
    exit;
  p := Value^;
  if p = nil then
    exit;
  dec(p);
  if (p^.refCnt >= 0) and
     DACntDecFree(p^.refCnt) then
  begin
    if ElemInfo <> nil then
      FastFinalizeArray(Value^, ElemInfo, p^.length);
    Freemem(p);
  end;
  Value^ := nil;
end;

function FastRecordClear(Value: pointer; Info: PRttiInfo): PtrInt;
var
  fields: TRttiRecordManagedFields;
  f: PRttiRecordField;
  p: PRttiInfo;
  n: PtrInt;
  fin: PRttiFinalizers;
begin
  // caller ensured Info is indeed a record/object
  Info.RecordManagedFields(fields);
  n := fields.Count;
  if n > 0 then
  begin
    fin := @RTTI_FINALIZE;
    f := fields.Fields;
    repeat
      p := f^.{$ifdef HASDIRECTTYPEINFO}TypeInfo{$else}TypeInfoRef^{$endif};
      {$ifdef FPC_OLDRTTI}
      if Assigned(fin[p^.Kind]) then
      {$endif FPC_OLDRTTI}
        fin[p^.Kind](PAnsiChar(Value) + f^.Offset, p);
      inc(f);
      dec(n);
    until n = 0;
  end;
  result := fields.Size;
end;

procedure RecordZero(Dest: pointer; Info: PRttiInfo);
begin
  if Info^.Kind in rkRecordTypes then
    FillCharFast(Dest^, FastRecordClear(Dest, Info), 0);
end;

procedure RecordCopy(var Dest; const Source; Info: PRttiInfo);
begin
  if Info^.Kind in rkRecordTypes then
    RTTI_MANAGEDCOPY[rkRecord](@Dest, @Source, Info);
end;

procedure _RecordCopySeveral(Dest, Source: PAnsiChar; n: PtrInt; Info: PRttiInfo);
var
  fields: TRttiRecordManagedFields;
  f: PRttiRecordField;
  p: PRttiInfo;
  i, offset: PtrUInt;
begin
  Info^.RecordManagedFields(fields); // retrieve RTTI once for all items
  repeat
    i := fields.Count;
    offset := 0;
    if i > 0 then
    begin
      f := fields.Fields;
      repeat
        p := f^.{$ifdef HASDIRECTTYPEINFO}TypeInfo{$else}TypeInfoRef^{$endif};
        {$ifdef FPC_OLDRTTI}
        if p^.Kind in rkManagedTypes then
        {$endif FPC_OLDRTTI}
        begin
          offset := f^.Offset - offset;
          if offset <> 0 then
          begin
            MoveFast(Source^, Dest^, offset);
            inc(Source, offset);
            inc(Dest, offset);
          end;
          offset := RTTI_MANAGEDCOPY[p^.Kind](Dest, Source, p);
          inc(Source, offset);
          inc(Dest, offset);
          inc(offset, f^.Offset);
        end;
        inc(f);
        dec(i);
      until i = 0;
    end;
    offset := PtrUInt(fields.Size) - offset;
    if offset <> 0 then
    begin
      MoveFast(Source^, Dest^, offset);
      inc(Source, offset);
      inc(Dest, offset);
    end;
    dec(n);
  until n = 0;
end;

procedure CopySeveral(Dest, Source: PByte; SourceCount: PtrInt;
  ItemInfo: PRttiInfo; ItemSize: PtrInt);
var
  cop: TRttiCopier;
  elemsize: PtrInt;
label
  raw;
begin
  if SourceCount > 0 then
    if ItemInfo = nil then // unmanaged items
raw:  MoveFast(Source^, Dest^, ItemSize * SourceCount)
    else if ItemInfo^.Kind in rkRecordTypes then
      // retrieve record/object RTTI once for all items
      _RecordCopySeveral(pointer(Dest), pointer(Source), SourceCount, ItemInfo)
    else
    begin
      // loop the TRttiCopier function over all items
      cop := RTTI_MANAGEDCOPY[ItemInfo^.Kind];
      if Assigned(cop) then
        repeat
          elemsize := cop(Dest, Source, ItemInfo);
          inc(Source, elemsize);
          inc(Dest, elemsize);
          dec(SourceCount);
        until SourceCount = 0
      else
        goto raw;
    end;
end;

function DynArrayNew(Dest: PPointer; Count, ItemSize: PtrInt): pointer;
begin
  result := AllocMem(Count * ItemSize +  SizeOf(TDynArrayRec));
  PDynArrayRec(result)^.refCnt := 1;
  PDynArrayRec(result)^.length := Count;
  inc(PDynArrayRec(result));
  Dest^ := result;
end;

function DynArrayGrow(Dest: PPointer; Count, ItemSize: PtrInt): PAnsiChar;
var
  old: PtrInt;
begin
  result := Dest^;
  dec(PDynArrayRec(result));
  ReallocMem(result, (Count * ItemSize) + SizeOf(TDynArrayRec));
  old := PDynArrayRec(result)^.length;
  PDynArrayRec(result)^.length := Count;
  inc(PDynArrayRec(result));
  FillCharFast(result[old * ItemSize], (Count - old) * ItemSize, 0);
  Dest^ := result;
end;

procedure DynArrayCopy(Dest, Source: PPointer; Info: PRttiInfo;
  SourceExtCount: PInteger);
var
  n, itemsize: PtrInt;
  iteminfo: PRttiInfo;
begin
  iteminfo := Info^.DynArrayItemType(itemsize); // nil for unmanaged items
  if Dest^ <> nil then
    FastDynArrayClear(Dest, iteminfo);
  Source := Source^;
  if Source <> nil then
  begin
    if SourceExtCount <> nil then
      n := SourceExtCount^
    else
      n := PDALen(PAnsiChar(Source) - _DALEN)^ + _DAOFF;
    DynArrayNew(Dest, n, itemsize); // allocate zeroed memory
    CopySeveral(Dest^, pointer(Source), n, iteminfo, itemsize);
  end;
end;

procedure DynArrayEnsureUnique(Value: PPointer; Info: PRttiInfo);
var
  p: PDynArrayRec;
  n, elemsize: PtrInt;
begin
  p := Value^;
  Value^ := nil;
  dec(p);
  if (p^.refCnt >= 0) and
     ((p^.refCnt <= 1) or
      DACntDecFree(p^.refCnt)) then
    exit;
  n := p^.length;
  Info := Info^.DynArrayItemType(elemsize);
  DynArrayNew(Value, n, elemsize); // allocate zeroed memory
  inc(p);
  CopySeveral(Value^, pointer(p), n, Info, elemsize);
end;

procedure EnsureUnique(var Value: TIntegerDynArray);
begin
  if (Value <> nil) and
     (PDACnt(PAnsiChar(Value) - _DACNT)^ > 1) then
    DynArrayEnsureUnique(@Value, TypeInfo(TIntegerDynArray));
end;

procedure EnsureUnique(var Value: TRawUtf8DynArray); overload;
begin
  if (Value <> nil) and
     (PDACnt(PAnsiChar(Value) - _DACNT)^ > 1) then
    DynArrayEnsureUnique(@Value, TypeInfo(TRawUtf8DynArray));
end;

procedure EnsureUnique(var Value: TVariantDynArray); overload;
begin
  if (Value <> nil) and
     (PDACnt(PAnsiChar(Value) - _DACNT)^ > 1) then
    DynArrayEnsureUnique(@Value, TypeInfo(TVariantDynArray));
end;


{ ************* Managed Types Finalization, Random or Copy }

{ RTTI_FINALIZE[] implementation functions }

function _StringClear(V: PPointer; Info: PRttiInfo): PtrInt;
var
  p: PStrRec;
begin
  p := V^;
  if p <> nil then // works for both rkLString + rkUString
  begin
    V^ := nil;
    dec(p);
    if (p^.refCnt >= 0) and
       StrCntDecFree(p^.refCnt) then
      Freemem(p);
  end;
  result := SizeOf(V^);
end;

function _WStringClear(V: PWideString; Info: PRttiInfo): PtrInt;
begin
  if V^ <> '' then
    {$ifdef FPC}
    Finalize(V^);
    {$else}
    V^ := '';
    {$endif FPC}
  result := SizeOf(V^);
end;

function _VariantClear(V: PVarData; Info: PRttiInfo): PtrInt;
begin
  VarClear(Variant(V^));
  result := SizeOf(V^);
end;

function _InterfaceClear(V: PInterface; Info: PRttiInfo): PtrInt;
begin
  if V^ <> nil then
    {$ifdef FPC}
    Finalize(V^);
    {$else}
    V^ := nil;
    {$endif FPC}
  result := SizeOf(V^);
end;

function _DynArrayClear(V: PPointer; Info: PRttiInfo): PtrInt;
var
  p: PDynArrayRec;
begin
  p := V^;
  if p <> nil then
  begin
    dec(p);
    if (p^.refCnt >= 0) and
       DACntDecFree(p^.refCnt) then
    begin
      Info := Info^.DynArrayItemType;
      if Info <> nil then
        FastFinalizeArray(V^, Info, p^.length);
      Freemem(p);
    end;
    V^ := nil;
  end;
  result := SizeOf(V^);
end;

function _ArrayClear(V: PByte; Info: PRttiInfo): PtrInt;
var
  n: PtrInt;
  fin: TRttiFinalizer;
begin
  Info := Info^.ArrayItemType(n, result);
  if Info = nil then
    FillCharFast(V^, result, 0)
  else
  begin
    fin := RTTI_FINALIZE[Info^.Kind];
    if Assigned(fin) then
      repeat
        inc(V, fin(V, Info));
        dec(n);
      until n = 0;
  end;
end;

function _ObjClear(V: PObject; Info: PRttiInfo): PtrInt;
begin
  if V^ <> nil then
  begin
    V^.Destroy;
    V^ := nil;
  end;
  result := SizeOf(V^);
end;

function _ObjArrayClear(V: PPointer; Info: PRttiInfo): PtrInt;
begin
  if V^ <> nil then
  begin
    RawObjectsClear(V^, PDALen(PAnsiChar(V^) - _DALEN)^ + _DAOFF);
    _DynArrayClear(V, Info);
  end;
  result := SizeOf(V^);
end;


{ PT_RANDOM[] implementation functions }

procedure _NoRandom(V: PPointer; RC: TRttiCustom);
begin
end;

// we use SharedRandom since TLightLock may be faster than a threadvar

procedure _FillRandom(V: PByte; RC: TRttiCustom);
begin
  SharedRandom.Fill(V, RC.Cache.Size);
end;

procedure _StringRandom(V: PPointer; RC: TRttiCustom);
var
  tmp: TShort31;
begin
  SharedRandom.FillShort31(tmp);
  FastSetStringCP(V^, @tmp[1], ord(tmp[0]), RC.Cache.CodePage);
end;

procedure _WStringRandom(V: PWideString; RC: TRttiCustom);
var
  tmp: TShort31;
  i: PtrInt;
  W: PWordArray;
begin
  SharedRandom.FillShort31(tmp);
  SetString(V^, PWideChar(nil), ord(tmp[0]));
  W := pointer(V^);
  for i := 1 to ord(tmp[0]) do
    W[i - 1] := cardinal(PByteArray(@tmp)[i]);
end;

{$ifdef HASVARUSTRING}
procedure _UStringRandom(V: PUnicodeString; RC: TRttiCustom);
var
  tmp: TShort31;
  i: PtrInt;
  W: PWordArray;
begin
  SharedRandom.FillShort31(tmp);
  SetString(V^, PWideChar(nil), ord(tmp[0]));
  W := pointer(V^);
  for i := 1 to ord(tmp[0]) do
    W[i - 1] := cardinal(PByteArray(@tmp)[i]);
end;
{$endif HASVARUSTRING}

procedure _VariantRandom(V: PRttiVarData; RC: TRttiCustom);
begin
  VarClearAndSetType(Variant(V^), varEmpty);
  V^.Data.VInt64 := SharedRandom.Next;
  // generate some 8-bit 32-bit 64-bit integers or a RawUtf8 varString
  case V^.Data.VInteger and 3 of
    0:
      V^.VType := varInteger;
    1:
      V^.VType := varInt64;
    2:
      V^.VType := varByte;
    3:
      begin
        V^.VType := varString;
        V^.Data.VAny := nil;
        _StringRandom(@V^.Data.VAny, RC);
      end;
  end;
end;

procedure _DoubleRandom(V: PDouble; RC: TRttiCustom);
begin
  V^ := SharedRandom.NextDouble;
end;

procedure _DateTimeRandom(V: PDouble; RC: TRttiCustom);
begin
  V^ := 38000 + Int64(SharedRandom.Next) / (maxInt shr 12);
end;

procedure _SingleRandom(V: PSingle; RC: TRttiCustom);
begin
  V^ := SharedRandom.NextDouble;
end;

var
  PT_RANDOM: array[TRttiParserType] of pointer = (
    @_NoRandom,       //  ptNone
    @_NoRandom,       //  ptArray
    @_FillRandom,     //  ptBoolean
    @_FillRandom,     //  ptByte
    @_FillRandom,     //  ptCardinal
    @_FillRandom,     //  ptCurrency
    @_DoubleRandom,   //  ptDouble
    @_NoRandom,       //  ptExtended
    @_FillRandom,     //  ptInt64
    @_FillRandom,     //  ptInteger
    @_FillRandom,     //  ptQWord
    @_StringRandom,   //  ptRawByteString
    @_NoRandom,       //  ptRawJson
    @_StringRandom,   //  ptRawUtf8
    @_NoRandom,       //  ptRecord
    @_SingleRandom,   //  ptSingle
    {$ifdef UNICODE}
    @_UStringRandom,
    {$else}           //  ptString
    @_StringRandom,
    {$endif UNICODE}
    {$ifdef HASVARUSTRING}
    @_UStringRandom,
    {$else}           //  ptSynUnicode
    @_WStringRandom,
    {$endif HASVARUSTRING}
    @_DateTimeRandom, //  ptDateTime
    @_DateTimeRandom, //  ptDateTimeMS
    @_FillRandom,     //  ptGuid
    @_FillRandom,     //  ptHash128
    @_FillRandom,     //  ptHash256
    @_FillRandom,     //  ptHash512
    @_NoRandom,       //  ptOrm
    @_FillRandom,     //  ptTimeLog
    {$ifdef HASVARUSTRING}
    @_UStringRandom,
    {$else}           //  ptUnicodeString
    @_NoRandom,
    {$endif HASVARUSTRING}
    @_FillRandom,     //  ptUnixTime
    @_FillRandom,     //  ptUnixMSTime
    @_VariantRandom,  //  ptVariant
    @_WStringRandom,  //  ptWideString
    @_StringRandom,   //  ptWinAnsi
    @_FillRandom,     //  ptWord
    @_FillRandom,     //  ptEnumeration
    @_FillRandom,     //  ptSet
    @_NoRandom,       //  ptClass
    @_NoRandom,       //  ptDynArray
    @_NoRandom,       //  ptInterface
    @_NoRandom,       //  ptPUtf8Char is read-only
    @_NoRandom);      //  ptCustom


{ RTTI_MANAGEDCOPY[] implementation functions }

function _LStringCopy(Dest, Source: PRawByteString; Info: PRttiInfo): PtrInt;
begin
  if (Source^ <> '') or
     (Dest^ <> '') then
    Dest^ := Source^;
  result := SizeOf(Source^);
end;

{$ifdef HASVARUSTRING}
function _UStringCopy(Dest, Source: PUnicodeString; Info: PRttiInfo): PtrInt;
begin
  if (Source^ <> '') or
     (Dest^ <> '') then
    Dest^ := Source^;
  result := SizeOf(Source^);
end;
{$endif HASVARUSTRING}

function _WStringCopy(Dest, Source: PWideString; Info: PRttiInfo): PtrInt;
begin
  if (Source^ <> '') or
     (Dest^ <> '') then
    Dest^ := Source^;
  result := SizeOf(Source^);
end;

function _VariantCopy(Dest, Source: PVarData; Info: PRttiInfo): PtrInt;
var
  vt: cardinal;
label
  rtl, raw;
begin
  vt := Source^.VType;
  VarClearAndSetType(Variant(Dest^), vt);
  if vt > varNull then
    // varEmpty,varNull need no copy
    if vt <= varWord64 then
      // most used types
      if (vt < varOleStr) or
         (vt > varError) then
raw:    // copy any simple value (e.g. ordinal, varByRef)
        Dest^.VInt64 := Source^.VInt64
      else if vt = varOleStr then
      begin
        // copy WideString with reference counting
        Dest^.VAny := nil;
        WideString(Dest^.VAny) := WideString(Source^.VAny)
      end
      else
        // varError, varDispatch
        goto rtl
    else if vt = varString then
    begin
      // copy AnsiString with reference counting
      Dest^.VAny := nil;
      RawByteString(Dest^.VAny) := RawByteString(Source^.VAny)
    end
    else if vt >= varByRef then
      // varByRef has no refcount -> copy VPointer
      goto raw
    {$ifdef HASVARUSTRING}
    else if vt = varUString then
    begin
      // copy UnicodeString with reference counting
      Dest^.VAny := nil;
      UnicodeString(Dest^.VAny) := UnicodeString(Source^.VAny)
    end
    {$endif HASVARUSTRING}
    else
rtl:  // copy any complex type via the RTL function of the variants unit
      VarCopyProc(Dest^, Source^);
  result := SizeOf(Source^);
end;

function _Per1Copy(Dest, Source: PByte; Info: PRttiInfo): PtrInt;
begin
  Dest^ := Source^;
  result := 0; // only called from TRttiCustom.ValueCopy which ignore this
end;

function _Per2Copy(Dest, Source: PWord; Info: PRttiInfo): PtrInt;
begin
  Dest^ := Source^;
  result := 0; // ignored
end;

function _Per4Copy(Dest, Source: PInteger; Info: PRttiInfo): PtrInt;
begin
  Dest^ := Source^;
  result := 0; // ignored
end;

function _Per8Copy(Dest, Source: PInt64; Info: PRttiInfo): PtrInt;
begin
  Dest^ := Source^;
  result := 0; // ignored
end;

function _Per16Copy(Dest, Source: PHash128; Info: PRttiInfo): PtrInt;
begin
  Dest^ := Source^;
  result := 0; // ignored
end;

function _Per32Copy(Dest, Source: PHash256; Info: PRttiInfo): PtrInt;
begin
  Dest^ := Source^;
  result := 0; // ignored
end;

function _InterfaceCopy(Dest, Source: PInterface; Info: PRttiInfo): PtrInt;
begin
  Dest^ := Source^;
  result := SizeOf(Source^);
end;

function _RecordCopy(Dest, Source: PByte; Info: PRttiInfo): PtrInt;
var
  fields: TRttiRecordManagedFields; // Size/Count/Fields
  offset: PtrUInt;
  f: PRttiRecordField;
  cop: PRttiCopiers;
begin
  Info^.RecordManagedFields(fields);
  f := fields.Fields;
  cop := @RTTI_MANAGEDCOPY;
  offset := 0;
  while fields.Count <> 0 do
  begin
    dec(fields.Count);
    Info := f^.{$ifdef HASDIRECTTYPEINFO}TypeInfo{$else}TypeInfoRef^{$endif};
    {$ifdef FPC_OLDRTTI}
    if Info^.Kind in rkManagedTypes then
    {$endif FPC_OLDRTTI}
    begin
      offset := f^.Offset - offset;
      if offset <> 0 then
      begin
        MoveFast(Source^, Dest^, offset);
        inc(Source, offset);
        inc(Dest, offset);
      end;
      offset := cop[Info^.Kind](Dest, Source, Info);
      inc(Source, offset);
      inc(Dest, offset);
      inc(offset, f^.Offset);
    end;
    inc(f);
  end;
  offset := PtrUInt(fields.Size) - offset;
  if offset > 0 then
    MoveFast(Source^, Dest^, offset);
  result := fields.Size;
end;

function _DynArrayCopy(Dest, Source: PPointer; Info: PRttiInfo): PtrInt;
begin
  DynArrayCopy(Dest, Source, Info, {extcount=}nil);
  result := SizeOf(Source^);
end;

function _ArrayCopy(Dest, Source: PByte; Info: PRttiInfo): PtrInt;
var
  n, itemsize: PtrInt;
  cop: TRttiCopier;
label
  raw;
begin
  Info := Info^.ArrayItemType(n, result);
  if Info = nil then
raw:MoveFast(Source^, Dest^, result)
  else
  begin
    cop := RTTI_MANAGEDCOPY[Info^.Kind];
    if Assigned(cop) then
      repeat
        itemsize := cop(Dest ,Source, Info);
        inc(Source, itemsize);
        inc(Dest, itemsize);
        dec(n);
      until n = 0
    else
      goto raw;
  end;
end;


{ RTTI-based FillZero() }

procedure FillZeroRtti(Info: PRttiInfo; var Value);
var
  nfo: TRttiCustom;
  fin: TRttiFinalizer;
  da: PDynArrayRec;
  i, siz: PtrInt;
  v: PAnsiChar;
  p: PRttiCustomProp;
begin
  if Info = nil then
    exit;
  nfo := nil; // is set below for rkClass/rkRecord
  case Info^.Kind of
    {$ifdef FPC}rkObject,{$else}{$ifdef UNICODE}rkMRecord,{$endif}{$endif}
    rkRecord:
      nfo := Rtti.RegisterType(Info);
    {$ifdef FPC}
    rkLStringOld,
    {$endif FPC}
    rkLString:
      FillZero(RawByteString(Value));
    {$ifdef HASVARUSTRING}
    rkUString:
      FillZero(UnicodeString(Value));
    {$endif HASVARUSTRING}
    rkVariant:
      if TVarData(Value).VType = varString then
        FillZero(RawByteString(TVarData(Value).VAny));
    rkClass:
      if TObject(Value) <> nil then
        nfo := Rtti.RegisterClass(TObject(Value));
    rkDynArray:
      begin
        da := PPointer(Value)^;
        if da <> nil then
        begin
          dec(da);
          if (da^.refCnt >= 0) and
             DACntDecFree(da^.refCnt) then
          begin
            Info := Info^.DynArrayItemType(siz);
            v := PPointer(Value)^;
            if Info <> nil then
              for i := 1 to da^.length do
              begin
                FillZeroRtti(Info, v^); // process nested items
                inc(v, siz);
              end
            else
              FillCharFast(v^, da^.length * siz, 0); // e.g. for TBytes
            Freemem(da);
          end;
          PPointer(Value)^ := nil;
        end;
        exit;
      end;
  end;
  if nfo <> nil then
  begin
    p := pointer(nfo.Props.List); // for both records and classes
    if Info^.Kind = rkClass then
      v := PPointer(Value)^ // classes are passed by reference
    else
      v := @Value;          // records are passed by value
    for i := 1 to nfo.Props.Count do
    begin
      if (p^.OffsetSet >= 0) and
         (p^.Value <> nil) and
         (p^.Value.Info <> nil) and
         not (rcfIsNumber in p^.Value.Cache.Flags) then
        FillZeroRtti(p^.Value.Info, v[p^.OffsetSet]); // process nested fields
      inc(p);
    end;
  end;
  fin := RTTI_FINALIZE[Info^.Kind];
  if Assigned(fin) then
    fin(@Value, Info);
end;


{ ************** RTTI Value Types used for JSON Parsing }

function ParserTypeToTypeInfo(pt: TRttiParserType;
  pct: TRttiParserComplexType): PRttiInfo;
begin
  result := PTC_INFO[pct];
  if result = nil then
    result := PT_INFO[pt];
end;

// called from TRttiCustomList.RegisterTypeFromName and TRttiCustom.Create
// if Rtti.Find(Name, NameLen) did not have any match
// -> detect array/record keywords, integer/cardinal types, T*ID pattern
function AlternateTypeNameToRttiParserType(Name: PUtf8Char; NameLen: integer;
  Complex: PRttiParserComplexType = nil; Kind: TRttiKind = rkUnknown): TRttiParserType;
begin
  result := ptNone;
  if Complex <> nil then
    Complex^ := pctNone;
  case NameLen of
    5:
      if IdemPropNameUSameLenNotNull(Name, 'array', 5) then
        result := ptArray;
    6:
      {$ifdef FPC}
      // TypeInfo(string)=TypeInfo(AnsiString) on FPC
      if IdemPropNameUSameLenNotNull(Name, 'string', 6) then
        result := ptString
      else
      {$endif FPC}
      if IdemPropNameUSameLenNotNull(Name, 'record', 6) then
        result := ptRecord;
    // TypeInfo(integer/cardinal)=TypeInfo(LongInt/LongWord) on FPC
    7:
      if IdemPropNameUSameLenNotNull(Name,
          {$ifdef FPC}'integer'{$else}'longint'{$endif}, 7) then
        result := ptInteger;
    8:
      if IdemPropNameUSameLenNotNull(Name,
           {$ifdef FPC}'cardinal'{$else}'longword'{$endif}, 8) then
        result := ptCardinal;
  end;
  if (result = ptNone) and
     (Complex <> nil) and
     (Kind = rkInt64) and
     (NameLen < 200) and
     (Name[0] = 'T') and // T...ID pattern in name?
     (PWord(@Name[NameLen - 2])^ and $dfdf = ord('I') + ord('D') shl 8) then
  begin
    result := ptOrm;
    Complex^ := pctSpecificClassID;
  end;
end;

// called internally by TRttiCustom.Create - can't use Rtti.RegisterType()
function GuessTypeInfoToStandardParserType(Info: PRttiInfo;
  Complex: PRttiParserComplexType): TRttiParserType;
var
  c: TRttiParserComplexType;
  ndx: PtrInt;
  cp: integer;
begin                                            
  result := ptNone;
  if Complex <> nil then
    Complex^ := pctNone;
  if Info = nil then
    exit;
  // search if it is a known standard type from PT_INFO[]/PTC_INFO[]
  ndx := PtrUIntScanIndex(@PT_INFO, length(PT_INFO), PtrUInt(Info));
  if ndx >= 0 then
  begin
    result := TRttiParserType(ndx);
    if not (result in ptComplexTypes) then
      exit;
  end;
  for c := succ(low(c)) to high(c) do
    if PTC_INFO[c] = Info then // complex ORM types as set by mormot.orm.base
      if PTC_PT[c] <> ptNone then
      begin
        result := PTC_PT[c];
        if Complex <> nil then
          Complex^ := c;
        exit;
      end
      else
        break;
  // array/record keywords, integer/cardinal FPC types, T*ID pattern
  result := AlternateTypeNameToRttiParserType(
    @Info^.RawName[1], ord(Info^.RawName[0]), Complex, Info^.Kind);
  if result <> ptNone then
    exit; // found by name
  // fallback to the closed known type, using RTTI
  case Info^.Kind of
    // FPC and Delphi will use a fast jmp table
  {$ifdef FPC}
    rkLStringOld,
  {$endif FPC}
    rkLString: // PT_INFO[ptRawUtf8/ptRawJson] have been found above
      begin
        cp := Info^.AnsiStringCodePage;
        if cp = CP_UTF8 then
          result := ptRawUtf8
        else if cp = CP_WINANSI then
          result := ptWinAnsi
        else if cp >= CP_RAWBLOB then
          result := ptRawByteString
        {$ifndef UNICODE}
        else if (cp = CP_ACP) or
                (cp = Unicode_CodePage) then
          result := ptString
        {$endif UNICODE}
        else
          result := ptRawUtf8; // fallback to UTF-8 string
      end;
    rkWString:
      result := ptWideString;
  {$ifdef HASVARUSTRING}
    rkUString:
      result := ptUnicodeString;
  {$endif HASVARUSTRING}
  {$ifdef FPC_OR_UNICODE}
    {$ifdef UNICODE}
    rkProcedure,
    {$endif UNICODE}
    rkClassRef,
    rkPointer:
      result := ptPtrInt;
  {$endif FPC_OR_UNICODE}
    rkVariant:
      result := ptVariant;
    rkArray:
      result := ptArray;
    rkDynArray:
      result := ptDynArray;
    {$ifdef FPC}rkObject,{$else}{$ifdef UNICODE}rkMRecord,{$endif}{$endif}
    rkRecord:
      result := ptRecord;
    rkChar:
      result := ptByte;
    rkWChar:
      result := ptWord;
    rkMethod:
      result := ptPtrInt;
    rkInterface:
      result := ptInterface;
    rkInteger:
      case Info^.RttiOrd of
        roSByte,
        roUByte:
          result := ptByte;
        roSWord,
        roUWord:
          result := ptWord;
        roSLong:
          result := ptInteger;
        roULong:
          result := ptCardinal;
      {$ifdef FPC_NEWRTTI}
        roSQWord:
          result := ptInt64;
        roUQWord:
          result := ptQWord;
      {$endif FPC_NEWRTTI}
      end;
    rkInt64:
    {$ifdef ISDELPHI}
      if Info^.IsQWord then
        result := ptQWord
      else
    {$endif ISDELPHI}
      // PT_INFO[ptOrm/ptTimeLog/ptUnixTime] have been found above
      result := ptInt64;
  {$ifdef FPC}
    rkQWord:
      result := ptQWord;
    rkBool:
      result := ptBoolean;
  {$endif FPC}
    rkEnumeration:
    {$ifdef ISDELPHI}
      if Info^.IsBoolean then
        result := ptBoolean
      else
    {$endif ISDELPHI}
        result := ptEnumeration;
    rkSet:
      result := ptSet;
    rkClass:
      result := ptClass;
    rkFloat:
      case Info^.RttiFloat of
        rfSingle:
          result := ptSingle;
        rfDouble:
          // PT_INFO[ptDateTime/ptDateTimeMS] have been found above
          result := ptDouble;
        rfCurr:
          result := ptCurrency;
        rfExtended:
          result := ptExtended;
        // rfComp: not implemented yet
      end;
  end;
end;

function SizeToDynArrayKind(size: integer): TRttiParserType;
  {$ifdef HASINLINE}inline;{$endif}
begin  // rough estimation
  case size of
    1:
      result := ptByte;
    2:
      result := ptWord;
    4:
      result := ptInteger;
    8:
      result := ptInt64;
    16:
      result := ptHash128;
    32:
      result := ptHash256;
    64:
      result := ptHash512;
  else
    result := ptNone;
  end;
end;

var
  PT_DYNARRAY: array[TRttiParserType] of pointer; // most simple dynamic arrays

function TypeInfoToDynArrayTypeInfo(ElemInfo: PRttiInfo;
  ExpectExactElemInfo: boolean; ParserType: PRttiParserType): PRttiInfo;
var
  rc: TRttiCustom;
begin
  // search using item RTTI and PT_DYNARRAY[] known arrays
  rc := Rtti.RegisterType(ElemInfo);
  if rc = nil then
  begin
    result := nil; // paranoid
    exit;
  end;
  result := PT_DYNARRAY[rc.parser];
  if result <> nil then
  begin
    if ParserType <> nil then
      ParserType^ := rc.Parser;
    if (not ExpectExactElemInfo) or
       (PT_INFO[rc.parser] = ElemInfo) then
      exit;
    rc := Rtti.RegisterType(result);
    if (rc.ArrayRtti <> nil) and
       (rc.ArrayRtti.Info = ElemInfo) then
      exit;
  end;
  // search in registered rkDynArray for complex types (e.g. ptRecord)
  rc := Rtti.FindByArrayRtti(ElemInfo);
  if rc <> nil then
  begin
    if ParserType <> nil then
      ParserType^ := rc.ArrayRtti.Parser;
    result := rc.Info;
  end;
end;

// call from TRttiCustom.Create (maybe via GuessItemTypeFromDynArrayInfo)
function GuessItemTypeFromDynArrayInfo(DynArrayInfo, ElemInfo: PRttiInfo;
  ElemSize: integer; ExactType: boolean; out FieldSize: integer;
  Complex: PRttiParserComplexType = nil): TRttiParserType;
// warning: we can't use TRttiInfo.RecordAllFields since it would break
// backward compatibility and code expectations
var
  fields: TRttiRecordManagedFields;
  offset: integer;
  pt: TRttiParserType;
begin
  result := ptNone;
  if Complex <> nil then
    Complex^ := pctNone;
  FieldSize := 0;
  // fast guess of most known ArrayType
  if (DynArrayInfo <> nil) and
     ((ElemInfo = nil) or
      not(ElemInfo^.Kind in [rkEnumeration, rkSet, rkDynArray, rkClass])) then
    for pt := ptBoolean to ptWord do
      if PT_DYNARRAY[pt] = DynArrayInfo then
      begin
        result := pt;
        break;
      end;
  if result = ptNone then
    repeat
      // guess from RTTI of nested record(s)
      if ElemInfo = nil then
      begin
        result := SizeToDynArrayKind(ElemSize);
        if result = ptNone then
          FieldSize := ElemSize;
      end
      else
      // try to guess from 1st record/object field
      if not exactType and
         (ElemInfo^.Kind in rkRecordTypes) then
      begin
        ElemInfo.RecordManagedFields(fields);
        if fields.Count = 0 then
        begin
          ElemInfo := nil;
          continue;
        end;
        offset := fields.Fields^.Offset;
        if offset <> 0 then
        begin
          result := SizeToDynArrayKind(offset);
          if result = ptNone then
            FieldSize := offset;
        end
        else
        begin
          ElemInfo := fields.Fields^.
            {$ifdef HASDIRECTTYPEINFO}TypeInfo{$else}TypeInfoRef^{$endif};
          if (ElemInfo = nil) or
             (ElemInfo^.Kind in rkRecordTypes) then
            continue; // nested records
          result := GuessTypeInfoToStandardParserType(ElemInfo, Complex);
          if result = ptNone then
          begin
            ElemInfo := nil;
            continue;
          end;
        end;
      end;
      break;
    until false;
  if result = ptNone then
    // will recognize simple arrays from TypeName and ElemType
    result := GuessTypeInfoToStandardParserType(ElemInfo, Complex);
  if PT_SIZE[result] <> 0 then
    FieldSize := PT_SIZE[result];
end;



{ ************** RTTI-based Registration for Custom JSON Parsing }

{ TRttiCustomProp }

function TRttiCustomProp.InitFrom(RttiProp: PRttiProp): PtrInt;
var
  addr: PtrInt;
begin
  Value := Rtti.RegisterType(RttiProp^.TypeInfo);
  if Value = nil then
    raise ERttiException.CreateUtf8('TRttiCustom: % property has no RTTI',
      [RttiProp^.Name^]);
  addr := PtrInt(RttiProp^.GetFieldAddr(nil));
  // GetterCall/SetterCall will handle void "read"/"write" attributes
  OffsetGet := -1;
  OffsetSet := -1;
  if RttiProp^.GetterCall = rpcField then
    OffsetGet := addr;
  if RttiProp^.SetterCall = rpcField then
    OffsetSet := addr;
  Name := ToUtf8(RttiProp^.Name^);
  fOrigName := Name;
  Prop := RttiProp;
  OrdinalDefault := NO_DEFAULT;
  if rcfHasRttiOrd in Value.Cache.Flags then
    OrdinalDefault := RttiProp.Default;
  Stored := RttiProp^.IsStoredKind;
  result := Value.Size;
end;

function TRttiCustomProp.NameMatch(P: PUtf8Char; Len: PtrInt): boolean;
var
  n: PUtf8Char;
begin // inlined IdemPropNameUSameLenNotNull()
  result := false;
  n := pointer(Name);
  if (n = nil) or // Name='' after NameChange()
     (PStrLen(n - _STRLEN)^ <> Len) then
    exit;
  pointer(Len) := @PUtf8Char(n)[Len - SizeOf(cardinal)];
  dec(PtrUInt(P), PtrUInt(n));
  while PtrUInt(n) < PtrUInt(Len) do
    // compare 4 Bytes per loop
    if (PCardinal(n)^ xor PCardinal(P + PtrUInt(n))^) and $dfdfdfdf <> 0 then
      exit
    else
      inc(PCardinal(n));
  inc(Len, SizeOf(cardinal));
  while PtrUInt(n) < PtrUInt(Len) do
    if (ord(n^) xor ord(P[PtrUInt(n)])) and $df <> 0 then
      exit
    else
      inc(PByte(n));
  result := true;
end;

procedure TRttiCustomProp.GetValue(Data: pointer; out RVD: TRttiVarData);
begin
  if (Prop = nil) or
     (OffsetGet >= 0 ) then
    // direct memory access of the value (classes and records)
    GetValueDirect(Data, RVD)
  else
    // need a class property getter
    GetValueGetter(Data, RVD);
end;

procedure TRttiCustomProp.GetValueVariant(Data: pointer; out Dest: TVarData;
  Options: pointer{PDocVariantOptions});
var
  a: pointer;
begin
  if (Prop = nil) or
     (OffsetGet >= 0) then
    Value.ValueToVariant(PAnsiChar(Data) + OffsetGet, Dest, Options)
  else if Value.Cache.RttiVarDataVType <> varAny then
    GetValueGetter(Data, TRttiVarData(Dest)) // not TRttiVarData specific
  else if Value.Cache.VarDataVType = varInt64 then // rkEnumeration, rkSet
  begin
    Dest.VType := varInt64;
    Dest.VInt64 := Prop^.GetInt64Value(Data);
  end
  else if Value.Kind = rkDynArray then
  begin
    a := nil;
    try
      a := Prop^.GetDynArrayPropGetter(Data);
      Value.ValueToVariant(@a, Dest, Options); // will create a TDocVariant
    finally
      FastDynArrayClear(@a, Value.ArrayRtti.Info);
    end;
  end;
end;

procedure TRttiCustomProp.SetValue(Data: pointer; var RVD: TRttiVarData;
  andclear: boolean);
begin
  if Prop <> nil then
    Prop.SetValue(TObject(Data), variant(RVD));
  if andclear and
     RVD.NeedsClear then
    VarClearProc(RVD.Data);
  if Prop = nil then // raise exception after NeedsClear to avoid memory leak
    raise ERttiException.Create('TRttiCustomProp.SetValue: with Prop=nil');
end;

function TRttiCustomProp.SetValueText(Data: pointer; const Text: RawUtf8): boolean;
begin
  if (Prop = nil) or
     (OffsetSet >= 0) then
    // direct fill value in memory (classes and records)
    result := Value.ValueSetText(PAnsiChar(Data) + OffsetSet, Text)
  else
    // need a class property setter
    result := Prop.SetValueText(Data, Text);
end;

procedure TRttiCustomProp.AddValueJson(W: TTextWriter; Data: pointer;
  Options: TTextWriterWriteObjectOptions; K: TTextWriterKind);
var
  rvd: TRttiVarData;
begin
  GetValue(Data, rvd);
  if K <> twOnSameLine then
    if Value.Parser = ptRawJson then
      K := twNone
    else
      K := twJsonEscape;
  W.AddVariant(variant(rvd), K, Options);
  if rvd.NeedsClear then
    VarClearProc(rvd.Data);
end;

procedure TRttiCustomProp.GetValueJson(Data: pointer; out Result: RawUtf8);
var
  w: TTextWriter;
  tmp: TTextWriterStackBuffer;
begin
  w := DefaultJsonWriter.CreateOwnedStream(tmp);
  try
    AddValueJson(w, Data, []);
    w.SetText(Result);
  finally
    w.Free;
  end;
end;

function TRttiCustomProp.ValueIsDefault(Data: pointer): boolean;
begin
  if rcfHasRttiOrd in Value.Cache.Flags then
    if OffsetGet >= 0 then
      result := RTTI_FROM_ORD[Value.Cache.RttiOrd](
                  PAnsiChar(Data) + OffsetGet) = OrdinalDefault
    else
      result := Prop.GetOrdProp(Data) = OrdinalDefault
  else if rcfGetInt64Prop in Value.Cache.Flags then
    if OffsetGet >= 0 then
      result := PInt64(PAnsiChar(Data) + OffsetGet)^ = OrdinalDefault
    else
      result := Prop.GetInt64Prop(Data) = OrdinalDefault
  else
    // only ordinals have default values
    result := false;
end;

function TRttiCustomProp.ValueIsVoid(Data: pointer): boolean;
begin
  // we assume the caller ensured Data<>nil
  if OffsetGet >= 0 then
    // direct check value from field in memory
    result := Value.ValueIsVoid(PAnsiChar(Data) + OffsetGet)
  else
    // slightly slower method using a getter
    result := ValueIsVoidGetter(Data);
end;

function TRttiCustomProp.ValueIsVoidGetter(Data: pointer): boolean;
var
  rvd: TRttiVarData;
begin
  if Prop = nil then
    result := true
  else if Value.Kind = rkClass then
    result := IsObjectDefaultOrVoid(Prop.GetObjProp(Data))
  else
  begin
    GetValueGetter(Data, rvd);
    case rvd.DataType of
      varEmpty,
      varNull:
        result := true;
      varAny,
      varUnknown,
      varString,
      varOleStr
      {$ifdef HASVARUSTRING}, varUString {$endif}:
        result := rvd.Data.VAny = nil;
      varSingle,
      varInteger,
      varLongWord:
        result := rvd.Data.VInteger = 0;
      varInt64,
      varWord64,
      varDate,
      varDouble,
      varCurrency,
      varBoolean:
        result := rvd.Data.VInt64 = 0;
    else
      result := false;
    end;
    if rvd.NeedsClear then
      VarClearProc(rvd.Data);
  end;
end;

procedure TRttiCustomProp.GetValueDirect(Data: PByte; out RVD: TRttiVarData);
begin
  inc(Data, OffsetGet);
  RVD.VType := Value.Cache.RttiVarDataVType; // reset NeedsClear/ValueIsInstance
  case RVD.VType of
  varEmpty:
    // void Data or unsupported TRttiKind
    exit;
  varInt64,
  varBoolean:
    // rkInteger, rkBool using VInt64 for proper cardinal support
    RVD.Data.VInt64 := RTTI_FROM_ORD[Value.Cache.RttiOrd](Data);
  varWord64:
    // rkInt64, rkQWord
    begin
      if not (rcfQWord in Value.Cache.Flags) then
        RVD.VType := varInt64;
      RVD.Data.VInt64 := PInt64(Data)^;
    end;
  varSingle:
    // copy this 32-bit type at binary level
    RVD.Data.VInteger := PInteger(Data)^;
  varDate,
  varDouble,
  varCurrency:
    // copy those 64-bit types at binary level
    RVD.Data.VInt64 := PInt64(Data)^;
  varAny:
    begin
      // rkEnumeration,rkSet,rkDynArray,rkClass,rkInterface,rkRecord,rkObject
      RVD.PropValue := Data; // keeping RVD.PropValueIsInstance=false
      RVD.Prop := @self;
      // varAny/Value handled by TJsonWriter.AddVariant/AddRttiVarData
    end;
  varUnknown:
    // rkChar, rkWChar, rkSString converted into temporary RawUtf8
    begin
      RVD.VType := varString;
      RVD.NeedsClear := true;
      RVD.Data.VAny := nil; // avoid GPF
      Value.Info.StringToUtf8(Data, RawUtf8(RVD.Data.VAny));
    end;
  else
    // varString, varVariant, varOleStr, varUString are returned by reference
    begin
      RVD.Data.VAny := Data; // return the pointer to the value
      RVD.VType := RVD.VType or varByRef // and access it by reference
    end;
  end;
end;

procedure TRttiCustomProp.GetValueGetter(Instance: TObject;
  out RVD: TRttiVarData);
begin
  RVD.VType := Value.Cache.RttiVarDataVType; // reset NeedsClear/ValueIsInstance
  case RVD.VType of
  varEmpty:
    // unsupported TRttiKind
    exit;
  varInt64,
  varBoolean:
    // rkInteger, rkBool
    RVD.Data.VInt64 := Prop.GetOrdProp(Instance); // VInt64 for cardinal
  varWord64:
    // rkInt64, rkQWord
    begin
      if not (rcfQWord in Value.Cache.Flags) then
        RVD.VType := varInt64;
      RVD.Data.VInt64 := Prop.GetInt64Prop(Instance);
    end;
  varCurrency:
    Prop.GetCurrencyProp(Instance, RVD.Data.VCurrency);
  varSingle:
    RVD.Data.VSingle := Prop.GetFloatProp(Instance);
  varDate,
  varDouble:
    RVD.Data.VDouble := Prop.GetFloatProp(Instance);
  varAny:
    begin
      // rkEnumeration,rkSet,rkDynArray,rkClass,rkInterface,rkRecord,rkObject
      RVD.PropValueIsInstance := true;
      RVD.PropValue := Instance;
      RVD.Prop := @self;
      // varAny/Value/Prop handled by TJsonWriter.AddVariant/AddRttiVarData
    end;
  varUnknown:
    // rkChar, rkWChar, rkSString converted into temporary RawUtf8
    begin
      RVD.VType := varString;
      RVD.Data.VAny := nil; // avoid GPF
      Prop.GetAsString(Instance, RawUtf8(RVD.Data.VAny));
      RVD.NeedsClear := RVD.Data.VAny <> nil; // if a RawUtf8 was allocated
    end
  else
    // varString/varOleStr/varUString or varVariant
    begin
      RVD.Data.VAny := nil; // avoid GPF below
      case Value.Kind of
        rkLString:
          Prop.GetLongStrProp(Instance, RawByteString(RVD.Data.VAny));
        rkWString:
          Prop.GetWideStrProp(Instance, WideString(RVD.Data.VAny));
        {$ifdef HASVARUSTRING}
        rkUString:
          Prop.GetUnicodeStrProp(Instance, UnicodeString(RVD.Data.VAny));
        {$endif HASVARUSTRING}
        rkVariant:
          begin
            RVD.VType := varEmpty; // to fill as variant
            Prop.GetVariantProp(Instance, variant(RVD), {byref=}false);
            RVD.NeedsClear := true; // we allocated a RVD for the getter result
            exit;
          end;
      end;
      RVD.NeedsClear := RVD.Data.VAny <> nil;
    end;
  end;
end;

function TRttiCustomProp.CompareValueComplex(Data, Other: pointer;
  OtherRtti: PRttiCustomProp; CaseInsensitive: boolean): integer;
var
  v1, v2: TRttiVarData;
begin
  // direct comparison of ordinal values (rkClass is handled below)
  if (rcfHasRttiOrd in Value.Cache.Flags) and
     (rcfHasRttiOrd in OtherRtti.Value.Cache.Flags) then
  begin
    if OffsetGet >= 0 then
      v1.Data.VInt64 := RTTI_FROM_ORD[Value.Cache.RttiOrd](
                          PAnsiChar(Data) + OffsetGet)
    else
      v1.Data.VInt64 := Prop.GetOrdProp(Data);
    if OtherRtti.OffsetGet >= 0 then
      v2.Data.VInt64 := RTTI_FROM_ORD[OtherRtti.Value.Cache.RttiOrd](
                          PAnsiChar(Other) + OtherRtti.OffsetGet)
    else
      v2.Data.VInt64 := OtherRtti.Prop.GetOrdProp(Other);
  end
  else if (rcfGetInt64Prop in Value.Cache.Flags) and
          (rcfGetInt64Prop in OtherRtti.Value.Cache.Flags) then
  begin
    if OffsetGet >= 0 then
      v1.Data.VInt64 := PInt64(PAnsiChar(Data) + OffsetGet)^
    else
      v1.Data.VInt64 := Prop.GetInt64Prop(Data);
    if OtherRtti.OffsetGet >= 0 then
      v2.Data.VInt64 := PInt64(PAnsiChar(Other) + OtherRtti.OffsetGet)^
    else
      v2.Data.VInt64 := OtherRtti.Prop.GetInt64Prop(Other);
  end
  else
  // comparison using temporary TRttiVarData (using varByRef if possible)
  begin
    GetValue(Data, v1);
    OtherRtti.GetValue(Other, v2);
    if (v1.Data.VType <> varAny) and
       (v2.Data.VType <> varAny) then
      // standard variant comparison function (from mormot.core.variants)
      result := SortDynArrayVariantComp(v1.Data, v2.Data, CaseInsensitive)
    else if (v1.Data.VType = v2.Data.VType) and
            (OtherRtti.Value = Value) then
      // v1 and v2 are both varAny, with the very same RTTI type -> use
      // mormot.core.json efficient comparison (also handle rkClass/TObject)
      result := Value.ValueCompare(v1.PropValue, v2.PropValue, CaseInsensitive)
    else
      // we don't know much about those fields: just compare the pointers
      result := ComparePointer(v1.PropValue, v2.PropValue);
    if v1.NeedsClear then
      VarClearProc(v1.Data);
    if v2.NeedsClear then
      VarClearProc(v2.Data);
    exit;
  end;
  result := CompareInt64(v1.Data.VInt64, v2.Data.VInt64);
end;

function TRttiCustomProp.CompareValue(Data, Other: pointer;
  const OtherRtti: TRttiCustomProp; CaseInsensitive: boolean): integer;
begin
  if (OtherRtti.Value = Value) and
     (OffsetGet >= 0) and
     (OtherRtti.OffsetGet >= 0) then
    // two direct fields of the same type (this most common case is inlined)
    result := Value.ValueCompare(PAnsiChar(Data) + OffsetGet,
                PAnsiChar(Other) + OtherRtti.OffsetGet, CaseInsensitive)
  else
    // more complex properties comparison (not inlined)
    result := CompareValueComplex(Data, Other, @OtherRtti, CaseInsensitive);
end;


{ TRttiCustomProps }

function FindCustomProp(p: PRttiCustomProp; name: pointer; namelen: TStrLen;
  count: integer): PRttiCustomProp;
var
  p1, p2, l: PUtf8Char;
label
  no;
begin
  result := p;
  if result = nil then
    exit;
  p2 := name;
  repeat
    // inlined IdemPropNameUSameLenNotNull(p, name, namelen)
    p1 := pointer(result^.Name);
    if (p1 <> nil) and // Name may be '' after NameChange()
       (PStrLen(p1 - _STRLEN)^ = namelen) then
    begin
      l := @p1[namelen - SizeOf(cardinal)];
      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 := nil;
end;

function TRttiCustomProps.Find(const PropName: RawUtf8): PRttiCustomProp;
begin
  result := pointer(PropName);
  if result <> nil then
    result := FindCustomProp(pointer(List), pointer(PropName),
      PStrLen(PAnsiChar(result) - _STRLEN)^, Count);
end;

function TRttiCustomProps.Find(PropName: PUtf8Char; PropNameLen: PtrInt): PRttiCustomProp;
begin
  result := pointer(PropName);
  if result <> nil then
    result := FindCustomProp(pointer(List), PropName, PropNameLen, Count);
end;

function TRttiCustomProps.FindIndex(PropName: PUtf8Char; PropNameLen: PtrInt): PtrInt;
var
  p: PRttiCustomProp;
begin
  if PropNameLen <> 0 then
  begin
    p := pointer(List);
    for result := 0 to Count - 1 do
      if p^.NameMatch(PropName, PropNameLen) then
        exit
      else
        inc(p);
  end;
  result := -1;
end;

function FromNames(p: PRttiCustomProp; n: integer; out names: RawUtf8): integer;
begin
  result := 0;
  if n <> 0 then
    repeat
      if p^.Name <> '' then
      begin
        inc(result);
        names := {%H-}names + '"' + p^.Name + '",';  // include trailing ,
      end;
      inc(p);
      dec(n);
    until n = 0;
end;

function TRttiCustomProps.NameChange(const Old, New: RawUtf8): PRttiCustomProp;
begin
  result := Find(Old);
  if result = nil then
    exit;
  result^.Name := New;
  CountNonVoid := FromNames(pointer(List), Count, NamesAsJsonArray);
end;

procedure TRttiCustomProps.NameChanges(const Old, New: array of RawUtf8);
var
  i: PtrInt;
  p: PRttiCustomProp;
begin
  if high(Old) <> high(New) then
    raise ERttiException.CreateUtf8(
      'NameChanges(%,%) fields count', [high(Old), high(New)]);
  // first reset the names
  p := pointer(List);
  for i := 1 to Count do
  begin
    p^.Name := p^.fOrigName; // back to original
    inc(p);
  end;
  // customize field names
  for i := 0 to high(Old) do
  begin
    p := Find(Old[i]);
    if p = nil then
      raise ERttiException.CreateUtf8('NameChanges(%) unknown', [Old[i]]);
    p^.Name := New[i];
  end;
  CountNonVoid := FromNames(pointer(List), Count, NamesAsJsonArray);
end;

procedure TRttiCustomProps.InternalAdd(Info: PRttiInfo; Offset: PtrInt;
  const PropName: RawUtf8; AddFirst: boolean);
var
  n: PtrInt;
begin
  if (Info = nil) or
     (Offset < 0) or
     (PropName = '') or
     (Find(PropName) <> nil) then // don't register if already existing
    exit;
  SetLength(List, Count + 1);
  if AddFirst then
  begin
    if Count > 0 then
    begin
      MoveFast(List[0], List[1], SizeOf(List[0]) * Count);
      pointer(List[0].Name) := nil; // avoid GPF below
      pointer(List[0].fOrigName) := nil;
    end;
    NamesAsJsonArray := '"' + PropName + '",' + NamesAsJsonArray;
    n := 0;
  end
  else
  begin
    NamesAsJsonArray := NamesAsJsonArray + '"' + PropName + '",';
    n := Count;
  end;
  inc(Count);
  inc(CountNonVoid);
  with List[n] do
  begin
    Value := Rtti.RegisterType(Info);
    OffsetGet := Offset;
    OffsetSet := Offset;
    Name := PropName;
    fOrigName := PropName;
    Prop := nil;
    OrdinalDefault := NO_DEFAULT;
    Stored := rpsTrue;
    inc(Size, Value.Size);
  end;
end;

function TRttiCustomProps.FromTextPrepare(const PropName: RawUtf8): integer;
begin
  if PropName = '' then
    raise ERttiException.Create('FromTextPrepare: Void property name');
  if Find(PropName) <> nil then
    raise ERttiException.CreateUtf8('Duplicated % property name', [PropName]);
  result := Count;
  inc(Count);
  SetLength(List, Count);
  with List[result] do
  begin
    Name := PropName;
    fOrigName := PropName;
  end;
end;

function TRttiCustomProps.AdjustAfterAdded: TRttiCustomFlags;
var
  i, n: PtrInt;
  p: PRttiCustomProp;
begin
  CountNonVoid := FromNames(pointer(List), Count, NamesAsJsonArray);
  if Count = 0 then
  begin
    result := [];
    Managed := nil;
    exit;
  end;
  result := [rcfHasNestedProperties, rcfHasOffsetSetJsonLoadProperties];
  SetLength(Managed, Count);
  n := 0;
  p := pointer(List);
  for i := 1 to Count do
  begin
    if (rcfIsManaged in p^.Value.Flags) and
       (p^.OffsetGet >= 0) then
    begin
      if not Assigned(p^.Value.fCopy) then
        raise ERttiException.Create('Paranoid managed Value.Copy');
      include(result, rcfHasNestedManagedProperties);
      Managed[n] := p;
      inc(n);
    end;
    if (p^.OffsetSet < 0) or
       (not Assigned(p^.Value.fJsonLoad)) then
      exclude(result, rcfHasOffsetSetJsonLoadProperties);
    inc(p);
  end;
  SetLength(Managed, n);
end;

procedure TRttiCustomProps.AsText(out Result: RawUtf8; IncludePropType: boolean;
  const Prefix, Suffix: RawUtf8);
var
  tmp: TTextWriterStackBuffer;
  i: PtrInt;
begin
  if Count > 0 then
    with TTextWriter.CreateOwnedStream(tmp) do
    try
      AddString(Prefix);
      for i := 0 to Count - 1 do
        with List[i] do
        begin
          if i > 0 then
            Add(',', ' ');
          AddNoJsonEscapeUtf8(Name);
          if IncludePropType then
          begin
            Add(':', ' ');
            AddString(Value.Name);
          end;
        end;
      AddString(Suffix);
      SetText(Result);
    finally
      Free;
    end;
end;

procedure TRttiCustomProps.InternalClear;
begin
  List := nil;
  Count := 0;
  Size := 0;
  NotInheritedIndex := 0;
  Managed := nil;
end;

procedure TRttiCustomProps.InternalAddFromClass(ClassInfo: PRttiInfo;
  IncludeParents: boolean);
var
  rc: PRttiClass;
  rp: PRttiProp;
  rs: PRttiProps;
  p: PRttiCustomProp;
  n, c: PtrInt;
begin
  if (ClassInfo = nil) or
     (ClassInfo^.Kind <> rkClass) then
    exit;
  rc := ClassInfo^.RttiNonVoidClass;
  if IncludeParents then
    // put parent properties first
    InternalAddFromClass(rc^.ParentInfo, true);
  rs := rc^.RttiProps;
  n := rs^.PropCount;
  if n = 0 then
    exit;
  c := Count;
  NotInheritedIndex := c;
  SetLength(List, c + n);
  rp := rs^.PropList;
  repeat
    if c = 0 then
      p := nil
    else
      p := FindCustomProp(pointer(List), @rp^.Name^[1], ord(rp^.Name^[0]), c);
    if p = nil then
    begin // first time we encounter this property
      inc(Size, List[c].InitFrom(rp));
      inc(c)
    end
    else // this property has been redefined in a sub-class
      p^.InitFrom(rp);
    rp := rp^.Next;
    dec(n);
  until n = 0;
  if c = Count then
    exit;
  Count := c;
  DynArrayFakeLength(List, c);
end;

procedure TRttiCustomProps.SetFromRecordExtendedRtti(RecordInfo: PRttiInfo);
var
  dummy: PtrInt;
  all: TRttiRecordAllFields;
  f: PRttiRecordAllField;
  i: PtrInt;
begin
  if (RecordInfo = nil) or
     not (RecordInfo^.Kind in rkRecordTypes) then
    exit;
  all := RecordInfo^.RecordAllFields(dummy);
  InternalClear;
  if all = nil then
    // enhanced RTTI is available since Delphi 2010
    exit;
  Count := length(all);
  SetLength(List, Count);
  f := pointer(all);
  for i := 0 to Count - 1 do
    with List[i] do
    begin
      Value := Rtti.RegisterType(f^.TypeInfo);
      inc(Size, Value.Size);
      OffsetGet := f^.Offset;
      OffsetSet := f^.Offset;
      Name := ToUtf8(f^.Name^);
      fOrigName := Name;
      OrdinalDefault := NO_DEFAULT;
      Stored := rpsTrue;
      inc(f);
    end;
end;

// TRttiCustom method defined here for proper inlining
procedure TRttiCustom.ValueFinalize(Data: pointer);
begin
  if Assigned(fFinalize) then
    // handle any kind of value from RTTI, including T*ObjArray
    fFinalize(Data, fCache.Info)
  else if rcfWithoutRtti in fFlags then
    // was defined from text
    if ArrayRtti <> nil then
      // static or dynamic array (not T*ObjArray)
      NoRttiArrayFinalize(Data)
    else if rcfHasNestedManagedProperties in fFlags then
      // rcfWithoutRtti records
      fProps.FinalizeManaged(Data);
end;

procedure TRttiCustomProps.FinalizeManaged(Data: PAnsiChar);
var
  pp: PPRttiCustomProp;
  p: PRttiCustomProp;
  n: integer;
begin
  pp := pointer(Managed);
  if pp <> nil then
  begin
    n := PDALen(PAnsiChar(pp) - _DALEN)^ + _DAOFF;
    repeat
      p := pp^;
      p.Value.ValueFinalize(Data + p.OffsetSet);
      inc(pp);
      dec(n);
    until n = 0;
  end;
end;

procedure TRttiCustomProps.FinalizeAndClearPublishedProperties(Instance: TObject);
var
  pp: PRttiCustomProp;
  p: PtrInt;
  n: integer;
  rtti: TRttiCustom;
  empty: TVarData;
begin
  PInteger(@empty)^ := 0;
  n := Count;
  pp := pointer(List);
  if pp <> nil then
    repeat
      p := pp^.OffsetSet;
      if p >= 0 then
      begin
        inc(p, PtrInt(Instance));
        rtti := pp^.Value;
        rtti.ValueFinalize(pointer(p));
        if pp^.OrdinalDefault <> NO_DEFAULT then
          MoveByOne(@pp^.OrdinalDefault, pointer(p), rtti.Size)
        else
          FillZeroSmall(pointer(p), rtti.Size);
      end
      else
        pp^.Prop^.SetValue(Instance, PVariant(@empty)^);
      inc(pp);
      dec(n);
    until n = 0;
end;

// TRttiCustom method defined here for proper inlining
procedure TRttiCustom.ValueCopy(Dest, Source: pointer);
begin
  if Assigned(fCopy) then
    fCopy(Dest, Source, fCache.Info)
  else
    MoveFast(Source^, Dest^, fCache.Size);
end;

procedure TRttiCustomProps.CopyRecord(Dest, Source: PAnsiChar);
var
  pp: PPRttiCustomProp;
  n: integer;
  offset: PtrInt;
begin
  offset := 0;
  pp := pointer(Managed);
  if pp <> nil then
  begin
    n := PDALen(PAnsiChar(pp) - _DALEN)^ + _DAOFF;
    repeat
      offset := pp^.OffsetGet - offset;
      if offset <> 0 then
      begin
        MoveFast(Source^, Dest^, offset); // fast copy unmanaged field
        inc(Source, offset);
        inc(Dest, offset);
      end;
      pp^.Value.fCopy(Dest, Source, pp^.Value.Info); // copy managed field
      offset := pp^.Value.Size;
      inc(Source, offset);
      inc(Dest, offset);
      inc(offset, pp^.OffsetGet);
      inc(pp);
      dec(n);
    until n = 0;
  end;
  offset := Size - offset;
  if offset > 0 then
    MoveFast(Source^, Dest^, offset);
end;

procedure TRttiCustomProps.CopyProperties(Dest, Source: PAnsiChar);
var
  p: PRttiCustomProp;
  n: integer;
  v: TRttiVarData;
  d, s: pointer;
begin
  if (Dest = nil) or
     (Source = nil) then
    exit; // avoid GPF
  p := pointer(List); // all published properties, not only Managed[]
  if p <> nil then
  begin
    n := PDALen(PAnsiChar(p) - _DALEN)^ + _DAOFF;
    repeat
      with p^ do
        if (OffsetGet < 0) or
           (OffsetSet < 0) then
        begin
          // there is a getter or a setter -> use local temporary value
          GetValue(Source, v);
          SetValue(Dest, v, {andclear=}true);
        end
        else
        begin
          d := Dest + OffsetSet;
          s := Source + OffsetGet;
          if p^.Value.Kind = rkClass then
            if Assigned(Value.CopyObject) then
              Value.CopyObject(PPointer(d)^, PPointer(s)^)
            else
              Value.Props.CopyProperties(PPointer(d)^, PPointer(s)^)
          else
            // direct content copy from the fields memory buffers
            Value.ValueCopy(d, s);
        end;
      inc(p);
      dec(n);
    until n = 0;
  end;
end;


{ TRttiCustom }

type
  EHook = class(Exception) // to access @Message private field offset
  public
    function MessageOffset: PtrInt; // for Delphi
  end;

function EHook.MessageOffset: PtrInt;
begin
  result := PtrInt(@Message);
end;

// since "var class" are not available in Delphi 6-7, and is inherited by
// the children classes under latest Delphi versions (i.e. the "var class" is
// shared by all inherited classes, whereas we want one var per class), we
// reused one of the magic VMT slots, i.e. vmtAutoTable as filled for automated
// methods, a relic from Delphi 2 that is not used  - see
// http://hallvards.blogspot.com/2007/05/hack17-virtual-class-variables-part-ii.html
// [you can define the NOPATCHVMT conditional to rely on our Rtti.FindType()
//  internal hash table instead, for a slower but more conservative approach]

procedure TRttiCustom.SetValueClass(aClass: TClass; aInfo: PRttiInfo);
{$ifndef NOPATCHVMT}
var
  vmt: PPointer;
{$endif NOPATCHVMT}
begin
  fValueClass := aClass;
  // we need to register this class ASAP into RTTI list to avoid infinite calls
  {$ifdef NOPATCHVMT}
  Rtti.fHashTable[RK_TOSLOT[rkClass]].LastInfo := self; // faster FindType()
  {$else}
  // set vmtAutoTable slot for efficient Find(TClass) - to be done asap
  vmt := Pointer(PAnsiChar(aClass) + vmtAutoTable);
  if vmt^ = nil then
    PatchCodePtrUInt(pointer(vmt), PtrUInt(self), {leaveunprotected=}true);
  if vmt^ <> self then
    raise ERttiException.CreateUtf8(
      '%.SetValueClass(%): vmtAutoTable set to %', [self, aClass, vmt^]);
  {$endif NOPATCHVMT}
  // identify the most known class types - see also overriden mormot.core.json
  if aClass.InheritsFrom(TCollection) then
    fValueRtlClass := vcCollection
  else if aClass.InheritsFrom(TStrings) then
    fValueRtlClass := vcStrings
  else if aClass.InheritsFrom(TObjectList) then
    fValueRtlClass := vcObjectList
  else if aClass.InheritsFrom(TList) then
    fValueRtlClass := vcList
  else if aClass.InheritsFrom(ESynException) then
    fValueRtlClass := vcESynException
  else if aClass.InheritsFrom(Exception) then
    fValueRtlClass := vcException
  else if aClass.InheritsFrom(TObjectWithID) then
    fValueRtlClass := vcObjectWithID;
  // register the published properties of this class using RTTI
  fProps.InternalAddFromClass(aInfo, {includeparents=}true);
  if fValueRtlClass = vcException then
    // manual registration of the Exception.Message property
    fProps.InternalAdd(TypeInfo(string), EHook(nil).MessageOffset, 'Message');
end;

procedure TRttiCustom.FromRtti(aInfo: PRttiInfo);
var
  dummy: integer;
  pt: TRttiParserType;
  pct: TRttiParserComplexType;
  item: PRttiInfo;
begin
  if aInfo = nil then
  begin
    include(fFlags, rcfWithoutRtti);
    exit; // will call NoRttiSetAndRegister() later on
  end;
  // retrieve RTTI into ready-to-be-consummed cache
  aInfo^.ComputeCache(fCache);
  if aInfo^.IsManaged then
    // also check nested record fields
    include(fFlags, rcfIsManaged);
  case fCache.Kind of
    rkClass:
      SetValueClass(aInfo.RttiClass.RttiClass, aInfo);
    {$ifdef FPC}rkObject,{$else}{$ifdef UNICODE}rkMRecord,{$endif}{$endif}
    rkRecord:
      fProps.SetFromRecordExtendedRtti(aInfo); // only for Delphi 2010+
    rkLString:
      if aInfo = TypeInfo(SpiUtf8) then
        include(fFlags, rcfSpi);
    rkDynArray:
      begin
        item := fCache.ItemInfo;
        if item = nil then // unmanaged types
        begin
          // try to guess the actual type, e.g. a TGuid or an integer
          item := aInfo^.DynArrayItemTypeExtended; // FPC or Delphi 2010+
          if item = nil then
          begin
            // on Delphi 7-2009, recognize at least the most common types
            pt := GuessItemTypeFromDynArrayInfo(aInfo, nil,
              fCache.ItemSize, {exacttype=}true, dummy, @pct);
            item := ParserTypeToTypeInfo(pt, pct);
          end
          else if item.Kind = rkClass then
          begin
            // no need to call RegisterObjArray() on FPC and Delphi 2010+ :)
            include(fFlags, rcfObjArray);
            fObjArrayClass := item.RttiClass^.RttiClass;
          end;
        end;
        fArrayRtti := Rtti.RegisterType(item);
        if (fArrayRtti <> nil) and
           (fArrayFirstField = ptNone) then
          if fArrayRtti.Kind in rkRecordOrDynArrayTypes then
            // guess first field (using fProps[0] would break compatibility)
            fArrayFirstField := GuessItemTypeFromDynArrayInfo(
              aInfo, fCache.ItemInfo, fCache.ItemSize, {exacttype=}false, dummy)
          else
            fArrayFirstField := fArrayRtti.Parser;
      end;
    rkArray:
      begin
        fArrayRtti := Rtti.RegisterType(fCache.ItemInfo);
        if (fArrayRtti = nil) or
           not (rcfIsManaged in fArrayRtti.Flags) then
          // a static array is as managed as its nested items
          exclude(fFlags, rcfIsManaged);
      end;
  end;
  // initialize processing callbacks
  fFinalize := RTTI_FINALIZE[fCache.Kind];
  fCopy := RTTI_MANAGEDCOPY[fCache.Kind];
  if not Assigned(fCopy) then
    case fCache.Size of // direct copy of most sizes, including class/pointer
      1:
        fCopy := @_Per1Copy;
      2:
        fCopy := @_Per2Copy;
      4:
        fCopy := @_Per4Copy;
      8:
        fCopy := @_Per8Copy;
      16:
        fCopy := @_Per16Copy;
      32:
        fCopy := @_Per32Copy;
    end; // ItemCopy() will fallback to MoveFast() otherwise
  pt := GuessTypeInfoToStandardParserType(aInfo, @pct);
  SetParserType(pt, pct);
end;

destructor TRttiCustom.Destroy;
begin
  inherited Destroy;
  ObjArrayClear(fOwnedRtti);
  TObject(fPrivateSlot).Free;
  ObjArrayClear(fPrivateSlots);
end;

constructor TRttiCustom.CreateFromText(const RttiDefinition: RawUtf8);
var
  P: PUtf8Char;
begin
  FromRtti(nil); // no associated RTTI
  P := pointer(RttiDefinition);
  SetPropsFromText(P, eeNothing, {NoRegister=}true);
end;

procedure TRttiCustom.NoRttiSetAndRegister(ParserType: TRttiParserType;
  const TypeName: RawUtf8; DynArrayElemType: TRttiCustom; NoRegister: boolean);
begin
  if (fNoRttiInfo <> nil) or
     not (rcfWithoutRtti in fFlags) then
    raise ERttiException.CreateUtf8('Unexpected %.NoRttiSetAndRegister(%)',
      [self, TypeName]);
  // validate record/dynarray only supported types
  case ParserType of
    ptRecord:
      begin
        fCache.Kind := rkRecord;
        fCache.Size := Props.Size; // as computed by caller
      end;
    ptDynArray:
      begin
        fCache.Kind := rkDynArray;
        fCache.Size := SizeOf(pointer);
        fArrayRtti := DynArrayElemType;
        if (DynArrayElemType.Info <> nil) and
           DynArrayElemType.Info.IsManaged then
          fCache.ItemInfo := DynArrayElemType.Info; // as regular dynarray RTTI
        fCache.ItemSize := DynArrayElemType.Size;
      end;
    ptClass:
      begin
        fCache.Kind := rkClass;
        fCache.Size := SizeOf(pointer);
      end;
  else
    raise ERttiException.CreateUtf8('Unexpected %.CreateWithoutRtti(%)',
      [self, ToText(ParserType)^]);
  end;
  if NoRegister then
  begin
    // initialize the instance, but don't register to TRttiCustomList
    SetParserType(ParserType, pctNone);
    exit;
  end;
  // create fake RTTI which should be enough for our purpose
  SetLength(fNoRttiInfo, length(TypeName) + 64); // all filled with zeros
  fCache.Info := pointer(fNoRttiInfo);
  fCache.Info.Kind := fCache.Kind;
  if TypeName = '' then // we need some name to search for
    fCache.Info.RawName := BinToHexDisplayLowerShort(@self, SizeOf(pointer))
  else
    fCache.Info.RawName := TypeName;
  case ParserType of
    ptRecord:
      PRecordInfo(GetTypeData(fCache.Info))^.RecSize := fCache.Size;
    ptDynArray:
      GetTypeData(fCache.Info)^.elSize := fCache.ItemSize;
  end;
  // initialize process
  SetParserType(ParserType, pctNone);
  // register to the internal list
  Rtti.AddToPairs(self, fCache.Info);
end;

function {%H-}_New_NotImplemented(Rtti: TRttiCustom): pointer;
begin
  raise ERttiException.CreateUtf8('%.ClassNewInstance(%:%) not implemented -> ' +
    'please include mormot.core.json unit to register TRttiJson',
    [Rtti, Rtti.Name, ToText(Rtti.Kind)^]);
end;

function TRttiCustom.SetParserType(aParser: TRttiParserType;
  aParserComplex: TRttiParserComplexType): TRttiCustom;
begin
  fParser := aParser;
  fParserComplex := aParserComplex;
  fSetRandom := PT_RANDOM[aParser];
  if fCache.Info <> nil then
    ShortStringToAnsi7String(fCache.Info.Name^, fName);
  fFlags := fFlags + fProps.AdjustAfterAdded;
  if (fArrayRtti <> nil) and
     (rcfIsManaged in fArrayRtti.Flags) then
    include(fFlags, rcfArrayItemManaged);
  if aParser in (ptStringTypes - [ptRawJson]) then
    include(fFlags, rcfJsonString);
  fNewInstance := @_New_NotImplemented; // raise ERttiException by default
  result := self;
end;

procedure TRttiCustom.NoRttiArrayFinalize(Data: PAnsiChar);
var
  n: integer;
  mem: PDynArrayRec;
begin
  if Kind = rkArray then
  begin
    // static array has fixed number of items
    n := fCache.ItemCount;
    mem := nil;
  end
  else
  begin
    // dereference rkDynArray pointer and retrieve length
    mem := PPointer(Data)^;
    if mem = nil then
      exit;
    PPointer(Data)^ := nil;
    Data := pointer(mem);
    dec(mem);
    if mem.refCnt > 1 then
      raise ERttiException.CreateUtf8('%.ArrayFinalize: % has refcnt=%',
        [self, ArrayRtti.Name, mem.refCnt]);
    n := mem.length;
  end;
  // release memory (T*ObjArray would never occur here)
  repeat
    ArrayRtti.ValueFinalize(Data);
    inc(Data, ArrayRtti.Size);
    dec(n);
  until n = 0;
  if mem <> nil then
    FreeMem(mem);
end;

procedure TRttiCustom.ValueFinalizeAndClear(Data: pointer);
begin
  ValueFinalize(Data);
  if not (rcfIsManaged in fFlags) then // managed fields are already set to nil
    FillCharFast(Data^, fCache.Size, 0);
end;

function TRttiCustom.ValueIsVoid(Data: PAnsiChar): boolean;
var
  s: PtrInt;
begin
  case Kind of
    rkVariant:
      result := cardinal(PVarData(Data).VType) <= varNull;
    rkClass:
      result := IsObjectDefaultOrVoid(PObject(Data)^);
    else
      // work fast for ordinal types and also any pointer/managed values
      begin
        result := false;
        s := fCache.Size;
        if s >= 4 then
          repeat
            dec(s, 4);
            if PInteger(Data + s)^ <> 0 then
              exit;
          until s < 4;
        if s > 0 then
          repeat
            if Data[s - 1] <> #0 then
              exit;
            dec(s);
          until s = 0;
        result := true;
      end;
  end;
end;

function TRttiCustom.{%H-}ValueCompare(Data, Other: pointer;
  CaseInsensitive: boolean): integer;
begin
  raise ERttiException.CreateUtf8('%.ValueCompare not implemented -> ' +
    'please include mormot.core.json unit to register TRttiJson', [self]);
end;

function TRttiCustom.{%H-}ValueToVariant(Data: pointer;
  out Dest: TVarData; Options: pointer): PtrInt;
begin
  raise ERttiException.CreateUtf8('%.ValueToVariant not implemented -> ' +
    'please include mormot.core.json unit to register TRttiJson', [self]);
end;

procedure TRttiCustom.ValueRandom(Data: pointer);
begin
  fSetRandom(Data, self); // handle most simple kind of values from RTTI
end;

function TRttiCustom.ValueFullHash(const Elem): cardinal;
begin
  result := DefaultHasher(0, @Elem, fCache.ItemSize);
end;

function TRttiCustom.ValueFullCompare(const A, B): integer;
begin
  result := MemCmp(@A, @B, fCache.ItemSize); // use SSE2 asm on Intel/AMD
end;

function TRttiCustom.ValueIterateCount(Data: pointer): integer;
begin
  result := -1; // unsupported
end;

function TRttiCustom.ValueIterate(Data: pointer; Index: PtrUInt;
  out ResultRtti: TRttiCustom): pointer;
begin
  result := nil;
end;

function TRttiCustom.ValueByPath(var Data: pointer; Path: PUtf8Char;
  var Temp: TVarData; PathDelim: AnsiChar): TRttiCustom;
begin
  result := nil;
end;

function TRttiCustom.ValueSetText(Data: pointer; const Text: RawUtf8): boolean;
var
  v: Int64;
  f: double;
begin
  result := true;
  case Cache.Kind of
    rkLString:
      PRawUtf8(Data)^ := Text;
    rkWString:
      Utf8ToWideString(pointer(Text), length(Text), PWideString(Data)^);
    {$ifdef HASVARUSTRING}
    rkUString:
      Utf8DecodeToUnicodeString(pointer(Text), length(Text), PUnicodeString(Data)^);
    {$endif HASVARUSTRING}
    rkFloat:
      if ToDouble(Text, f) then
        RTTI_TO_FLOAT[Cache.RttiFloat](Data, f)
      else
        result := false;
    rkVariant:
      RawUtf8ToVariant(Text, PVariant(Data)^);
  else
    if rcfHasRttiOrd in Cache.Flags then
      if ToInt64(Text, v) then
        RTTI_TO_ORD[Cache.RttiOrd](Data, v)
      else
        result := false
    else if rcfGetInt64Prop in Cache.Flags then
      result := ToInt64(Text, PInt64(Data)^)
    else
      result := false;
  end;
end;

function TRttiCustom.ClassNewInstance: pointer;
begin
  result := fNewInstance(self);
end;

procedure TRttiCustom.SetClassNewInstance(FactoryMethod: TRttiCustomNewInstance);
begin
  fNewInstance := FactoryMethod;
end;

function TRttiCustom.HasClassNewInstance: boolean;
begin
  result := (self <> nil) and
            (@fNewInstance <> @_New_NotImplemented);
end;

procedure TRttiCustom.PropsClear;
begin
  Props.InternalClear;
  fFlags := fFlags - [rcfHasNestedProperties, rcfHasNestedManagedProperties];
end;

function TRttiCustom.PropFindByPath(var Data: pointer; FullName: PUtf8Char;
  PathDelim: AnsiChar): PRttiCustomProp;
var
  rc: TRttiCustom;
  n: ShortString;
begin
  rc := self;
  repeat
    result := nil;
    if (rc = nil) or
       (Data = nil) or
       (rc.Props.CountNonVoid = 0) then
      exit;
    GetNextItemShortString(FullName, @n, PathDelim);
    if n[0] = #0 then
      exit;
    result := FindCustomProp(
      pointer(rc.Props.List), @n[1], ord(n[0]), rc.Props.Count);
    if (result = nil) or
       (FullName = nil) then
      exit;
    // search next path level
    rc := result.Value;
    if result.OffsetGet < 0 then
      Data := nil
    else if rc.Kind in rkRecordTypes then
      inc(PAnsiChar(Data), result.OffsetGet)
    else if rc.Kind = rkClass then
      Data := PPointer(PAnsiChar(Data) + result.OffsetGet)^
    else
      Data := nil;
  until false;
end;

function TRttiCustom.SetObjArray(Item: TClass): TRttiCustom;
begin
  if (self <> nil) and
     (Kind = rkDynArray) and
     (fCache.ItemSize = SizeOf(pointer)) and
     (fCache.ItemInfo = nil) then
  begin
    fObjArrayClass := Item;
    if Item = nil then
    begin
      // unregister
      exclude(fFlags, rcfObjArray);
      fArrayRtti := nil;
      fFinalize := @_DynArrayClear;
    end
    else
    begin
      // register
      include(fFlags, rcfObjArray);
      fArrayRtti := Rtti.RegisterClass(Item); // will call _ObjClear()
      fFinalize := @_ObjArrayClear; // calls RawObjectsClear()
    end;
  end;
  SetParserType(Parser, ParserComplex); // notify format change
  result := self;
end;

var
  RttiArrayCount: integer;

function TRttiCustom.SetBinaryType(BinarySize: integer): TRttiCustom;
begin
  if self <> nil then
  begin
    if BinarySize < 0 then
    begin
      BinarySize := 0;
      exclude(fFlags, rcfBinary);
      if not (Kind in rkStringTypes) then
        exclude(fFlags, rcfJsonString);
    end
    else
    begin
      if BinarySize = 0 then
        BinarySize := fCache.Size;
      fFlags := fFlags + [rcfBinary, rcfJsonString];
    end;
    fBinarySize := BinarySize;
    SetParserType(Parser, ParserComplex); // notify format change (e.g. for json)
  end;
  result := self;
end;

procedure TRttiCustom.SetPropsFromText(var P: PUtf8Char;
  ExpectedEnd: TRttiCustomFromTextExpectedEnd; NoRegister: boolean);
var
  prop: TIntegerDynArray;
  propcount: integer;
  propname, typname, atypname: RawUtf8;
  aname: PUtf8Char;
  ee: TRttiCustomFromTextExpectedEnd;
  alen, i: PtrInt;
  pt, apt: TRttiParserType;
  c, ac, nested: TRttiCustom;
  cp: PRttiCustomProp;
begin
  PropsClear;
  fCache.Size := 0;
  propcount := 0;
  while (P <> nil) and
        (P^ <> #0) do
  begin
    // fill prop[] from new properties, and set associated type
    if P^ = ',' then
      inc(P);
    if P^ in ['''', '"'] then
    begin
      // parse identifier as SQL string (e.g. "@field0")
      P := UnQuoteSqlStringVar(P, propname);
      if P = nil then
        break;
    end
    else if not GetNextFieldProp(P, propname) then
      // expect regular object pascal identifier (i.e. 0..9,a..z,A..Z,_)
      break;
    if P^ = ',' then
    begin
      // a,'b,b',c: integer
      inc(P);
      AddInteger(prop{%H-}, propcount, Props.FromTextPrepare(propname));
      continue; // several properties defined with the same type
    end;
    AddInteger(prop, propcount, Props.FromTextPrepare(propname));
    if P^ = ':' then
      P := GotoNextNotSpace(P + 1);
    // identify type for prop[]
    typname := '';
    atypname := '';
    c := nil;
    ac := nil;
    pt := ptNone;
    ee := eeNothing;
    if P^ = '{' then
    begin
      // rec: { a,b: integer }
      pt := ptRecord;
      ee := eeCurly;
      repeat
        inc(P)
      until (P^ > ' ') or
            (P^ = #0);
    end
    else if P^ = '[' then
    begin
      // arr: [ a,b:integer ]
      pt := ptDynArray;
      ee := eeSquare;
      repeat
        inc(P)
      until (P^ > ' ') or
            (P^ = #0);
    end
    else
    begin
      if not GetNextFieldProp(P, typname) then
        ERttiException.CreateUtf8('Missing field type for %', [propname]);
      c := Rtti.RegisterTypeFromName(typname, @pt);
      if c = nil then
      case pt of
        ptArray:
          // array of ...
          begin
            if IdemPChar(P, 'OF') then
            begin
              // array of ....   or   array of record ... end
              P := GotoNextNotSpace(P + 2);
              if not GetNextFieldProp(P, atypname) or
                 (P = nil) then
                ERttiException.Create('Missing array field type');
              FormatUtf8('[%%]', [atypname, RttiArrayCount], typname);
              LockedInc32(@RttiArrayCount); // ensure genuine type name
              ac := Rtti.RegisterTypeFromName(atypname, @apt);
              if ac = nil then
                if apt = ptRecord then
                  // array of record ... end
                  ee := eeEndKeyWord
                else
                  P := nil;
            end
            else
              P := nil;
            if P = nil then
              raise ERttiException.CreateUtf8('Expected text definition syntax is ' +
                '"array of record" or "array of KnownType" for %', [propname]);
            pt := ptDynArray;
          end;
        ptRecord:
          // record ... end
          ee := eeEndKeyWord;
        ptNone:
          // unknown type name -> try from TArray<*>/T*DynArray/T*s patterns
          begin
            if PropNameEquals(typname, 'TArray') and
               (P^ = '<') then
            begin
              // try generic syntax TArray<##>
              inc(P);
              if GetNextFieldProp(P, typname) and
                 (P^ = '>') then
              begin
                inc(P);
                ac := Rtti.RegisterTypeFromName(typname);
              end;
            end
            else
            begin
              // try T##DynArray/T##s patterns
              aname := pointer(typname);
              alen := length(typname);
              if (alen > 10) and
                 (IdemPropName('DynArray', aname + alen - 8, 8) or
                  IdemPropName('ObjArray', aname + alen - 8, 8)) then
                dec(alen, 8)
              else if (alen > 3) and
                      (aname[aLen] in ['s', 'S']) then
                dec(alen)
              else
                alen := 0;
              if alen > 0 then
              begin
                // try TIntegerDynArray/TIntegers -> integer
                ac := Rtti.RegisterTypeFromName(@PByteArray(typname)[1], alen - 1);
                if ac = nil then
                  // try TMyTypeObjArray/TMyTypes -> TMyType
                  ac := Rtti.RegisterTypeFromName(pointer(typname), alen);
              end;
            end;
            if ac = nil then
              raise ERttiException.CreateUtf8(
                'Unknown type %: %', [propname, typname]);
            pt := ptDynArray;
          end;
      end;
    end;
    // retrieve nested type information
    if ee <> eeNothing then
    begin
      if (c <> nil) or
         (ac <> nil) or
         not (pt in [ptRecord, ptDynArray]) then
        raise ERttiException.CreateUtf8(
          'Unexpected nested % %', [c, ToText(pt)^]);
      nested := Rtti.GlobalClass.Create;
      nested.FromRtti(nil);
      nested.SetPropsFromText(P, ee, NoRegister);
      nested.NoRttiSetAndRegister(ptRecord, '', nil, NoRegister);
      if NoRegister then
        ObjArrayAdd(fOwnedRtti, nested);
      if pt = ptRecord then
        // rec: record .. end  or  rec: { ... }
        c := nested
      else
        // arr: [ ... ]   or  arr: array of record .. end
        ac := nested;
    end;
    if ac <> nil then
    begin
      if (c <> nil) or
         (pt <> ptDynArray) then // paranoid
        raise ERttiException.CreateUtf8(
          'Unexpected array % %', [c, ToText(pt)^]);
      c := Rtti.GlobalClass.Create;
      c.FromRtti(nil);
      c.NoRttiSetAndRegister(ptDynArray, typname, ac, NoRegister);
      if NoRegister then
        ObjArrayAdd(fOwnedRtti, c);
    end;
    // set type for all prop[]
    for i := 0 to propcount - 1 do
    begin
      cp := @Props.List[prop[i]];
      cp^.Value := c;
      cp^.OffsetGet := fCache.Size;
      cp^.OffsetSet := fCache.Size;
      cp^.OrdinalDefault := NO_DEFAULT;
      cp^.Stored := rpsTrue;
      inc(fCache.Size, c.fCache.Size);
    end;
    // continue until we reach end of buffer or ExpectedEnd
    while P^ in [#1..' ', ';'] do
      inc(P);
    case ExpectedEnd of
      eeEndKeyWord:
        if IdemPChar(P, 'END') then
        begin
          inc(P, 3);
          while P^ in [#1..' ', ';'] do
            inc(P);
          break;
        end;
      eeSquare:
        if P^ = ']' then
        begin
          inc(P);
          break;
        end;
      eeCurly:
        if P^ = '}' then
        begin
          inc(P);
          break;
        end;
    end;
    propcount := 0;
  end;
  // set whole size and managed fields/properties
  fProps.Size := fCache.Size;
  fFlags := fFlags + Props.AdjustAfterAdded;
end;

function FindPrivateSlot(c: TClass; slot: PPointer): pointer;
var
  n: integer;
begin
  result := slot^;
  if PClass(result)^ = c then // if fPrivateSlots[0].ClassType = c then
    exit;
  n := PDALen(PAnsiChar(slot) - _DALEN)^ + (_DAOFF - 1);
  if n <> 0 then
    repeat
      inc(slot);
      result := slot^;
      if PClass(result)^ = c then
        exit;
      dec(n);
    until n = 0;
  result := nil;
end;

function TRttiCustom.GetPrivateSlot(aClass: TClass): pointer;
begin
  // is used by GetWeakZero() so benefits from a per-class lock
  fPrivateSlotsSafe.Lock;
  result := pointer(fPrivateSlots);
  if result <> nil then
    result := FindPrivateSlot(aClass, result);
  fPrivateSlotsSafe.UnLock;
end;

function TRttiCustom.SetPrivateSlot(aObject: TObject): pointer;
begin
  fPrivateSlotsSafe.Lock;
  try
    result := pointer(fPrivateSlots);
    if result <> nil then
      result := FindPrivateSlot(PClass(aObject)^, result); // search again
    if result = nil then
    begin
      ObjArrayAdd(fPrivateSlots, aObject);
      result := aObject;
    end
    else
      aObject.Free;
  finally
    fPrivateSlotsSafe.UnLock;
  end;
end;

function TRttiCustom.ComputeFakeObjArrayRtti(aItemClass: TClass): TBytes;
begin
  if Kind <> rkDynArray then
    raise ERttiException.CreateUtf8('ComputeFakeArrayRtti %?', [Name]);
  SetLength(result, InstanceSize);
  MoveFast(pointer(self)^, pointer(result)^, InstanceSize);  // weak copy
  TRttiCustom(pointer(result)).fObjArrayClass := aItemClass; // overwrite class
  TRttiCustom(pointer(result)).fArrayRtti := Rtti.RegisterClass(aItemClass);
end; // no need to set other fields like Name


{ TRttiCustomList }

constructor TRttiCustomList.Create;
begin
  SetLength(fHashTable, RK_TOSLOT_MAX + 1); // 6-12KB zeroed allocation
  fGlobalClass := TRttiCustom;
  RegisterSafe.Init;
end;

destructor TRttiCustomList.Destroy;
var
  i: PtrInt;
begin
  for i := Count - 1 downto 0 do
    fInstances[i].Free;
  inherited Destroy;
  RegisterSafe.Done;
end;

function LockedFind(Pairs, PEnd: PPointerArray; Info: PRttiInfo): TRttiCustom;
  {$ifdef HASINLINE}inline;{$endif}
begin
  repeat
    if Pairs[0] <> Info then
    begin
      Pairs := @Pairs[2]; // PRttiInfo/TRttiCustom pairs
      if PAnsiChar(Pairs) >= PAnsiChar(PEnd) then
        break;
      continue;
    end;
    result := Pairs[1]; // found
    exit;
  until false;
  result := nil; // not found
end;

function TRttiCustomList.FindType(Info: PRttiInfo): TRttiCustom;
var
  k: PRttiCustomListPairs;
  h: PtrUInt;
  p: PPointerArray; // ^TPointerDynArray
begin
  {$ifndef NOPATCHVMT}
  if Info^.Kind <> rkClass then
  begin
  {$endif NOPATCHVMT}
    // our dedicated "hash table of the poor" (tm) lookup
    k := @fHashTable[RK_TOSLOT[Info^.Kind]];
    // try latest found RTTI for this kind of type definition (naive but works)
    result := k^.LastInfo;
    if (result <> nil) and
       (result.Info = Info) then
      exit;
    // O(1) hash of the PRttiInfo pointer using inlined xxHash32 shuffle stage
    h := xxHash32Mixup(PtrUInt(Info)) and RTTIHASH_MAX;
    // Knuth's magic number had more collision (even more with KNUTH_HASHPTR_MUL)
    // h := cardinal(Info * KNUTH_HASH32_MUL) shr (32 - RTTIHASH_BITS);
    // h := crc32cBy4(0, Info) and RTTICUSTOMTYPEINFOMAX; // slower, not better
    // try latest found RTTI for this hash slot
    result := k^.LastHash[h];
    if (result <> nil) and
       (result.Info = Info) then
    begin
      k^.LastInfo := result; // for faster lookup next time
      exit; // avoid most ReadLock/ReadUnLock and LockedFind() search
    end;
    // thread-safe O(n) search in CPU L1 cache
    k^.Safe.ReadLock;
    p := pointer(k^.HashInfo[h]); // read TPointerDynArray within the lock
    if p <> nil then
      result := LockedFind(p, @p[PDALen(PAnsiChar(p) - _DALEN)^ + _DAOFF], Info);
    k^.Safe.ReadUnLock;
    if result <> nil then
    begin
      k^.LastInfo := result;   // aligned pointers are atomically accessed
      k^.LastHash[h] := result;
    end;
  {$ifndef NOPATCHVMT}
  end
  else
    // direct O(1) lookup of the vmtAutoTable slot for classes
    result := PPointer(PAnsiChar(Info.RttiNonVoidClass.RttiClass) + vmtAutoTable)^;
  {$endif NOPATCHVMT}
end;

{$ifdef NOPATCHVMT}
function TRttiCustomList.FindClass(ObjectClass: TClass): TRttiCustom;
begin
  result := FindType(PPointer(PAnsiChar(ObjectClass) + vmtTypeInfo)^);
end;
{$else}
class function TRttiCustomList.FindClass(ObjectClass: TClass): TRttiCustom;
begin
  result := PPointer(PAnsiChar(ObjectClass) + vmtAutoTable)^;
end;
{$endif NOPATCHVMT}

function LockedFindNameInPairs(Pairs, PEnd: PPointerArray;
  Name: PUtf8Char; NameLen: PtrInt): TRttiCustom;
var
  nfo: PRttiInfo;
  p1, p2: PUtf8Char;
label
  no;
begin
  repeat
    nfo := Pairs[0];
    if ord(nfo^.RawName[0]) <> NameLen then
    begin
no:   Pairs := @Pairs[2]; // PRttiInfo/TRttiCustom pairs
      if PAnsiChar(Pairs) >= PAnsiChar(PEnd) then
        break;
      continue;
    end;
    // inlined IdemPropNameUSameLenNotNull
    p1 := @nfo^.RawName[1];
    p2 := Name;
    nfo := pointer(@p1[NameLen - SizeOf(cardinal)]);
    dec(p2, PtrUInt(p1));
    while PtrUInt(nfo) >= 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(nfo));
    while PtrUInt(p1) < PtrUInt(nfo) do
      // remaining bytes
      if (ord(p1^) xor ord(p2[PtrUInt(p1)])) and $df <> 0 then
        goto no
      else
        inc(PByte(p1));
    result := Pairs[1];  // found
    exit;
  until false;
  result := nil; // not found
end;

function RttiHashName(Name: PByteArray; Len: PtrUInt): byte;
  {$ifdef HASINLINE}inline;{$endif}
begin
  result := Len;
  repeat
    dec(Len);
    if Len = 0 then
      break;
    inc(result, Name[Len] and $df); // simple case-insensitive hash
  until false;
  result := result and RTTIHASH_MAX;
end;

function TRttiCustomList.FindName(Name: PUtf8Char; NameLen: PtrInt;
  Kind: TRttiKind): TRttiCustom;
var
  k: PRttiCustomListPairs;
  p: PPointer; // ^TPointerDynArray
begin
  if (Kind <> rkUnknown) and
     (Name <> nil) and
     (NameLen > 0) then
  begin
    k := @fHashTable[RK_TOSLOT[Kind]];
    // try latest found name e.g. calling from JsonRetrieveObjectRttiCustom()
    result := k^.LastName;
    if (result <> nil) and
       (PStrLen(PAnsiChar(pointer(result.Name)) - _STRLEN)^ = NameLen) and
       IdemPropNameUSameLenNotNull(pointer(result.Name), Name, NameLen) then
      exit;
    // our dedicated "hash table of the poor" (tm) lookup
    p := @k^.HashName[RttiHashName(pointer(Name), NameLen)];
    k^.Safe.ReadLock;
    result := p^; // read TPointerDynArray within the lock
    if result <> nil then
      result := LockedFindNameInPairs(@PPointerArray(result)[0],
        @PPointerArray(result)[PDALen(PAnsiChar(result) - _DALEN)^ + _DAOFF],
        Name, NameLen);
    k^.Safe.ReadUnLock;
    if result <> nil then
      k^.LastName := result;
  end
  else
    result := nil;
end;

function TRttiCustomList.FindName(Name: PUtf8Char; NameLen: PtrInt;
  Kinds: TRttiKinds): TRttiCustom;
var
  k: TRttiKind;
begin
  // not very optimized, but called only at startup from Rtti.RegisterFromText()
  if (Name <> nil) and
     (NameLen > 0) then
  begin
    if Kinds = [] then
      Kinds := rkAllTypes;
    for k := succ(low(k)) to high(k) do
      if k in Kinds then
      begin
        result := FindName(Name, NameLen, k);
        if result <> nil then
          exit;
      end;
  end;
  result := nil;
end;

function TRttiCustomList.FindName(const Name: ShortString; Kinds: TRttiKinds): TRttiCustom;
begin
  result := FindName(@Name[1], ord(Name[0]), Kinds);
end;

function FindNameInArray(Pairs, PEnd: PPointerArray; ElemInfo: PRttiInfo): TRttiCustom;
  {$ifdef HASINLINE} inline; {$endif}
begin
  repeat
    result := Pairs[1]; // PRttiInfo/TRttiCustom pairs
    if (result.ArrayRtti <> nil) and
       (result.ArrayRtti.Info = ElemInfo) then
      exit;
    Pairs := @Pairs[2];
  until Pairs = PEnd;
  result := nil;
end;

function TRttiCustomList.FindByArrayRtti(ElemInfo: PRttiInfo): TRttiCustom;
var
  n: integer;
  k: PRttiCustomListPairs;
  p: PPointer; // TPointerDynArray
begin
  if ElemInfo = nil then
  begin
    result := nil;
    exit;
  end;
  k := @fHashTable[RK_TOSLOT[rkDynArray]];
  k^.Safe.ReadLock;
  p := @k^.HashInfo;
  n := length(k^.HashInfo);
  repeat
    result := p^;
    if result <> nil then
    begin
      result := FindNameInArray(@PPointerArray(result)[1],
        @PPointerArray(result)[PDALen(PAnsiChar(result) - _DALEN)^ + _DAOFF], ElemInfo);
      if result <> nil then
        break;
    end;
    inc(p);
    dec(n);
  until n = 0;
  k^.Safe.ReadUnLock;
end;

function TRttiCustomList.DoRegister(Info: PRttiInfo): TRttiCustom;
begin
  if Info = nil then
  begin
    result := nil;
    exit;
  end;
  RegisterSafe.Lock;
  try
    result := FindType(Info);  // search again (within RegisterSafe context)
    if result <> nil then
      exit; // already registered in the background
    // initialize a new TRttiCustom/TRttiJson instance for this type
    result := GlobalClass.Create;
    // register ASAP to avoid endless recursion in FromRtti
    AddToPairs(result, Info);
    // now we can parse and process the RTTI
    result.FromRtti(Info);
  finally
    RegisterSafe.UnLock;
  end;
  if FindType(Info) <> result then // paranoid check
    raise ERttiException.CreateUtf8('%.DoRegister(%)?', [self, Info.RawName]);
end;

function TRttiCustomList.DoRegister(ObjectClass: TClass): TRttiCustom;
var
  info: PRttiInfo;
begin
  info := PPointer(PAnsiChar(ObjectClass) + vmtTypeInfo)^;
  if info <> nil then
    result := DoRegister(info)
  else
  begin
    // generate fake RTTI for classes without {$M+}, e.g. TObject or Exception
    RegisterSafe.Lock;
    try
      result := FindClass(ObjectClass); // search again (for thread safety)
      if result <> nil then
        exit; // already registered in the background
      result := GlobalClass.Create;
      result.FromRtti(nil);
      result.SetValueClass(ObjectClass, nil);
      result.NoRttiSetAndRegister(ptClass, ToText(ObjectClass));
      GetTypeData(result.fCache.Info)^.ClassType := ObjectClass;
    finally
      RegisterSafe.UnLock;
    end;
  end;
end;

function TRttiCustomList.DoRegister(ObjectClass: TClass; ToDo: TRttiCustomFlags): TRttiCustom;
var
  i: integer;
  p: PRttiCustomProp;
begin
  RegisterSafe.Lock;
  try
    result := DoRegister(ObjectClass);
    if (rcfAutoCreateFields in ToDo) and
       not (rcfAutoCreateFields in result.fFlags) then
    begin
      // detect T*AutoCreate fields
      p := pointer(result.Props.List);
      for i := 1 to result.Props.Count do
      begin
        case p^.Value.Kind of
          rkClass:
            if (p^.OffsetGet >= 0) and
               (p^.OffsetSet >= 0) then
            begin
              PtrArrayAdd(result.fAutoCreateInstances, p);
              PtrArrayAdd(result.fAutoDestroyClasses, p);
            end;
          rkDynArray:
            if (rcfObjArray in p^.Value.Flags) and
               (p^.OffsetGet >= 0) then
              PtrArrayAdd(result.fAutoCreateObjArrays, p);
          rkInterface:
            if (p^.OffsetGet >= 0) and
               (p^.OffsetSet >= 0) then
              if p^.Value.HasClassNewInstance then
                PtrArrayAdd(result.fAutoCreateInstances, p)
              else
                PtrArrayAdd(result.fAutoResolveInterfaces, p);
        end;
        inc(p);
      end;
      include(result.fFlags, rcfAutoCreateFields); // should be set once defined
    end;
  finally
    RegisterSafe.UnLock;
  end;
end;


procedure TRttiCustomList.AddToPairs(Instance: TRttiCustom; Info: PRttiInfo);

  procedure AddPair(var List: TPointerDynArray);
  var
    n: PtrInt;
  begin
    n := length(List);
    SetLength(List, n + 2);
    List[n] := Info;
    List[n + 1] := Instance;
  end;

var
  k: PRttiCustomListPairs;
begin
  k := @fHashTable[RK_TOSLOT[Info^.Kind]];
  k^.Safe.WriteLock; // needed when resizing k^.HashInfo/HashName[]
  try
    AddPair(k^.HashInfo[xxHash32Mixup(PtrUInt(Info)) and RTTIHASH_MAX]);
    AddPair(k^.HashName[RttiHashName(@Info.RawName[1], ord(Info.RawName[0]))]);
    ObjArrayAddCount(fInstances, Instance, Count); // to release memory
    inc(Counts[Info^.Kind]); // Instance.Kind is not available from DoRegister
  finally
    k^.Safe.WriteUnLock;
  end;
end;

procedure TRttiCustomList.SetGlobalClass(RttiClass: TRttiCustomClass);
var
  i: PtrInt;
  pt: TRttiParserType;
  ptc: TRttiParserComplexType;
  regtypes: RawUtf8;
  newunit: PShortString;
begin
  // ensure registration is done once for all
  if Count <> 0 then
  begin
    for i := 0 to Count - 1 do
      regtypes := {%H-}regtypes + fInstances[i].Name + ' ';
    newunit := _ClassUnit(RttiClass);
    raise ERttiException.CreateUtf8('Rtti.Count=% at Rtti.GlobalClass := % : ' +
      'some types have been registered as % before % has been loaded and ' +
      'initialized - please put % in the uses clause where you register '+
      'your [ %] types, in addition to mormot.core.rtti',
      [Count, RttiClass, fGlobalClass, newunit^, newunit^, regtypes]);
  end;
  fGlobalClass := RttiClass;
  // now we can register all the known types to be found by name
  for pt := succ(low(pt)) to high(pt) do    // standard types
    PT_RTTI[pt] := Rtti.RegisterType(PT_INFO[pt]);
  for ptc := succ(low(ptc)) to high(ptc) do // done as final in mormot.orm.base
    PTC_RTTI[ptc] := Rtti.RegisterType(PTC_INFO[ptc]);
  Rtti.RegisterTypes([
    TypeInfo(SpiUtf8), TypeInfo(RawBlob), TypeInfo(TFileName)]);
end;

procedure TRttiCustomList.RegisterTypes(const Info: array of PRttiInfo);
var
  i: PtrInt;
begin
  for i := 0 to high(Info) do
    RegisterType(Info[i]);
end;

function TRttiCustomList.RegisterTypeFromName(Name: PUtf8Char;
  NameLen: PtrInt; ParserType: PRttiParserType): TRttiCustom;
var
  pt: TRttiParserType;
  i: PtrInt;
begin
  if ParserType <> nil then
    ParserType^ := ptNone;
  if (Name = nil) or
     (NameLen <= 0) then
  begin
    result := nil;
    exit;
  end;
  repeat
    i := ByteScanIndex(pointer(Name), NameLen, ord('.'));
    if i < 0 then
      break;
    inc(i); // truncate 'unitname.typename' into 'typename'
    inc(Name, i);
    dec(NameLen, i);
  until false;
  result := FindName(Name, NameLen);
  if result = nil then
  begin
    // array/record keywords, integer/cardinal FPC types not available by Find()
    pt := AlternateTypeNameToRttiParserType(Name, NameLen);
    if ParserType <> nil then
      ParserType^ := pt;
    result := PT_RTTI[pt];
  end
  else if ParserType <> nil then
    ParserType^ := result.Parser;
end;

function TRttiCustomList.RegisterTypeFromName(const Name: RawUtf8;
  ParserType: PRttiParserType): TRttiCustom;
begin
  result := RegisterTypeFromName(pointer(Name), length(Name), ParserType);
end;

function TRttiCustomList.RegisterClass(ObjectClass: TClass): TRttiCustom;
begin
  {$ifdef NOPATCHVMT}
  result := FindType(PPointer(PAnsiChar(ObjectClass) + vmtTypeInfo)^);
  {$else}
  result := PPointer(PAnsiChar(ObjectClass) + vmtAutoTable)^;
  {$endif NOPATCHVMT}
  if result = nil then
    result := DoRegister(ObjectClass);
end;

function TRttiCustomList.GetByClass(ObjectClass: TClass): TRttiCustom;
begin
  result := RegisterClass(ObjectClass);
end;

function TRttiCustomList.RegisterClass(aObject: TObject): TRttiCustom;
begin
  {$ifdef NOPATCHVMT}
  result := FindType(PPointer(PPAnsiChar(aObject)^ + vmtTypeInfo)^);
  {$else}
  result := PPointer(PPAnsiChar(aObject)^ + vmtAutoTable)^;
  {$endif NOPATCHVMT}
  if result = nil then
    result := DoRegister(PClass(aObject)^);
end;

function TRttiCustomList.RegisterAutoCreateFieldsClass(ObjectClass: TClass): TRttiCustom;
begin
  {$ifdef NOPATCHVMT}
  result := FindType(PPointer(PAnsiChar(ObjectClass) + vmtTypeInfo)^);
  {$else}
  result := PPointer(PAnsiChar(ObjectClass) + vmtAutoTable)^;
  {$endif NOPATCHVMT}
  if (result = nil) or // caller should have checked it - paranoiac we are
     not (rcfAutoCreateFields in result.Flags) then
    result := DoRegister(ObjectClass, [rcfAutoCreateFields]);
end;

procedure TRttiCustomList.RegisterClasses(const ObjectClass: array of TClass);
var
  i: PtrInt;
begin
  for i := 0 to high(ObjectClass) do
  begin
    if ObjectClass[i].InheritsFrom(TCollection) then
      raise ERttiException.CreateUtf8(
        'RegisterClasses(%): please call RegisterCollection() instead',
        [ObjectClass[i]]);
    RegisterClass(ObjectClass[i]);
  end;
end;

function TRttiCustomList.RegisterCollection(Collection: TCollectionClass;
  CollectionItem: TCollectionItemClass): TRttiCustom;
begin
  result := RegisterClass(Collection);
  if result <> nil then
  begin
    result.fCollectionItem := CollectionItem;
    result.fCollectionItemRtti := RegisterClass(CollectionItem);
  end;
end;

procedure TRttiCustomList.RegisterUnsafeSpiType(const Types: array of PRttiInfo);
var
  i: PtrInt;
begin
  for i := 0 to high(Types) do
    include(RegisterType(Types[i]).fFlags, rcfSpi);
end;

function TRttiCustomList.RegisterBinaryType(Info: PRttiInfo;
  BinarySize: integer): TRttiCustom;
begin
  result := RegisterType(Info).SetBinaryType(BinarySize);
end;

procedure TRttiCustomList.RegisterBinaryTypes(const InfoBinarySize: array of const);
var
  i, n: PtrInt;
begin
  n := length(InfoBinarySize);
  if (n <> 0) and
     (n and 1 = 0) then
    for i := 0 to (n shr 1) - 1 do
      if (InfoBinarySize[i * 2].VType <> vtPointer) or
         not(InfoBinarySize[i * 2 + 1].VType {%H-}in [vtInteger, vtInt64]) then
        raise ERttiException.Create('Rtti.RegisterBinaryTypes(?)')
      else if RegisterType(InfoBinarySize[i * 2].VPointer).
         SetBinaryType(InfoBinarySize[i * 2 + 1].VInteger) = nil then
        raise ERttiException.CreateUtf8('Rtti.RegisterBinaryTypes: %?',
           [PRttiInfo(InfoBinarySize[i * 2].VPointer)^.Name]);
end;

function TRttiCustomList.RegisterObjArray(DynArray: PRttiInfo;
  Item: TClass): TRttiCustom;
begin
  if DynArray^.Kind = rkDynArray then
    result := RegisterType(DynArray).SetObjArray(Item)
  else
    result := nil;
end;

procedure TRttiCustomList.RegisterObjArrays(const DynArrayItem: array of const);
var
  i, n: PtrInt;
begin
  n := length(DynArrayItem);
  if (n <> 0) and
     (n and 1 = 0) then
    for i := 0 to (n shr 1) - 1 do
      if (DynArrayItem[i * 2].VType <> vtPointer) or
         (DynArrayItem[i * 2 + 1].VType <> vtClass) then
        raise ERttiException.Create('Rtti.RegisterObjArrays([?])')
      else
        RegisterObjArray(DynArrayItem[i * 2].VPointer,
          DynArrayItem[i * 2 + 1].VClass);
end;

function TRttiCustomList.RegisterFromText(DynArrayOrRecord: PRttiInfo;
  const RttiDefinition: RawUtf8): TRttiCustom;
var
  P: PUtf8Char;
  rttisize: integer;
begin
  if (DynArrayOrRecord = nil) or
     not (DynArrayOrRecord^.Kind in rkRecordOrDynArrayTypes) then
    raise ERttiException.Create('Rtti.RegisterFromText(DynArrayOrRecord?)');
  RegisterSafe.Lock;
  try
    result := RegisterType(DynArrayOrRecord);
    if result.Kind = rkDynArray then
      if result.ArrayRtti = nil then
      begin
        result.fArrayRtti := RegisterFromText('', RttiDefinition);
        result := result.fArrayRtti;
        exit;
      end
      else
        result := result.ArrayRtti;
    result.PropsClear; // reset to the Base64 serialization if RttiDefinition=''
    P := pointer(RttiDefinition);
    if P <> nil then
    begin
      rttisize := result.Size; // was taken from RTTI
      result.SetPropsFromText(P, eeNothing, {NoRegister=}false);
      if result.Props.Size <> rttisize then
        raise ERttiException.CreateUtf8('Rtti.RegisterFromText(%): text ' +
          'definition  covers % bytes, but RTTI defined %',
          [DynArrayOrRecord^.RawName, result.Props.Size, rttisize]);
    end
    else if result.Kind in rkRecordTypes then
      result.Props.SetFromRecordExtendedRtti(result.Info); // only for Delphi 2010+
    result.SetParserType(result.Parser, result.ParserComplex);
  finally
    RegisterSafe.UnLock;
  end;
end;

function TRttiCustomList.RegisterFromText(const TypeName: RawUtf8;
  const RttiDefinition: RawUtf8): TRttiCustom;
var
  P: PUtf8Char;
  new: boolean;
begin
  RegisterSafe.Lock;
  try
    result := FindName(pointer(TypeName), length(TypeName));
    new := result = nil;
    if new then
    begin
      result := GlobalClass.Create;
      result.FromRtti(nil);
    end
    else if not (result.Kind in rkRecordTypes) then
      raise ERttiException.CreateUtf8('Rtti.RegisterFromText: existing % is a %',
        [TypeName, ToText(result.Kind)^]);
    result.PropsClear;
    P := pointer(RttiDefinition);
    result.SetPropsFromText(P, eeNothing, {NoRegister=}false);
    if new then
      result.NoRttiSetAndRegister(ptRecord, TypeName);
  finally
    RegisterSafe.UnLock;
  end;
end;

procedure TRttiCustomList.RegisterFromText(
  const TypeInfoTextDefinitionPairs: array of const);
var
  i, n: PtrInt;
  d: RawUtf8;
begin
  n := length(TypeInfoTextDefinitionPairs);
  if (n <> 0) and
     (n and 1 = 0) then
    for i := 0 to (n shr 1) - 1 do
      if (TypeInfoTextDefinitionPairs[i * 2].VType <> vtPointer) or
         not VarRecToUtf8IsString(TypeInfoTextDefinitionPairs[i * 2 + 1], d) then
        raise ERttiException.Create('Rtti.RegisterFromText[?]')
      else
         RegisterFromText(TypeInfoTextDefinitionPairs[i * 2].VPointer, d);
end;


procedure CopyCollection(Source, Dest: TCollection);
var
  i: integer; // Items[] uses an integer
begin
  if (Source = nil) or
     (Dest = nil) or
     (Source.ClassType <> Dest.ClassType) then
    exit;
  Dest.BeginUpdate;
  try
    Dest.Clear;
    for i := 0 to Source.Count - 1 do
      CopyObject(Source.Items[i], Dest.Add); // Assign() fails for most objects
  finally
    Dest.EndUpdate;
  end;
end;

procedure CopyStrings(Source, Dest: TStrings);
begin
  if (Source <> nil) and
     (Dest <> nil) then
    Dest.Assign(Source); // will do the copy RTL-style
end;

procedure CopyObject(aFrom, aTo: TObject);
var
  cf: TRttiCustom;
  rf, rt: PRttiCustomProps;
  pf, pt: PRttiCustomProp;
  i: integer;
  rvd: TRttiVarData;
begin
  if (aFrom <> nil) and
     (aTo <> nil) then
  begin
    cf := Rtti.RegisterClass(PClass(aFrom)^);
    if (cf.ValueRtlClass = vcCollection) and
       (PClass(aFrom)^ = PClass(aTo)^)  then
      // specific process of TCollection items
      CopyCollection(TCollection(aFrom), TCollection(aTo))
    else if (cf.ValueRtlClass = vcStrings) and
            PClass(aTo)^.InheritsFrom(TStrings) then
      // specific process of TStrings items using RTL-style copy
      TStrings(aTo).Assign(TStrings(aFrom))
    else if PClass(aTo)^.InheritsFrom(PClass(aFrom)^) then
      // fast copy from RTTI properties of the common (or same) hierarchy
      if Assigned(cf.CopyObject) then
        cf.CopyObject(aTo, aFrom) // overriden e.g. for TOrm
      else
        cf.Props.CopyProperties(pointer(aTo), pointer(aFrom))
    else
    begin
      // no common inheritance -> slower lookup by property name
      rf := @cf.Props;
      rt := @Rtti.RegisterClass(PClass(aTo)^).Props;
      pf := pointer(rf.List);
      for i := 1 to rf.Count do
      begin
        if pf^.Name <> '' then
        begin
          pt := rt.Find(pf^.Name);
          if pt <> nil then
          begin
            pf^.GetValue(pointer(aFrom), rvd);
            pt^.SetValue(pointer(aTo), rvd, {andclear=}true);
          end;
        end;
        inc(pf);
      end;
    end;
  end;
end;

function CopyObject(aFrom: TObject): TObject;
begin
  if aFrom = nil then
    result := nil
  else
  begin
    result := Rtti.RegisterClass(aFrom.ClassType).ClassNewInstance;
    CopyObject(aFrom, result);
  end;
end;

procedure SetDefaultValuesObject(Instance: TObject);
var
  rc: TRttiCustom;
  p: PRttiCustomProp;
  i: integer;
begin
  if Instance = nil then
    exit;
  rc := Rtti.RegisterClass(Instance);
  p := pointer(rc.Props.List);
  for i := 1 to rc.Props.Count do
  begin
    if p^.Value.Kind = rkClass then
      SetDefaultValuesObject(p^.Prop.GetObjProp(Instance))
    else if p^.OrdinalDefault <> NO_DEFAULT then
      p^.Prop.SetInt64Value(Instance, p^.OrdinalDefault);
    inc(p);
  end;
end;

function GetInstanceByPath(var Instance: TObject; const Path: RawUtf8;
  out Prop: PRttiCustomProp; PathDelim: AnsiChar): boolean;
begin
  result := false;
  if (Instance = nil) or
     (Path = '') then
    exit;
  Prop := Rtti.RegisterClass(Instance).
    PropFindByPath(pointer(Instance), pointer(Path), PathDelim);
  result := (Prop <> nil) and
            (Instance <> nil);
end;

function SetValueObject(Instance: TObject; const Path: RawUtf8;
  const Value: variant): boolean;
var
  p: PRttiCustomProp;
begin
  result := GetInstanceByPath(Instance, Path, p) and
            p^.Prop^.SetValue(Instance, Value);
end;

procedure ClearObject(Value: TObject; FreeAndNilNestedObjects: boolean);
var
  rc: TRttiCustom;
  p: PRttiCustomProp;
  i: integer;
begin
  if Value = nil then
    exit;
  rc := Rtti.RegisterClass(Value.ClassType);
  p := pointer(rc.Props.List);
  for i := 1 to rc.Props.Count do
  begin
    if not FreeAndNilNestedObjects and
       (p^.Value.Kind = rkClass) then
      ClearObject(p^.Prop.GetObjProp(Value), false)
    else if p^.OffsetSet >= 0 then
      // for rkClass, _ObjClear() mimics FreeAndNil()
      p^.Value.ValueFinalizeAndClear(PAnsiChar(Value) + p^.OffsetSet)
    else
      p^.SetValue(pointer(Value), PRttiVarData(@NullVarData)^, {andclear=}false);
    inc(p);
  end;
end;

procedure FinalizeObject(Value: TObject);
begin
  if Value <> nil then
    Value.CleanupInstance;
end;

function IsObjectDefaultOrVoid(Value: TObject): boolean;
var
  rc: TRttiCustom;
  p: PRttiCustomProp;
  i: integer;
begin
  if Value <> nil then
  begin
    result := false;
    rc := Rtti.RegisterClass(Value.ClassType);
    if (rc.ValueRtlClass <> vcNone) and
       (rc.ValueIterateCount(@Value) > 0) then
      exit; // e.g. TObjectList.Count or TCollection.Count
    p := pointer(rc.Props.List);
    for i := 1 to rc.Props.Count do
      if p^.ValueIsVoid(Value) then
        inc(p)
      else
        exit;
  end;
  result := true;
end;

function SetObjectFromExecutableCommandLine(Value: TObject;
  const SwitchPrefix, DescriptionSuffix: RawUtf8;
  CommandLine: TExecutableCommandLine): boolean;
var
  rc: TRttiCustom;
  p: PRttiCustomProp;
  v, desc, def, typ: RawUtf8;
  dolower: boolean;
  i: integer;
  v64: QWord;
begin
  result := false;
  if Value = nil then
    exit;
  if CommandLine = nil then
    CommandLine := Executable.Command;
  rc := Rtti.RegisterClass(Value.ClassType);
  p := pointer(rc.Props.List);
  for i := 1 to rc.Props.Count do
  begin
    if (p^.Name <> '') and
       not (p^.Value.Kind in rkComplexTypes) then
    begin
      desc := '';
      dolower := false;
      if p^.Value.Kind in [rkEnumeration, rkSet] then
      begin
        p^.Value.Cache.EnumInfo^.GetEnumNameTrimedAll(desc);
        desc := StringReplaceChars(desc, ',', '|');
        if UpperCaseU(desc) = desc then
        begin
          dolower := true;
          desc := LowerCaseU(desc); // cosmetic
        end;
        if p^.Value.Kind = rkSet then // see TExecutableCommandLine.Describe
          desc := ' - values: set of ' + desc
        else
          desc := ' - values: ' + desc;
      end;
      desc := FormatUtf8('%%%', [UnCamelCase(p^.Name), DescriptionSuffix, desc]);
      if not p.ValueIsDefault(Value) then
      begin
        def := '';
        typ := '';
        if p^.Value.Kind in rkOrdinalTypes then
        begin
          v64 := p^.Prop^.GetInt64Value(Value);
          case p^.Value.Kind of
            rkEnumeration:
              def := p^.Value.Cache.EnumInfo.GetEnumNameTrimed(v64);
            rkSet:
              if v64 <> 0 then
                def := p^.Value.Cache.EnumInfo.GetSetName(v64, {trim=}true, '|');
          else
            begin
              UInt64ToUtf8(v64, def);
              typ := 'integer';
            end;
          end;
          if dolower then
            def := LowerCaseU(def);
        end
        else
        begin
          def := p^.Prop^.GetValueText(Value);
          if p^.Value.Name = 'TFileName' then
            if (PosEx('Folder', p^.Prop^.NameUtf8) <> 0) or
               (PosEx('Path', p^.Prop^.NameUtf8) <> 0) then
            typ := 'folder'
          else
            typ := 'filename'
          else if (p^.Value.Kind = rkLString) and
                  (p^.Value.Cache.CodePage <> CP_RAWBYTESTRING) then
            typ := 'text';
        end;
        if typ <> '' then
          desc := FormatUtf8('##% %', [typ, desc]); // ##typename to be trimmed
        if def <> '' then
          desc := FormatUtf8('% (default: %)', [desc, def]);
      end;
      if CommandLine.Get([SwitchPrefix + p^.Name], v, desc) and
         p^.Prop^.SetValueText(Value, v) then // supports also enums and sets
        result := true;
    end;
    inc(p);
  end;
end;


{ *********** High Level TObjectWithID and TObjectWithCustomCreate Class Types }

{ TObjectWithCustomCreate }

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

class function TObjectWithCustomCreate.RttiCustom: TRttiCustom;
begin
  // inlined Rtti.Find(ClassType): we know it is the first slot
  {$ifdef NOPATCHVMT}
  result := Rtti.FindType(PPointer(PAnsiChar(self) + vmtTypeInfo)^);
  {$else}
  result := PPointer(PAnsiChar(self) + vmtAutoTable)^;
  {$endif NOPATCHVMT}
  // assert(result.InheritsFrom(TRttiCustom));
end;

class function TObjectWithCustomCreate.NewInstance: TObject;
begin
  {$ifndef NOPATCHVMT}
  // register the class to the RTTI cache
  if PPointer(PAnsiChar(self) + vmtAutoTable)^ = nil then
    Rtti.DoRegister(self); // ensure TRttiCustom is set
  {$endif NOPATCHVMT}
  // bypass vmtIntfTable and vmt^.vInitTable (FPC management operators)
  GetMem(pointer(result), InstanceSize); // InstanceSize is inlined
  FillCharFast(pointer(result)^, InstanceSize, 0);
  PPointer(result)^ := pointer(self); // store VMT
end; // no benefit of rewriting FreeInstance/CleanupInstance

class procedure TObjectWithCustomCreate.RttiCustomSetParser(Rtti: TRttiCustom);
begin
  // do nothing by default
end;

function TObjectWithCustomCreate.RttiBeforeWriteObject(W: TTextWriter;
  var Options: TTextWriterWriteObjectOptions): boolean;
begin
  result := false; // default JSON serialization
end;

function TObjectWithCustomCreate.RttiWritePropertyValue(W: TTextWriter;
  Prop: PRttiCustomProp; Options: TTextWriterWriteObjectOptions): boolean;
begin
  result := false; // default JSON serializaiton
end;

procedure TObjectWithCustomCreate.RttiAfterWriteObject(W: TTextWriter;
  Options: TTextWriterWriteObjectOptions);
begin
  // nothing to do
end;

function TObjectWithCustomCreate.RttiBeforeReadObject(Ctxt: pointer): boolean;
begin
  result := false; // default JSON unserialization
end;

function TObjectWithCustomCreate.RttiBeforeReadPropertyValue(
  Ctxt: pointer; Prop: PRttiCustomProp): boolean;
begin
  result := false; // default JSON unserialization
end;

procedure TObjectWithCustomCreate.RttiAfterReadObject;
begin
  // nothing to do
end;

procedure TObjectWithCustomCreateRttiCustomSetParser(
  O: TObjectWithCustomCreateClass; Rtti: TRttiCustom);
begin
  O.RttiCustomSetParser(Rtti); // to circumvent some compiler issue
end;


{ TObjectWithID }

constructor TObjectWithID.CreateWithID(aID: TID);
begin
  Create; // may have be overriden
  fID := aID;
end;

class procedure TObjectWithID.RttiCustomSetParser(Rtti: TRttiCustom);
begin
  Rtti.Props.InternalAdd(
    TypeInfo(TID), PtrInt(@TObjectWithID(nil).fID), 'ID', {first=}true);
end;


{$ifdef CPUX64}

// very efficient branchless asm - rcx/rdi=Item1 rdx/rsi=Item2
function TObjectWithIDDynArrayCompare(const Item1, Item2): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
        mov     rcx, qword ptr [Item1]
        mov     rdx, qword ptr [Item2]
        mov     rcx, qword ptr [rcx + TObjectWithID.fID]
        mov     rdx, qword ptr [rdx + TObjectWithID.fID]
        xor     eax, eax
        cmp     rcx, rdx
        seta    al
        sbb     eax, 0
end;

{$else}

function TObjectWithIDDynArrayCompare(const Item1,Item2): integer;
begin
  // we assume Item1<>nil and Item2<>nil
  result := CompareQWord(TObjectWithID(Item1).fID, TObjectWithID(Item2).fID);
  // inlined branchless comparison or correct x86 asm for older Delphi
end;

{$endif CPUX64}

function TObjectWithIDDynArrayHashOne(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0, pointer(@TObjectWithID(Elem).fID), SizeOf(TID));
end;


// ------ some integer conversion wrapper functions

function FromRttiOrdSByte(P: PShortInt): Int64;
begin
  result := P^;
end;

function FromRttiOrdSWord(P: PSmallInt): Int64;
begin
  result := P^;
end;

function FromRttiOrdSLong(P: PInteger): Int64;
begin
  result := P^;
end;

function FromRttiOrdUByte(P: PByte): Int64;
begin
  result := P^;
end;

function FromRttiOrdUWord(P: PWord): Int64;
begin
  result := P^;
end;

function FromRttiOrdULong(P: PCardinal): Int64;
begin
  result := P^;
end;

procedure ToRttiOrd1(P: PByte; Value: PtrUInt);
begin
  P^ := Value;
end;

procedure ToRttiOrd2(P: PWord; Value: PtrUInt);
begin
  P^ := Value;
end;

procedure ToRttiOrd4(P: PCardinal; Value: PtrUInt);
begin
  P^ := Value;
end;

{$ifdef FPC_NEWRTTI}
function FromRttiOrdInt64(P: PInt64): Int64;
begin
  result := P^;
end;

procedure ToRttiOrd8(P: PInt64; Value: PtrInt);
begin
  P^ := Value;
end;
{$endif FPC_NEWRTTI}

procedure ToRttiFloat32(P: PSingle; Value: TSynExtended);
begin
  P^ := Value;
end;

procedure ToRttiFloat64(P: PDouble; Value: TSynExtended);
begin
  unaligned(P^) := Value;
end;

procedure ToRttiFloat80(P: PExtended; Value: TSynExtended);
begin
  P^ := Value;
end;

procedure ToRttiFloatCurr(P: PCurrency; Value: TSynExtended);
begin
  DoubleToCurrency(Value, P);
end;


procedure InitializeUnit;
var
  k: TRttiKind;
  t: TRttiParserType;
begin
  RTTI_FROM_ORD[roSByte] := @FromRttiOrdSByte;
  RTTI_FROM_ORD[roSWord] := @FromRttiOrdSWord;
  RTTI_FROM_ORD[roSLong] := @FromRttiOrdSLong;
  RTTI_FROM_ORD[roUByte] := @FromRttiOrdUByte;
  RTTI_FROM_ORD[roUWord] := @FromRttiOrdUWord;
  RTTI_FROM_ORD[roULong] := @FromRttiOrdULong;
  RTTI_TO_ORD[roSByte] := @ToRttiOrd1;
  RTTI_TO_ORD[roSWord] := @ToRttiOrd2;
  RTTI_TO_ORD[roSLong] := @ToRttiOrd4;
  RTTI_TO_ORD[roUByte] := @ToRttiOrd1;
  RTTI_TO_ORD[roUWord] := @ToRttiOrd2;
  RTTI_TO_ORD[roULong] := @ToRttiOrd4;
  {$ifdef FPC_NEWRTTI}
  RTTI_FROM_ORD[roSQWord] := @FromRttiOrdInt64;
  RTTI_FROM_ORD[roUQWord] := @FromRttiOrdInt64;
  RTTI_TO_ORD[roSQWord]   := @ToRttiOrd8;
  RTTI_TO_ORD[roUQWord]   := @ToRttiOrd8;
  {$endif FPC_NEWRTTI}
  RTTI_TO_FLOAT[rfSingle]   := @ToRttiFloat32;
  RTTI_TO_FLOAT[rfDouble]   := @ToRttiFloat64;
  RTTI_TO_FLOAT[rfExtended] := @ToRttiFloat80;
  RTTI_TO_FLOAT[rfCurr]     := @ToRttiFloatCurr;
  RTTI_FINALIZE[rkLString]   := @_StringClear;
  RTTI_FINALIZE[rkWString]   := @_WStringClear;
  RTTI_FINALIZE[rkVariant]   := @_VariantClear;
  RTTI_FINALIZE[rkArray]     := @_ArrayClear;
  RTTI_FINALIZE[rkRecord]    := @FastRecordClear;
  RTTI_FINALIZE[rkInterface] := @_InterfaceClear;
  RTTI_FINALIZE[rkDynArray]  := @_DynArrayClear;
  RTTI_TO_VARTYPE[rkInteger] := varInt64;
  RTTI_TO_VARTYPE[rkInt64]   := varWord64;
  RTTI_TO_VARTYPE[rkFloat]   := varDouble;
  RTTI_TO_VARTYPE[rkLString] := varString;
  RTTI_TO_VARTYPE[rkWString] := varOleStr;
  RTTI_TO_VARTYPE[rkVariant] := varVariant;
  RTTI_TO_VARTYPE[rkChar]    := varUnknown; // to use temp RawUtf8 -> varString
  RTTI_TO_VARTYPE[rkWChar]   := varUnknown;
  RTTI_TO_VARTYPE[rkSString] := varUnknown;
  RTTI_MANAGEDCOPY[rkLString]   := @_LStringCopy;
  RTTI_MANAGEDCOPY[rkWString]   := @_WStringCopy;
  RTTI_MANAGEDCOPY[rkVariant]   := @_VariantCopy;
  RTTI_MANAGEDCOPY[rkArray]     := @_ArrayCopy;
  RTTI_MANAGEDCOPY[rkRecord]    := @_RecordCopy;
  RTTI_MANAGEDCOPY[rkInterface] := @_InterfaceCopy;
  RTTI_MANAGEDCOPY[rkDynArray]  := @_DynArrayCopy;
  {$ifdef HASVARUSTRING}
  RTTI_FINALIZE[rkUString]      := @_StringClear; // share same PStrRec layout
  RTTI_TO_VARTYPE[rkUString]    := varUString;
  RTTI_MANAGEDCOPY[rkUString]   := @_UStringCopy;
  {$endif HASVARUSTRING}
  {$ifdef FPC}
  RTTI_FINALIZE[rkLStringOld]    := @_StringClear;
  RTTI_FINALIZE[rkObject]        := @FastRecordClear;
  RTTI_TO_VARTYPE[rkBool]        := varBoolean;
  RTTI_TO_VARTYPE[rkQWord]       := varWord64;
  RTTI_TO_VARTYPE[rkLStringOld]  := varString;
  RTTI_TO_VARTYPE[rkObject]      := varAny;
  RTTI_MANAGEDCOPY[rkLStringOld] := @_LStringCopy;
  RTTI_MANAGEDCOPY[rkObject]     := @_RecordCopy;
  {$else}
  {$ifdef UNICODE}
  RTTI_FINALIZE[rkMRecord]       := @FastRecordClear;
  RTTI_TO_VARTYPE[rkMRecord]     := varAny;
  RTTI_MANAGEDCOPY[rkMRecord]    := @_RecordCopy;
  {$endif UNICODE}
  {$endif FPC}
  for k := low(k) to high(k) do
  begin
    // paranoid checks
    if Assigned(RTTI_FINALIZE[k]) <> (k in rkManagedTypes) then
      raise ERttiException.CreateUtf8('Unexpected RTTI_FINALIZE[%]', [ToText(k)^]);
    if Assigned(RTTI_MANAGEDCOPY[k]) <> (k in rkManagedTypes) then
      raise ERttiException.CreateUtf8('Unexpected RTTI_MANAGEDCOPY[%]', [ToText(k)^]);
    // TJsonWriter.AddRttiVarData for TRttiCustomProp.GetValueDirect/GetValueGetter
    case k of
      rkEnumeration,
      rkSet,
      rkDynArray,
      rkClass,
      rkInterface,
      {$ifdef FPC}rkObject,{$else}{$ifdef UNICODE}rkMRecord,{$endif}{$endif}
      rkRecord,
      rkArray:
        RTTI_TO_VARTYPE[k] := varAny; // TVarData.VAny pointing to the value
    end;
  end;
  RTTI_FINALIZE[rkClass]   := @_ObjClear;
  PT_INFO[ptBoolean]       := TypeInfo(boolean);
  PT_INFO[ptByte]          := TypeInfo(byte);
  PT_INFO[ptCardinal]      := TypeInfo(cardinal);
  PT_INFO[ptCurrency]      := TypeInfo(Currency);
  PT_INFO[ptDouble]        := TypeInfo(Double);
  PT_INFO[ptExtended]      := TypeInfo(Extended);
  PT_INFO[ptInt64]         := TypeInfo(Int64);
  PT_INFO[ptInteger]       := TypeInfo(integer);
  PT_INFO[ptQWord]         := TypeInfo(QWord);
  PT_INFO[ptRawByteString] := TypeInfo(RawByteString);
  PT_INFO[ptRawJson]       := TypeInfo(RawJson);
  PT_INFO[ptRawUtf8]       := TypeInfo(RawUtf8);
  PT_INFO[ptSingle]        := TypeInfo(Single);
  PT_INFO[ptString]        := TypeInfo(String);
  PT_INFO[ptSynUnicode]    := TypeInfo(SynUnicode);
  PT_INFO[ptDateTime]      := TypeInfo(TDateTime);
  PT_INFO[ptDateTimeMS]    := TypeInfo(TDateTimeMS);
  {$ifdef HASNOSTATICRTTI} // for Delphi 7/2007: use fake TypeInfo()
  PT_INFO[ptGuid]          := @_TGUID;
  PT_INFO[ptHash128]       := @_THASH128;
  PT_INFO[ptHash256]       := @_THASH256;
  PT_INFO[ptHash512]       := @_THASH512;
  PT_INFO[ptPUtf8Char]     := @_PUTF8CHAR;
  {$else}
  PT_INFO[ptGuid]          := TypeInfo(TGuid);
  PT_INFO[ptHash128]       := TypeInfo(THash128);
  PT_INFO[ptHash256]       := TypeInfo(THash256);
  PT_INFO[ptHash512]       := TypeInfo(THash512);
  PT_INFO[ptPUtf8Char]     := TypeInfo(PUtf8Char);
  {$endif HASNOSTATICRTTI}
  {$ifdef HASVARUSTRING}
  PT_INFO[ptUnicodeString]     := TypeInfo(UnicodeString);
  PT_DYNARRAY[ptUnicodeString] := TypeInfo(TUnicodeStringDynArray);
  {$else}
  PT_INFO[ptUnicodeString]     := TypeInfo(SynUnicode);
  PT_DYNARRAY[ptUnicodeString] := TypeInfo(TSynUnicodeDynArray);
  {$endif HASVARUSTRING}
  PT_INFO[ptUnixTime]      := TypeInfo(TUnixTime);
  PT_INFO[ptUnixMSTime]    := TypeInfo(TUnixMSTime);
  PT_INFO[ptVariant]       := TypeInfo(Variant);
  PT_INFO[ptWideString]    := TypeInfo(WideString);
  PT_INFO[ptWinAnsi]       := TypeInfo(WinAnsiString);
  PT_INFO[ptWord]          := TypeInfo(Word);
  // ptComplexTypes may have several matching TypeInfo() -> put generic
  PT_INFO[ptOrm]           := TypeInfo(TID);
  PT_INFO[ptTimeLog]       := TypeInfo(TTimeLog);
  for t := succ(low(t)) to high(t) do
    if Assigned(PT_INFO[t]) = (t in (ptComplexTypes - [ptOrm, ptTimeLog])) then
      raise ERttiException.CreateUtf8('Unexpected PT_INFO[%]', [ToText(t)^]);
  PTC_INFO[pctTimeLog]     := TypeInfo(TTimeLog);
  PTC_INFO[pctID]          := TypeInfo(TID);
  PTC_INFO[pctCreateTime]  := TypeInfo(TTimeLog);
  PTC_INFO[pctModTime]     := TypeInfo(TTimeLog);
  // may be overriden to the exact TRecordReference/TRecordVersion TypeInfo()
  PTC_INFO[pctSpecificClassID] := TypeInfo(QWord);
  PTC_INFO[pctRecordReference] := TypeInfo(QWord);
  PTC_INFO[pctRecordVersion]   := TypeInfo(QWord);
  PTC_INFO[pctRecordReferenceToBeDeleted] := TypeInfo(QWord);
  PT_DYNARRAY[ptBoolean]       := TypeInfo(TBooleanDynArray);
  PT_DYNARRAY[ptByte]          := TypeInfo(TByteDynArray);
  PT_DYNARRAY[ptCardinal]      := TypeInfo(TCardinalDynArray);
  PT_DYNARRAY[ptCurrency]      := TypeInfo(TCurrencyDynArray);
  PT_DYNARRAY[ptDouble]        := TypeInfo(TDoubleDynArray);
  PT_DYNARRAY[ptExtended]      := TypeInfo(TExtendedDynArray);
  PT_DYNARRAY[ptInt64]         := TypeInfo(TInt64DynArray);
  PT_DYNARRAY[ptInteger]       := TypeInfo(TIntegerDynArray);
  PT_DYNARRAY[ptQWord]         := TypeInfo(TQWordDynArray);
  PT_DYNARRAY[ptRawByteString] := TypeInfo(TRawByteStringDynArray);
  PT_DYNARRAY[ptRawJson]       := TypeInfo(TRawJsonDynArray);
  PT_DYNARRAY[ptRawUtf8]       := TypeInfo(TRawUtf8DynArray);
  PT_DYNARRAY[ptSingle]        := TypeInfo(TSingleDynArray);
  PT_DYNARRAY[ptString]        := TypeInfo(TStringDynArray);
  PT_DYNARRAY[ptSynUnicode]    := TypeInfo(TSynUnicodeDynArray);
  PT_DYNARRAY[ptDateTime]      := TypeInfo(TDateTimeDynArray);
  PT_DYNARRAY[ptDateTimeMS]    := TypeInfo(TDateTimeMSDynArray);
  PT_DYNARRAY[ptGuid]          := TypeInfo(TGuidDynArray);
  PT_DYNARRAY[ptHash128]       := TypeInfo(THash128DynArray);
  PT_DYNARRAY[ptHash256]       := TypeInfo(THash256DynArray);
  PT_DYNARRAY[ptHash512]       := TypeInfo(THash512DynArray);
  PT_DYNARRAY[ptOrm]           := TypeInfo(TIDDynArray);
  PT_DYNARRAY[ptTimeLog]       := TypeInfo(TTimeLogDynArray);
  PT_DYNARRAY[ptUnixTime]      := TypeInfo(TUnixTimeDynArray);
  PT_DYNARRAY[ptUnixMSTime]    := TypeInfo(TUnixMSTimeDynArray);
  PT_DYNARRAY[ptVariant]       := TypeInfo(TVariantDynArray);
  PT_DYNARRAY[ptWideString]    := TypeInfo(TWideStringDynArray);
  PT_DYNARRAY[ptWinAnsi]       := TypeInfo(TWinAnsiDynArray);
  PT_DYNARRAY[ptWord]          := TypeInfo(TWordDynArray);
  PT_DYNARRAY[ptPUtf8Char]     := TypeInfo(TPUtf8CharDynArray);
  // prepare global thread-safe TRttiCustomList
  Rtti := RegisterGlobalShutdownRelease(TRttiCustomList.Create);
  ClassUnit := _ClassUnit;
  // redirect most used FPC RTL functions to optimized x86_64 assembly
  {$ifdef FPC_CPUX64}
  RedirectRtl;
  {$endif FPC_CPUX64}
  // validate some redefined RTTI structures with compiler definitions
  assert(SizeOf(TRttiVarData) = SizeOf(TVarData));
  assert(@PRttiVarData(nil)^.PropValue = @PVarData(nil)^.VAny);
  {$ifdef FPC_OR_UNICODE}
  assert(SizeOf(TRttiRecordField) = SizeOf(TManagedField));
  {$endif FPC_OR_UNICODE}
end;


initialization
  InitializeUnit;


end.