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 set:
28 proc;
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52 dcl a_audit_flag bit (1) aligned parameter;
53 dcl a_auth char (*) parameter;
54 dcl a_bitct fixed bin (24) parameter;
55 dcl 1 a_btimes aligned like based_btimes;
56 dcl a_chasesw fixed bin (1) parameter;
57 dcl a_code fixed bin (35) parameter;
58 dcl a_copy fixed bin (1) parameter;
59 dcl a_damaged_sw bit (1) parameter;
60 dcl a_date bit (36) parameter;
61 dcl a_datep ptr parameter;
62 dcl a_delta_bc fixed bin (24) parameter;
63 dcl a_dirname char (*) parameter;
64 dcl a_dtime fixed bin (52) parameter;
65 dcl a_ename char (*) parameter;
66 dcl a_entry_bound fixed bin (14) parameter;
67 dcl a_max_length fixed bin (19) parameter;
68 dcl a_new_bc fixed bin (24) parameter;
69 dcl a_ncd fixed bin parameter;
70 dcl a_nid fixed bin parameter;
71 dcl a_old_bc fixed bin (24) parameter;
72 dcl a_safety_sw bit (1) parameter;
73 dcl a_segptr ptr parameter;
74 dcl a_setp ptr parameter;
75 dcl a_synchronized_sw bit (1) aligned parameter;
76
77
78
79 dcl 1 a_reload_set_info aligned based like reload_set_info;
80 dcl 1 based_time based aligned,
81 2 dtem bit (36),
82 2 dtd bit (36),
83 2 dtu bit (36),
84 2 dtm bit (36);
85
86 dcl 1 based_btimes based aligned,
87 2 dtem fixed bin (52),
88 2 dtd fixed bin (52),
89 2 dtu fixed bin (52),
90 2 dtm fixed bin (52);
91
92
93
94 dcl 1 access_name aligned,
95 2 person char (32),
96 2 project char (32),
97 2 tag char (1);
98 dcl audit_flag bit (1) aligned;
99 dcl auth char (32) aligned;
100 dcl authp ptr;
101 dcl bitct fixed bin (24);
102 dcl bs bit (1) aligned;
103 dcl 1 btimes aligned like based_btimes;
104 dcl chasesw fixed bin (1);
105 dcl check_rb bit (1) aligned;
106 dcl code fixed bin (35);
107 dcl copy fixed bin (1);
108 dcl damaged_sw bit (1) aligned;
109 dcl date bit (36);
110 dcl delta_bc fixed bin (24);
111 dcl detailed_operation fixed bin (18) uns;
112 dcl dirname char (168);
113 dcl dirsw bit (1) aligned;
114 dcl dtm bit (36) aligned;
115 dcl dtu bit (36) aligned;
116 dcl ename char (32);
117 dcl entry_bound fixed bin (14);
118 dcl entry_type fixed bin;
119 dcl find_was_called bit (1) aligned;
120 dcl max_length fixed bin (19);
121 dcl mxl fixed bin (9);
122 dcl ncd fixed bin;
123 dcl new_bc fixed bin (24);
124 dcl nid fixed bin;
125 dcl old_bc fixed bin (24);
126 dcl 1 pc_msk like vtoce_pc_sws aligned;
127 dcl 1 pc_val like vtoce_pc_sws aligned;
128 dcl priv_ml bit (1) aligned init ("0"b);
129 dcl pvid bit (36) aligned;
130 dcl safety_sw bit (1) aligned;
131 dcl segptr ptr;
132 dcl setp ptr;
133 dcl setting_for_reloader fixed bin init (0);
134 dcl synchronized_sw bit (1) aligned;
135 dcl 1 time aligned like based_time;
136 dcl uid bit (36) aligned;
137 dcl val fixed bin (17);
138 dcl vtocx fixed bin;
139
140
141
142 dcl Normal_entry fixed bin init (1) static options (constant);
143 dcl Set_bc_entry fixed bin init (2) static options (constant);
144 dcl Change_bc_entry fixed bin init (3) static options (constant);
145 dcl Dsw_entry fixed bin init (4) static options (constant);
146 dcl Set_bc_entry_priv fixed bin init (5) static options (constant);
147 dcl Normal_priv_entry fixed bin init (6) static options (constant);
148
149
150
151 dcl error_table_$ai_restricted external fixed bin (35);
152 dcl error_table_$argerr external fixed bin (35);
153 dcl error_table_$bad_ring_brackets external fixed bin (35);
154 dcl error_table_$dirseg external fixed bin (35);
155 dcl error_table_$link external fixed bin (35);
156 dcl error_table_$not_a_branch external fixed bin (35);
157 dcl error_table_$not_dm_ring external fixed bin (35);
158 dcl pds$access_name fixed bin (35) external;
159 dcl 1 pds$transparent ext aligned,
160 2 m bit (1) unaligned,
161 2 u bit (1) unaligned;
162 dcl sys_info$data_management_ringno fixed bin external;
163 dcl sys_info$seg_size_256K fixed bin (19) external;
164
165
166
167 dcl acc_name_$delete entry (ptr);
168 dcl acc_name_$elements entry (ptr, ptr, fixed bin (35));
169 dcl acc_name_$encode entry (ptr, ptr, fixed bin (35));
170 dcl change_dtem entry (ptr);
171 dcl level$get returns (fixed bin (17));
172 dcl lock$dir_unlock entry (pointer);
173 dcl mountedp entry (bit (36) aligned) returns (fixed bin (35));
174 dcl setfaults$if_active entry (bit (36) aligned, bit (36) aligned, fixed bin, bit (1) aligned);
175 dcl sum$dirmod entry (pointer);
176 dcl vtoc_attributes$reloading entry (bit (36) aligned, bit (36) aligned, fixed bin, bit (36) aligned, bit (36) aligned, fixed bin (9), fixed bin (35));
177 dcl vtoc_attributes$set_dates entry (bit (36) aligned, bit (36) aligned, fixed bin, bit (36) aligned, bit (36) aligned, fixed bin (35));
178 dcl vtoc_attributes$set_dump_switches entry (bit (36) aligned, bit (36) aligned, fixed bin, fixed bin, fixed bin, fixed bin (35));
179 dcl vtoc_attributes$set_max_lth entry (bit (36) aligned, bit (36) aligned, fixed bin, fixed bin (9), bit (1) aligned, fixed bin (35));
180 dcl vtoc_attributes$set_pc_switches entry (bit (36) aligned, bit (36) aligned, fixed bin, bit (36) aligned, bit (36) aligned, fixed bin (35));
181
182
183
184 dcl (addr, binary, bit, clock, fixed, divide, length, ptr, string, substr, unspec) builtin;
185 %page;
186
187
188
189
190 copysw:
191 entry (a_dirname, a_ename, a_copy, a_code);
192
193 detailed_operation = FS_OBJ_COPY_SW_MOD;
194 copy = a_copy;
195 chasesw = 1;
196 check_rb = "1"b;
197 entry_type = Normal_entry;
198 call find_entry;
199 entry.copysw = bit (copy, 1);
200 go to finish;
201 %page;
202
203
204
205
206 auth:
207 entry (a_dirname, a_ename, a_chasesw, a_auth, a_code);
208
209 detailed_operation = FS_OBJ_AUTHOR_MOD;
210 chasesw = a_chasesw;
211 auth = a_auth;
212 check_rb = "0"b;
213 entry_type = Normal_entry;
214 call find_entry;
215 authp = addr (entry.author);
216
217 set_auth:
218 call acc_name_$elements (addr (auth), addr (access_name), code);
219 if code ^= 0
220 then go to unlock;
221 call acc_name_$delete (authp);
222 call acc_name_$encode (authp, addr (access_name), code);
223 go to unlock;
224 %page;
225
226
227
228
229
230
231
232
233 bc_seg_priv:
234 entry (a_segptr, a_bitct, a_code);
235
236 entry_type = Set_bc_entry_priv;
237 go to bc_set_ptr_join;
238
239 bc_seg:
240 entry (a_segptr, a_bitct, a_code);
241
242 entry_type = Set_bc_entry;
243
244 bc_set_ptr_join:
245 detailed_operation = FS_OBJ_BC_MOD;
246 bitct = a_bitct;
247 check_rb = "0"b;
248 call get_entry_ptr;
249 if dirsw
250 then
251 goto dirseg;
252
253 go to set_bc;
254
255 bc:
256 entry (a_dirname, a_ename, a_bitct, a_code);
257
258 detailed_operation = FS_OBJ_BC_MOD;
259 bitct = a_bitct;
260 chasesw = 1;
261 check_rb = "0"b;
262 entry_type = Set_bc_entry;
263 call find_entry;
264
265 set_bc:
266 if entry.dirsw then
267 if binary (entry.ring_brackets (1), 3) > 1 then
268 if entry.multiple_class then
269 go to ai_error;
270
271 entry.bc = bitct;
272
273 call acc_name_$delete (addr (entry.bc_author));
274 call acc_name_$encode (addr (entry.bc_author), addr (pds$access_name), code);
275
276 go to finish;
277 %page;
278
279
280
281
282
283 change_bc_path:
284 entry (a_dirname, a_ename, a_delta_bc, a_old_bc, a_new_bc, a_code);
285
286 detailed_operation = FS_OBJ_BC_MOD;
287 delta_bc = a_delta_bc;
288 chasesw = 1;
289 check_rb = "0"b;
290 entry_type = Change_bc_entry;
291 call find_entry;
292 go to change_bc;
293
294
295
296
297 change_bc_ptr:
298 entry (a_segptr, a_delta_bc, a_old_bc, a_new_bc, a_code);
299
300 detailed_operation = FS_OBJ_BC_MOD;
301 delta_bc = a_delta_bc;
302 check_rb = "0"b;
303 entry_type = Change_bc_entry;
304 call get_entry_ptr;
305 if dirsw
306 then go to dirseg;
307
308 change_bc:
309 old_bc = entry.bc;
310 new_bc, bitct = old_bc + delta_bc;
311 go to set_bc;
312 %page;
313
314
315
316
317
318
319
320 dtd:
321 entry (a_dirname, a_ename, a_date, a_code);
322
323 date = a_date;
324 entry_type = Normal_entry;
325 go to set_dtd;
326
327 backup_dump_time:
328 entry (a_dirname, a_ename, a_dtime, a_code);
329
330 date = substr (bit (a_dtime, 52), 1, length (date));
331 entry_type = Normal_priv_entry;
332
333 set_dtd:
334 detailed_operation = FS_OBJ_DT_DUMPED_MOD;
335 chasesw = 0;
336 check_rb = "0"b;
337 call find_entry;
338 if bs
339 then entry.dtd = date;
340 else link.dtd = date;
341 go to unlock;
342 %page;
343
344
345
346
347 dates:
348 entry (a_dirname, a_ename, a_datep, a_code);
349
350 detailed_operation = FS_OBJ_DATES_MOD;
351 time = a_datep -> based_time;
352 chasesw = 0;
353 check_rb = "0"b;
354 entry_type = Normal_entry;
355 call find_entry;
356 if bs then do;
357 uid = entry.uid;
358 pvid = entry.pvid;
359 vtocx = entry.vtocx;
360 dtu = time.dtu;
361 dtm = time.dtm;
362 if dirsw
363 then code = 0;
364 else code = mountedp (dir.sons_lvid);
365 if code = 0
366 then call vtoc_attributes$set_dates (uid, pvid, vtocx, dtu, dtm, code);
367 if code ^= 0
368 then go to unlock;
369 entry.dtem = time.dtem;
370 entry.dtd = time.dtd;
371 end;
372 else do;
373 link.dtem = time.dtem;
374 link.dtd = time.dtd;
375 end;
376 go to unlock;
377 %page;
378
379
380
381
382 volume_dump_switches:
383 entry (a_dirname, a_ename, a_nid, a_ncd, a_code);
384
385 detailed_operation = FS_OBJ_VOL_DUMP_SW_MOD;
386 chasesw = 1;
387 check_rb = "1"b;
388 ncd = a_ncd;
389 nid = a_nid;
390 entry_type = Normal_entry;
391 call find_entry;
392 if bs then do;
393 uid = entry.uid;
394 pvid = entry.pvid;
395 vtocx = entry.vtocx;
396 if dirsw
397 then code = error_table_$dirseg;
398 else code = mountedp (dir.sons_lvid);
399 if code = 0
400 then call vtoc_attributes$set_dump_switches (uid, pvid, vtocx, nid, ncd, code);
401 end;
402 else code = error_table_$link;
403 goto unlock;
404 %page;
405
406
407
408
409 backup_times:
410 entry (a_dirname, a_ename, a_btimes, a_code);
411
412 detailed_operation = FS_OBJ_BACKUP_TIMES_MOD;
413 btimes = a_btimes;
414 chasesw = 0;
415 check_rb = "0"b;
416 entry_type = Normal_entry;
417 call find_entry;
418 if bs then do;
419 uid = entry.uid;
420 pvid = entry.pvid;
421 vtocx = entry.vtocx;
422 dtu = substr (bit (btimes.dtu, 52), 1, length (dtu));
423 dtm = substr (bit (btimes.dtm, 52), 1, length (dtm));
424 if dirsw
425 then code = 0;
426 else code = mountedp (dir.sons_lvid);
427 if code = 0
428 then call vtoc_attributes$set_dates (uid, pvid, vtocx, dtu, dtm, code);
429 if code ^= 0
430 then go to unlock;
431 entry.dtem = substr (bit (btimes.dtem, 52), 1, length (entry.dtem));
432 entry.dtd = substr (bit (btimes.dtd, 52), 1, length (entry.dtd));
433 end;
434 else do;
435 link.dtem = substr (bit (btimes.dtem, 52), 1, length (link.dtem));
436 link.dtd = substr (bit (btimes.dtd, 36), 1, length (link.dtd));
437 end;
438 go to unlock;
439 %page;
440
441
442
443
444
445
446 safety_sw_ptr:
447 entry (a_segptr, a_safety_sw, a_code);
448
449 detailed_operation = FS_OBJ_SAFETY_SW_MOD;
450 safety_sw = a_safety_sw;
451 check_rb = "1"b;
452 entry_type = Normal_entry;
453 call get_entry_ptr;
454 go to set_safety;
455
456 safety_sw_path:
457 entry (a_dirname, a_ename, a_safety_sw, a_code);
458
459 detailed_operation = FS_OBJ_SAFETY_SW_MOD;
460 safety_sw = a_safety_sw;
461 chasesw = 1;
462 check_rb = "1"b;
463 entry_type = Normal_entry;
464 call find_entry;
465
466 set_safety:
467 entry.safety_sw = safety_sw;
468 go to finish;
469 %page;
470
471
472
473 audit_flag_path:
474 entry (a_dirname, a_ename, a_audit_flag, a_code);
475
476 detailed_operation = FS_OBJ_AUDIT_FLAG_MOD;
477 audit_flag = a_audit_flag;
478 chasesw = 1;
479 check_rb = "1"b;
480 entry_type = Normal_entry;
481 call find_entry;
482
483 set_audit_flag:
484 entry.audit_flag = audit_flag;
485 go to finish;
486 %page;
487
488
489
490
491
492
493 damaged_sw_ptr:
494 entry (a_segptr, a_damaged_sw, a_code);
495
496 detailed_operation = FS_OBJ_DAMAGED_SW_MOD;
497 damaged_sw = a_damaged_sw;
498 check_rb = "1"b;
499 entry_type = Dsw_entry;
500 call get_entry_ptr;
501 go to set_damaged;
502
503 damaged_sw_path:
504 entry (a_dirname, a_ename, a_damaged_sw, a_code);
505
506 detailed_operation = FS_OBJ_DAMAGED_SW_MOD;
507 damaged_sw = a_damaged_sw;
508 chasesw = 1;
509 check_rb = "1"b;
510 entry_type = Dsw_entry;
511 call find_entry;
512
513 set_damaged:
514 unspec (pc_val) = ""b;
515 unspec (pc_msk) = ""b;
516 pc_val.damaged = damaged_sw;
517 pc_msk.damaged = "1"b;
518 uid = entry.uid;
519 pvid = entry.pvid;
520 vtocx = entry.vtocx;
521 if dirsw
522 then code = 0;
523 else code = mountedp (dir.sons_lvid);
524 if code = 0
525 then call vtoc_attributes$set_pc_switches (uid, pvid, vtocx, string (pc_val), string (pc_msk), code);
526 if code ^= 0
527 then go to unlock;
528 go to finish;
529 %page;
530
531
532
533
534
535
536
537
538 declare a_dnzp_sw bit (1) aligned parameter;
539
540
541
542 declare dnzp_sw bit (1) aligned;
543
544
545
546 dnzp_sw_ptr:
547 entry (a_segptr, a_dnzp_sw, a_code);
548
549 detailed_operation = FS_OBJ_DNZP_MOD;
550 dnzp_sw = a_dnzp_sw;
551 check_rb = "1"b;
552 entry_type = Normal_entry;
553 call get_entry_ptr;
554 go to set_dnzp;
555
556 dnzp_sw_path:
557 entry (a_dirname, a_ename, a_dnzp_sw, a_code);
558
559 detailed_operation = FS_OBJ_DNZP_MOD;
560 dnzp_sw = a_dnzp_sw;
561 chasesw = 1;
562 check_rb = "1"b;
563 entry_type = Normal_entry;
564 call find_entry;
565
566 set_dnzp:
567 if dirsw
568 then go to dirseg;
569
570 unspec (pc_val) = ""b;
571 unspec (pc_msk) = ""b;
572 pc_val.dnzp = dnzp_sw;
573 pc_msk.dnzp = "1"b;
574 uid = entry.uid;
575 pvid = entry.pvid;
576 vtocx = entry.vtocx;
577 if dirsw
578 then code = 0;
579 else code = mountedp (dir.sons_lvid);
580 if code = 0
581 then call vtoc_attributes$set_pc_switches (uid, pvid, vtocx, string (pc_val), string (pc_msk), code);
582 if code ^= 0
583 then go to unlock;
584 go to finish;
585 %page;
586
587
588
589
590 synchronized_sw:
591 entry (a_dirname, a_ename, a_synchronized_sw, a_code);
592
593 detailed_operation = FS_OBJ_SYNC_SW_MOD;
594 synchronized_sw = a_synchronized_sw;
595 chasesw = 0;
596 check_rb = "1"b;
597 entry_type = Normal_entry;
598 call find_entry;
599
600 if dirsw
601 then goto dirseg;
602
603 if fixed (entry.ring_brackets (1), 3) > sys_info$data_management_ringno
604 then do;
605 code = error_table_$not_dm_ring;
606 goto unlock;
607 end;
608
609 unspec (pc_val) = ""b;
610 unspec (pc_msk) = ""b;
611 pc_val.synchronized = synchronized_sw;
612 pc_msk.synchronized = "1"b;
613 uid = entry.uid;
614 pvid = entry.pvid;
615 vtocx = entry.vtocx;
616 code = mountedp (dir.sons_lvid);
617 if code = 0
618 then call vtoc_attributes$set_pc_switches (uid, pvid, vtocx, string (pc_val), string (pc_msk), code);
619 if code ^= 0 then goto unlock;
620 goto finish;
621 %page;
622
623
624
625
626
627
628 max_length_ptr:
629 entry (a_segptr, a_max_length, a_code);
630
631 detailed_operation = FS_OBJ_MAX_LEN_MOD;
632 max_length = a_max_length;
633 check_rb = "1"b;
634 entry_type = Normal_entry;
635 call get_entry_ptr;
636 go to set_max_length;
637
638 max_length_priv:
639 entry (a_dirname, a_ename, a_max_length, a_code);
640
641 priv_ml = "1"b;
642 check_rb = "0"b;
643 goto cp_ml_args;
644
645 max_length_path:
646 entry (a_dirname, a_ename, a_max_length, a_code);
647 check_rb = "1"b;
648
649 cp_ml_args:
650 detailed_operation = FS_OBJ_MAX_LEN_MOD;
651 max_length = a_max_length;
652 chasesw = 1;
653 entry_type = Normal_entry;
654 call find_entry;
655
656 set_max_length:
657 if dirsw
658 then go to dirseg;
659 if max_length < 0
660 then go to argerr;
661 if max_length > sys_info$seg_size_256K
662 then go to argerr;
663 uid = entry.uid;
664 pvid = entry.pvid;
665 vtocx = entry.vtocx;
666 mxl = divide (max_length + 1023, 1024, 9, 0);
667 code = mountedp (dir.sons_lvid);
668 if code = 0
669 then call vtoc_attributes$set_max_lth (uid, pvid, vtocx, mxl, priv_ml, code);
670 if code ^= 0
671 then go to unlock;
672 go to finish;
673 %page;
674
675
676
677
678 bc_auth_path:
679 entry (a_dirname, a_ename, a_auth, a_code);
680
681 detailed_operation = FS_OBJ_BC_AUTHOR_MOD;
682 auth = a_auth;
683 chasesw = 1;
684 check_rb = "0"b;
685 entry_type = Normal_entry;
686 call find_entry;
687
688 authp = addr (entry.bc_author);
689 go to set_auth;
690 %page;
691
692
693
694
695
696
697
698
699
700 entry_bound_ptr:
701 entry (a_segptr, a_entry_bound, a_code);
702
703 detailed_operation = FS_OBJ_ENTRY_BOUND_MOD;
704 entry_bound = a_entry_bound;
705 check_rb = "1"b;
706 entry_type = Normal_entry;
707 call get_entry_ptr;
708 go to set_call_limiter;
709
710 entry_bound_path:
711 entry (a_dirname, a_ename, a_entry_bound, a_code);
712
713 detailed_operation = FS_OBJ_ENTRY_BOUND_MOD;
714 entry_bound = a_entry_bound;
715 chasesw = 1;
716 check_rb = "1"b;
717 entry_type = Normal_entry;
718 call find_entry;
719
720 set_call_limiter:
721 if dirsw
722 then go to dirseg;
723 if entry_bound < 0
724 then go to argerr;
725 if entry_bound > 16383
726 then go to argerr;
727 uid = entry.uid;
728 pvid = entry.pvid;
729 vtocx = entry.vtocx;
730 call setfaults$if_active (uid, pvid, vtocx, "0"b);
731 if entry_bound = 0 then do;
732 entry.entrypt_sw = "0"b;
733 entry.entrypt_bound = "0"b;
734 end;
735 else do;
736 entry.entrypt_sw = "1"b;
737 entry.entrypt_bound = bit (entry_bound, 14);
738 end;
739 go to finish;
740 %page;
741
742
743
744
745
746
747
748
749
750
751
752
753
754 set_for_reloader:
755 entry (a_dirname, a_ename, a_setp, a_code);
756
757 detailed_operation = FS_OBJ_FOR_RELOADER_MOD;
758 setp = a_setp;
759 reload_set_info = setp -> a_reload_set_info;
760 if reload_set_info.version ^= reload_set_version_2 then do;
761
762 a_code = error_table_$argerr;
763 return;
764 end;
765 setting_for_reloader = 1;
766 chasesw = 0;
767 check_rb = "0"b;
768 entry_type = Normal_priv_entry;
769 call find_entry;
770 uid = entry.uid;
771 pvid = entry.pvid;
772 vtocx = entry.vtocx;
773
774 if ^bs then do;
775 code = error_table_$not_a_branch;
776 go to unlock;
777 end;
778
779 if reload_set_info.should_set.safety_sw
780 then
781 entry.safety_sw = reload_set_info.safety_sw;
782
783 if reload_set_info.should_set.audit_flag
784 then
785 entry.audit_flag = reload_set_info.audit_flag;
786
787
788
789 if reload_set_info.should_set.author then do;
790 authp = addr (entry.author);
791 call acc_name_$elements (addr (reload_set_info.author), addr (access_name), reload_set_info.author_code);
792 if reload_set_info.author_code = 0 then do;
793 call acc_name_$delete (authp);
794 call acc_name_$encode (authp, addr (access_name), reload_set_info.author_code);
795 end;
796 end;
797
798 if reload_set_info.should_set.bc_author then do;
799 authp = addr (entry.bc_author);
800 call acc_name_$elements (addr (reload_set_info.bc_author), addr (access_name),
801 reload_set_info.bc_author_code);
802 if reload_set_info.bc_author_code = 0 then do;
803 call acc_name_$delete (authp);
804 call acc_name_$encode (authp, addr (access_name), reload_set_info.bc_author_code);
805 end;
806 end;
807
808
809
810
811
812
813 if reload_set_info.should_set.dtu
814 then dtu = reload_set_info.dtu;
815 else dtu = "0"b;
816
817 if reload_set_info.should_set.dtm
818 then dtm = reload_set_info.dtm;
819 else dtm = "0"b;
820
821 mxl = -1;
822 if reload_set_info.should_set.max_length then do;
823 if dirsw
824 then reload_set_info.max_length_code = error_table_$dirseg;
825
826 else if reload_set_info.max_length < 0
827 then reload_set_info.max_length_code = error_table_$argerr;
828 else mxl = divide (reload_set_info.max_length + 1023, 1024, 9, 0);
829 end;
830
831 if dtm | dtu | mxl >= 0 then do;
832 if dirsw
833 then code = 0;
834 else code = mountedp (dir.sons_lvid);
835 if code = 0
836 then call vtoc_attributes$reloading (uid, pvid, vtocx, dtu, dtm, mxl, code);
837 NOTE
838 end;
839
840 if reload_set_info.should_set.entry_bound then do;
841 if dirsw
842 then reload_set_info.entry_bound_code = error_table_$dirseg;
843 else if reload_set_info.entry_bound < 0
844 then reload_set_info.entry_bound_code = error_table_$argerr;
845 else if reload_set_info.entry_bound > 16383
846 then reload_set_info.entry_bound_code = error_table_$argerr;
847 else do;
848 if mxl < 0 | code ^= 0
849 then
850 call setfaults$if_active (uid, pvid, vtocx, "0"b);
851 if reload_set_info.entry_bound = 0 then do;
852
853 entry.entrypt_sw = "0"b;
854 entry.entrypt_bound = "0"b;
855 end;
856 else do;
857 entry.entrypt_sw = "1"b;
858 entry.entrypt_bound = bit (reload_set_info.entry_bound, 14);
859 end;
860 end;
861 end;
862
863 if reload_set_info.should_set.dtem
864 then
865 entry.dtem = reload_set_info.dtem;
866
867 if reload_set_info.should_set.dtd
868 then
869 entry.dtd = reload_set_info.dtd;
870
871 go to finish;
872 %page;
873
874
875
876 finish:
877 if pds$transparent.m = "0"b
878 then if entry.dtem ^= bit (binary (clock (), 52), 36)
879 then call change_dtem (ep);
880
881 unlock:
882 call sum$dirmod (dp);
883 if find_was_called
884 then call dc_find$finished (dp, "1"b);
885 else call lock$dir_unlock (dp);
886
887 if setting_for_reloader ^= 0
888 then setp -> a_reload_set_info = reload_set_info;
889 else if entry_type = Change_bc_entry then do;
890 a_old_bc = old_bc;
891 a_new_bc = new_bc;
892 end;
893
894 finale:
895 a_code = code;
896 return;
897
898
899
900 ai_error:
901 code = error_table_$ai_restricted;
902 go to unlock;
903
904 argerr:
905 code = error_table_$argerr;
906 go to unlock;
907
908 dirseg:
909 code = error_table_$dirseg;
910 go to unlock;
911
912 bracket_error:
913 code = error_table_$bad_ring_brackets;
914 goto unlock;
915 %page;
916
917
918 find_entry:
919 proc;
920
921 code = 0;
922 dirname = a_dirname;
923 ename = a_ename;
924 if entry_type = Normal_entry then
925 call dc_find$obj_status_write (dirname, ename, chasesw, detailed_operation, ep, code);
926 else if entry_type = Set_bc_entry then
927 call dc_find$obj_bc_write (dirname, ename, bitct, ep, code);
928 else if entry_type = Change_bc_entry then
929 call dc_find$obj_bc_delta_write (dirname, ename, delta_bc, ep, code);
930 else if entry_type = Dsw_entry then
931 call dc_find$obj_attributes_write (dirname, ename, chasesw, detailed_operation, ep, code);
932 else if entry_type = Set_bc_entry_priv | entry_type = Normal_priv_entry then
933 call dc_find$obj_status_write_priv (dirname, ename, chasesw, detailed_operation, ep, code);
934 dp = ptr (ep, 0);
935 if code ^= 0
936 then go to finale;
937 find_was_called = "1"b;
938 go to check;
939
940 get_entry_ptr:
941 entry;
942
943 code = 0;
944 segptr = a_segptr;
945 find_was_called = "0"b;
946 if entry_type = Normal_entry then
947 call dc_find$obj_status_write_ptr (segptr, detailed_operation, ep, code);
948 else if entry_type = Set_bc_entry then
949 call dc_find$obj_bc_write_ptr (segptr, bitct, ep, code);
950 else if entry_type = Change_bc_entry then
951 call dc_find$obj_bc_delta_write_ptr (segptr, delta_bc, ep, code);
952 else if entry_type = Dsw_entry then
953 call dc_find$obj_attributes_write_ptr (segptr, detailed_operation, ep, code);
954 else if entry_type = Set_bc_entry_priv | entry_type = Normal_priv_entry then
955 call dc_find$obj_status_write_priv_ptr (segptr, detailed_operation, ep, code);
956 dp = ptr (ep, 0);
957 if code ^= 0
958 then go to finale;
959
960 check:
961 bs = entry.bs;
962 dirsw = entry.dirsw;
963 if check_rb then do;
964 val = level$get ();
965 if dirsw then do;
966 if val > fixed (entry.ex_ring_brackets (1), 3)
967 then go to bracket_error;
968 end;
969 else do;
970 if val > fixed (entry.ring_brackets (1), 3)
971 then go to bracket_error;
972 end;
973 end;
974
975 end find_entry;
976 %page;
977
978
979 %page; %include dc_find_dcls;
980 %page; %include dir_entry;
981 %page; %include dir_header;
982 %page; %include dir_link;
983 %page; %include fs_obj_access_codes;
984 %page; %include reload_set_info;
985 %page; %include vtoce_pc_sws;
986 end set;