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