1
2
3
4
5
6
7
8
9
10
11
12
13
14 terminate_: proc (a_segptr, a_rsw, 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 note
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60 dcl a_code fixed bin (35) parameter;
61 dcl a_dirname char (*) parameter;
62 dcl a_ename char (*) parameter;
63 dcl a_name char (*) parameter;
64 dcl a_rsw fixed bin (1) parameter;
65 dcl a_segptr ptr parameter;
66 dcl a_uid bit (36) aligned parameter;
67
68
69
70 dcl code fixed bin (35);
71 dcl dirname char (168);
72 dcl ename char (32);
73 dcl hash_bucket fixed bin (17);
74 dcl n_names fixed bin;
75 dcl refname char (32) var;
76 dcl rsw fixed bin (1);
77 dcl segno fixed bin (17);
78 dcl segptr ptr;
79 dcl uid bit (36) aligned;
80
81
82
83 dcl error_table_$r0_refname ext fixed bin (35);
84 dcl error_table_$root ext fixed bin (35);
85 dcl error_table_$seg_deleted ext fixed bin (35);
86 dcl pds$stacks (0:7) ptr ext;
87
88
89
90 dcl (baseno, baseptr, bit, dim, fixed, mod, ptr, rel) builtin;
91
92
93
94 dcl level$get ext entry () returns (fixed bin);
95 dcl lock$dir_unlock ext entry (ptr);
96 dcl makeunknown_ ext entry (fixed bin (17), bit (36) aligned, bit (1) aligned, fixed bin (35));
97 dcl makeunknown_$protect_names ext entry (fixed bin, fixed bin, bit (36) aligned, bit (1) aligned, fixed bin (35));
98 dcl ref_name_$delete ext entry (char (32) varying, fixed bin (17), fixed bin (35));
99 dcl ref_name_$delete_segno ext entry (fixed bin (17), fixed bin (35));
100 dcl ref_name_$get_count ext entry (fixed bin (17), fixed bin (17), fixed bin (35));
101 dcl ref_name_$get_segno ext entry (char (32) varying, fixed bin (17), fixed bin (35));
102 %page;
103 teseg: entry (a_segptr, a_rsw, a_code);
104
105 segptr = a_segptr;
106 rsw = a_rsw;
107 segno = fixed (baseno (segptr), 17);
108 call dc_find$obj_terminate_ptr (segptr, ep, code);
109 if code = 0 then call lock$dir_unlock (ptr (ep, 0));
110 if code = error_table_$root then code = 0;
111 if code = error_table_$seg_deleted then code = 0;
112 if code = 0 then call term_seg;
113 a_code = code;
114 return;
115 %page;
116 tefile: entry (a_dirname, a_ename, a_rsw, a_code);
117
118 dirname = a_dirname;
119 ename = a_ename;
120 rsw = a_rsw;
121 call dc_find$obj_terminate (dirname, ename, DC_FIND_CHASE, ep, code);
122 if code = 0 then do;
123 uid = entry.uid;
124 call dc_find$finished (ptr (ep, 0), "1"b);
125 call term_uid;
126 end;
127 a_code = code;
128 return;
129 %page;
130 noname: entry (a_segptr, a_code);
131
132 segptr = a_segptr;
133 segno = fixed (baseno (segptr), 17);
134 call dc_find$obj_terminate_ptr (segptr, ep, code);
135 if code = 0 then call lock$dir_unlock (ptr (ep, 0));
136 if code = error_table_$root then code = 0;
137 if code = error_table_$seg_deleted then code = 0;
138 if code = 0 then do;
139 call ref_name_$get_count (segno, n_names, code);
140 if code ^= 0 then
141 n_names = 0;
142 if n_names > 0 then
143 call terminate_and_zero_lot$$protect (segno, ""b, n_names, code);
144 else call terminate_and_zero_lot (segno, ""b, code);
145 end;
146 a_code = code;
147 return;
148 %page;
149 name: entry (a_name, a_code);
150
151 refname = a_name;
152 call ref_name_$get_segno (refname, segno, code);
153 if code = 0 then do;
154 segptr = baseptr (segno);
155 call dc_find$obj_terminate_ptr (segptr, ep, code);
156 if code = 0 then call lock$dir_unlock (ptr (ep, 0));
157 if code = error_table_$root then code = 0;
158 if code = error_table_$seg_deleted then code = 0;
159 if code = 0 then do;
160 call ref_name_$delete (refname, segno, code);
161 if code = 0 then call terminate_and_zero_lot (segno, "0"b, (0));
162 end;
163 end;
164 a_code = code;
165 return;
166 %page;
167 id: entry (a_uid, a_rsw, a_code);
168
169 uid = a_uid;
170 rsw = a_rsw;
171 code = 0;
172 call term_uid;
173 a_code = code;
174 return;
175 %page;
176 term_seg: proc;
177
178 call ref_name_$delete_segno (segno, code);
179 if (code = 0) | (code = error_table_$r0_refname) then
180 call terminate_and_zero_lot (segno, bit (rsw, 1) || "1"b, code);
181 return;
182 end;
183
184 term_uid: proc;
185
186 kstp = pds$kstp;
187 hash_bucket = mod (fixed (uid), dim (kst.uid_hash_bucket, 1));
188 do kstep = ptr (kstp, kst.uid_hash_bucket (hash_bucket))
189 repeat (ptr (kstp, kste.fp)) while (rel (kstep) ^= "0"b);
190 if uid = kste.uid then do;
191 segno = kste.segno;
192 call term_seg;
193 return;
194 end;
195 end;
196 return;
197 end;
198 %page;
199 terminate_and_zero_lot: proc (segnum, switches, ecode);
200
201 dcl ecode fixed bin (35) parameter;
202 dcl segnum fixed bin (17) parameter;
203 dcl switches bit (36) aligned parameter;
204
205 dcl n_names fixed bin;
206 dcl ring fixed bin;
207 dcl zero_lot bit (1) aligned;
208
209 call makeunknown_ (segnum, switches, zero_lot, ecode);
210 go to Join;
211
212 terminate_and_zero_lot$$protect:
213 entry (segnum, switches, n_names, ecode);
214
215 call makeunknown_$protect_names (segnum, n_names, switches, zero_lot, ecode);
216 if ecode ^= 0 then return;
217
218 Join:
219 if zero_lot then do;
220 ring = level$get ();
221
222 if segnum <= pds$stacks (ring) -> stack_header.cur_lot_size then do;
223
224 pds$stacks (ring) -> stack_header.lot_ptr -> lot.lp (segnum) = baseptr (0);
225 pds$stacks (ring) -> stack_header.isot_ptr -> isot.isp (segnum) = baseptr (0);
226 end;
227 end;
228 end;
229 %page; %include dc_find_dcls;
230 %page; %include dir_entry;
231 %page; %include kst;
232 %page; %include lot;
233 %page; %include stack_header;
234 end;