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 function makehash(s:ansistring):integer;\r
  41 const\r
  42   shifter=6;\r
  43 var\r
  44   a,b:integer;\r
  45 begin\r
  46   result := 0;\r
  47   b := length(s);\r
  48   for a := 1 to b do begin\r
  49     result := (result shl shifter) xor byte(s[a]);\r
  50   end;\r
  51   result := (result xor result shr 16) and (hashtable_size-1);\r
  52 end;\r
  53 \r
  54 procedure addtree(t:phashtable;s:ansistring;item:pointer);\r
  55 var\r
  56   hash:integer;\r
  57   p:thashitem;\r
  58 begin\r
  59   hash := makehash(s);\r
  60   p := thashitem.create;\r
  61   p.hash := hash;\r
  62   p.s := s;\r
  63   p.p := item;\r
  64   linklistadd(tlinklist(t[hash]),tlinklist(p));\r
  65 end;\r
  66 \r
  67 procedure deltree(t:phashtable;s:ansistring);\r
  68 var\r
  69   p,p2:thashitem;\r
  70   hash:integer;\r
  71 begin\r
  72   hash := makehash(s);\r
  73   p := t[hash];\r
  74   p2 := nil;\r
  75   while p <> nil do begin\r
  76     if p.s = s then begin\r
  77       p2 := p;\r
  78       break;\r
  79     end;\r
  80     p := thashitem(p.next);\r
  81   end;\r
  82   linklistdel(tlinklist(t[hash]),tlinklist(p2));\r
  83   p2.destroy;\r
  84 end;\r
  85 \r
  86 \r
  87 function findtree(t:phashtable;s:ansistring):pointer;\r
  88 var\r
  89   p:thashitem;\r
  90   hash:integer;\r
  91 begin\r
  92   result := nil;\r
  93   hash := makehash(s);\r
  94   p := t[hash];\r
  95   while p <> nil do begin\r
  96     if p.s = s then begin\r
  97       result := p.p;\r
  98       exit;\r
  99     end;\r
 100     p := thashitem(p.next);\r
 101   end;\r
 102 end;\r
 103 \r
 104 procedure cleartree(t:phashtable);\r
 105 var\r
 106   hash:integer;\r
 107   p,p2:thashitem;\r
 108 begin\r
 109   for hash := 0 to hashtable_size-1 do begin\r
 110     p := t[hash];\r
 111     while p <> nil do begin\r
 112       p2 := thashitem(p.next);\r
 113       linklistdel(tlinklist(t[hash]),tlinklist(p));\r
 114       p.destroy;\r
 115       p := thashitem(p2);\r
 116     end;\r
 117   end;\r
 118 end;\r
 119 \r
 120 end.\r