1 files changed, 224 insertions, 0 deletions
diff --git a/nim/hashes.pas b/nim/hashes.pas
new file mode 100755
index 000000000..80acc57ca
--- /dev/null
+++ b/nim/hashes.pas
@@ -0,0 +1,224 @@
+//
+//
+//           The Nimrod Compiler
+//        (c) Copyright 2008 Andreas Rumpf
+//
+//    See the file "copying.txt", included in this
+//    distribution, for details about the copyright.
+//
+unit hashes;
+
+interface
+
+uses
+  charsets, nsystem, strutils;
+
+const
+  SmallestSize = (1 shl 3) - 1;
+  DefaultSize = (1 shl 11) - 1;
+  BiggestSize = (1 shl 28) - 1;
+
+type
+  THash = type int;
+  PHash = ^THash;
+  THashFunc = function (str: PChar): THash;
+
+function GetHash(str: PChar): THash;
+function GetHashCI(str: PChar): THash;
+
+function GetDataHash(Data: Pointer; Size: int): THash;
+
+function hashPtr(p: Pointer): THash;
+
+function GetHashStr(const s: string): THash;
+function GetHashStrCI(const s: string): THash;
+
+function getNormalizedHash(const s: string): THash;
+
+//function nextPowerOfTwo(x: int): int;
+
+function concHash(h: THash; val: int): THash;
+function finishHash(h: THash): THash;
+
+implementation
+
+type
+  TUnsignedHash = cardinal;
+
+{@ignore}
+{$ifopt Q+} { we need Q- here! }
+  {$define Q_on}
+  {$Q-}
+{$endif}
+
+{$ifopt R+}
+  {$define R_on}
+  {$R-}
+{$endif}
+{@emit}
+
+function nextPowerOfTwo(x: int): int;
+begin
+  result := x -{%} 1;
+  result := result or (result shr 32);
+  result := result or (result shr 16);
+  result := result or (result shr 8);
+  result := result or (result shr 4);
+  result := result or (result shr 2);
+  result := result or (result shr 1);
+  Inc(result)
+end;
+
+function concHash(h: THash; val: int): THash;
+begin
+  result := h +{%} val;
+  result := result +{%} result shl 10;
+  result := result xor (result shr 6);
+end;
+
+function finishHash(h: THash): THash;
+begin
+  result := h +{%} h shl 3;
+  result := result xor (result shr 11);
+  result := result +{%} result shl 15;
+end;
+
+function GetDataHash(Data: Pointer; Size: int): THash;
+var
+  h: TUnsignedHash;
+  p: PChar;
+  i, s: int;
+begin
+  h := 0;
+  p := {@cast}pchar(Data);
+  i := 0;
+  s := size;
+  while s > 0 do begin
+    h := h +{%} ord(p[i]);
+    h := h +{%} h shl 10;
+    h := h xor (h shr 6);
+    Inc(i); Dec(s)
+  end;
+  h := h +{%} h shl 3;
+  h := h xor (h shr 11);
+  h := h +{%} h shl 15;
+  result := THash(h)
+end;
+
+function hashPtr(p: Pointer): THash;
+begin
+  result := ({@cast}THash(p)) shr 3; // skip the alignment
+end;
+
+function GetHash(str: PChar): THash;
+var
+  h: TUnsignedHash;
+  i: int;
+begin
+  h := 0; 
+  i := 0;
+  while str[i] <> #0 do begin
+    h := h +{%} ord(str[i]);
+    h := h +{%} h shl 10;
+    h := h xor (h shr 6);
+    Inc(i)
+  end;
+  h := h +{%} h shl 3;
+  h := h xor (h shr 11);
+  h := h +{%} h shl 15;
+  result := THash(h)
+end;
+
+function GetHashStr(const s: string): THash;
+var
+  h: TUnsignedHash;
+  i: int;
+begin
+  h := 0; 
+  for i := 1 to Length(s) do begin
+    h := h +{%} ord(s[i]);
+    h := h +{%} h shl 10;
+    h := h xor (h shr 6);
+  end;
+  h := h +{%} h shl 3;
+  h := h xor (h shr 11);
+  h := h +{%} h shl 15;
+  result := THash(h)
+end;
+
+function getNormalizedHash(const s: string): THash;
+var
+  h: TUnsignedHash;
+  c: Char;
+  i: int;
+begin
+  h := 0; 
+  for i := strStart to length(s)+strStart-1 do begin
+    c := s[i];
+    if c = '_' then continue; // skip _
+    if c in ['A'..'Z'] then c := chr(ord(c) + (ord('a')-ord('A'))); // toLower()
+    h := h +{%} ord(c);
+    h := h +{%} h shl 10;
+    h := h xor (h shr 6);
+  end;
+  h := h +{%} h shl 3;
+  h := h xor (h shr 11);
+  h := h +{%} h shl 15;
+  result := THash(h)
+end;
+
+function GetHashStrCI(const s: string): THash;
+var
+  h: TUnsignedHash;
+  c: Char;
+  i: int;
+begin
+  h := 0; 
+  for i := strStart to length(s)+strStart-1 do begin
+    c := s[i];
+    if c in ['A'..'Z'] then c := chr(ord(c) + (ord('a')-ord('A'))); // toLower()
+    h := h +{%} ord(c);
+    h := h +{%} h shl 10;
+    h := h xor (h shr 6);
+  end;
+  h := h +{%} h shl 3;
+  h := h xor (h shr 11);
+  h := h +{%} h shl 15;
+  result := THash(h)
+end;
+
+function GetHashCI(str: PChar): THash;
+var
+  h: TUnsignedHash;
+  c: Char;
+  i: int;
+begin
+  h := 0;
+  i := 0; 
+  while str[i] <> #0 do begin
+    c := str[i];
+    if c in ['A'..'Z'] then c := chr(ord(c) + (ord('a')-ord('A'))); // toLower()
+    h := h +{%} ord(c);
+    h := h +{%} h shl 10;
+    h := h xor (h shr 6);
+    Inc(i)
+  end;
+  h := h +{%} h shl 3;
+  h := h xor (h shr 11);
+  h := h +{%} h shl 15;
+  result := THash(h)
+end;
+
+{@ignore}
+{$ifdef Q_on}
+  {$undef Q_on}
+  {$Q+}
+{$endif}
+
+{$ifdef R_on}
+  {$undef R_on}
+  {$R+}
+{$endif}
+{@emit}
+
+end.