mORMot and Open Source friends
Check-in [8fe7cc53b7]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
SHA1 Hash:8fe7cc53b74f58e0e7178a3df15d4ad8b887f5b4
Date: 2014-05-25 12:22:54
User: User
Comment:added crc32c() function using either optimized unrolled version, or SSE 4.2 instruction: naive rolled crc32c is 325 MB/s, unrolled/asm crc32cfast() is 1.7 GB/s, crc32csse42() is 3.5 GB/s - it is now used as default hashing function (i.e. DefaultHasher global variable)
Tags And Properties
Context
2014-05-25
14:09
[53b574df03] small speed enhancement of crc32csse42() function: now speed is 3.7 GB/s instead of 3.5 GB/s (user: User, tags: trunk)
12:22
[8fe7cc53b7] added crc32c() function using either optimized unrolled version, or SSE 4.2 instruction: naive rolled crc32c is 325 MB/s, unrolled/asm crc32cfast() is 1.7 GB/s, crc32csse42() is 3.5 GB/s - it is now used as default hashing function (i.e. DefaultHasher global variable) (user: User, tags: trunk)
2014-05-24
14:13
[840adacf7c] StrLen() function will now use faster SSE2 instructions on supported CPUs (user: User, tags: trunk)
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to SynCommons.pas.

525
526
527
528
529
530
531


532
533
534
535
536
537
538
....
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
....
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
....
6689
6690
6691
6692
6693
6694
6695
6696

6697
6698
6699
6700
6701

6702
6703
6704































6705
6706
6707
6708
6709
6710
6711
6712
6713
.....
15879
15880
15881
15882
15883
15884
15885
15886
15887

15888
15889
15890
15891
15892
15893
15894
.....
15928
15929
15930
15931
15932
15933
15934






















15935
15936
15937
15938
15939
15940
15941
.....
21046
21047
21048
21049
21050
21051
21052















































































































































































































21053
21054
21055
21056
21057
21058
21059
.....
29682
29683
29684
29685
29686
29687
29688
29689
29690
29691
29692
29693
29694
29695
29696
29697
29698
29699
29700
.....
41440
41441
41442
41443
41444
41445
41446

41447
41448
41449
41450
41451
41452
41453
  - added TSynLog/ISynLog.LogLines() method for direct multi-line text logging
  - added optional TextTruncateAtLength parameter for TSynLog/ISynLog.Log()
  - declared TSynLog.LogInternal() methods as virtual - request [e47c64fb2c]
  - .NET/CLR external exceptions will now be logged with their C# type name
  - special 'SetThreadName' exception will now be ignored by TSynLog hook
  - expose all internal Hash*() functions (following TDynArrayHashOne prototype)
    in interface section of the unit


  - added GetAllBits() function
  - changed GetBitCSV/SetBitCSV CSV format to use 'first-last,' pattern to
    regroup set bits (reduce storage size e.g. for TSQLAccessRights) - format
    is still compatible with old layout, but will more optimized and readable
  - TSynTableStatement.Create() SQL statement parser will handle optional
    LIMIT [OFFSET] clause (in new FoundLimit/FoundOffset integer properties),
    and "SELECT Count() FROM TableName WHERE ..." statement
................................................................................
    /// the internal type information of one element, as retrieved from RTTI
    property ElemType: pointer read fElemType;
  end;

  /// function prototype to be used for hashing of an element
  // - it must return a cardinal hash, with as less collision as possible
  // - a good candidate is our crc32() function in optimized asm in SynZip unit
  // - TDynArrayHashed.Init will use kr32() if no custom function is supplied,
  // which is the standard Kernighan & Ritchie hash function
  THasher = function(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;

  /// function prototype to be used for hashing of a dynamic array element
  // - this function must use the supplied hasher on the Elem data
  TDynArrayHashOne = function(const Elem; Hasher: THasher): cardinal;

  /// event handler to be used for hashing of a dynamic array element
................................................................................
    /// initialize the wrapper with a one-dimension dynamic array
    // - this version accepts some hash-dedicated parameters: aHashElement to
    // set how to hash each element, aCompare to handle hash collision
    // - if no aHashElement is supplied, it will hash according to the RTTI, i.e.
    // strings or binary types, and the first field for records (strings included)
    // - if no aCompare is supplied, it will use default Equals() method
    // - if no THasher function is supplied, it will use the one supplied in
    // DefaultHasher global variable, set to kr32() by default - i.e. the well
    // known Kernighan & Ritchie hash function
    // - if CaseInsensitive is set to TRUE, it will ignore difference in 7 bit
    // alphabetic characters (e.g. compare 'a' and 'A' as equal)
    procedure Init(aTypeInfo: pointer; var aValue;
      aHashElement: TDynArrayHashOne=nil; aCompare: TDynArraySortCompare=nil;
      aHasher: THasher=nil; aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
    /// initialize the wrapper with a one-dimension dynamic array
    // - this version accepts to specify how both hashing and comparison should
................................................................................
// - is faster than CRC32 or Adler32, since use DQWord (128 bytes) aligned read
// - uses RawByteString for binary content hashing, thatever the codepage is
function Hash32(const Text: RawByteString): cardinal; overload;
  {$ifdef HASINLINE}inline;{$endif}

// our custom hash function, specialized for Text comparaison
// - has less colision than Adler32 for short strings
// - is faster than CRC32 or Adler32, since use DQWord (128 bytes) aligned read

// - overloaded version for direct binary content hashing
function Hash32(Data: pointer; Len: integer): cardinal; overload;

/// standard Kernighan & Ritchie hash from "The C programming Language", 3rd edition
// - not the best, but simple and efficient code - perfect for THasher

function kr32(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;

var































  /// the default hasher used by TDynArrayHashed()
  // - is set to kr32() function above
  // - should be set to faster and more accurate crc32() function if available
  // (this is what mORMot.pas unit does in its initialization block) 
  DefaultHasher: THasher;

/// retrieve a particular bit status from a bit array
function GetBit(const Bits; aIndex: PtrInt): boolean;
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}
................................................................................
  for i := j to P2Len-1 do
    if (PByteArray(P1)^[i] xor ord(P2[i])) and $df<>0 then
      exit;
  result := true;
end;

procedure InitSynCommonsConversionTables;
var i: integer;
    v: byte;

{$ifdef OWNNORMTOUPPER}
    d: integer;
const n2u: array[138..255] of byte =
  (83,139,140,141,90,143,144,145,146,147,148,149,150,151,152,153,83,155,140,
   157,90,89,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,
   176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,65,65,65,
   65,65,65,198,67,69,69,69,69,73,73,73,73,68,78,79,79,79,79,79,215,79,85,85,
................................................................................
  for i := ord('A') to ord('F') do begin
    ConvertHexToBin[i] := v;
    ConvertHexToBin[i+(ord('a')-ord('A'))] := v;
    inc(v);
  end;
  // initialize our internaly used TSynAnsiConvert engines
  TSynAnsiConvert.Engine(0);






















end;

var
  StdOut: THandle;

{$ifdef MSWINDOWS}
const
................................................................................
    jnz @1
@z: pop ebp
    pop ebx
    pop esi
    pop edi
end;
{$endif}
















































































































































































































type TWordRec = packed record YDiv100, YMod100: byte; end;

{$ifdef PUREPASCAL}
function Div100(Y: PtrUInt): TWordRec;
{$ifdef HASINLINE}inline;{$endif}
begin
................................................................................
      aHashElement: TDynArrayHashOne=nil; aCompare: TDynArraySortCompare=nil;
      aHasher: THasher=nil; aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
var aKind: TDynArrayKind;
begin
  {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$else}inherited{$endif}
    Init(aTypeInfo,aValue,aCountPointer);
  fEventCompare := nil;
  if @aHasher=nil then begin
    if @DefaultHasher=nil then
      DefaultHasher := @kr32; // set here so that kr32() could be smart-linked
    fHasher := DefaultHasher;
  end else
    fHasher := aHasher;
  if (@aHashElement=nil) or (@aCompare=nil) then begin
    // it's faster to retrieve now the hashing/compare function than in HashOne
    aKind := {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}ToKnownType;
    if @aHashElement=nil then
      aHashElement := DYNARRAY_HASHFIRSTFIELD[aCaseInsensitive,aKind];
    if @aCompare=nil then
................................................................................
    {$ifndef DELPHI5OROLDER}
  if not SupportsSSE2 then // back to default X86 code for older CPUs
    PatchCode(@SynCommons.StrLen,@StrLenX86,STRLEN_SIZE);
    {$endif DELPHI5OROLDER}
   {$endif PUREPASCAL}
  {$endif FPC}
end;


var
  GarbageCollectorFreeAndNilList: TList;
  
procedure GarbageCollectorFree;
type PObject = ^TObject;
var i: integer;







>
>







 







|
|







 







|
|







 







|
>




|
>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|







 







|

>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
<
<
|
<







 







>







525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
....
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
....
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
....
6691
6692
6693
6694
6695
6696
6697
6698
6699
6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
.....
15914
15915
15916
15917
15918
15919
15920
15921
15922
15923
15924
15925
15926
15927
15928
15929
15930
.....
15964
15965
15966
15967
15968
15969
15970
15971
15972
15973
15974
15975
15976
15977
15978
15979
15980
15981
15982
15983
15984
15985
15986
15987
15988
15989
15990
15991
15992
15993
15994
15995
15996
15997
15998
15999
.....
21104
21105
21106
21107
21108
21109
21110
21111
21112
21113
21114
21115
21116
21117
21118
21119
21120
21121
21122
21123
21124
21125
21126
21127
21128
21129
21130
21131
21132
21133
21134
21135
21136
21137
21138
21139
21140
21141
21142
21143
21144
21145
21146
21147
21148
21149
21150
21151
21152
21153
21154
21155
21156
21157
21158
21159
21160
21161
21162
21163
21164
21165
21166
21167
21168
21169
21170
21171
21172
21173
21174
21175
21176
21177
21178
21179
21180
21181
21182
21183
21184
21185
21186
21187
21188
21189
21190
21191
21192
21193
21194
21195
21196
21197
21198
21199
21200
21201
21202
21203
21204
21205
21206
21207
21208
21209
21210
21211
21212
21213
21214
21215
21216
21217
21218
21219
21220
21221
21222
21223
21224
21225
21226
21227
21228
21229
21230
21231
21232
21233
21234
21235
21236
21237
21238
21239
21240
21241
21242
21243
21244
21245
21246
21247
21248
21249
21250
21251
21252
21253
21254
21255
21256
21257
21258
21259
21260
21261
21262
21263
21264
21265
21266
21267
21268
21269
21270
21271
21272
21273
21274
21275
21276
21277
21278
21279
21280
21281
21282
21283
21284
21285
21286
21287
21288
21289
21290
21291
21292
21293
21294
21295
21296
21297
21298
21299
21300
21301
21302
21303
21304
21305
21306
21307
21308
21309
21310
21311
21312
21313
21314
21315
21316
21317
21318
21319
21320
21321
21322
21323
21324
.....
29947
29948
29949
29950
29951
29952
29953
29954


29955

29956
29957
29958
29959
29960
29961
29962
.....
41702
41703
41704
41705
41706
41707
41708
41709
41710
41711
41712
41713
41714
41715
41716
  - added TSynLog/ISynLog.LogLines() method for direct multi-line text logging
  - added optional TextTruncateAtLength parameter for TSynLog/ISynLog.Log()
  - declared TSynLog.LogInternal() methods as virtual - request [e47c64fb2c]
  - .NET/CLR external exceptions will now be logged with their C# type name
  - special 'SetThreadName' exception will now be ignored by TSynLog hook
  - expose all internal Hash*() functions (following TDynArrayHashOne prototype)
    in interface section of the unit
  - added crc32c() function using either optimized unrolled version, or SSE 4.2
    instruction: crc32cfast() is 1.7 GB/s, crc32csse42() is 3.5 GB/s
  - added GetAllBits() function
  - changed GetBitCSV/SetBitCSV CSV format to use 'first-last,' pattern to
    regroup set bits (reduce storage size e.g. for TSQLAccessRights) - format
    is still compatible with old layout, but will more optimized and readable
  - TSynTableStatement.Create() SQL statement parser will handle optional
    LIMIT [OFFSET] clause (in new FoundLimit/FoundOffset integer properties),
    and "SELECT Count() FROM TableName WHERE ..." statement
................................................................................
    /// the internal type information of one element, as retrieved from RTTI
    property ElemType: pointer read fElemType;
  end;

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

  /// function prototype to be used for hashing of a dynamic array element
  // - this function must use the supplied hasher on the Elem data
  TDynArrayHashOne = function(const Elem; Hasher: THasher): cardinal;

  /// event handler to be used for hashing of a dynamic array element
................................................................................
    /// initialize the wrapper with a one-dimension dynamic array
    // - this version accepts some hash-dedicated parameters: aHashElement to
    // set how to hash each element, aCompare to handle hash collision
    // - if no aHashElement is supplied, it will hash according to the RTTI, i.e.
    // strings or binary types, and the first field for records (strings included)
    // - if no aCompare is supplied, it will use default Equals() method
    // - if no THasher function is supplied, it will use the one supplied in
    // DefaultHasher global variable, set to crc32c() by default - using
    // SSE4.2 instruction if available
    // - if CaseInsensitive is set to TRUE, it will ignore difference in 7 bit
    // alphabetic characters (e.g. compare 'a' and 'A' as equal)
    procedure Init(aTypeInfo: pointer; var aValue;
      aHashElement: TDynArrayHashOne=nil; aCompare: TDynArraySortCompare=nil;
      aHasher: THasher=nil; aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
    /// initialize the wrapper with a one-dimension dynamic array
    // - this version accepts to specify how both hashing and comparison should
................................................................................
// - is faster than CRC32 or Adler32, since use DQWord (128 bytes) aligned read
// - uses RawByteString for binary content hashing, thatever the codepage is
function Hash32(const Text: RawByteString): cardinal; overload;
  {$ifdef HASINLINE}inline;{$endif}

// our custom hash function, specialized for Text comparaison
// - has less colision than Adler32 for short strings
// - is faster than CRC32 or Adler32, since use DQWord (128 bytes) aligned read:
// Hash32() is 2.5 GB/s, kr32() 0.9 GB/s, crc32c() 1.7 GB/s or 3.5 GB/s (SSE4.2)
// - overloaded version for direct binary content hashing
function Hash32(Data: pointer; Len: integer): cardinal; overload;

/// standard Kernighan & Ritchie hash from "The C programming Language", 3rd edition
// - not the best, but simple and efficient code - good candidate for THasher
// - kr32() is 898.8 MB/s - crc32cfast() 1.7 GB/s, crc32csse42() 3.5 GB/s
function kr32(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;

var
  /// tables used by crc32cfast() function
  // - created with a polynom diverse from zlib's crc32() algorithm, but
  // compatible with SSE 4.2 crc32 instruction
  // - tables content is created from code in initialization section below
  crc32ctab: array[0..{$ifdef PUREPASCAL}3{$else}7{$endif},byte] of cardinal;

/// compute CRC32C checksum on the supplied buffer
// - result is compatible with SSE 4.2 based hardware accelerated instruction
// - result is not compatible with zlib's crc32() - not the same polynom
// - crc32cfast() is 1.7 GB/s, crc32csse42() is 3.5 GB/s
function crc32cfast(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;

{$ifndef PUREPASCAL}
/// returns TRUE if Intel Streaming SIMD Extensions 4.2 is available
function SupportSSE42: boolean;

/// compute CRC32C checksum on the supplied buffer using SSE 4.2
// - use Intel Streaming SIMD Extensions 4.2 hardware accelerated instruction 
// - SSE 4.2 shall be available on the processor (checked with SupportSSE42)
// - result is not compatible with zlib's crc32() - not the same polynom
// - crc32cfast() is 1.7 GB/s, crc32csse42() is 3.5 GB/s
function crc32csse42(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$endif}

var
  /// compute CRC32C checksum on the supplied buffer
  // - this variable will use the fastest mean available, e.g. SSE 4.2
  // - you should use this function instead of crc32cfast() nor crc32csse42()
  crc32c: THasher;

var
  /// the default hasher used by TDynArrayHashed()
  // - is set to crc32c() function above
  // - should be set to faster and more accurate crc32() function if available
  // (this is what mORMot.pas unit does in its initialization block) 
  DefaultHasher: THasher;

/// retrieve a particular bit status from a bit array
function GetBit(const Bits; aIndex: PtrInt): boolean;
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}
................................................................................
  for i := j to P2Len-1 do
    if (PByteArray(P1)^[i] xor ord(P2[i])) and $df<>0 then
      exit;
  result := true;
end;

procedure InitSynCommonsConversionTables;
var i,n: integer;
    v: byte;
    crc: cardinal;
{$ifdef OWNNORMTOUPPER}
    d: integer;
const n2u: array[138..255] of byte =
  (83,139,140,141,90,143,144,145,146,147,148,149,150,151,152,153,83,155,140,
   157,90,89,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,
   176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,65,65,65,
   65,65,65,198,67,69,69,69,69,73,73,73,73,68,78,79,79,79,79,79,215,79,85,85,
................................................................................
  for i := ord('A') to ord('F') do begin
    ConvertHexToBin[i] := v;
    ConvertHexToBin[i+(ord('a')-ord('A'))] := v;
    inc(v);
  end;
  // initialize our internaly used TSynAnsiConvert engines
  TSynAnsiConvert.Engine(0);
  // initialize tables for crc32cfast()
  for i := 0 to 255 do begin
    crc := i;
    for n := 1 to 8 do
      if (crc and 1)<>0 then // polynom is not the same as with zlib's crc32()
        crc := (crc shr 1) xor $82f63b78 else
        crc := crc shr 1;
    crc32ctab[0,i] := crc;
  end;
  for i := 0 to 255 do begin
    crc := crc32ctab[0,i];
    for n := 1 to high(crc32ctab) do begin
      crc := (crc shr 8) xor crc32ctab[0,byte(crc)];
      crc32ctab[n,i] := crc;
    end;
  end;
{$ifndef PUREPASCAL}
  if SupportSSE42 then
    crc32c := @crc32csse42 else
{$endif PUREPASCAL}
    crc32c := @crc32cfast;
  DefaultHasher := crc32c;
end;

var
  StdOut: THandle;

{$ifdef MSWINDOWS}
const
................................................................................
    jnz @1
@z: pop ebp
    pop ebx
    pop esi
    pop edi
end;
{$endif}

function crc32cfast(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$ifdef PUREPASCAL}
begin
  result := not crc;
  if (buf<>nil) and (len>0) then begin
    repeat
      if PtrUInt(buf) and 3=0 then // align to 4 bytes boundary
        break;
      result := crc32ctab[0,byte(result xor ord(buf^))] xor (result shr 8);
      dec(len);
      inc(buf);
    until len=0;
    while len>=4 do begin
      result := result xor PCardinal(buf)^;
      inc(buf,4);
      result := crc32ctab[3,byte(result)] xor
                crc32ctab[2,byte(result shr 8)] xor
                crc32ctab[1,byte(result shr 16)] xor
                crc32ctab[0,result shr 24];
      dec(len,4);
    end;
    while len>0 do begin
      result := crc32ctab[0,byte(result xor ord(buf^))] xor (result shr 8);
      dec(len);
      inc(buf);
    end;
  end;
  result := not result;
end;
{$else}
// adapted from fast Aleksandr Sharahov version
asm
  test edx, edx
  jz   @ret
  neg  ecx
  jz   @ret
  not eax
  push ebx
@head:
  test dl,3
  jz   @bodyinit
  movzx ebx, byte [edx]
  inc  edx
  xor  bl, al
  shr  eax, 8
  xor  eax,dword ptr [ebx*4 + crc32ctab]
  inc  ecx
  jnz  @head
  pop  ebx
  not eax
@ret:
  ret
@bodyinit:
  sub  edx, ecx
  add  ecx, 8
  jg   @bodydone
  push esi
  push edi
  mov  edi, edx
  mov  edx, eax
@bodyloop:
  mov ebx, [edi + ecx - 4]
  xor edx, [edi + ecx - 8]
  movzx esi, bl
  mov eax,dword ptr [esi*4 + crc32ctab + 1024*3]
  movzx esi, bh
  xor eax,dword ptr [esi*4 + crc32ctab + 1024*2]
  shr ebx, 16
  movzx esi, bl
  xor eax,dword ptr [esi*4 + crc32ctab + 1024*1]
  movzx esi, bh
  xor eax,dword ptr [esi*4 + crc32ctab + 1024*0]
  movzx esi, dl
  xor eax,dword ptr [esi*4 + crc32ctab + 1024*7]
  movzx esi, dh
  xor eax,dword ptr [esi*4 + crc32ctab + 1024*6]
  shr edx, 16
  movzx esi, dl
  xor eax,dword ptr [esi*4 + crc32ctab + 1024*5]
  movzx esi, dh
  xor eax,dword ptr [esi*4 + crc32ctab + 1024*4]
  add ecx, 8
  jg  @done
  mov ebx, [edi + ecx - 4]
  xor eax, [edi + ecx - 8]
  movzx esi, bl
  mov edx,dword ptr [esi*4 + crc32ctab + 1024*3]
  movzx esi, bh
  xor edx,dword ptr [esi*4 + crc32ctab + 1024*2]
  shr ebx, 16
  movzx esi, bl
  xor edx,dword ptr [esi*4 + crc32ctab + 1024*1]
  movzx esi, bh
  xor edx,dword ptr [esi*4 + crc32ctab + 1024*0]
  movzx esi, al
  xor edx,dword ptr [esi*4 + crc32ctab + 1024*7]
  movzx esi, ah
  xor edx,dword ptr [esi*4 + crc32ctab + 1024*6]
  shr eax, 16
  movzx esi, al
  xor edx,dword ptr [esi*4 + crc32ctab + 1024*5]
  movzx esi, ah
  xor edx,dword ptr [esi*4 + crc32ctab + 1024*4]
  add ecx, 8
  jle @bodyloop
  mov eax, edx
@done:
  mov edx, edi
  pop edi
  pop esi
@bodydone:
  sub ecx, 8
  jl @tail
  pop ebx
  not eax
  ret
@tail:
  movzx ebx, byte [edx + ecx]
  xor bl,al
  shr eax,8
  xor eax,dword ptr [ebx*4 + crc32ctab]
  inc ecx
  jnz @tail
  pop ebx
  not eax
end;

function SupportSSE42: boolean;
asm
    {$ifndef CPUX64}
    pushfd
    pop eax
    mov edx,eax
    xor eax,$200000
    push eax
    popfd
    pushfd
    pop eax
    xor eax,edx
    jz @0
    {$endif}
    push ebx
    mov eax,1
    cpuid
    test edx,$100000
    setz al
    pop ebx
    ret
@0: xor eax,eax
end;

function crc32csse42(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
asm // eax=crc, edx=buf, ecx=len
    push esi
    push ebx
    mov esi,edx
    not eax
    test ecx,ecx; jz @0
    test esi,esi; jz @0
@7: test esi,7 // align to 8 bytes boundary
    jz @8
    {$ifdef ISDELPHI2010}
    crc32 dword ptr eax,byte ptr [esi]
    {$else}
    db $F2,$0F,$38,$F0,$06
    {$endif}
    inc esi
    dec ecx; jz @0
    test esi,7; jnz @7
@8: mov ebx,ecx
    shr ecx,2
    xor edx,edx
    test ecx,ecx; jz @2
@1: {$ifdef ISDELPHI2010}
    crc32 dword ptr eax,dword ptr [edx*4+esi]
    {$else}
    db $F2,$0F,$38,$F1,$04,$96
    {$endif}
    inc edx
    cmp edx,ecx
    jb @1
@2: and ebx,3
    lea esi,edx*4+esi
    jz @0
    {$ifdef ISDELPHI2010}
    crc32 dword ptr eax,byte ptr [esi]
    dec ebx; jz @0
    crc32 dword ptr eax,byte ptr [esi+1]
    dec ebx; jz @0
    crc32 dword ptr eax,byte ptr [esi+2]
    dec ebx; jz @0
    crc32 dword ptr eax,byte ptr [esi+3]
    {$else}
    db $F2,$0F,$38,$F0,$06
    dec ebx; jz @0
    db $F2,$0F,$38,$F0,$46,$01
    dec ebx; jz @0
    db $F2,$0F,$38,$F0,$46,$02
    dec ebx; jz @0
    db $F2,$0F,$38,$F0,$46,$03
    {$endif}
@0: not eax
    pop ebx
    pop esi
end;
{$endif PUREPASCAL}

type TWordRec = packed record YDiv100, YMod100: byte; end;

{$ifdef PUREPASCAL}
function Div100(Y: PtrUInt): TWordRec;
{$ifdef HASINLINE}inline;{$endif}
begin
................................................................................
      aHashElement: TDynArrayHashOne=nil; aCompare: TDynArraySortCompare=nil;
      aHasher: THasher=nil; aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
var aKind: TDynArrayKind;
begin
  {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$else}inherited{$endif}
    Init(aTypeInfo,aValue,aCountPointer);
  fEventCompare := nil;
  if @aHasher=nil then


    fHasher := DefaultHasher else

    fHasher := aHasher;
  if (@aHashElement=nil) or (@aCompare=nil) then begin
    // it's faster to retrieve now the hashing/compare function than in HashOne
    aKind := {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}ToKnownType;
    if @aHashElement=nil then
      aHashElement := DYNARRAY_HASHFIRSTFIELD[aCaseInsensitive,aKind];
    if @aCompare=nil then
................................................................................
    {$ifndef DELPHI5OROLDER}
  if not SupportsSSE2 then // back to default X86 code for older CPUs
    PatchCode(@SynCommons.StrLen,@StrLenX86,STRLEN_SIZE);
    {$endif DELPHI5OROLDER}
   {$endif PUREPASCAL}
  {$endif FPC}
end;


var
  GarbageCollectorFreeAndNilList: TList;
  
procedure GarbageCollectorFree;
type PObject = ^TObject;
var i: integer;

Changes to SynDB.pas.

6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
var i: integer;
begin
  with CheckParam(Param,ftDate,paramIn,length(Values))^ do
    for i := 0 to high(Values) do
      VArray[i] := ''''+DateTimeToIso8601Text(Values[i])+'''';
end;

procedure TSQLDBStatementWithParams.BindArrayRowPrepare(const aParamTypes: array of TSQLDBFieldType;
  aExpectedMinimalRowCount: integer=0);
var i: integer;
begin
  fParam.Count := 0;
  for i := 0 to high(aParamTypes) do
    CheckParam(i+1,aParamTypes[i],paramIn,aExpectedMinimalRowCount);
  fParamsArrayCount := 0;
end;







|
|







6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
var i: integer;
begin
  with CheckParam(Param,ftDate,paramIn,length(Values))^ do
    for i := 0 to high(Values) do
      VArray[i] := ''''+DateTimeToIso8601Text(Values[i])+'''';
end;

procedure TSQLDBStatementWithParams.BindArrayRowPrepare(
  const aParamTypes: array of TSQLDBFieldType; aExpectedMinimalRowCount: integer);
var i: integer;
begin
  fParam.Count := 0;
  for i := 0 to high(aParamTypes) do
    CheckParam(i+1,aParamTypes[i],paramIn,aExpectedMinimalRowCount);
  fParamsArrayCount := 0;
end;

Changes to SynSelfTests.pas.

188
189
190
191
192
193
194


195
196
197
198
199
200
201
....
2174
2175
2176
2177
2178
2179
2180


































































2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191

2192
2193
2194
2195
2196
2197
2198
....
2263
2264
2265
2266
2267
2268
2269



2270
2271
2272
2273
2274
2275
2276
....
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
....
6019
6020
6021
6022
6023
6024
6025

6026
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
....
7279
7280
7281
7282
7283
7284
7285
7286

7287
7288
7289
7290
7291
7292
7293
    procedure _IsMatch;
    /// the Soundex search feature (i.e. TSynSoundex and all related
    // functions)
    procedure Soundex;
    /// low level fast Integer or Floating-Point to/from string conversion
    // - especially the RawUTF8 or PUTF8Char relative versions
    procedure NumericalConversions;


    /// the new fast Currency to/from string conversion
    procedure Curr64;
    /// the camel-case / camel-uncase features, used for i18n from Delphi RTII
    procedure _CamelCase;
    /// the low-level bit management functions
    procedure Bits;
    /// the fast .ini file content direct access
................................................................................
  {$define EXTENDEDTOSTRING_USESTR} // FloatToText() maps str() in FPC
{$endif}

{$ifdef CPU64}
  {$define EXTENDEDTOSTRING_USESTR} // FloatToText() slower in x64
{$endif}



































































procedure TTestLowLevelCommon.NumericalConversions;
var i, j, b, err: integer;
    juint: cardinal absolute j;
    k,l: Int64;
    s: RawUTF8;
    d,e: double;
    a: shortstring;
    u: string;
    varint: array[0..17] of byte;
    PB,PC: PByte;
    P: PUTF8Char;

begin
  Check(IntToThousandString(0)='0');
  Check(IntToThousandString(1)='1');
  Check(IntToThousandString(10)='10');
  Check(IntToThousandString(100)='100');
  Check(IntToThousandString(1000)='1,000');
  Check(IntToThousandString(10000)='10,000');
................................................................................
  DecimalSeparator := '.';
{$endif}
  for i := 0 to 10000 do begin
    j := Random(maxInt)-Random(maxInt);
    str(j,a);
    s := RawUTF8(a);
    Check(kr32(0,pointer(s),length(s))=kr32pas(pointer(s),length(s)));



    u := string(a);
    Check(SysUtils.IntToStr(j)=u);
    Check(Int32ToUtf8(j)=s);
    Check(format('%d',[j])=u);
    Check(GetInteger(pointer(s))=j);
{$ifndef DELPHI5OROLDER}
    Check(FormatUTF8('%',[j])=s);
................................................................................
procedure TTestCompression.CleanUp;
begin
  FreeAndNil(M);
end;

const
  // uses a const table instead of a dynamic array, for better regression test
  crc32Tab: array[byte] of cardinal =
    ($00000000, $77073096, $EE0E612C, $990951BA,
    $076DC419, $706AF48F, $E963A535, $9E6495A3,
    $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
    $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
    $1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
    $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
    $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
................................................................................
    $A7672661, $D06016F7, $4969474D, $3E6E77DB,
    $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
    $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
    $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
    $BAD03605, $CDD70693, $54DE5729, $23D967BF,
    $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
    $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);

function UpdateCrc32(aCRC32: cardinal; inBuf: pointer; inLen: integer) : cardinal;
var i: integer;
begin // slowest but always accurate version
  result := not aCRC32;
  for i := 1 to inLen do begin
    result := crc32Tab[byte(result xor pByte(inBuf)^)] xor (result shr 8);
    inc(PByte(inBuf));
  end;
  result := not result;
end;

procedure TTestCompression.GZipFormat;
var Z: TSynZipCompressor;
    L,n: integer;
    P: PAnsiChar;
    crc2: Cardinal;
    s: RawByteString;
begin
  Check(crc32(0,@crc32Tab,5)=$DF4EC16C,'crc32');
  Check(UpdateCrc32(0,@crc32Tab,5)=$DF4EC16C,'crc32');
  Check(crc32(0,@crc32Tab,1024)=$6FCF9E13,'crc32');
  Check(UpdateCrc32(0,@crc32Tab,1024)=$6FCF9E13);
  Check(crc32(0,@crc32Tab,1024-5)=$70965738,'crc32');
  Check(UpdateCrc32(0,@crc32Tab,1024-5)=$70965738);
  Check(crc32(0,pointer(PtrInt(@crc32Tab)+1),2)=$41D912FF,'crc32');
  Check(UpdateCrc32(0,pointer(PtrInt(@crc32Tab)+1),2)=$41D912FF);
  Check(crc32(0,pointer(PtrInt(@crc32Tab)+3),1024-5)=$E5FAEC6C,'crc32');
  Check(UpdateCrc32(0,pointer(PtrInt(@crc32Tab)+3),1024-5)=$E5FAEC6C);
  M := SynCommons.THeapMemoryStream.Create;
  Z := TSynZipCompressor.Create(M,6,szcfGZ);
  L := length(Data);
  P := Pointer(Data);
  crc := 0;
  crc2 := 0;
  while L<>0 do begin
................................................................................
      Check(Hash32(TSQLTableJSON(Resp).PrivateInternalCopy)=$8D727024);
    finally
      Resp.Free;
    end;
  end;
{$ifdef WTIME}
  fRunConsole := format('%sdone %s i.e. %d/s, aver. %s, %s/s',
    [fRunConsole,Timer.Stop,Timer.PerSec(LOOP),Timer.ByCount(LOOP),KB(Timer.PerSec(4898*(LOOP+1)))]);

{$endif}
end;

procedure TTestClientServerAccess.HttpClientKeepAlive;
begin
  (Client as TSQLHttpClientGeneric).KeepAliveMS := 20000;
  (Client as TSQLHttpClientGeneric).Compression := [];







>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>











>







 







>
>
>







 







|







 







>





|












|
|
|
|
|
|
|
|
|
|







 







|
>







188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
....
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
....
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
....
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
....
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
6119
6120
6121
6122
6123
6124
6125
6126
6127
6128
6129
6130
6131
6132
6133
....
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
7366
7367
    procedure _IsMatch;
    /// the Soundex search feature (i.e. TSynSoundex and all related
    // functions)
    procedure Soundex;
    /// low level fast Integer or Floating-Point to/from string conversion
    // - especially the RawUTF8 or PUTF8Char relative versions
    procedure NumericalConversions;
    /// test crc32c in both software and hardware (SSE4.2) implementations
    procedure _crc32c;
    /// the new fast Currency to/from string conversion
    procedure Curr64;
    /// the camel-case / camel-uncase features, used for i18n from Delphi RTII
    procedure _CamelCase;
    /// the low-level bit management functions
    procedure Bits;
    /// the fast .ini file content direct access
................................................................................
  {$define EXTENDEDTOSTRING_USESTR} // FloatToText() maps str() in FPC
{$endif}

{$ifdef CPU64}
  {$define EXTENDEDTOSTRING_USESTR} // FloatToText() slower in x64
{$endif}



function crc32cpas(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
begin
  result := not crc;
  if buf<>nil then
    while len>0 do begin
      result := crc32ctab[0,byte(result xor ord(buf^))] xor (result shr 8);
      dec(len);
      inc(buf);
    end;
  result := not result;
end;

procedure TTestLowLevelCommon._crc32c;
var crc: array[0..10000] of record
      s: RawByteString;
      crc: cardinal;
    end;
    totallen: Cardinal;
procedure Test(hash: THasher; const name: string);
var i: Integer;
    Timer: TPrecisionTimer;
    a: string[10];
begin
  Timer.Start;
  a := '123456789';
  Check(hash(0,@a,0)=0);
  Check(hash(0,@a,1)=$2ACF889D);
  Check(hash(0,@a,2)=$BD5FE6AF);
  Check(hash(0,@a,3)=$7F40BC73);
  Check(hash(0,@a,4)=$13790E51);
  Check(hash(0,@a,5)=$659AD21);
  Check(hash(0,@a,6)=$85BF5A8C);
  Check(hash(0,@a,7)=$8B0FB6FA);
  Check(hash(0,@a,8)=$2E5336F0);
  for i := 0 to High(crc) do
    with crc[i] do
      Check(hash(0,pointer(s),length(s))=crc);
  fRunConsole := format('%s %s %s %s/s',[fRunConsole,name,Timer.Stop,
    KB(Timer.PerSec(totallen))]);
end;
var i: integer;
//Timer: TPrecisionTimer;
begin
  totallen := 36;
  for i := 0 to High(crc) do
  with crc[i] do begin
    s := RandomString(i shr 3+1);
    crc := crc32cpas(0,pointer(s),length(s));
    inc(totallen,length(s));
  end;
  Test(crc32cpas,'pas');
  Test(crc32cfast,'fast');
  {$ifndef PUREPASCAL}
  if SupportSSE42 then
    Test(crc32csse42,'sse42');
  {$endif}
//  Timer.Start;
//  for i := 0 to high(crc) do
//    with crc[i] do
//      Hash32(pointer(s),length(s));
//  fRunConsole := format('%s Hash32 %s %s/s',[fRunConsole,Timer.Stop,
//    KB(Timer.PerSec(totallen))]);
end;

procedure TTestLowLevelCommon.NumericalConversions;
var i, j, b, err: integer;
    juint: cardinal absolute j;
    k,l: Int64;
    s: RawUTF8;
    d,e: double;
    a: shortstring;
    u: string;
    varint: array[0..17] of byte;
    PB,PC: PByte;
    P: PUTF8Char;
    crc: cardinal;
begin
  Check(IntToThousandString(0)='0');
  Check(IntToThousandString(1)='1');
  Check(IntToThousandString(10)='10');
  Check(IntToThousandString(100)='100');
  Check(IntToThousandString(1000)='1,000');
  Check(IntToThousandString(10000)='10,000');
................................................................................
  DecimalSeparator := '.';
{$endif}
  for i := 0 to 10000 do begin
    j := Random(maxInt)-Random(maxInt);
    str(j,a);
    s := RawUTF8(a);
    Check(kr32(0,pointer(s),length(s))=kr32pas(pointer(s),length(s)));
    crc := crc32cpas(0,pointer(s),length(s));
    Check(crc32cfast(0,pointer(s),length(s))=crc);
    Check(crc32c(0,pointer(s),length(s))=crc);
    u := string(a);
    Check(SysUtils.IntToStr(j)=u);
    Check(Int32ToUtf8(j)=s);
    Check(format('%d',[j])=u);
    Check(GetInteger(pointer(s))=j);
{$ifndef DELPHI5OROLDER}
    Check(FormatUTF8('%',[j])=s);
................................................................................
procedure TTestCompression.CleanUp;
begin
  FreeAndNil(M);
end;

const
  // uses a const table instead of a dynamic array, for better regression test
  crc32tab: array[byte] of cardinal =
    ($00000000, $77073096, $EE0E612C, $990951BA,
    $076DC419, $706AF48F, $E963A535, $9E6495A3,
    $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
    $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
    $1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
    $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
    $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
................................................................................
    $A7672661, $D06016F7, $4969474D, $3E6E77DB,
    $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
    $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
    $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
    $BAD03605, $CDD70693, $54DE5729, $23D967BF,
    $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
    $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);

function UpdateCrc32(aCRC32: cardinal; inBuf: pointer; inLen: integer) : cardinal;
var i: integer;
begin // slowest but always accurate version
  result := not aCRC32;
  for i := 1 to inLen do begin
    result := crc32tab[byte(result xor pByte(inBuf)^)] xor (result shr 8);
    inc(PByte(inBuf));
  end;
  result := not result;
end;

procedure TTestCompression.GZipFormat;
var Z: TSynZipCompressor;
    L,n: integer;
    P: PAnsiChar;
    crc2: Cardinal;
    s: RawByteString;
begin
  Check(crc32(0,@crc32tab,5)=$DF4EC16C,'crc32');
  Check(UpdateCrc32(0,@crc32tab,5)=$DF4EC16C,'crc32');
  Check(crc32(0,@crc32tab,1024)=$6FCF9E13,'crc32');
  Check(UpdateCrc32(0,@crc32tab,1024)=$6FCF9E13);
  Check(crc32(0,@crc32tab,1024-5)=$70965738,'crc32');
  Check(UpdateCrc32(0,@crc32tab,1024-5)=$70965738);
  Check(crc32(0,pointer(PtrInt(@crc32tab)+1),2)=$41D912FF,'crc32');
  Check(UpdateCrc32(0,pointer(PtrInt(@crc32tab)+1),2)=$41D912FF);
  Check(crc32(0,pointer(PtrInt(@crc32tab)+3),1024-5)=$E5FAEC6C,'crc32');
  Check(UpdateCrc32(0,pointer(PtrInt(@crc32tab)+3),1024-5)=$E5FAEC6C);
  M := SynCommons.THeapMemoryStream.Create;
  Z := TSynZipCompressor.Create(M,6,szcfGZ);
  L := length(Data);
  P := Pointer(Data);
  crc := 0;
  crc2 := 0;
  while L<>0 do begin
................................................................................
      Check(Hash32(TSQLTableJSON(Resp).PrivateInternalCopy)=$8D727024);
    finally
      Resp.Free;
    end;
  end;
{$ifdef WTIME}
  fRunConsole := format('%sdone %s i.e. %d/s, aver. %s, %s/s',
    [fRunConsole,Timer.Stop,Timer.PerSec(LOOP),Timer.ByCount(LOOP),
     KB(Timer.PerSec(4898*(LOOP+1)))]);
{$endif}
end;

procedure TTestClientServerAccess.HttpClientKeepAlive;
begin
  (Client as TSQLHttpClientGeneric).KeepAliveMS := 20000;
  (Client as TSQLHttpClientGeneric).Compression := [];