bsearchtree.pas

   1 { Copyright (C) 2005 Bas Steendijk and Peter Green\r
   2   For conditions of distribution and use, see copyright notice in zlib_license.txt\r
   3   which is included in the package\r
   4   ----------------------------------------------------------------------------- }\r
   5   \r
   6 {actually a hashtable. it was a tree in earlier versions}\r
   7 \r
   8 unit bsearchtree;\r
   9 \r
  10 interface\r
  11 \r
  12 uses blinklist;\r
  13 \r
  14 const\r
  15   hashtable_size=$4000;\r
  16 \r
  17 type\r
  18   thashitem=class(tlinklist)\r
  19     hash:integer;\r
  20     s:ansistring;\r
  21     p:pointer;\r
  22   end;\r
  23   thashtable=array[0..hashtable_size-1] of thashitem;\r
  24   phashtable=^thashtable;\r
  25 \r
  26 {adds "item" to the tree for name "s". the name must not exist (no checking done)}\r
  27 procedure addtree(t:phashtable;s:ansistring;item:pointer);\r
  28 \r
  29 {removes name "s" from the tree. the name must exist (no checking done)}\r
  30 procedure deltree(t:phashtable;s:ansistring);\r
  31 \r
  32 {returns the item pointer for s, or nil if not found}\r
  33 function findtree(t:phashtable;s:ansistring):pointer;\r
  34 \r
  35 {clear a hashtable, deallocating all used resources}\r
  36 procedure cleartree(t:phashtable);\r
  37 \r
  38 implementation\r
  39 \r
  40 //FNV-1a hash function\r
  41 function makehash(s:ansistring):integer;\r
  42 const\r
  43   shifter=6;\r
  44 var\r
  45   a,b:integer;\r
  46   h:longword;\r
  47 begin\r
  48   result := 0;\r
  49   b := length(s);\r
  50   h := 216613626;\r
  51   for a := 1 to b do begin\r
  52     h := (h xor byte(s[a])) * 16777619;\r
  53   end;\r
  54   result := h and (hashtable_size-1);\r
  55 end;\r
  56 \r
  57 procedure addtree(t:phashtable;s:ansistring;item:pointer);\r
  58 var\r
  59   hash:integer;\r
  60   p:thashitem;\r
  61 begin\r
  62   hash := makehash(s);\r
  63   p := thashitem.create;\r
  64   p.hash := hash;\r
  65   p.s := s;\r
  66   p.p := item;\r
  67   linklistadd(tlinklist(t[hash]),tlinklist(p));\r
  68 end;\r
  69 \r
  70 procedure deltree(t:phashtable;s:ansistring);\r
  71 var\r
  72   p,p2:thashitem;\r
  73   hash:integer;\r
  74 begin\r
  75   hash := makehash(s);\r
  76   p := t[hash];\r
  77   p2 := nil;\r
  78   while p <> nil do begin\r
  79     if p.s = s then begin\r
  80       p2 := p;\r
  81       break;\r
  82     end;\r
  83     p := thashitem(p.next);\r
  84   end;\r
  85   linklistdel(tlinklist(t[hash]),tlinklist(p2));\r
  86   p2.destroy;\r
  87 end;\r
  88 \r
  89 \r
  90 function findtree(t:phashtable;s:ansistring):pointer;\r
  91 var\r
  92   p:thashitem;\r
  93   hash:integer;\r
  94 begin\r
  95   result := nil;\r
  96   hash := makehash(s);\r
  97   p := t[hash];\r
  98   while p <> nil do begin\r
  99     if p.s = s then begin\r
 100       result := p.p;\r
 101       exit;\r
 102     end;\r
 103     p := thashitem(p.next);\r
 104   end;\r
 105 end;\r
 106 \r
 107 procedure cleartree(t:phashtable);\r
 108 var\r
 109   hash:integer;\r
 110   p,p2:thashitem;\r
 111 begin\r
 112   for hash := 0 to hashtable_size-1 do begin\r
 113     p := t[hash];\r
 114     while p <> nil do begin\r
 115       p2 := thashitem(p.next);\r
 116       linklistdel(tlinklist(t[hash]),tlinklist(p));\r
 117       p.destroy;\r
 118       p := thashitem(p2);\r
 119     end;\r
 120   end;\r
 121 end;\r
 122 \r
 123 end.\r