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:string;\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:string;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:string);\r
  31 \r
  32 {returns the item pointer for s, or nil if not found}\r
  33 function findtree(t:phashtable;s:string):pointer;\r
  34 \r
  35 implementation\r
  36 \r
  37 function makehash(s:string):integer;\r
  38 const\r
  39   shifter=6;\r
  40 var\r
  41   a,b:integer;\r
  42 begin\r
  43   result := 0;\r
  44   b := length(s);\r
  45   for a := 1 to b do begin\r
  46     result := (result shl shifter) xor byte(s[a]);\r
  47   end;\r
  48   result := (result xor result shr 16) and (hashtable_size-1);\r
  49 end;\r
  50 \r
  51 procedure addtree(t:phashtable;s:string;item:pointer);\r
  52 var\r
  53   hash:integer;\r
  54   p:thashitem;\r
  55 begin\r
  56   hash := makehash(s);\r
  57   p := thashitem.create;\r
  58   p.hash := hash;\r
  59   p.s := s;\r
  60   p.p := item;\r
  61   linklistadd(tlinklist(t[hash]),tlinklist(p));\r
  62 end;\r
  63 \r
  64 procedure deltree(t:phashtable;s:string);\r
  65 var\r
  66   p,p2:thashitem;\r
  67   hash:integer;\r
  68 begin\r
  69   hash := makehash(s);\r
  70   p := t[hash];\r
  71   p2 := nil;\r
  72   while p <> nil do begin\r
  73     if p.s = s then begin\r
  74       p2 := p;\r
  75       break;\r
  76     end;\r
  77     p := thashitem(p.next);\r
  78   end;\r
  79   linklistdel(tlinklist(t[hash]),tlinklist(p2));\r
  80   p2.destroy;\r
  81 end;\r
  82 \r
  83 \r
  84 function findtree(t:phashtable;s:string):pointer;\r
  85 var\r
  86   p:thashitem;\r
  87   hash:integer;\r
  88 begin\r
  89   result := nil;\r
  90   hash := makehash(s);\r
  91   p := t[hash];\r
  92   while p <> nil do begin\r
  93     if p.s = s then begin\r
  94       result := p.p;\r
  95       exit;\r
  96     end;\r
  97     p := thashitem(p.next);\r
  98   end;\r
  99 end;\r
 100 \r
 101 end.\r