-
Notifications
You must be signed in to change notification settings - Fork 0
/
lock.list
2223 lines (2197 loc) · 120 KB
/
lock.list
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
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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
COMPILATION LISTING OF SEGMENT lock
Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989
Compiled at: Bull HN, Phoenix AZ, System-M
Compiled on: 11/11/89 1022.3 mst Sat
Options: optimize map
1 /****^ ***********************************************************
2* * *
3* * Copyright, (C) Honeywell Bull Inc., 1987 *
4* * *
5* * Copyright, (C) Honeywell Information Systems Inc., 1982 *
6* * *
7* * Copyright (c) 1972 by Massachusetts Institute of *
8* * Technology and Honeywell Information Systems, Inc. *
9* * *
10* *********************************************************** */
11
12
13
14 /****^ HISTORY COMMENTS:
15* 1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
16* audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
17* Correct error message documentation.
18* 2) change(87-03-31,Fawcett), approve(87-04-23,MCR7672),
19* audit(87-04-23,Farley), install(87-04-28,MR12.1-1028):
20* Corrected dir_unlock_given_uid to use "ind". Put the mylock check in
21* LOCK_FAST into the stac do loop to possibly avoid a missed cache write
22* notify on lock.pid. Added VALIDATE_CACHE internal proc to insure that
23* the cache and memory contents of lock_count and highset_in_use are the
24* same and detect any differences.
25* END HISTORY COMMENTS */
26
27
28 /* format: style3 */
29
30 lock:
31 procedure;
32
33 /* format: off */
34
35 /* * LOCK - ring zero primitive for shared data base locking.
36* *
37* * This procedure supplies a number of entry points for manipulating
38* * locks. Its coding is dependent on the read-alter-rewrite ability
39* * provided by the STAC and STACQ instructions.
40* *
41* * The following entry points are available for setting a lock:
42* *
43* * lock$try -
44* *
45* * declare lock$try external entry (ptr, fixed bin(35), fixed bin(35), fixed bin(1));
46* * call lock$try (lock_ptr, event, code, failsw);
47* *
48* * lock$wait -
49* *
50* * declare lock$wait external entry (ptr, fixed bin(35), fixed bin(35));
51* * call lock$wait (lock_ptr, event, code);
52* *
53* * lock$dir_wait -
54* *
55* * declare lock$dir_wait external entry (ptr, bit(36) aligned, fixed bin(35));
56* * call lock$dir_wait (dp, typelock, code);
57* *
58* * lock$dir_try -
59* *
60* * declare lock$dir_try external entry (ptr, bit(36) aligned, fixed bin(35), fixed bin(1));
61* * call lock$dir_try (dp, typelock, code, failsw);
62* *
63* * Where -
64* * lock_ptr is a pointer to the lock to be set. (Input)
65* * dp is a pointer to the directory whose lock is to be set. (Input)
66* * typelock = "0"b if locked for read, = "1"b if locked for write. (Input)
67* * code is a standard error code. (Output)
68* * event is the event to be waited for if the lock cannot be set. (Input)
69* * failsw = 0 if lock was set, = 1 if unable to set lock. (Output)
70* *
71* * lock$dir_lock_(read write) -
72* * declare lock$dir_lock_(write read) entry (ptr, fixed bin (35));
73* * call lock$dir_lock_(write read) (dp, code);
74* *
75* * These entries crash on mylock, and trust dir.uid, and salvage
76* * the directory under certain circumstances. They do wait for the lock.
77* *
78* * lock$dir_lock_salvage -
79* *
80* * declare lock$dir_lock_salvage entry (ptr, bit (36) aligned,
81* * fixed bin (35));
82* * call lock$dir_lock_salvage (dp, uid, code);
83* *
84* * This SIDE-DOOR for the salvager :
85* * 1) derives the UID for locking from the kst, not dir.uid.
86* * 2) returns mylock rather than crashing
87* * 3) takes a write lock.
88* * 4) returns the UID used for locking
89* *
90* *
91* * The following entry points are available for unlocking a lock:
92* *
93* * lock$dir_unlock_given_uid -
94* *
95* * declare lock$dir_unlock_given_uid
96* * external entry (bit (36) aligned);
97* * call lock$dir_unlock_given_uid (dir_uid);
98* *
99* * This entrypoint is for use when the contents of the directory
100* * are untrustworthy. Primarily for the salvager.
101* *
102* * lock$dir_unlock -
103* *
104* * declare lock$dir_unlock entry (pointer);
105* * call lock$dir_unlock (dp);
106* *
107* * This is the ordinary dir-unlocker.
108*
109* *
110* * lock$unlock -
111* *
112* * declare lock$unlock external entry (ptr, fixed bin(35));
113* * call lock$unlock (lock_ptr, event);
114* *
115* * Where -
116* * lock_ptr is a pointer to the lock to be unlocked. (Input)
117* * dp is a pointer to the directory to be unlocked. (Input)
118* * event is the event to be signalled after resetting the lock. (Input)
119* *
120* *
121* * Modifications:
122* * 20 Apr 1975, Andre Bensoussan: Rewritten for the new storage system.
123* * 23 Sep 1975, Andre Bensoussan: Move call to caller() from internal proc to beginning of each entry point.
124* * 24 Sep 1975, Andre Bensoussan: dir.modify is no longer reset to 0 by unlock_dir.
125* * Also the entry lock$modify_dir has been eliminated.
126* * Added new entries for lock_ast and unlock_ast.
127* * 25 Feb 1976, RE Mullen: Added ast lock metering code.
128* * 13 Jul 1978, B. Greenberg: Changed not to DIRW per-process dirs, and clock and stacq bifs.
129* * 13 Feb 1980, M. Grady: fixed race condition with lock_dir and on_line_salvager.
130* * 10 Aug 1981, W. Olin Sibert: changed lock_dir to validate UID in dir header vs. UID in KSTE,
131* * changes for external static SST, and, *sigh*, format_pl1'd it.
132* * 21 Nov 1981, J. Bongiovanni for ast lock metering
133* Dec 81/Jan 82, Benson I. Margulies, multiple reader dir locks.
134* * 2/82 BIM for salvager dir sidedoors.
135* * 7 August 1982, J. Bongiovanni, don't stash AST locks in pds$lock_array,
136* * meter AST locking conditionally
137* * Modified 830111 BIM to improve interactions of locking and salvaging.
138* * 13 January 1983, J. Bongiovanni, to fix some races and add a trap
139* * Modified 830118 BIM to try again to find the race.
140* * Modified 830817 BIM to use salvage_entry not salvage_sw.
141* * Modified 831107 BIM to make array of dir locks quick to reference.
142* * Modified 831110 BIM to revert to heap strategy for dir locks.
143* * Modified 841102 KPL to fix dirw and to improve its efficiency.
144* */
145
146
147 /* format: on */
148
149 dcl prds$processor_tag ext fixed bin (3);
150 dcl absadr entry (ptr, fixed bin (35)) returns (fixed bin (26));
151 dcl CPU_NAMES char (8) aligned internal static options (constant) init ("abcdefgh");
152 dcl a_lock_ptr pointer parameter; /* Arguments - pointer to lock */
153 dcl a_dp pointer parameter; /* pointer to directory */
154 dcl a_ind bit (36) aligned parameter; /* wait event for lock */
155 dcl a_typelock bit (36) aligned parameter; /* = "0"b if read lock, = "1"b if write lock */
156 dcl a_code fixed bin (35) parameter; /* standard error code */
157 dcl a_failsw fixed bin (1) parameter; /* = 1 if try lock failed */
158 dcl a_dir_uid bit (36) aligned; /* returned to salvager */
159
160 dcl per_process_flag bit (1);
161 dcl must_salvage bit (1) aligned;
162 dcl ind bit (36) aligned; /* wait event for lock */
163 dcl caller_ptr pointer; /* pointer to where we were called from (+1) */
164 dcl dir_uid bit (36) aligned; /* global var set by LOCK_DIR_SALVAGE */
165 dcl code fixed bin (35); /* code set by internal procedure LOCK */
166 dcl failsw fixed bin (1);
167 dcl (time_in, time_out) fixed bin (52); /* temporaries for ast lock metering */
168
169 dcl seg_fault_error condition;
170
171 dcl error_table_$mylock fixed bin (35) external static;
172 dcl error_table_$dir_damage
173 fixed bin (35) external static;
174 dcl error_table_$notadir
175 fixed bin (35) ext static;
176
177 dcl sst$ast_locked_at_time
178 fixed bin (71) external static;
179 dcl sst$ast_locked_total_time
180 fixed bin (71) external static;
181 dcl sst$ast_locking_count
182 fixed bin (35) external static;
183 dcl sst$ast_lock_wait_time
184 fixed bin (71) external static;
185 dcl sst$astl bit (36) aligned external static;
186 dcl sst$dirlock_writebehind
187 fixed bin external static;
188 dcl sst$lock_waits fixed bin (35) external static;
189 dcl sst$meter_ast_locking
190 fixed bin external static;
191 dcl tc_data$lock_error_severity
192 fixed bin external static;
193
194 dcl pds$block_lock_count
195 fixed bin external static; /* count of locks set to this process */
196 dcl pds$processid bit (36) aligned external static;
197 dcl tc_data$system_shutdown
198 fixed bin external static; /* for determining whether to force the lock */
199
200 dcl caller entry returns (pointer); /* returns a pointer to our caller */
201 dcl get_kstep entry (fixed bin, pointer, fixed bin (35));
202 dcl meter_ast_lock$lock entry;
203 dcl meter_ast_lock$unlock
204 entry;
205 dcl on_line_salvager entry (pointer, fixed bin (35));
206 dcl pxss$addevent entry (bit (36) aligned);
207 dcl pxss$delevent entry (bit (36) aligned);
208 dcl pxss$notify entry (bit (36) aligned);
209 dcl pxss$wait entry;
210 dcl syserr entry options (variable);
211 dcl update_vtoce entry (pointer);
212
213 dcl (addr, baseno, binary, clock, hbound, max, null, segno, stac, stacq, substr, unspec)
214 builtin;
215
216
217 try:
218 entry (a_lock_ptr, a_ind, a_code, a_failsw);
219
220 caller_ptr = caller ();
221 call LOCK (a_lock_ptr, a_ind, a_code, a_failsw, 0 /* waitsw */);
222 return;
223
224 wait:
225 entry (a_lock_ptr, a_ind, a_code);
226
227 caller_ptr = caller ();
228 call LOCK (a_lock_ptr, a_ind, a_code, failsw, 1 /* waitsw */);
229 return;
230
231 unlock:
232 entry (a_lock_ptr, a_ind);
233
234 caller_ptr = caller ();
235 call UNLOCK (a_lock_ptr, a_ind);
236 return;
237
238
239
240
241 lock_fast:
242 entry (a_lock_ptr);
243 caller_ptr = caller ();
244 call LOCK_FAST (a_lock_ptr);
245 return;
246
247 unlock_fast:
248 entry (a_lock_ptr);
249 caller_ptr = caller ();
250 call UNLOCK_FAST (a_lock_ptr);
251 return;
252
253
254 lock_ast:
255 entry;
256 caller_ptr = caller ();
257 time_in = clock ();
258 call LOCK_FAST (addr (sst$astl));
259 if sst$meter_ast_locking ^= 0
260 then call meter_ast_lock$lock;
261 time_out = clock ();
262 sst$ast_lock_wait_time = sst$ast_lock_wait_time + time_out - time_in;
263 sst$ast_locked_at_time = time_out;
264 sst$ast_locking_count = sst$ast_locking_count + 1;
265 return;
266
267
268 unlock_ast:
269 entry;
270 caller_ptr = caller ();
271 sst$ast_locked_total_time = sst$ast_locked_total_time - sst$ast_locked_at_time + clock ();
272 if sst$meter_ast_locking ^= 0
273 then call meter_ast_lock$unlock;
274 call UNLOCK_FAST (addr (sst$astl));
275 return;
276
277
278
279 dir_wait:
280 entry (a_dp, a_typelock, a_code);
281
282 caller_ptr = caller ();
283 call LOCK_DIR (a_dp, a_typelock, a_code, failsw, 1 /* waitsw */);
284
285 return;
286
287 dir_try:
288 entry (a_dp, a_typelock, a_code, a_failsw);
289
290 caller_ptr = caller ();
291 call LOCK_DIR (a_dp, a_typelock, a_code, a_failsw, 0 /* waitsw */);
292 return;
293
294 dir_unlock:
295 entry (a_dp);
296
297 caller_ptr = caller ();
298 ind = a_dp -> dir.uid;
299 call UNLOCK_DIR (a_dp, ind);
300 return;
301
302 dir_unlock_given_uid:
303 entry (a_dir_uid);
304
305 caller_ptr = caller ();
306 ind = a_dir_uid;
307 call UNLOCK_DIR_NOCHECK (null, ind);
308 return;
309
310
311 dir_lock_read:
312 entry (a_dp, a_code);
313
314 caller_ptr = caller ();
315 call LOCK_DIR (a_dp, (36)"0"b, a_code, failsw, 1 /* waitsw */);
316 if a_code = error_table_$mylock
317 then call syserr (CRASH, "lock: dir_lock_read mylock err. dp =^p", a_dp);
318 return;
319
320 dir_lock_write:
321 entry (a_dp, a_code);
322
323 caller_ptr = caller ();
324 call LOCK_DIR (a_dp, (36)"1"b, a_code, failsw, 1 /* waitsw */);
325 if a_code = error_table_$mylock
326 then call syserr (CRASH, "lock: dir_lock_write mylock err. dp =^p", a_dp);
327 return;
328
329 dir_lock_salvage:
330 entry (a_dp, a_dir_uid, a_code);
331
332 caller_ptr = caller ();
333 dir_uid = ""b;
334 call LOCK_DIR_SALVAGE (a_dp, (36)"1"b, a_code, failsw, 1 /* waitsw */);
335 /* Always locks for write */
336 a_dir_uid = dir_uid;
337 return;
338
339
340
341 LOCK:
342 procedure (lock_ptr, ind, code, failsw, waitsw);
343
344 dcl lock_ptr ptr,
345 ind bit (36) aligned,
346 code fixed bin (35),
347 failsw fixed bin (1),
348 waitsw fixed bin (1);
349
350 dcl lwd bit (36) aligned based (lock_ptr);
351
352 code = 0;
353 failsw = 0;
354
355 if tc_data$system_shutdown ^= 0
356 then return;
357
358 if lwd = pds$processid
359 then do;
360 code = error_table_$mylock;
361 goto POST;
362 end;
363
364 pds$block_lock_count = pds$block_lock_count + 1;
365
366 do while (^stac (lock_ptr, pds$processid));
367 if waitsw = 0
368 then do;
369 failsw = 1;
370 pds$block_lock_count = pds$block_lock_count - 1;
371 goto POST;
372 end;
373
374 call pxss$addevent (ind);
375
376 if lwd = "0"b
377 then call pxss$delevent (ind);
378 else do;
379 call pxss$wait;
380 sst$lock_waits = sst$lock_waits + 1;
381 end;
382 end;
383
384 POST:
385 return;
386
387 end LOCK;
388
389
390
391 UNLOCK:
392 procedure (lock_ptr, ind);
393
394 dcl lock_ptr ptr,
395 lwd bit (36) aligned based (lock_ptr),
396 ind bit (36) aligned;
397
398
399
400 code = 0;
401 failsw = 0;
402
403 if tc_data$system_shutdown ^= 0
404 then return; /* system shutdown ? */
405
406
407 if pds$block_lock_count <= 0
408 then do;
409 call syserr (tc_data$lock_error_severity, "lock: pds$block_lock_count <= 0. caller = ^p.", caller ());
410 pds$block_lock_count = 0;
411 end;
412
413 if ^stacq (lwd, "000000000000"b3, pds$processid)
414 then do;
415 call syserr (tc_data$lock_error_severity, "lock: lock ^p not equal to processid. caller = ^p",
416 addr (lwd), caller ());
417 goto FORGET_RETURN;
418 end;
419
420 if lwd = pds$processid /* Always crash if the hardware craps */
421 then call syserr (CRASH, "lock: stacq hardware failure on ^p", lock_ptr);
422 call pxss$notify (ind); /* tell the world */
423
424 FORGET_RETURN:
425 pds$block_lock_count = pds$block_lock_count - 1;
426
427 return;
428
429 end UNLOCK;
430
431
432
433 LOCK_FAST:
434 proc (lock_ptr);
435
436
1 1 /* Begin include file hc_lock.incl.pl1 BIM 2/82 */
1 2 /* Replaced by hc_fast_lock.incl.pl1 RSC 11/84 because name of structure
1 3* encourages name conflicts.
1 4* USE HC_FAST_LOCK INSTEAD!
1 5**/
1 6
1 7 /* Lock format suitable for use with lock$lock_fast, unlock_fast */
1 8
1 9 /* format: style3 */
1 10
1 11 declare lock_ptr pointer;
1 12 declare 1 lock aligned based (lock_ptr),
1 13 2 pid bit (36) aligned, /* holder of lock */
1 14 2 event bit (36) aligned, /* event associated with lock */
1 15 2 flags aligned,
1 16 3 notify_sw bit (1) unaligned,
1 17 3 pad bit (35) unaligned; /* certain locks use this pad, like dirs */
1 18
1 19 /* End include file hc_lock.incl.pl1 */
437
438 /* the ptr in here becomes a parameter */
439
440 if tc_data$system_shutdown ^= 0
441 then return;
442
443 do while (^stac (addr (lock.pid), pds$processid));
444 if lock.pid = pds$processid
445 then call syserr (CRASH, "lock: lock_fast mylock err ^p", lock_ptr);
446 lock.notify_sw = "1"b;
447 call pxss$addevent (lock.event);
448 if (lock.pid ^= "0"b & lock.notify_sw = "1"b)
449 then call pxss$wait;
450 else call pxss$delevent (lock.event);
451 end;
452
453 pds$block_lock_count = pds$block_lock_count + 1;
454 return;
455
456 end LOCK_FAST;
457
458
459
460 UNLOCK_FAST:
461 proc (lock_ptr);
462
2 1 /* Begin include file hc_lock.incl.pl1 BIM 2/82 */
2 2 /* Replaced by hc_fast_lock.incl.pl1 RSC 11/84 because name of structure
2 3* encourages name conflicts.
2 4* USE HC_FAST_LOCK INSTEAD!
2 5**/
2 6
2 7 /* Lock format suitable for use with lock$lock_fast, unlock_fast */
2 8
2 9 /* format: style3 */
2 10
2 11 declare lock_ptr pointer;
2 12 declare 1 lock aligned based (lock_ptr),
2 13 2 pid bit (36) aligned, /* holder of lock */
2 14 2 event bit (36) aligned, /* event associated with lock */
2 15 2 flags aligned,
2 16 3 notify_sw bit (1) unaligned,
2 17 3 pad bit (35) unaligned; /* certain locks use this pad, like dirs */
2 18
2 19 /* End include file hc_lock.incl.pl1 */
463
464 /* the ptr in here becomes the parameter */
465
466
467 if tc_data$system_shutdown ^= 0
468 then return;
469
470 if ^stacq (lock.pid, "000000000000"b3, pds$processid)
471 then do;
472 call syserr (tc_data$lock_error_severity,
473 "lock: unlock_fast lock ^p not locked to process. caller = ^p.", lock_ptr, caller ());
474 return;
475 end;
476 if lock.pid = pds$processid
477 then call syserr (CRASH, "lock: stacq hardware failure on ^p", lock_ptr);
478
479 if lock.notify_sw
480 then do;
481 lock.notify_sw = "0"b;
482 call pxss$notify (lock.event);
483 end;
484 pds$block_lock_count = pds$block_lock_count - 1;
485 return;
486
487 end UNLOCK_FAST;
488
489
490
491 LOCK_DIR:
492 procedure (dirp, typelock, code, failsw, waitsw);
493
494 dcl dirp ptr;
495 dcl typelock bit (36) aligned;
496 dcl code fixed bin (35);
497 dcl failsw fixed bin (1);
498 dcl waitsw fixed bin (1);
499
500 dcl get_kstep_code fixed bin (35);
501 dcl salvage_entry bit (1) aligned;
502 dcl severity fixed bin;
503 dcl uid_to_lock bit (36) aligned;
504 dcl dir_lockx fixed bin;
505
506 salvage_entry = "0"b;
507 go to LOCK_START;
508
509 LOCK_DIR_SALVAGE:
510 entry (dirp, typelock, code, failsw, waitsw);
511
512 salvage_entry = "1"b;
513
514 LOCK_START:
515 code = 0;
516 failsw = 0;
517
518 if tc_data$system_shutdown ^= 0
519 then return;
520
521 dir_lock_segp = addr (dir_lock_seg$);
522 dir_lock_all_locksp = dir_lock_seg.header.locks_ptr;
523 dir_lock_all_readersp = dir_lock_seg.header.readers_ptr;
524
525 call get_kstep (segno (dirp), kstep, get_kstep_code);
526 /* The code is nonzero for fake dirs -- */
527 /* happens if dirp is a hardcore segment (stack_0) */
528 if salvage_entry
529 then do;
530 if get_kstep_code ^= 0 /* needed for salvaging */
531 then do;
532 code = get_kstep_code;
533 return;
534 end;
535 if ^kste.dirsw
536 then do; /* Not a dir? */
537 code = error_table_$notadir;
538 return;
539 end;
540 dir_uid = kste.uid;
541 end;
542
543 RELOCK:
544 if salvage_entry
545 then uid_to_lock = dir_uid; /* The REAL uid, rather than what was recorded inside the dir */
546 else uid_to_lock = dirp -> dir.uid; /* let a seg_fault happen here */
547
548
549 /****
550*Here, we make sure that the UID in the directory matches the UID in the
551*kste, which, perforce, must have been derived from the branch at some time in
552*the past. This check is skipped, however, if we find that the "directory" is
553*actually in a non-directory segment, since the supervisor occasionally
554*constructs imitation directory headers in automatic storage just so it can
555*lock with the right UID. If the UID's fail to match, then the dir is
556*salvaged. If we are called from the salvager, though, we skip all this.
557******/
558
559 if ^salvage_entry
560 then do;
561 must_salvage = "0"b;
562 if (dirp -> dir.uid = ""b) /* Cannot be correct */
563 then must_salvage = "1"b;
564 else if (get_kstep_code = 0)
565 then /* means segno is valid, and hence kstep is valid */
566 if kste.dirsw
567 then /* only check directories */
568 if (dirp -> dir.uid ^= kste.uid)
569 then must_salvage = "1"b;
570
571 if must_salvage /* Flunked the test */
572 then do; /* Neither the dir not dir_lock_seg is locked
573*here */
574 call LOCK_FOR_SALVAGE_AND_SALVAGE (dirp, code);
575 /* they will be locked and unlocked here. */
576 if code = 0 & dirp -> dir.uid ^= ""b
577 then go to RELOCK; /* Dir is still valid */
578 code = error_table_$dir_damage;
579 /* dir went west */
580 return;
581 end; /** salvage case */
582 end;
583
584 /************************ LOCK DIR LOCK SEG *********************************/
585
586
587 call LOCK_FAST (dir_lock_segp);
588
589 dir_lockx = FIND_OR_MAKE_DIR_LOCK (uid_to_lock);
590 dir_lockp = addr (dir_lock_all_dir_locks (dir_lockx));
591
592 call VALIDATE_CACHE (addr (dir_lock.lock_count)); /* ensure cache is correct */
593
594 if dir_lock.lock_count > 0
595 then do; /** Write Lock Locked */
596 if dir_lock.write_locker ^= pds$processid
597 /* Not Us */
598 then go to LOCK_NOT_AVAILABLE; /* common to read vs. write and write vs. write. */
599 else go to MYLOCK_RETURN;
600 end;
601 else do; /* Read or no lock */
602 dir_read_lockers_ptr = addr (dir_lock_all_readers (dir_lockx, 1));
603 if THIS_PROCESS_IS_A_READER (dir_lockp, dir_read_lockers_ptr)
604 /* some kind of mylock */
605 then do; /* we do not know a recovery mechanism for this one. */
606 if typelock ^= ""b /* We want write */
607 then do;
608 severity = tc_data$lock_error_severity;
609 if severity ^= CRASH
610 then severity = TERMINATE_PROCESS;
611
612 call syserr (severity,
613 "lock: LOCK_DIR: write lock call with read lock held. dp = ^p, uid = ^w.",
614 dirp, uid_to_lock);
615 end; /* Control never passes here */
616 else go to MYLOCK_RETURN; /* simple read mylock */
617 end;
618
619 if /* tree */ typelock ^= ""b /* want write ? */
620 then if dir_lock.lock_count ^= 0 /* locked for read */
621 then goto LOCK_NOT_AVAILABLE; /* wait for it */
622 else call LOCK_FOR_WRITE (dir_lockp);
623 else call ADD_THIS_PROCESS_AS_READER (dir_lockp, dir_read_lockers_ptr);
624 /* no, want read */
625 end;
626
627 /******* UNLOCK DIR LOCK SEG *********************************************/
628
629
630
631 UNLOCK_DIR_LOCK_SEG_RETURN:
632 call UNLOCK_FAST (dir_lock_segp);
633
634 if ^salvage_entry
635 then if dirp -> dir.modify
636 then if code = 0
637 then do;
638 call dir_unlock (dirp);
639 call LOCK_FOR_SALVAGE_AND_SALVAGE (dirp, code);
640 if code = 0
641 then go to RELOCK;
642 end;
643 return;
644
645 /****** The following paths return to UNLOCK_DIR_LOCK_SEG_RETURN *****/
646
647
648 MYLOCK_RETURN:
649 code = error_table_$mylock;
650 go to UNLOCK_DIR_LOCK_SEG_RETURN;
651
652
653 LOCK_NOT_AVAILABLE:
654 if waitsw = 0
655 then do;
656 failsw = 1;
657 go to UNLOCK_DIR_LOCK_SEG_RETURN;
658 end;
659
660 /********** Waiting is required, wait. */
661
662 call pxss$addevent (uid_to_lock);
663 dir_lock.notify_sw = "1"b;
664 call UNLOCK_FAST (dir_lock_segp);
665 call pxss$wait; /* since we set notify under the lock, there is no race. */
666 sst$lock_waits = sst$lock_waits + 1;
667 goto LOCK_START; /* Anything can happen, so revalidate */
668
669
670 THIS_PROCESS_IS_A_READER:
671 procedure (a_dir_lockp, a_dir_readersp) returns (bit (1) aligned);
672
673 declare a_dir_lockp pointer;
674 declare a_dir_readersp pointer;
675 declare l_dir_readersp pointer;
676 declare l_dir_readers (dir_lock_seg.header.max_readers) bit (36) aligned based (l_dir_readersp);
677 declare rx fixed bin; /* ReaderIndex */
678
679
680 if a_dir_lockp -> dir_lock.lock_count = 0
681 then return ("0"b);
682 l_dir_readersp = a_dir_readersp;
683 do rx = 1 to dir_lock_seg.header.max_readers;
684 if l_dir_readers (rx) = pds$processid
685 then return ("1"b);
686 end;
687 return ("0"b);
688 end THIS_PROCESS_IS_A_READER;
689
690
691 FIND_OR_MAKE_DIR_LOCK:
692 procedure (a_UID) returns (fixed bin);
693
694 declare a_UID bit (36) aligned;
695 declare UID bit (36) aligned;
696 declare dx fixed bin;
697 declare first_free_dx fixed bin;
698 declare l_dir_lockp pointer;
699 declare 1 l_dir_lock aligned like dir_lock based (l_dir_lockp);
700 declare l_dir_readersp pointer;
701 declare find_only bit (1) aligned;
702
703 find_only = "0"b;
704 go to Join;
705
706 FIND_DIR_LOCK:
707 entry (a_UID) returns (fixed bin);
708
709 find_only = "1"b;
710
711 Join:
712 UID = a_UID;
713 first_free_dx = 0;
714 dir_lock_seg.header.meters.find_calls = dir_lock_seg.header.find_calls + 1;
715
716 call VALIDATE_CACHE (addr (dir_lock_seg.header.highest_in_use));
717 /* ensure cache is correct */
718 do dx = 1 to dir_lock_seg.header.highest_in_use;
719 if dir_lock_all_dir_locks (dx).uid = UID
720 then go to FOUND_ENTRY;
721 else if dir_lock_all_dir_locks (dx).uid = (36)"0"b & first_free_dx = 0
722 then first_free_dx = dx;
723 end;
724
725 dir_lock_seg.header.meters.find_failures = dir_lock_seg.header.meters.find_failures + 1;
726 if find_only
727 then return (-1);
728
729
730 if first_free_dx = 0
731 then do;
732 if dir_lock_seg.header.highest_in_use = dir_lock_seg.header.n_dir_locks
733 then call syserr (CRASH, "lock: LOCK_DIR: dir_lock_seg full.");
734 dir_lock_seg.header.highest_in_use, first_free_dx = dir_lock_seg.header.highest_in_use + 1;
735 dir_lock_seg.header.meters.max_in_use = max (dir_lock_seg.header.meters.max_in_use, first_free_dx);
736 end;
737
738 l_dir_lockp = addr (dir_lock_all_dir_locks (first_free_dx));
739 unspec (l_dir_lock) = ""b;
740 l_dir_readersp = addr (dir_lock_seg.readers (first_free_dx, 1));
741 l_dir_readersp -> dir_read_lockers (*) = ""b;
742
743 l_dir_lock.uid = a_UID;
744 return (first_free_dx);
745
746 FOUND_ENTRY:
747 l_dir_lockp = addr (dir_lock_all_dir_locks (dx));
748 return (dx);
749 end FIND_OR_MAKE_DIR_LOCK;
750
751 LOCK_FOR_WRITE:
752 procedure (a_dir_lockp);
753
754 declare a_dir_lockp pointer;
755 declare l_dir_lockp pointer;
756 declare 1 l_dir_lock aligned like dir_lock based (l_dir_lockp);
757 declare rx fixed bin;
758
759 l_dir_lockp = a_dir_lockp;
760 l_dir_lock.write_locker = pds$processid;
761 l_dir_lock.lock_count = 1;
762 l_dir_lock.notify_sw = "0"b;
763 l_dir_lock.salvage_sw = salvage_entry; /* GLOBAL */
764 pds$block_lock_count = pds$block_lock_count + 1;
765 return;
766
767 ADD_THIS_PROCESS_AS_READER:
768 entry (a_dir_lockp, a_dir_readersp);
769
770 declare a_dir_readersp pointer;
771 declare l_dir_readersp pointer;
772 declare l_dir_readers (dir_lock_seg.header.max_readers) bit (36) aligned based (l_dir_readersp);
773
774 l_dir_lockp = a_dir_lockp;
775 l_dir_readersp = a_dir_readersp;
776 do rx = 1 to hbound (l_dir_readers, 1) while (l_dir_readers (rx) ^= ""b);
777 end;
778 if rx > hbound (l_dir_readers, 1)
779 then call syserr (CRASH, "lock: LOCK_DIR: Too many readers.");
780
781 call VALIDATE_CACHE (addr (l_dir_lock.lock_count));
782 /* ensure cache is correct */
783 l_dir_lock.lock_count = l_dir_lock.lock_count - 1;
784 l_dir_readers (rx) = pds$processid;
785 pds$block_lock_count = pds$block_lock_count + 1;
786 return;
787
788 UNLOCK_THIS_DIR:
789 entry (a_dir_lockx, a_uid); /* Checks for screwups */
790
791 declare a_dir_lockx fixed bin;
792 declare a_uid bit (36) aligned;
793
794 l_dir_lockp = addr (dir_lock_all_dir_locks (a_dir_lockx));
795 l_dir_readersp = addr (dir_lock_all_readers (a_dir_lockx, 1));
796 if l_dir_lock.uid ^= a_uid
797 then do;
798 call syserr (tc_data$lock_error_severity, "lock: UNLOCK_DIR: UID Mismatch.");
799 return;
800 end;
801
802 call VALIDATE_CACHE (addr (l_dir_lock.lock_count));
803 /* ensure cache is correct */
804 if l_dir_lock.lock_count = 0
805 then do;
806 call syserr (tc_data$lock_error_severity, "lock: UNLOCK_DIR: lock count 0.");
807 return;
808 end;
809 else if l_dir_lock.lock_count < 0
810 then do;
811 do rx = 1 to hbound (l_dir_readers, 1) while (l_dir_readers (rx) ^= pds$processid);
812 end;
813 if rx > hbound (l_dir_readers, 1)
814 then do;
815 call syserr (tc_data$lock_error_severity,
816 "lock: UNLOCK_DIR: lock not read locked to process.");
817 return;
818 end;
819 l_dir_lock.lock_count = l_dir_lock.lock_count + 1;
820 l_dir_readers (rx) = ""b;
821 if l_dir_lock.notify_sw
822 then if l_dir_lock.lock_count = 0
823 then do;
824 l_dir_lock.notify_sw = "0"b;
825 call pxss$notify (l_dir_lock.uid);
826 end;
827 end;
828 else if l_dir_lock.lock_count > 0
829 then do;
830 if l_dir_lock.write_locker ^= pds$processid
831 then do;
832 call syserr (tc_data$lock_error_severity,
833 "lock: UNLOCK_DIR: lock not write locked to process.");
834 return;
835 end;
836 l_dir_lock.lock_count = 0;
837 l_dir_lock.write_locker = ""b;
838 if l_dir_lock.notify_sw
839 then do;
840 l_dir_lock.notify_sw = "0"b;
841 call pxss$notify (l_dir_lock.uid);
842 end;
843 end;
844 pds$block_lock_count = pds$block_lock_count - 1;
845 if (l_dir_lock.lock_count = 0) & (l_dir_lock.uid ^= (36)"1"b)
846 /* leave the root at a nice low slot */
847 then do;
848 unspec (l_dir_lock) = ""b;
849
850 call VALIDATE_CACHE (addr (dir_lock_seg.header.highest_in_use));
851 /* ensure cache is correct */
852 if a_dir_lockx = dir_lock_seg.header.highest_in_use
853 then dir_lock_seg.header.highest_in_use = max (0, dir_lock_seg.header.highest_in_use - 1);
854 /* last one out please close the light */
855 end;
856
857 return;
858 end LOCK_FOR_WRITE;
859
860 LOCK_FOR_SALVAGE_AND_SALVAGE:
861 procedure (dir_ptr, code);
862 declare dir_ptr pointer;
863 declare correct_uid bit (36) aligned;
864 declare code fixed bin (35);
865
866 code = 0;
867 call dir_lock_salvage (dir_ptr, correct_uid, code);
868 if code ^= 0
869 then return;
870
871 call on_line_salvager (dir_ptr, code);
872 call dir_unlock_given_uid (correct_uid);
873
874 return;
875 end LOCK_FOR_SALVAGE_AND_SALVAGE;
876
877
878
879 UNLOCK_DIR:
880 entry (dirp, a_uid);
881
882 dcl a_uid bit (36) aligned;
883
884 dcl uid_to_unlock bit (36) aligned;
885 dcl nocheck_entry bit (1);
886
887 dcl get_ptrs_$given_segno
888 entry (fixed bin) returns (ptr);
889 dcl pc_wired$write_wait_uid
890 entry (ptr, fixed bin, fixed bin, bit (36) aligned);
891
892
893 nocheck_entry = "0"b;
894 go to UNLOCK_START;
895
896 UNLOCK_DIR_NOCHECK:
897 entry (dirp, a_uid);
898
899 nocheck_entry = "1"b;
900
901 UNLOCK_START:
902 uid_to_unlock = a_uid;
903 if tc_data$system_shutdown ^= 0
904 then return;
905
906 dir_lock_segp = addr (dir_lock_seg$);
907 dir_lock_all_locksp = dir_lock_seg.header.locks_ptr;
908 dir_lock_all_readersp = dir_lock_seg.header.readers_ptr;
909
910 per_process_flag = "0"b;
911
912 if dirp ^= null & ^nocheck_entry
913 then begin;
914
915 on seg_fault_error go to DIR_GONE;
916
917 if dirp -> dir.modify
918 then call syserr (JUST_LOG, "lock: unlock_dir with dir.modify - uid = ^w - callerp = ^p", ind,
919 caller ());
920 per_process_flag = dirp -> dir.per_process_sw;
921 /* Save for unlocking */
922 end;
923
924 DIR_GONE:
925 call LOCK_FAST (dir_lock_segp);
926
927 dir_lockx = FIND_DIR_LOCK (uid_to_unlock);
928
929 if dir_lockx = -1
930 then call TRY_TO_FIND_A_BETTER_UID; /* This can change dir_lockx */
931 /* and uid_to_unlock */
932 if dir_lockx = -1
933 then do;
934 call syserr (tc_data$lock_error_severity, "lock: UNLOCK_DIR: dir ^w not locked. caller = ^p.", ind,
935 caller ());
936 go to UNLOCK_SIDE_RETURN;
937 end;
938
939 call PERHAPS_WRITE_BEHIND (dir_lockx);
940
941 call UNLOCK_THIS_DIR (dir_lockx, uid_to_unlock);
942
943 UNLOCK_SIDE_RETURN:
944 call UNLOCK_FAST (dir_lock_segp);
945 return;
946
947
948
949
950 TRY_TO_FIND_A_BETTER_UID:
951 procedure;
952
953 if dirp = null ()
954 then return;
955
956 call get_kstep (binary (baseno (dirp)), kstep, get_kstep_code);