1
2
3
4
5
6
7
8
9
10
11
12
13
14 setfaults: proc (a_astep, a_recalculate_access);
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 dcl a_astep ptr parameter;
64 dcl a_cache_bit bit (1) aligned parameter;
65 dcl a_segno fixed bin (17) parameter;
66 dcl a_uid bit (36) aligned parameter;
67 dcl a_pvid bit (36) aligned parameter;
68 dcl a_rdstep fixed bin (17) parameter;
69 dcl a_recalculate_access bit (1) aligned parameter;
70 dcl a_vtocx fixed bin parameter;
71
72 dcl dstep ptr;
73 dcl (segno, rdstep) fixed bin (17);
74 dcl uid bit (36) aligned;
75 dcl pvid bit (36) aligned;
76 dcl vtocx fixed bin;
77 dcl cache_bit bit (1) aligned;
78 dcl disconnect_any_msl bit (1) aligned;
79 dcl sdwp pointer;
80
81 dcl (set_cache_bit, process_all_trailers, recalculate_access) bit (1) init ("0"b);
82
83 dcl pds$dstep bit (18) aligned external static;
84 dcl sst$tfreep pointer external static;
85 dcl sst$setfaults_acc fixed bin (35) external static;
86 dcl sst$setfaults_all fixed bin (35) external static;
87 dcl sys_info$system_type fixed bin external static;
88
89 dcl sst_seg$ external static;
90 dcl ds_seg$ (0:1023) fixed bin (71) external static;
91 dcl dseg$ (0:1023) fixed bin (71) external static;
92
93 dcl get_ptrs_$given_astep entry (ptr) returns (fixed bin (71));
94 dcl get_ptrs_$given_segno entry (fixed bin) returns (ptr);
95 dcl lock$lock_ast entry ();
96 dcl lock$unlock_ast entry ();
97 dcl page$cam entry ();
98 dcl pmut$swap_sdw entry (ptr, ptr);
99 dcl search_ast$check entry (bit (36) aligned, bit (36) aligned, fixed bin, fixed bin (35)) returns (ptr);
100 dcl syserr ext entry options (variable);
101 dcl thread$out ext entry (ptr, bit (18) aligned);
102
103 dcl (addr, baseno, binary, null, ptr, rel) builtin;
104
105
106
107 astep = a_astep;
108 recalculate_access = a_recalculate_access;
109 process_all_trailers = "1"b;
110 set_cache_bit = "0"b;
111
112 call process_trailers ();
113 call page$cam ();
114 return;
115
116
117
118 setfaults$if_active: entry (a_uid, a_pvid, a_vtocx, a_recalculate_access);
119
120 uid = a_uid;
121 pvid = a_pvid;
122 vtocx = a_vtocx;
123 recalculate_access = a_recalculate_access;
124 process_all_trailers = "1"b;
125 set_cache_bit = "0"b;
126
127 call lock$lock_ast ();
128
129 astep = search_ast$check (uid, pvid, vtocx, (0));
130 if astep ^= null () then do;
131 call process_trailers ();
132 call page$cam ();
133 end;
134
135 call lock$unlock_ast ();
136 return;
137
138
139 setfaults$cache: entry (a_astep, a_cache_bit);
140
141 astep = a_astep;
142 cache_bit = a_cache_bit;
143
144 if sys_info$system_type = ADP_SYSTEM then do;
145 call syserr (5, "setfaults: Ignoring setfaults$cache call for aste @ ^o on ADP system", astep);
146 return;
147 end;
148
149 recalculate_access = "0"b;
150 set_cache_bit = "1"b;
151 process_all_trailers = "1"b;
152
153 if astep -> aste.strp = (18)"0"b then
154 call syserr (1, "setfaults: illegal cache access trailer.");
155
156 call process_trailers ();
157 call page$cam ();
158 return;
159
160
161
162 setfaults$deltrailer: entry (a_astep, a_segno, a_rdstep);
163
164 astep = a_astep;
165 segno = a_segno;
166 rdstep = a_rdstep;
167
168 recalculate_access = "0"b;
169 process_all_trailers = "0"b;
170 set_cache_bit = "0"b;
171
172 call process_trailers ();
173 return;
174
175
176
177 setfaults$disconnect: entry (a_segno);
178
179 disconnect_any_msl = "1"b;
180 go to disconnect_common;
181
182 setfaults$if_256K: entry (a_segno);
183
184 disconnect_any_msl = "0"b;
185
186 disconnect_common:
187 segno = a_segno;
188
189 recalculate_access = "0"b;
190 process_all_trailers = "0"b;
191 set_cache_bit = "0"b;
192
193 astep = get_ptrs_$given_segno (segno);
194 if astep = null () then return;
195
196 rdstep = binary (pds$dstep, 18);
197
198 call lock$lock_ast ();
199
200 astep = get_ptrs_$given_segno (segno);
201 if astep ^= null () then
202 if disconnect_any_msl | bin (aste.msl) = 256 then
203 call process_trailers ();
204
205 call lock$unlock_ast ();
206 return;
207
208
209
210 process_trailers: proc ();
211
212 dcl thrtmp bit (18) aligned;
213 dcl trp pointer;
214 dcl next_trp pointer;
215
216 if astep -> aste.hc then return;
217
218 if ^set_cache_bit & process_all_trailers then do;
219 if ^astep -> aste.inhibit_cache then do;
220 astep -> aste.any_access_on = "0"b;
221 astep -> aste.write_access_on = "0"b;
222 end;
223 end;
224
225 strp = ptr (sst$tfreep, 0);
226
227 do trp = ptr (strp, astep -> aste.strp) repeat (next_trp) while (rel (trp));
228 next_trp = ptr (trp, trp -> str.fp);
229 dstep = ptr (addr (sst_seg$), trp -> str.dstep);
230
231 if rel (dstep) = (18)"1"b then
232 call syserr (1, "setfaults: deleted trailer.");
233
234 if ^(dstep -> aste.ehs | (dstep -> aste.bp = "0"b)) then
235 call syserr (1, "setfaults: illegal trailer");
236
237 if process_all_trailers
238 | (binary (trp -> str.dstep, 18) = rdstep & binary (trp -> str.segno, 18) = segno)
239 then do;
240 segno = binary (trp -> str.segno, 18);
241
242 call flush_this_sdw ();
243
244 if recalculate_access then do;
245 sst$setfaults_acc = sst$setfaults_acc + 1;
246 sst$setfaults_all = sst$setfaults_all + 1;
247 end;
248
249 if (^recalculate_access) & (^set_cache_bit) then do;
250 sst$setfaults_all = sst$setfaults_all + 1;
251
252 thrtmp = astep -> aste.strp;
253 call thread$out (trp, thrtmp);
254 astep -> aste.strp = thrtmp;
255
256 trp -> str.fp = rel (sst$tfreep);
257 sst$tfreep = trp;
258 trp -> str.bp = "0"b;
259 trp -> str.dstep = "777777"b3;
260 end;
261
262 if ^process_all_trailers then return;
263 end;
264 end;
265
266 if ^process_all_trailers then call syserr (1, "setfaults: Missing trailer.");
267
268 return;
269 end process_trailers;
270
271
272
273 flush_this_sdw: proc ();
274
275
276
277
278
279 dcl ds_sdw fixed bin (71);
280
281
282 ds_sdw = get_ptrs_$given_astep (dstep);
283 call pmut$swap_sdw (addr (ds_seg$), addr (ds_sdw));
284
285 sdwp = addr (ds_seg$ (segno));
286
287 if sys_info$system_type = ADP_SYSTEM then do;
288 if set_cache_bit then ;
289
290 else if recalculate_access then
291 adp_sdw.valid = "0"b;
292
293 else do;
294 adp_sdw.valid = "0"b;
295 adp_sdw.add = ""b;
296 end;
297 end;
298
299 else do;
300 l68_sdw.df_no = "00"b;
301
302 if set_cache_bit then
303 l68_sdw.cache = cache_bit;
304
305 else if recalculate_access then
306 l68_sdw.valid = "0"b;
307
308 else do;
309 l68_sdw.valid = "0"b;
310 l68_sdw.add = ""b;
311 end;
312 end;
313
314 dseg$ (binary (baseno (addr (ds_seg$)), 17)) = 0;
315
316 return;
317 end flush_this_sdw;
318
319 %page; %include system_types;
320 %page; %include aste;
321 %page; %include str;
322 %page; %include "sdw.l68";
323 %page; %include "sdw.adp";
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 end setfaults;