1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34 NOTE
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52 pathname_am: proc;
53
54
55
56 dcl a_pname char (*) varying parameter;
57 dcl a_segnum fixed bin (17) parameter;
58 dcl a_uid bit (36) aligned parameter;
59
60
61
62 dcl flush_level fixed bin (35);
63 dcl hash_slot fixed bin;
64 dcl pam_index fixed bin;
65 dcl plen fixed bin;
66 dcl prevp ptr;
67
68
69
70 dcl kstsrch entry (bit (36) aligned, fixed bin (17), ptr);
71 dcl segno_usage$increment entry (fixed bin (17), fixed bin (35));
72
73
74
75 dcl (addr, baseptr, dimension, length, mod, null, segno, stacq, substr) builtin;
76 %page;
77 initialize: entry ();
78
79 amp = addr (pds$pathname_am);
80 call empty_pam;
81 pam.sets, pam.gets, pam.hits, pam.getps, pam.hitps, pam.rejects = 0;
82 pam.clears, pam.flushes, pam.overflows, pam.overflow_uids, pam.flushed = 0;
83 pam.initial_flush_level, pam.flush_level = active_hardcore_data$pam_flush_level;
84 return;
85 %page;
86 get_segno: entry (a_pname, a_segnum);
87
88 call update_to_current_flush_level ();
89 plen = length (a_pname);
90 a_segnum = -1;
91 pam.gets = pam.gets + 1;
92 if plen > PAM_name_max_lth then return;
93 do amep = amp -> ame.fp repeat (ame.fp) while (amep ^= amp);
94 if plen = ame.name_len then
95 if a_pname = substr (ame.name, 1, ame.name_len) then do;
96 pam.hits = pam.hits + 1;
97 call segno_usage$increment ((ame.segno), (0));
98 a_segnum = ame.segno;
99 call thread_to_head ();
100 return;
101 end;
102 end;
103 return;
104 %page;
105 get_path: entry (a_pname, a_segnum);
106
107 call update_to_current_flush_level ();
108 pam.getps = pam.getps + 1;
109 do amep = amp -> ame.fp repeat (ame.fp) while (amep ^= amp);
110 if a_segnum = ame.segno then do;
111 pam.hitps = pam.hitps + 1;
112 a_pname = substr (ame.name, 1, ame.name_len);
113 call thread_to_head ();
114 return;
115 end;
116 end;
117 a_pname = "";
118 return;
119 %page;
120 set: entry (a_pname, a_segnum);
121
122 call update_to_current_flush_level ();
123 pam.sets = pam.sets + 1;
124 plen = length (a_pname);
125 if plen > PAM_name_max_lth then do;
126 pam.rejects = pam.rejects + 1;
127 return;
128 end;
129 amep = amp -> ame.bp;
130 ame.segno = a_segnum;
131 substr (ame.name, 1, plen) = a_pname;
132 ame.name_len = plen;
133 call thread_to_head ();
134 return;
135 %page;
136 clear: entry (a_segnum);
137
138 amp = addr (pds$pathname_am);
139 pam.clears = pam.clears + 1;
140 do pam_index = 1 to dimension (pam.search, 1);
141 if pam.search (pam_index).segno = a_segnum then do;
142 pam.cleared = pam.cleared + 1;
143 amep = addr (pam.search (pam_index));
144 ame.segno = 0;
145 ame.name_len = 0;
146 call thread_to_tail ();
147 end;
148 end;
149 return;
150 %page;
151 flush: entry (a_uid);
152
153
154
155
156
157 amp = addr (pds$pathname_am);
158 do flush_level = active_hardcore_data$pam_flush_level + 1 repeat (active_hardcore_data$pam_flush_level + 1) while (^set_flush_level ());
159
160 end;
161 active_hardcore_data$pam_flush_buffer
162 (mod (flush_level, dimension (active_hardcore_data$pam_flush_buffer, 1))) = a_uid;
163
164 do while (active_hardcore_data$pam_flush_level - flush_level
165 > dimension (active_hardcore_data$pam_flush_buffer, 1));
166 flush_level = active_hardcore_data$pam_flush_level;
167 active_hardcore_data$pam_flush_buffer
168 (mod (flush_level, dimension (active_hardcore_data$pam_flush_buffer, 1))) = (36)"1"b;
169 end;
170 return;
171
172 set_flush_level: proc () returns (bit (1) aligned);
173
174 dcl flush_level_minus_1 fixed bin (35);
175
176 dcl new_value bit (36) aligned based (addr (flush_level));
177 dcl old_value bit (36) aligned based (addr (flush_level_minus_1));
178 dcl word bit (36) aligned based (addr (active_hardcore_data$pam_flush_level));
179
180 flush_level_minus_1 = flush_level - 1;
181 return (stacq (word, new_value, old_value));
182 end;
183 %page;
184 empty_pam: proc;
185
186 prevp = addr (pds$pathname_am);
187 do pam_index = 1 to dimension (pam.search, 1);
188 amep = addr (pam.search (pam_index));
189 prevp -> ame.fp = amep;
190 ame.bp = prevp;
191 ame.segno = 0;
192 ame.name_len = 0;
193 prevp = amep;
194 end;
195 prevp -> ame.fp = amp;
196 amp -> ame.bp = prevp;
197 return;
198 end;
199
200 thread_to_head: proc;
201
202 ame.fp -> ame.bp = ame.bp;
203 ame.bp -> ame.fp = ame.fp;
204 ame.fp = amp -> ame.fp;
205 ame.bp = amp;
206 ame.bp -> ame.fp = amep;
207 ame.fp -> ame.bp = amep;
208 return;
209 end thread_to_head;
210
211 thread_to_tail: proc;
212
213 ame.fp -> ame.bp = ame.bp;
214 ame.bp -> ame.fp = ame.fp;
215 ame.bp = amp -> ame.bp;
216 ame.fp = amp;
217 ame.bp -> ame.fp = amep;
218 ame.fp -> ame.bp = amep;
219 return;
220 end thread_to_tail;
221 %page;
222 update_to_current_flush_level: proc;
223
224
225
226
227
228
229
230
231
232 dcl ahd_flush_buffer_index fixed bin;
233 dcl current_flush_level fixed bin (35);
234 dcl entryp ptr;
235 dcl num_uids_to_flush fixed bin;
236 dcl pam_index fixed bin;
237 dcl uid bit (36) aligned;
238 dcl uids_to_flush (15) bit (36) aligned;
239 dcl uids_to_flush_index fixed bin;
240
241 amp = addr (pds$pathname_am);
242 current_flush_level = active_hardcore_data$pam_flush_level;
243 if current_flush_level = pam.flush_level then return;
244
245 if current_flush_level - pam.flush_level ^> dimension (active_hardcore_data$pam_flush_buffer, 1) then do;
246
247 num_uids_to_flush = 0;
248 do ahd_flush_buffer_index = pam.flush_level + 1 to current_flush_level;
249 uid = active_hardcore_data$pam_flush_buffer (mod (ahd_flush_buffer_index, dimension (active_hardcore_data$pam_flush_buffer, 1)));
250 if uid = (36)"1"b then go to overflow;
251 call kstsrch (uid, hash_slot, kstep);
252 if kstep ^= null then do;
253 if num_uids_to_flush >= dimension (uids_to_flush, 1) then do;
254 pam.overflow_uids = pam.overflow_uids + 1;
255 go to overflow;
256 end;
257 num_uids_to_flush = num_uids_to_flush + 1;
258 uids_to_flush (num_uids_to_flush) = uid;
259 end;
260 end;
261 if active_hardcore_data$pam_flush_level - pam.flush_level
262 > dimension (active_hardcore_data$pam_flush_buffer, 1) then go to overflow;
263 end;
264 else do;
265 overflow:
266 pam.overflows = pam.overflows + 1;
267 call empty_pam;
268 pam.flush_level = current_flush_level;
269 return;
270 end;
271
272 if num_uids_to_flush > 0 then do;
273 kstp = pds$kstp;
274 pam.flushes = pam.flushes + 1;
275 do pam_index = 1 to dimension (pam.search, 1);
276 if pam.search (pam_index).segno > 0 then
277 do entryp = baseptr (pam.search (pam_index).segno) repeat kste.entryp while (entryp ^= null);
278
279 kstep = addr (kst.kst_entry (segno (entryp)));
280 do uids_to_flush_index = 1 to num_uids_to_flush;
281 if kste.uid = uids_to_flush (uids_to_flush_index) then do;
282 amep = addr (pam.search (pam_index));
283
284 pam.flushed = pam.flushed + 1;
285 ame.segno = 0;
286 ame.name_len = 0;
287 call thread_to_tail ();
288 go to next_pam_entry;
289 end;
290 end;
291 end;
292 next_pam_entry:
293 end;
294 end;
295 pam.flush_level = current_flush_level;
296 return;
297 end update_to_current_flush_level;
298 %page; %include kst;
299 %page; %include pathname_am;
300 end pathname_am;