1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1984 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 /* format: style4 */
 14 setfaults: proc (a_astep, a_recalculate_access);
 15 
 16 /* Modified by B. Greenberg 4/24/74 for cache and v2pl1 */
 17 /* Rewritten by R. Bratt 2/4/75 to restructure the code, clear associative memories, and add the disconnect entry */
 18 /* Modified by R. Bratt 10/9/75  to adhere to nss locking strategies */
 19 /* Modified by E. Stone 5/75 to retain access in the sdw, ie just to zero the df bits and the address */
 20 /* Modified by D. Vinograd 6/76 to allow setfaulting of hardcore segs - used by the volume dumper */
 21 /* Modified 03/21/81, W. Olin Sibert, for ADP SDW formats */
 22 /* Reorganized, 04/17/81, WOS */
 23 /* Modified 02/15/83, E. N. Kittlitz, added if_256K. */
 24 /* Modified 08/09/83, E. N. Kittlitz, setfaults$if_active added pvid, vtocx args */
 25 /*
 26    setfaults contains four entry points
 27 
 28    ---> setfaults$setfaults allows a process to disconnect all sdws from an active segment.
 29    As an optimization, if the setfaults is to cause access recalculation then the connected
 30    sdws have their fault bits set but they remain on the trailer. The associative memories
 31    of all processors are cleared. The ast is assumed to be locked.
 32    USAGE: call setfaults (astep, recalculate_access);
 33 
 34    ---> setfaults$if_active is used to setfaults when given a uid. It searches
 35    the ast and if the segment is active all connected sdws are faulted. See setfaults$setfaults.
 36    The ast is presumed to be unlocked.
 37    USAGE: call setfaults$if_active (uid, pvid, vtocx, recalculate_access);
 38 
 39    ---> setfaults$deltrailer is used to clean up a dead process.
 40    The ast is presumed to be locked!
 41    USAGE: call setfaults$deltrailer (astep, segno, dstep);
 42 
 43    ---> setfaults$disconnect is used to disconnect a segment number in the calling
 44    process from its aste. This code depends on  pmut$swap_sdw to clear this processors'
 45    sdw associative memory. The ast is assumed to be unlocked.
 46    USAGE: call setfaults$disconnect (segno);
 47 
 48    ---> setfaults$cache is used to set cache bits in all the sdws connected to an aste.
 49    The associative memories of all processors are cleared. The ast must be locked.
 50    USAGE: call setfaults$cache (astep, cache_bit);
 51 
 52    astep ptr --- aste pointer
 53    segno fixed bin(17) --- segment number to be disconnected
 54    uid bit (36) aligned --- unique identifier of segment of interest
 55    dstep fixed bin(17) --- relative descriptor segment aste pointer
 56    recalculate_access bit(1) aligned ---  set to cause access recalculation
 57    cache_bit bit(1) aligned --- bit to stuff into sdw cache bit
 58 
 59 */
 60 
 61 /*^L*/
 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 /*^L*/
106 
107           astep = a_astep;                                  /* copy the arguments */
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;                                           /* End of setfaults$setfaults */
115 
116 
117 
118 setfaults$if_active: entry (a_uid, a_pvid, a_vtocx, a_recalculate_access);
119 
120           uid = a_uid;                                      /* copy these as service to caller */
121           pvid = a_pvid;                                    /* avoid segfaults on directory */
122           vtocx = a_vtocx;                                  /* if that's where formals are */
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)); /* ignore double-uid error */
130           if astep ^= null () then do;
131                call process_trailers ();
132                call page$cam ();
133           end;
134 
135           call lock$unlock_ast ();
136           return;                                           /* End of setfaults$if_active */
137 
138 
139 setfaults$cache: entry (a_astep, a_cache_bit);
140 
141           astep = a_astep;                                  /* copy arguments */
142           cache_bit = a_cache_bit;                          /* AST is locked */
143 
144           if sys_info$system_type = ADP_SYSTEM then do;     /* Oh yeah? */
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             /* should be trailers  */
154                call syserr (1, "setfaults: illegal cache  access trailer.");
155 
156           call process_trailers ();
157           call page$cam ();
158           return;                                           /* End of setfaults$cache */
159 
160 /*^L*/
161 
162 setfaults$deltrailer: entry (a_astep, a_segno, a_rdstep);
163 
164           astep = a_astep;                                  /* copy arguments */
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;                                           /* End of setfaults$deltrailer */
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);            /* Does it seem active? */
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);            /* Still active ? */
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 /*^L*/
209 
210 process_trailers: proc ();
211 
212 dcl  thrtmp bit (18) aligned;                               /* temporary for unthreading */
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; /* if turning off access for all */
219                if ^astep -> aste.inhibit_cache then do;     /* let cache control know */
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);                       /* get a pointer to the trailer segment */
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); /* get the DSEG ASTEP for this trailer */
230 
231                if rel (dstep) = (18)"1"b then               /* check for bad trailer entry */
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);  /* get segno of the SDW of interest */
241 
242                     call flush_this_sdw ();                 /* Perform appropriate manipulations */
243 
244                     if recalculate_access then do;          /* Meter */
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; /* Must actually remove this one */
250                          sst$setfaults_all = sst$setfaults_all + 1; /* Meter */
251 
252                          thrtmp = astep -> aste.strp;       /* thread this trailer out */
253                          call thread$out (trp, thrtmp);     /* and zero its threads */
254                          astep -> aste.strp = thrtmp;
255 
256                          trp -> str.fp = rel (sst$tfreep);  /* thread entry into free list */
257                          sst$tfreep = trp;                  /* set new free list pointer */
258                          trp -> str.bp = "0"b;              /* for neatness */
259                          trp -> str.dstep = "777777"b3;     /* wipe out the old dstep so check_trailer works */
260                     end;
261 
262                     if ^process_all_trailers then return;   /* Got the one we wanted */
263                end;
264           end;
265 
266           if ^process_all_trailers then call syserr (1, "setfaults: Missing trailer.");
267                                                             /* Looked everywhere and failed to find it */
268           return;
269      end process_trailers;
270 
271 /*^L*/
272 
273 flush_this_sdw: proc ();
274 
275 /* This procedure does whatever is appropriate to a single SDW. It sets up the abs_seg
276    (we use ds_seg$) for this, modifies the SDW, and cleans it up. It expect dstep and
277    segno to be set, to tell it what to do. */
278 
279 dcl  ds_sdw fixed bin (71);
280 
281 
282           ds_sdw = get_ptrs_$given_astep (dstep);           /* set up the address field of the SDW */
283           call pmut$swap_sdw (addr (ds_seg$), addr (ds_sdw)); /* store the SDW into the DSEG abs_seg */
284 
285           sdwp = addr (ds_seg$ (segno));                    /* The SDW in question */
286 
287           if sys_info$system_type = ADP_SYSTEM then do;
288                if set_cache_bit then ;                      /* Oh yeah? -- ignore it */
289 
290                else if recalculate_access then              /* Just turn it off */
291                     adp_sdw.valid = "0"b;
292 
293                else do;
294                     adp_sdw.valid = "0"b;                   /* Kill it completely */
295                     adp_sdw.add = ""b;
296                end;
297           end;                                              /* of ADP SDW modifications */
298 
299           else do;
300                l68_sdw.df_no = "00"b;                       /* For safety's sake */
301 
302                if set_cache_bit then
303                     l68_sdw.cache = cache_bit;
304 
305                else if recalculate_access then              /* Just turn it off */
306                     l68_sdw.valid = "0"b;
307 
308                else do;
309                     l68_sdw.valid = "0"b;                   /* Kill it completely */
310                     l68_sdw.add = ""b;
311                end;
312           end;                                              /* of L68 SDW modifications */
313 
314           dseg$ (binary (baseno (addr (ds_seg$)), 17)) = 0; /* cleanup the abs_seg */
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 /*^L*/
326 
327 /* BEGIN MESSAGE DOCUMENTATION
328 
329    Message:
330    setfaults: illegal cache access trailer
331 
332    S: $crash
333 
334    T: $run
335 
336    M: It was found that no record of processes connected to a
337    segment (trailers) existed when the encacheability state of a segment
338    had to be changed. Such change can only occur if processes are
339    connected to the segment. $err
340 
341    A: Be sure to get a dump. $recover
342    $notify
343 
344    Message:
345    setfaults: deleted trailer
346 
347    S: $crash
348 
349    T: $run
350 
351    M: A trailer entry (record of a process's connection to a segment)
352    for some segment was marked as free. $err
353 
354 
355    A: $recover
356    $inform
357 
358    Message:
359    setfaults: illegal trailer
360 
361    S: $crash
362 
363    T: $run
364 
365    M: A trailer  entry (record of a process's connection to a segment)
366    for some segment specifies a second segment as the descriptor
367    segment for some process connected to that segment, but that second segment
368    does not have certain bits on in its AST entry which would be on in the
369    AST entry of a descriptor segment.
370    $err
371 
372    A: $recover
373    $inform
374 
375    Message:
376    setfaults: missing trailer
377 
378    S: $crash
379 
380    T: $run
381 
382    M: Upon terminating a segment, it was found that
383    no record of the process's connection to that segment (trailer)
384    existed, even though an SDW for that segment appeared in
385    the process's descriptor segment (i.e., the process was connected to it).
386    $err
387 
388    A: $recover
389    $notify
390 
391    END MESSAGE DOCUMENTATION */
392 
393      end setfaults;