1
2
3
4
5
6
7
8
9
10
11
12
13 hash: proc;
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59 ^L
60
61
62
63 dcl arg_name_ptr ptr;
64 dcl arg_name_entry_ptr ptr;
65 dcl arg_entry_ptr ptr;
66 dcl code fixed bin (35);
67
68
69
70 dcl name_ptr ptr;
71 dcl p ptr;
72 dcl cur_index fixed bin;
73 dcl cur_offset bit (18) unal;
74 dcl prev_offset bit (18) unal;
75 dcl found bit (1) unal;
76 dcl names_seen fixed bin;
77
78
79 dcl name char (32) based (name_ptr);
80
81 dcl (error_table_$argerr, error_table_$noentry,
82 error_table_$hashtbl_error) ext fixed bin (35);
83 dcl active_hardcore_data$num_hash_table_sizes ext fixed bin;
84 dcl active_hardcore_data$hash_table_sizes (1) ext fixed bin;
85 dcl fs_alloc$free entry (ptr, fixed bin, ptr);
86 dcl allocate_dir_ht_ entry (ptr, fixed bin, fixed bin (35));
87 dcl hash_index_ entry (ptr, fixed bin, fixed bin, fixed bin) returns (fixed bin);
88 dcl (addr, index, null, ptr, rel, unspec) builtin;
89 dcl bad_dir_ condition;
90 ^L
91
92 % include dir_header;
93 % include dir_ht;
94
95 %include dir_entry;
96 %include dir_link;
97 % include dir_name;
98 % include fs_types;
99 ^L
100
101
102
103
104
105 in: entry (dp, arg_name_entry_ptr, code);
106
107 if dir.rehashing then signal bad_dir_;
108
109 if dir.htused >= dir.htsize then do;
110 call get_larger_hash_table;
111 if code ^= 0 then return;
112 end;
113 call add_name (arg_name_entry_ptr);
114
115 return;
116 ^L
117
118
119 out: entry (dp, arg_name_ptr, arg_name_entry_ptr, code);
120
121 if dir.rehashing then signal bad_dir_;
122
123 name_ptr = arg_name_ptr;
124 call hash_entry;
125
126 if found then do;
127 arg_name_entry_ptr = p;
128 if prev_offset
129 then ptr (dp, prev_offset) -> names.hash_thread = p -> names.hash_thread;
130 else hash_table.name_rp (cur_index) = p -> names.hash_thread;
131 dir.htused = dir.htused - 1;
132 end;
133 else if code = 0 then code = error_table_$noentry;
134
135 return;
136 ^L
137
138
139 search: entry (dp, arg_name_ptr, arg_entry_ptr, code);
140
141 if dir.rehashing then signal bad_dir_;
142
143 name_ptr = arg_name_ptr;
144 call hash_entry;
145
146 if found then arg_entry_ptr = ptr (dp, p -> names.entry_rp);
147 else do;
148 if code = 0 then code = error_table_$noentry;
149 arg_entry_ptr = null;
150 end;
151
152 return;
153 ^L
154
155
156
157
158
159 hash_entry: proc;
160
161 dcl xp ptr;
162
163 found = "0"b;
164 code = 0;
165
166 htp = ptr (dp, dir.hash_table_rp);
167 cur_index = hash_index_ (name_ptr, 32, 0, (dir.htsize));
168 prev_offset = "0"b;
169
170 names_seen = 0;
171 do cur_offset = hash_table.name_rp (cur_index)
172 repeat p -> names.hash_thread
173 while (cur_offset);
174 names_seen = names_seen + 1;
175 if names_seen > dir.htused then signal bad_dir_;
176
177 p = ptr (dp, cur_offset);
178 if p -> names.type ^= NAME_TYPE then signal bad_dir_;
179 xp = ptr (dp, p -> names.entry_rp);
180 if p -> names.owner ^= xp -> entry.uid then signal bad_dir_;
181 if name = p -> names.name then do;
182 if cur_index = p -> names.ht_index then found = "1"b;
183 else signal bad_dir_;
184 return;
185 end;
186 prev_offset = cur_offset;
187 end;
188
189 return;
190
191 end hash_entry;
192
193
194
195
196
197 add_name: proc (nep);
198
199 dcl nep ptr;
200
201 name_ptr = addr (nep -> names.name);
202 call check_name;
203 if code ^= 0 then return;
204 call hash_entry;
205 if code = 0 & ^found then do;
206 nep -> names.hash_thread = hash_table.name_rp (cur_index);
207 hash_table.name_rp (cur_index) = rel (nep);
208
209 nep -> names.ht_index = cur_index;
210 dir.htused = dir.htused + 1;
211 end;
212
213 return;
214
215 end add_name;
216
217
218
219
220
221 check_name: proc;
222
223 dcl 1 check_for_ascii aligned static options (constant),
224 2 part1 bit (9 * 16) init ((16)"110000000"b),
225 2 part2 bit (9 * 16) init ((16)"110000000"b);
226
227 code = 0;
228 if (unspec (name) & unspec (check_for_ascii)) = "0"b
229 then if name ^= ""
230 then if index (name, ">") = 0 then return;
231
232 code = error_table_$argerr;
233
234 return;
235
236 end check_name;
237
238 ^L
239
240
241
242 get_larger_hash_table: proc;
243
244 dcl (nentries, nnames, nentries_expected) fixed bin;
245 dcl nep ptr;
246 dcl save_htp ptr;
247
248
249
250
251 code = 0;
252 if dir.htsize >= active_hardcore_data$hash_table_sizes (active_hardcore_data$num_hash_table_sizes) then return;
253
254 save_htp = ptr (dp, dir.hash_table_rp);
255 call allocate_dir_ht_ (dp, dir.htused+1, code);
256 if code ^= 0 then do;
257 code = 0;
258 return;
259 end;
260 dir.rehashing = "1"b;
261 call fs_alloc$free (ptr (dp, dir.arearp), (save_htp -> hash_table.size), save_htp);
262 htp = ptr (dp, dir.hash_table_rp);
263
264
265
266 dir.htused = 0;
267 nentries = 0;
268 nentries_expected = dir.seg_count + dir.dir_count + dir.lcount;
269 do ep = ptr (dp, dir.entryfrp)
270 repeat ptr (dp, ep -> entry.efrp)
271 while (rel (ep));
272
273 nentries = nentries + 1;
274 if nentries > nentries_expected
275 then signal bad_dir_;
276 if entry.bs then
277 if entry.owner ^= dir.uid
278 | (entry.type ^= SEG_TYPE & entry.type ^= DIR_TYPE) then signal bad_dir_;
279 else;
280 else if link.type ^= LINK_TYPE | link.owner ^= dir.uid then signal bad_dir_;
281 nnames = 0;
282 do nep = ptr (dp, entry.name_frp) repeat ptr (dp, nep -> names.fp) while (rel (nep));
283 nnames = nnames + 1;
284 if nnames > entry.nnames
285 | nep -> names.type ^= NAME_TYPE
286 | nep -> names.owner ^= entry.uid
287 | nep -> names.entry_rp ^= rel (ep)
288 then signal bad_dir_;
289 call add_name (nep);
290 if code ^= 0 then signal bad_dir_;
291 end;
292 end;
293 dir.rehashing = "0"b;
294
295 return;
296 end get_larger_hash_table;
297
298 end hash;