1
2
3
4
5
6
7
8
9
10
11
12
13
14 makeunknown_: proc (a_segno, a_switches, zero_lot, a_code);
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 dcl a_segno fixed bin (17),
53 a_switches bit (36) aligned,
54 zero_lot bit (1) aligned,
55 a_code fixed bin (35);
56 dcl a_n_names fixed bin;
57
58 dcl pkstep ptr,
59 ring fixed bin,
60 code fixed bin (35),
61 segno fixed bin (17);
62 dcl n_names fixed bin;
63
64 dcl 1 switches aligned,
65 2 rsw bit (1) unal,
66 2 force bit (1) unal,
67 2 pad bit (34) unal;
68
69 dcl setfaults$disconnect ext entry (fixed bin (17)),
70 pathname_am$clear ext entry (fixed bin (17)),
71 get_kstep ext entry (fixed bin (17), ptr, fixed bin (35)),
72 kst_util$unthread_kste ext entry (ptr),
73 level$get ext entry returns (fixed bin);
74
75 dcl (error_table_$known_in_other_rings, error_table_$infcnt_non_zero) ext fixed bin (35);
76 dcl error_table_$no_null_refnames fixed bin (35) ext static;
77
78 dcl (addr, baseno, baseptr, binary, fixed, null, rel, substr, unspec) builtin;
79
80 %include kst;
81 ^L
82
83 n_names = 0;
84 go to Join;
85
86 protect_names:
87 entry (a_segno, a_n_names, a_switches, zero_lot, a_code);
88 n_names = a_n_names;
89
90 Join:
91 string (switches) = a_switches;
92 segno = a_segno;
93 zero_lot = "0"b;
94 a_code = 0;
95 kstp = pds$kstp;
96 ring = level$get ();
97
98 call get_kstep (segno, kstep, code);
99 if code ^= 0 then call abort (code);
100
101
102
103 if n_names > 0
104 then if kste.usage_count (ring) ^> n_names
105 then do;
106 a_code = error_table_$no_null_refnames;
107 return;
108 end;
109
110 if switches.force
111 then kste.usage_count (ring) = 0;
112 else if kste.usage_count (ring) > 0
113 then kste.usage_count (ring) = kste.usage_count (ring) - 1;
114
115
116
117 if kste.usage_count (ring) = 0 then if (ring > 0) & (^kste.dirsw) then zero_lot = "1"b;
118
119 if unspec (kste.usage_count) ^= "0"b
120 then if switches.force
121 then call abort (error_table_$known_in_other_rings);
122 else return;
123
124 if kste.infcount ^= 0 & kste.flags.dirsw
125 then call abort (error_table_$infcnt_non_zero);
126
127 if kste.entryp ^= null
128 then do;
129 pkstep = addr (kst.kst_entry (fixed (baseno (kste.entryp), 17)));
130 pkstep -> kste.infcount = pkstep -> kste.infcount - 1;
131 end;
132
133 call kst_util$unthread_kste (kstep);
134
135 call setfaults$disconnect (segno);
136 if kste.flags.dirsw then call pathname_am$clear (segno);
137
138 unspec (kste) = "0"b;
139 kste.segno = segno;
140
141 if switches.rsw
142 then kste.fp = (18)"1"b;
143 else do;
144 kste.fp = kst.free_list;
145 kst.free_list = rel (kstep);
146 end;
147 return;
148
149 abort: proc (code);
150 dcl code fixed bin (35);
151 a_code = code;
152 go to non_local_return;
153 end abort;
154
155 non_local_return:
156 return;
157
158 end makeunknown_;