/[lcore]/trunk/bsearchtree.pas
ViewVC logotype

Contents of /trunk/bsearchtree.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 149 - (show annotations)
Sun Sep 10 20:02:13 2017 UTC (3 months ago) by plugwash
File size: 2689 byte(s)
Replace obsolete/broken lcoregtklaz with new lcorelazarus
Rename lmessages to lcoremessages due to unit name conflict with Lazarus

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

Properties

Name Value
svn:eol-style CRLF

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.5