X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fhashtable.pas;h=997a1dde3366dc8b2c7e18185ae093b23f52f4e4;hb=987c4a835a103345b59937e8e1be8524a6228712;hp=33920a176e70261225a843d9ffc0dd0cb7663937;hpb=8eea4becb53e1531c8d539c37a2809a8de9965b2;p=d2df-sdl.git

diff --git a/src/shared/hashtable.pas b/src/shared/hashtable.pas
index 33920a1..997a1dd 100644
--- a/src/shared/hashtable.pas
+++ b/src/shared/hashtable.pas
@@ -1,9 +1,8 @@
-(* Copyright (C)  DooM 2D:Forever Developers
+(* Copyright (C)  Doom 2D: Forever Developers
  *
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
+ * the Free Software Foundation, version 3 of the License ONLY.
  *
  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -194,6 +193,14 @@ type
     class procedure freekey (var k: AnsiString); inline;
   end;
 
+  // case-insensitive (ansi)
+  THashKeyStrAnsiCI = class
+  public
+    class function hash (const k: AnsiString): LongWord; inline;
+    class function equ (const a, b: AnsiString): Boolean; inline;
+    class procedure freekey (var k: AnsiString); inline;
+  end;
+
 type
   THashIntInt = specialize THashBase<Integer, Integer, THashKeyInt>;
   THashStrInt = specialize THashBase<AnsiString, Integer, THashKeyStr>;
@@ -204,7 +211,7 @@ type
 
 function u32Hash (a: LongWord): LongWord; inline;
 function fnvHash (constref buf; len: LongWord): LongWord;
-function joaatHash (constref buf; len: LongWord): LongWord;
+function joaatHash (constref buf; len: LongWord; seed: LongWord=0): LongWord;
 
 // has to be public due to FPC generics limitation
 function nextPOTU32 (x: LongWord): LongWord; inline;
@@ -281,17 +288,30 @@ end;
 {$POP}
 
 
-function joaatHash (constref buf; len: LongWord): LongWord;
+// ////////////////////////////////////////////////////////////////////////// //
+{$PUSH}
+{$RANGECHECKS OFF}
+function joaatHash (constref buf; len: LongWord; seed: LongWord=0): LongWord;
 var
-  h: TJoaatHasher;
+  b: PByte;
+  f: LongWord;
 begin
-  h := TJoaatHasher.Create(0);
-  h.put(PByte(@buf)^, len);
-  result := h.value;
+  result := seed;
+  b := PByte(@buf);
+  for f := 1 to len do
+  begin
+    result += b^;
+    result += (result shl 10);
+    result := result xor (result shr 6);
+    Inc(b);
+  end;
+  // finalize
+  result += (result shl 3);
+  result := result xor (result shr 11);
+  result += (result shl 15);
 end;
+{$POP}
 
-
-// ////////////////////////////////////////////////////////////////////////// //
 {$PUSH}
 {$RANGECHECKS OFF}
 // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
@@ -311,7 +331,6 @@ begin
 end;
 {$POP}
 
-
 {$PUSH}
 {$RANGECHECKS OFF}
 function u32Hash (a: LongWord): LongWord; inline;
@@ -327,6 +346,29 @@ begin
 end;
 {$POP}
 
+function locase1251 (ch: AnsiChar): AnsiChar; inline;
+begin
+  if ch < #128 then
+  begin
+    if (ch >= 'A') and (ch <= 'Z') then Inc(ch, 32);
+  end
+  else
+  begin
+    if (ch >= #192) and (ch <= #223) then
+    begin
+      Inc(ch, 32);
+    end
+    else
+    begin
+      case ch of
+        #168, #170, #175: Inc(ch, 16);
+        #161, #178: Inc(ch);
+      end;
+    end;
+  end;
+  result := ch;
+end;
+
 
 // ////////////////////////////////////////////////////////////////////////// //
 // THashKeyInt
@@ -353,6 +395,42 @@ class function THashKeyStr.equ (const a, b: AnsiString): Boolean; inline; begin
 class procedure THashKeyStr.freekey (var k: AnsiString); inline; begin k := ''; end;
 
 
+// ////////////////////////////////////////////////////////////////////////// //
+// case-insensitive (ansi)
+{$PUSH}
+{$RANGECHECKS OFF}
+// fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/
+function fnvHashLo (constref buf; len: LongWord): LongWord;
+var
+  b: PAnsiChar;
+begin
+  b := @buf;
+  result := 2166136261; // fnv offset basis
+  while (len > 0) do
+  begin
+    result := result xor Byte(locase1251(b^));
+    result := result*16777619; // 32-bit fnv prime
+    Inc(b);
+    Dec(len);
+  end;
+end;
+{$POP}
+
+class function THashKeyStrAnsiCI.hash (const k: AnsiString): LongWord; inline; begin if (Length(k) > 0) then result := fnvHash((@k[1])^, Length(k)) else result := 0; end;
+class function THashKeyStrAnsiCI.equ (const a, b: AnsiString): Boolean; inline;
+var
+  f: Integer;
+begin
+  result := false;
+  if (Length(a) = Length(b)) then
+  begin
+    for f := 1 to Length(a) do if (locase1251(a[f]) <> locase1251(b[f])) then exit;
+  end;
+  result := true;
+end;
+class procedure THashKeyStrAnsiCI.freekey (var k: AnsiString); inline; begin k := ''; end;
+
+
 // ////////////////////////////////////////////////////////////////////////// //
 function THashBase.TEntry.getEmpty (): Boolean; inline; begin result := (hash = 0); end;
 
@@ -366,6 +444,7 @@ begin
   freevalfn := afreevalfn;
   mSeed := u32Hash($29a);
 
+  mFreeEntryHead := nil;
   mFirstEntry := -1;
   mLastEntry := -1;
   clear();
@@ -374,6 +453,7 @@ end;
 
 destructor THashBase.Destroy ();
 begin
+  freeEntries();
   mBuckets := nil;
   mEntries := nil;
   inherited;
@@ -414,14 +494,19 @@ end;
 
 
 procedure THashBase.clear ();
-//var idx: Integer;
 begin
   freeEntries();
+  {
   SetLength(mBuckets, InitSize);
   FillChar(mBuckets[0], InitSize*sizeof(mBuckets[0]), 0);
-  //for idx := 0 to High(mBuckets) do mBuckets[idx] := nil;
   SetLength(mEntries, InitSize);
   FillChar(mEntries[0], InitSize*sizeof(mEntries[0]), 0);
+  }
+  mFreeEntryHead := nil;
+  mBuckets := nil;
+  mEntries := nil;
+  mFirstEntry := -1;
+  mLastEntry := -1;
   mBucketsUsed := 0;
 end;
 
@@ -445,6 +530,21 @@ var
 begin
   if (mFreeEntryHead = nil) then
   begin
+    // nothing was allocated, so allocate something now
+    if (Length(mBuckets) = 0) then
+    begin
+      assert(Length(mEntries) = 0);
+      assert(mFirstEntry = -1);
+      assert(mLastEntry = -1);
+      assert(mBucketsUsed = 0);
+      {$IFDEF RBHASH_SANITY_CHECKS}
+      mEntriesUsed := 0;
+      {$ENDIF}
+      SetLength(mBuckets, InitSize);
+      FillChar(mBuckets[0], InitSize*sizeof(mBuckets[0]), 0);
+      SetLength(mEntries, InitSize);
+      FillChar(mEntries[0], InitSize*sizeof(mEntries[0]), 0);
+    end;
     if (mLastEntry = High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (0.0)');
     Inc(mLastEntry);
     if (mFirstEntry = -1) then
@@ -848,7 +948,7 @@ begin
       lastfree := e;
     end;
   end;
-  if (lastfree <> nil) then e.nextFree := nil;
+  if (lastfree <> nil) then lastfree.nextFree := nil;
   {$IFDEF RBHASH_SANITY_CHECKS}
   if (cnt <> mBucketsUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 0)');
   if (cnt <> mEntriesUsed) then raise Exception.Create('internal error in hash table resize (invalid first/last range; 1)');