1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18 forum_notifications_$accept:
19 procedure (P_status);
20
21
22
23
24
25
26 declare P_status fixed bin (35) parameter,
27 P_result bit (1) aligned parameter,
28 P_user_name char (*) parameter;
29
30 declare notify_seg_ptr ptr static init (null ()),
31 me char (22) static init (""),
32 my_authorization bit (72) aligned static init (""b),
33 my_lock_id bit (36) aligned static init (""b);
34
35 declare notify_seg_entry char (32) static options (constant) init ("Notifications Database"),
36 sentinel bit (36) aligned static options (constant) init ("123456765432"b3);
37
38 declare exit label variable,
39 (inner_ring, user_ring) fixed bin (3),
40 max_auth bit (72) aligned,
41 (notify_idx, chain, slot) fixed bin,
42 p ptr,
43 status fixed bin (35),
44 system_high bit (72) aligned,
45 user_name char (22);
46
47 declare forum_data_$central_directory char (168) external;
48
49 declare (error_table_$lock_wait_time_exceeded,
50 error_table_$invalid_lock_reset,
51 error_table_$locked_by_this_process,
52 error_table_$noentry,
53 error_table_$no_w_permission,
54 forum_error_table_$need_system_high,
55 forum_error_table_$no_notify_seg,
56 forum_error_table_$notify_seg_bad,
57 forum_error_table_$unexpected_fault)
58 fixed bin (35) external;
59
60 declare (addr, hbound, length, null, rtrim, unspec)
61 builtin,
62 (any_other, cleanup, no_write_permission)
63 condition;
64
65 declare 1 notify_seg aligned based (notify_seg_ptr),
66 2 sentinel bit (36) aligned,
67 2 lock bit (36) aligned,
68 2 first_free fixed bin,
69 2 highest_used fixed bin,
70 2 first_slot (200) fixed bin,
71 2 user (0 refer (notify_seg.highest_used)),
72 3 name char (22),
73 3 lock_id bit (36) aligned,
74 3 authorization bit (72) aligned,
75 3 next_slot fixed bin;
76
77 declare 1 cbi aligned like create_branch_info;
78
79 declare convert_authorization_$from_string
80 entry (bit (72) aligned, char (*), fixed bin (35)),
81 get_authorization_ entry (bit (72) aligned),
82 get_max_authorization_ entry returns (bit (72) aligned),
83 get_lock_id_ entry (bit(36) aligned),
84 get_ring_ entry returns (fixed bin (3)),
85 hash_index_ entry (ptr, fixed bin, fixed bin, fixed bin) returns (fixed bin),
86 hcs_$create_branch_ entry (char(*), char(*), ptr, fixed bin(35)),
87 hcs_$delentry_file entry (char(*), char(*), fixed bin(35)),
88 hcs_$initiate entry (char(*), char(*), char(*), fixed bin(1), fixed bin(2), ptr, fixed bin(35)),
89 hcs_$level_get entry returns (fixed bin (3)),
90 hcs_$level_set entry (fixed bin (3)),
91 hcs_$terminate_noname entry (ptr, fixed bin(35)),
92 set_lock_$lock entry (bit(36) aligned, fixed bin, fixed bin(35)),
93 set_lock_$unlock entry (bit(36) aligned, fixed bin(35)),
94 user_info_$whoami entry (char(*), char(*), char(*));
95 %page;
96 %include create_branch_info;
97 %page;
98
99
100
101 user_ring = hcs_$level_get ();
102 on cleanup call unlock_db ();
103 call initialize (ACCEPT_EXIT);
104
105 call lock_db ();
106
107 notify_idx = lookup (me, chain);
108 if notify_idx = 0 then do;
109 slot = allocate_slot ();
110 call thread_in (chain, slot);
111 end;
112
113 call unlock_db ();
114
115 P_status = 0;
116 return;
117
118 ACCEPT_EXIT:
119 REFUSE_EXIT:
120 P_status = status;
121 call unlock_db ();
122 return;
123
124 forum_notifications_$accept_test: entry (P_user_name, P_status);
125
126 user_name = P_user_name;
127 user_ring = hcs_$level_get ();
128 on cleanup call unlock_db ();
129 call initialize (ACCEPT_EXIT);
130
131 call lock_db ();
132
133 notify_idx = lookup (user_name, chain);
134 if notify_idx = 0 then do;
135 slot = allocate_slot ();
136 notify_seg.user (slot).name = user_name;
137 call thread_in (chain, slot);
138 end;
139
140 call unlock_db ();
141
142 P_status = 0;
143 return;
144 %page;
145 forum_notifications_$refuse:
146 entry (P_status);
147
148 user_ring = hcs_$level_get ();
149 on cleanup call unlock_db ();
150 call initialize (REFUSE_EXIT);
151
152 call lock_db ();
153
154 notify_idx = lookup (me, chain);
155
156 if notify_idx > 0 then do;
157 call thread_out (chain, notify_idx);
158 call free_slot (notify_idx);
159 end;
160
161 call unlock_db ();
162
163 P_status = 0;
164 return;
165 %page;
166 forum_notifications_$lookup:
167 entry (P_user_name, P_result, P_status);
168
169 user_ring = hcs_$level_get ();
170 on cleanup call unlock_db ();
171 call initialize (LOOKUP_EXIT);
172
173 call lock_db ();
174
175 user_name = P_user_name;
176 notify_idx = lookup (user_name, chain);
177
178 if notify_idx = 0 then P_result = "0"b;
179 else P_result = "1"b;
180
181 call unlock_db ();
182 P_status = 0;
183 return;
184
185 LOOKUP_EXIT:
186 P_status = status;
187 P_result = "0"b;
188 call unlock_db ();
189 return;
190 %page;
191 forum_notifications_$init:
192 entry (P_status);
193
194 exit = INIT_EXIT;
195 inner_ring = get_ring_ ();
196 user_ring = hcs_$level_get ();
197
198 on cleanup begin;
199 call hcs_$delentry_file (forum_data_$central_directory, notify_seg_entry, (0));
200 call hcs_$level_set (user_ring);
201 end;
202 on any_other call error (forum_error_table_$unexpected_fault);
203
204 call convert_authorization_$from_string (system_high, "system_high", status);
205 if status ^= 0 then call error (status);
206 max_auth = get_max_authorization_ ();
207 if max_auth ^= system_high then call error (forum_error_table_$need_system_high);
208
209 call hcs_$level_set (inner_ring);
210 call hcs_$delentry_file (forum_data_$central_directory, notify_seg_entry, status);
211 if status ^= 0 & status ^= error_table_$noentry then call error (status);
212
213 unspec (cbi) = ""b;
214 cbi.version = create_branch_version_2;
215 cbi.priv_upgrade_sw = "1"b;
216 cbi.mode = "101"b;
217 cbi.rings (*) = inner_ring;
218 cbi.userid = "*.*.*";
219 cbi.access_class = max_auth;
220
221 call hcs_$create_branch_ (forum_data_$central_directory, notify_seg_entry, addr (cbi), status);
222 if status ^= 0 then call error (status);
223
224 call hcs_$initiate (forum_data_$central_directory, notify_seg_entry, "", 0, 0, notify_seg_ptr, status);
225 if notify_seg_ptr = null () then call error (status);
226
227 notify_seg.first_free, notify_seg.highest_used = 0;
228 notify_seg.sentinel = sentinel;
229
230 p = notify_seg_ptr;
231 notify_seg_ptr = null ();
232 call hcs_$terminate_noname (p, (0));
233
234 call hcs_$level_set (user_ring);
235 P_status = 0;
236 return;
237
238 INIT_EXIT:
239 call hcs_$delentry_file (forum_data_$central_directory, notify_seg_entry, (0));
240 call hcs_$level_set (user_ring);
241 P_status = status;
242 return;
243 %page;
244 lock_db:
245 procedure;
246
247 on no_write_permission call error (error_table_$no_w_permission);
248
249 call set_lock_$lock (notify_seg.lock, 5, status);
250 if status ^= 0 & status ^= error_table_$invalid_lock_reset then call error (status);
251
252 return;
253 end lock_db;
254
255 unlock_db:
256 procedure;
257
258 on no_write_permission begin;
259 goto PUNT;
260 end;
261
262 if notify_seg_ptr ^= null () then
263 call set_lock_$unlock (notify_seg.lock, (0));
264 PUNT:
265 call hcs_$level_set (user_ring);
266 return;
267 end unlock_db;
268 %page;
269
270 lookup: proc (user_name, hash) returns (fixed bin);
271 dcl user_name char (*);
272 dcl hash fixed bin;
273 dcl last_slot fixed bin;
274 dcl slot fixed bin;
275
276 hash = hash_index_ (addr (user_name), length (rtrim (user_name)), 0, hbound (notify_seg.first_slot, 1)) + 1;
277
278 lookup_retry:
279 last_slot = 0;
280 do slot = notify_seg.first_slot (hash) repeat notify_seg.user (slot).next_slot while (slot ^= 0);
281 NEXT: call set_lock_$lock (notify_seg.user.lock_id (slot), 0, status);
282 if status ^= error_table_$lock_wait_time_exceeded & status ^= error_table_$locked_by_this_process then do;
283 call thread_out (chain, slot);
284 call free_slot (slot);
285 goto lookup_retry;
286 end;
287 else if notify_seg.user (slot).name = user_name then do;
288 if notify_seg.user (slot).authorization = my_authorization
289 then return (slot);
290 end;
291 else last_slot = slot;
292 end;
293
294 return (0);
295
296 end lookup;
297 %page;
298 allocate_slot: procedure () returns (fixed bin);
299 dcl slot fixed bin;
300
301 if notify_seg.first_free = 0 then call gc ();
302
303 slot = notify_seg.first_free;
304 notify_seg.first_free = notify_seg.user (slot).next_slot;
305
306 notify_seg.user (slot).name = me;
307 notify_seg.user (slot).lock_id = my_lock_id;
308 notify_seg.user (slot).authorization = my_authorization;
309 notify_seg.user (slot).next_slot = 0;
310
311 return (slot);
312 end allocate_slot;
313 %page;
314 free_slot: proc (slot);
315 dcl slot fixed bin;
316
317 notify_seg.user (slot).name = "";
318 notify_seg.user (slot).lock_id = ""b;
319 notify_seg.user (slot).authorization = ""b;
320 notify_seg.user (slot).next_slot = notify_seg.first_free;
321 notify_seg.first_free = slot;
322 return;
323 end free_slot;
324 %page;
325 thread_in: proc (chain, inslot);
326 dcl (chain, inslot) fixed bin;
327 dcl slot fixed bin;
328 dcl last_slot fixed bin;
329
330 last_slot = 0;
331 do slot = notify_seg.first_slot (chain) repeat notify_seg.user (slot).next_slot while (slot ^= 0);
332 last_slot = slot;
333 end;
334 if last_slot = 0 then
335 notify_seg.first_slot (chain) = inslot;
336 else notify_seg.user (last_slot).next_slot = inslot;
337
338 return;
339
340 end thread_in;
341 %page;
342 thread_out: proc (chain, outslot);
343 dcl chain fixed bin;
344 dcl outslot fixed bin;
345 dcl last_slot fixed bin;
346 dcl slot fixed bin;
347
348 last_slot = 0;
349 do slot = notify_seg.first_slot (chain) repeat notify_seg.user (slot).next_slot while (slot ^= 0);
350 if slot = outslot then do;
351 if last_slot = 0 then notify_seg.first_slot (chain) =
352 notify_seg.user (slot).next_slot;
353 else notify_seg.user (last_slot).next_slot =
354 notify_seg.user (slot).next_slot;
355 notify_seg.user (slot).next_slot = 0;
356 return;
357 end;
358 last_slot = slot;
359 end;
360 return;
361 end thread_out;
362
363 %page;
364 gc: proc ();
365 dcl (idx, slot) fixed bin;
366 dcl freed bit (1) aligned;
367
368 freed = "0"b;
369 do idx = 1 to hbound (notify_seg.first_slot, 1);
370 retry_gc_idx:
371 do slot = notify_seg.first_slot (idx) repeat notify_seg.user (slot).next_slot while (slot > 0);
372 call set_lock_$lock (notify_seg.user.lock_id (slot), 0, status);
373 if status ^= error_table_$lock_wait_time_exceeded &
374 status ^= error_table_$locked_by_this_process then do;
375 call thread_out (idx, slot);
376 call free_slot (slot);
377 freed = "1"b;
378 goto retry_gc_idx;
379 end;
380 end;
381 end;
382
383 if ^freed then do;
384 notify_seg.highest_used = notify_seg.highest_used + 1;
385 notify_seg.first_free = notify_seg.highest_used;
386 end;
387
388 return;
389 end gc;
390 %page;
391 initialize:
392 procedure (P_exit);
393
394 declare P_exit label variable;
395
396 exit = P_exit;
397 inner_ring = get_ring_ ();
398
399 call hcs_$level_set (inner_ring);
400
401 if notify_seg_ptr = null () then do;
402 call hcs_$initiate (forum_data_$central_directory, notify_seg_entry, "", 0, 0, notify_seg_ptr, (0));
403 if notify_seg_ptr = null () then call error (forum_error_table_$no_notify_seg);
404 if notify_seg.sentinel ^= sentinel then do;
405 call hcs_$terminate_noname (notify_seg_ptr, (0));
406 notify_seg_ptr = null ();
407 call error (forum_error_table_$notify_seg_bad);
408 end;
409 call user_info_$whoami (me, "", "");
410 call get_lock_id_ (my_lock_id);
411 call get_authorization_ (my_authorization);
412 end;
413
414 return;
415 end initialize;
416
417
418 error:
419 procedure (P_status);
420
421 declare P_status fixed bin (35);
422
423 status = P_status;
424 goto exit;
425
426 end error;
427
428 end forum_notifications_$accept;