summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 45d686b)
raw | patch | inline | side by side (parent: 45d686b)
author | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
Fri, 22 Sep 2017 11:03:49 +0000 (14:03 +0300) | ||
committer | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
Fri, 22 Sep 2017 11:04:45 +0000 (14:04 +0300) |
index 578f86583d3d3df5ea68f8afebc94f630fa1a754..e76b7f2918268195a3ea72b463573828fee3ac66 100644 (file)
function cmdName (): AnsiString;
end;
- TCmdHash = specialize THashBase<AnsiString, PHolmesCommand>;
+ TCmdHash = specialize THashBase<AnsiString, PHolmesCommand, THashKeyStr>;
// ////////////////////////////////////////////////////////////////////////// //
// ////////////////////////////////////////////////////////////////////////// //
function hashNewCommand (): TCmdHash;
begin
- result := TCmdHash.Create(hashStrHash, hashStrEqu, hashStrFree);
+ result := TCmdHash.Create();
end;
diff --git a/src/game/g_map.pas b/src/game/g_map.pas
index 745f26166a931226c604f90871e2213d1291f288..0dc5090c2f123848164d467cdcdf56745d736529 100644 (file)
--- a/src/game/g_map.pas
+++ b/src/game/g_map.pas
function CreateNullTexture(RecName: String): Integer;
begin
RecName := toLowerCase1251(RecName);
- if (TextNameHash = nil) then TextNameHash := hashNewStrInt();
+ if (TextNameHash = nil) then TextNameHash := THashStrInt.Create();
if TextNameHash.get(RecName, result) then exit; // i found her!
SetLength(Textures, Length(Textures)+1);
a, ResLength: Integer;
begin
RecName := toLowerCase1251(RecName);
- if (TextNameHash = nil) then TextNameHash := hashNewStrInt();
+ if (TextNameHash = nil) then TextNameHash := THashStrInt.Create();
if TextNameHash.get(RecName, result) then
begin
// i found her!
else // Íåò òàêîãî ðåóñðñà â WAD'å
begin
//e_WriteLog(Format('SHIT! Error loading texture %s : %s', [RecName, g_ExtractFilePathName(RecName)]), MSG_WARNING);
- if (BadTextNameHash = nil) then BadTextNameHash := hashNewStrInt();
+ if (BadTextNameHash = nil) then BadTextNameHash := THashStrInt.Create();
if log and (not BadTextNameHash.get(RecName, a)) then
begin
e_WriteLog(Format('Error loading texture %s', [RecName]), TMsgType.Warning);
f, c, frdelay, frloop: Integer;
begin
RecName := toLowerCase1251(RecName);
- if (TextNameHash = nil) then TextNameHash := hashNewStrInt();
+ if (TextNameHash = nil) then TextNameHash := THashStrInt.Create();
if TextNameHash.get(RecName, result) then
begin
// i found her!
//e_LogWritefln('*** Loading animated texture "%s"', [RecName]);
- if (BadTextNameHash = nil) then BadTextNameHash := hashNewStrInt();
+ if (BadTextNameHash = nil) then BadTextNameHash := THashStrInt.Create();
if BadTextNameHash.get(RecName, f) then
begin
//e_WriteLog(Format('no animation texture %s (don''t worry)', [RecName]), MSG_NOTIFY);
if not WAD.GetResource(g_ExtractFilePathName(RecName), TextureWAD, ResLength, log) then
begin
- if (BadTextNameHash = nil) then BadTextNameHash := hashNewStrInt();
+ if (BadTextNameHash = nil) then BadTextNameHash := THashStrInt.Create();
if log and (not BadTextNameHash.get(RecName, f)) then
begin
e_WriteLog(Format('Error loading animation texture %s', [RecName]), TMsgType.Warning);
end
else
begin
- if (BadTextNameHash = nil) then BadTextNameHash := hashNewStrInt();
+ if (BadTextNameHash = nil) then BadTextNameHash := THashStrInt.Create();
if log and (not BadTextNameHash.get(RecName, f)) then
begin
e_WriteLog(Format('Error loading animation texture %s', [RecName]), TMsgType.Warning);
end
else
begin
- if (BadTextNameHash = nil) then BadTextNameHash := hashNewStrInt();
+ if (BadTextNameHash = nil) then BadTextNameHash := THashStrInt.Create();
if log and (not BadTextNameHash.get(RecName, f)) then
begin
e_WriteLog(Format('Error loading animation texture "%s" images', [RecName]), TMsgType.Warning);
g_Game_SetLoadingText(_lc[I_LOAD_TEXTURES], mapTextureList.count-1, False);
// find used textures
- usedTextures := hashNewStrInt();
+ usedTextures := THashStrInt.Create();
try
if (panels <> nil) and (panels.count > 0) then
begin
index ac5a523ff296172447c9b34579bd7cddf184aab3..19edc46fd96b97b9efec5d5f156af12da87ae73d 100644 (file)
--- a/src/game/g_triggers.pas
+++ b/src/game/g_triggers.pas
if (Length(afldname) > 4) and (afldname[1] = 'u') and (afldname[2] = 's') and
(afldname[3] = 'e') and (afldname[4] = 'r') then
begin
- if (me.userVars = nil) then me.userVars := hashNewStrVariant();
+ if (me.userVars = nil) then me.userVars := THashStrVariant.Create();
me.userVars.put(afldname, aval);
exit;
end;
if (uvcount < 0) or (uvcount > 1024*1024) then raise XStreamError.Create('invalid number of user vars in trigger');
if (uvcount > 0) then
begin
- gTriggers[i].userVars := hashNewStrVariant();
+ gTriggers[i].userVars := THashStrVariant.Create();
vv := Unassigned;
while (uvcount > 0) do
begin
diff --git a/src/shared/exoma.pas b/src/shared/exoma.pas
index 1931dbbee9c973bbbf4840714fbe4fdcda91f8fe..ffa11a91bec8aea9a243163c19731cbd1c98a2e4 100644 (file)
--- a/src/shared/exoma.pas
+++ b/src/shared/exoma.pas
n: AnsiString;
begin
mClass := aklass;
- mNames := hashNewStrInt();
+ mNames := THashStrInt.Create();
pi := aklass.ClassInfo;
pt := GetTypeData(pi);
GetMem(pl, pt^.PropCount*sizeof(Pointer));
index 495f432c46474bc89027e779a6c404303fefbd55..33920a176e70261225a843d9ffc0dd0cb7663937 100644 (file)
--- a/src/shared/hashtable.pas
+++ b/src/shared/hashtable.pas
interface
-
+(*
+ * HashObjT: class that contains class methods:
+ * class function hash (const[ref] k: KeyT): LongWord;
+ * class function equ (const[ref] a, b: KeyT): Boolean;
+ * class procedure freekey (var k: KeyT); // this may free key
+ *)
type
// WARNING! don't put structures into hash, use ponters or ids!
- generic THashBase<KeyT, ValueT> = class(TObject)
+ generic THashBase<KeyT, ValueT, HashObjT> = class(TObject)
private
const InitSize = {$IF DEFINED(RBHASH_SANITY_CHECKS)}16{$ELSE}256{$ENDIF}; // *MUST* be power of two
const LoadFactorPrc = 90; // it is ok for robin hood hashes
property keyhash: LongWord read hash; // cannot be 0
end;
- type THashFn = function (constref o: KeyT): LongWord;
- type TEquFn = function (constref a, b: KeyT): Boolean;
- type TFreeKeyFn = procedure (var k: KeyT); // this may free key
type TFreeValueFn = procedure (var v: ValueT); // this may free value
type TIteratorFn = function (constref k: KeyT; constref v: ValueT): Boolean is nested; // return `true` to stop
type TIteratorExFn = function (constref k: KeyT; constref v: ValueT; keyhash: LongWord): Boolean is nested; // return `true` to stop
end;
private
- hashfn: THashFn;
- equfn: TEquFn;
- freekeyfn: TFreeKeyFn;
freevalfn: TFreeValueFn;
mBuckets: array of PEntry; // entries, points to mEntries elements
mBucketsUsed: Integer;
procedure freeEntries ();
public
- constructor Create (ahashfn: THashFn; aequfn: TEquFn; afreekeyfn: TFreeKeyFn=nil; afreevalfn: TFreeValueFn=nil);
+ constructor Create (afreevalfn: TFreeValueFn=nil);
destructor Destroy (); override;
procedure clear ();
type
- THashIntInt = specialize THashBase<Integer, Integer>;
- THashStrInt = specialize THashBase<AnsiString, Integer>;
- THashIntStr = specialize THashBase<Integer, AnsiString>;
- THashStrStr = specialize THashBase<AnsiString, AnsiString>;
- THashStrVariant = specialize THashBase<AnsiString, Variant>;
+ THashKeyInt = class
+ public
+ class function hash (const k: Integer): LongWord; inline;
+ class function equ (const a, b: Integer): Boolean; inline;
+ class procedure freekey (k: Integer); inline;
+ end;
+ THashKeyStr = 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;
-function hashNewIntInt (): THashIntInt; inline;
-function hashNewStrInt (): THashStrInt; inline;
-function hashNewIntStr (): THashIntStr; inline;
-function hashNewStrStr (): THashStrStr; inline;
-function hashNewStrVariant (): THashStrVariant; inline;
+type
+ THashIntInt = specialize THashBase<Integer, Integer, THashKeyInt>;
+ THashStrInt = specialize THashBase<AnsiString, Integer, THashKeyStr>;
+ THashIntStr = specialize THashBase<Integer, AnsiString, THashKeyInt>;
+ THashStrStr = specialize THashBase<AnsiString, AnsiString, THashKeyStr>;
+ THashStrVariant = specialize THashBase<AnsiString, Variant, THashKeyStr>;
function u32Hash (a: LongWord): LongWord; inline;
function fnvHash (constref buf; len: LongWord): LongWord;
function joaatHash (constref buf; len: LongWord): LongWord;
-function nextPOT (x: LongWord): LongWord; inline;
-
-
-// for integer keys
-function hashIntEqu (constref a, b: Integer): Boolean;
-function hashIntHash (constref k: Integer): LongWord;
-function hashStrEqu (constref a, b: AnsiString): Boolean;
-function hashStrHash (constref k: AnsiString): LongWord;
-procedure hashStrFree (var s: AnsiString);
-procedure hashVariantFree (var v: Variant);
+// has to be public due to FPC generics limitation
+function nextPOTU32 (x: LongWord): LongWord; inline;
implementation
// ////////////////////////////////////////////////////////////////////////// //
{$PUSH}
{$RANGECHECKS OFF}
-function nextPOT (x: LongWord): LongWord; inline;
+function nextPOTU32 (x: LongWord): LongWord; inline;
begin
result := x;
result := result or (result shr 1);
{$POP}
-// ////////////////////////////////////////////////////////////////////////// //
-function hashIntEqu (constref a, b: Integer): Boolean; begin result := (a = b); end;
-function hashStrEqu (constref a, b: AnsiString): Boolean; begin result := (a = b); end;
-procedure hashStrFree (var s: AnsiString); begin s := ''; end;
-procedure hashVariantFree (var v: Variant); begin v := Unassigned; end;
-
-{$PUSH}
-{$RANGECHECKS OFF}
-function hashIntHash (constref k: Integer): LongWord;
-begin
- result := LongWord(k);
- result -= (result shl 6);
- result := result xor (result shr 17);
- result -= (result shl 9);
- result := result xor (result shl 4);
- result -= (result shl 3);
- result := result xor (result shl 10);
- result := result xor (result shr 15);
-end;
-
-function hashStrHash (constref k: AnsiString): LongWord;
-begin
- if (Length(k) > 0) then result := fnvHash(PAnsiChar(k)^, Length(k)) else result := 0;
-end;
-{$POP}
-
-
-function hashNewIntInt (): THashIntInt; inline;
-begin
- result := THashIntInt.Create(hashIntHash, hashIntEqu);
-end;
-
-
-function hashNewStrInt (): THashStrInt; inline;
-begin
- result := THashStrInt.Create(hashStrHash, hashStrEqu, hashStrFree);
-end;
-
-
-function hashNewIntStr (): THashIntStr; inline;
-begin
- result := THashIntStr.Create(hashIntHash, hashIntEqu, nil, hashStrFree);
-end;
-
-
-function hashNewStrStr (): THashStrStr; inline;
-begin
- result := THashStrStr.Create(hashStrHash, hashStrEqu, hashStrFree, hashStrFree);
-end;
-
-
-function hashNewStrVariant (): THashStrVariant; inline;
-begin
- result := THashStrVariant.Create(hashStrHash, hashStrEqu, hashStrFree, hashVariantFree);
-end;
-
-
// ////////////////////////////////////////////////////////////////////////// //
{$PUSH}
{$RANGECHECKS OFF}
reset(aseed);
end;
-
procedure TJoaatHasher.reset (); inline; overload;
begin
hash := seed;
end;
-
procedure TJoaatHasher.reset (aseed: LongWord); inline; overload;
begin
seed := aseed;
hash := aseed;
end;
-
procedure TJoaatHasher.put (constref buf; len: LongWord);
var
bytes: PByte;
hash := h;
end;
-
function TJoaatHasher.value: LongWord; inline;
begin
result := hash;
{$POP}
+// ////////////////////////////////////////////////////////////////////////// //
+// THashKeyInt
+class function THashKeyInt.hash (const k: Integer): LongWord; inline;
+begin
+ result := LongWord(k);
+ result -= (result shl 6);
+ result := result xor (result shr 17);
+ result -= (result shl 9);
+ result := result xor (result shl 4);
+ result -= (result shl 3);
+ result := result xor (result shl 10);
+ result := result xor (result shr 15);
+end;
+
+class function THashKeyInt.equ (const a, b: Integer): Boolean; inline; begin result := (a = b); end;
+class procedure THashKeyInt.freekey (k: Integer); inline; begin end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+// THashKeyStr
+class function THashKeyStr.hash (const k: AnsiString): LongWord; inline; begin if (Length(k) > 0) then result := fnvHash((@k[1])^, Length(k)) else result := 0; end;
+class function THashKeyStr.equ (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
+class procedure THashKeyStr.freekey (var k: AnsiString); inline; begin k := ''; end;
+
+
// ////////////////////////////////////////////////////////////////////////// //
function THashBase.TEntry.getEmpty (): Boolean; inline; begin result := (hash = 0); end;
@@ -398,14 +361,8 @@ function THashBase.TEntry.getEmpty (): Boolean; inline; begin result := (hash =
function THashBase.getCapacity (): Integer; inline; begin result := Length(mBuckets); end;
-constructor THashBase.Create (ahashfn: THashFn; aequfn: TEquFn; afreekeyfn: TFreeKeyFn=nil; afreevalfn: TFreeValueFn=nil);
+constructor THashBase.Create (afreevalfn: TFreeValueFn=nil);
begin
- if not assigned(ahashfn) then raise Exception.Create('cannot create hash without hash function');
- if not assigned(aequfn) then raise Exception.Create('cannot create hash without equality function');
-
- hashfn := ahashfn;
- equfn := aequfn;
- freekeyfn := afreekeyfn;
freevalfn := afreevalfn;
mSeed := u32Hash($29a);
e := @mEntries[f];
if not e.empty then
begin
- if assigned(freekeyfn) then freekeyfn(e.key);
- if assigned(freevalfn) then freevalfn(e.value);
+ HashObjT.freekey(e.key);
+ if assigned(freevalfn) then freevalfn(e.value) else e.value := Default(ValueT);
e.key := Default(KeyT);
e.value := Default(ValueT);
e.hash := 0;
if (idx < 0) or (idx > High(mEntries)) then raise Exception.Create('internal error in hash entry allocator (invalid entry address)');
if (e <> @mEntries[idx]) then raise Exception.Create('internal error in hash entry allocator (wtf?!)');
{$ENDIF}
- if assigned(freekeyfn) then freekeyfn(e.key);
- if assigned(freevalfn) then freevalfn(e.value);
+ HashObjT.freekey(e.key);
+ if assigned(freevalfn) then freevalfn(e.value) else e.value := Default(ValueT);
{$IFDEF RBHASH_SANITY_CHECKS}
Dec(mEntriesUsed);
{$ENDIF}
if (keyhashin <> nil) then
begin
khash := keyhashin^;
- if (khash = 0) then khash := hashfn(akey);
+ if (khash = 0) then khash := HashObjT.hash(akey);
end
else
begin
- khash := hashfn(akey);
+ khash := HashObjT.hash(akey);
end;
if (khash = 0) then khash := $29a;
if (mBuckets[idx] = nil) then break;
pdist := distToStIdx(idx);
if (dist > pdist) then break;
- result := (mBuckets[idx].hash = khash) and equfn(mBuckets[idx].key, akey);
+ result := (mBuckets[idx].hash = khash) and HashObjT.equ(mBuckets[idx].key, akey);
if result then break;
idx := (idx+1) and bhigh;
end;
if (keyhashin <> nil) then
begin
khash := keyhashin^;
- if (khash = 0) then khash := hashfn(akey);
+ if (khash = 0) then khash := HashObjT.hash(akey);
end
else
begin
- khash := hashfn(akey);
+ khash := HashObjT.hash(akey);
end;
if (khash = 0) then khash := $29a;
if (mBuckets[idx] = nil) then break;
pdist := distToStIdx(idx);
if (dist > pdist) then break;
- result := (mBuckets[idx].hash = khash) and equfn(mBuckets[idx].key, akey);
+ result := (mBuckets[idx].hash = khash) and HashObjT.equ(mBuckets[idx].key, akey);
if result then begin rval := mBuckets[idx].value; break; end;
idx := (idx+1) and bhigh;
end;
bhigh := High(mBuckets);
xseed := mSeed;
- khash := hashfn(akey);
+ khash := HashObjT.hash(akey);
if (khash = 0) then khash := $29a;
if (keyhashout <> nil) then keyhashout^ := khash;
idx := (khash xor xseed) and bhigh;
if (mBuckets[idx] = nil) then break;
pdist := distToStIdx(idx);
if (dist > pdist) then break;
- result := (mBuckets[idx].hash = khash) and equfn(mBuckets[idx].key, akey);
+ result := (mBuckets[idx].hash = khash) and HashObjT.equ(mBuckets[idx].key, akey);
if result then
begin
// replace element
- if assigned(freekeyfn) then freekeyfn(mBuckets[idx].key);
- if assigned(freevalfn) then freevalfn(mBuckets[idx].value);
+ HashObjT.freekey(mBuckets[idx].key);
+ if assigned(freevalfn) then freevalfn(mBuckets[idx].value) else mBuckets[idx].value := Default(ValueT);
mBuckets[idx].key := akey;
mBuckets[idx].value := aval;
exit;
if (keyhashin <> nil) then
begin
khash := keyhashin^;
- if (khash = 0) then khash := hashfn(akey);
+ if (khash = 0) then khash := HashObjT.hash(akey);
end
else
begin
- khash := hashfn(akey);
+ khash := HashObjT.hash(akey);
end;
if (khash = 0) then khash := $29a;
if (mBuckets[idx] = nil) then break;
pdist := distToStIdx(idx);
if (dist > pdist) then break;
- result := (mBuckets[idx].hash = khash) and equfn(mBuckets[idx].key, akey);
+ result := (mBuckets[idx].hash = khash) and HashObjT.equ(mBuckets[idx].key, akey);
if result then break;
idx := (idx+1) and bhigh;
end;
if (cnt = mBucketsUsed) and (idx <> mLastEntry) then raise Exception.Create('internal error in rehash: inconsistent (2)');
{$ENDIF}
// no need to recalculate hash
- //e.hash := hashfn(e.key) xor mSeed; if (e.hash = 0) then e.hash := $29a;
putEntryInternal(e);
end
else
cnt: Integer;
{$ENDIF}
begin
- newsz := nextPOT(LongWord(mBucketsUsed));
+ newsz := nextPOTU32(LongWord(mBucketsUsed));
if (newsz >= 1024*1024*1024) then exit;
if (newsz*2 >= Length(mBuckets)) then exit;
if (newsz*2 < 128) then exit;
diff --git a/src/shared/mempool.pas b/src/shared/mempool.pas
index 73c48c1776192ed985c023bdc5196ff86783df89..0ca3f2f589a437c3931a6d7a510313aa24035dac 100644 (file)
--- a/src/shared/mempool.pas
+++ b/src/shared/mempool.pas
hashtable;
type
- THashPtrPtr = specialize THashBase<Pointer, PMemPool>; // key: TClass; value: PMemPool
+ THashKeyPtr = class
+ public
+ class function hash (const k: Pointer): LongWord; inline;
+ class function equ (const a, b: Pointer): Boolean; inline;
+ class procedure freekey (k: Pointer); inline;
+ end;
+
+ THashPtrPtr = specialize THashBase<Pointer, PMemPool, THashKeyPtr>; // key: TClass; value: PMemPool
var
pools: THashPtrPtr = nil;
// ////////////////////////////////////////////////////////////////////////// //
-function hashequ (constref a, b: Pointer): Boolean; begin result := (a = b); end;
-function hashhash (constref a: Pointer): LongWord; begin result := fnvHash(PByte(@a)^, sizeof(a)); end;
+class function THashKeyPtr.hash (const k: Pointer): LongWord; inline; begin result := fnvHash(PByte(@k)^, sizeof(k)); end;
+class function THashKeyPtr.equ (const a, b: Pointer): Boolean; inline; begin result := (a = b); end;
+class procedure THashKeyPtr.freekey (k: Pointer); inline; begin end;
function getPoolFor (c: TClass): PMemPool;
begin
- if (pools = nil) then pools := THashPtrPtr.Create(hashhash, hashequ);
+ if (pools = nil) then pools := THashPtrPtr.Create();
if not pools.get(Pointer(c), result) then
begin
GetMem(result, sizeof(TMemPool));
diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas
index a9d3bbe45c86f9d7fd7195207cf079e4fdef88d5..12d99d015c663a706eb258cf8523d9911ba8c7db 100644 (file)
--- a/src/shared/xdynrec.pas
+++ b/src/shared/xdynrec.pas
if (mType = TType.TList) then
begin
mRVal := TDynRecList.Create();
- mRHash := hashNewStrInt();
+ mRHash := THashStrInt.Create();
end;
end;
if (mRVal <> nil) then
begin
if (result.mRVal = nil) then result.mRVal := TDynRecList.Create(mRVal.count);
- if (result.mRHash = nil) then result.mRHash := hashNewStrInt();
+ if (result.mRHash = nil) then result.mRHash := THashStrInt.Create();
for rec in mRVal do result.addListItem(rec.clone(registerIn));
end;
result.mRecRef := mRecRef;
if (fld.mRVal = nil) then
begin
fld.mRVal := TDynRecList.Create();
- fld.mRHash := hashNewStrInt();
+ fld.mRHash := THashStrInt.Create();
end;
result := fld.addListItem(rc);
end;