1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1983 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 /* format: style3 */
 14 
 15 tc_util:
 16      proc;
 17 
 18 /* DESCRIPTION:
 19    Various traffic control utility functions which used to live in pxss.
 20    They need to run wired and masked, with various traffic control locks,
 21    but are called infrequently.
 22 
 23    Entries:
 24 
 25    check_abort         - returns non-zero code if a quit or trm_ IPS signal,
 26                          or a stop is pending for the process. Can be used
 27                          by long-running ring-0 procedures to simulate quits.
 28 
 29    get_aptep           - validates a processid and returns the apte pointer.
 30 
 31    get_ipc_operands    - returns to the caller the values of apte.ipc_r_offset
 32                          and apte.ipc_r_factor.  These are used by user-ring
 33                          (and hardcore) IPC event channel validation and
 34                          decoding.  It is the target of hcs_$get_ipc_operands.
 35 
 36    get_ipc_operands_priv
 37                        - returns to the caller the values of apte.ipc_r_offset
 38                          and apte.ipc_r_factor for a specified process.  This
 39                          is a highly privileged entrypoint and intended only
 40                          to be used by hardcore IPC (hc_ipc) and the
 41                          Initializer process (dialup_).  It is the target
 42                          of the gate hphcs_$get_ipc_operands_priv.
 43 
 44    ips_wakeup          - send a given named IPS signal to a given process.
 45 
 46    process_status      - return information about a process.
 47 
 48    resume_tc           - unfreeze traffic control scheduling (see suspend_tc
 49                          described below).
 50 
 51    set_cpu_monitor     - establishes a wakeup call to the term processid
 52                          after a given amount of virtual CPU time has
 53                          been used by a specified process.
 54 
 55    set_timax           - sets timax for a process
 56 
 57    suspend_tc          - freeze traffic control's running of processes, with
 58                          the exception of all idles and the calling process.
 59 
 60    validate_processid  - determines whether a processid coresponds to an
 61                          active process.
 62 
 63    Moved from pxss and converted to PL1 by J. Bongiovanni, September 1981
 64    Modified June 1982, J. Bongiovanni, to add validate_processid
 65    Modified September 1982, J. Bongiovanni, to add check_abort
 66    Modififed February 1983, E. N. Kittlitz, to clear cpu timer if arg < 0.
 67    Modified 831111 for validate_processid_all entry -E. A. Ranzenbach
 68    Modified 831213, E. N. Kittlitz, to remove validate_processid_all and
 69       several intermediate changes.
 70    Modified: 07/15/84 by R. Michael Tague:  Added ips_wakeup.
 71    Modified October 1984 by M. Pandolf to add suspend_tc and resume_tc
 72    Modified 1984-11-11 by E. Swenson for IPC event channel validation
 73       support of hcs_$get_ipc_operands.  Also added highly privileged
 74       entrypoint get_ipc_operands_priv which is used in ring-0 and as
 75       the garget of the gate hphcs_$get_ipc_operands_priv.
 76 */
 77 
 78 /*  Parameter  */
 79 
 80 dcl       a_allow_special_procs
 81                               bit (1) aligned;              /* allow special processes in get_apte search */
 82 dcl       a_code              fixed bin (35) parameter;     /* standard error code */
 83 dcl       a_delta_vcpu        fixed bin (71) parameter;     /* increment to current VCPU for wakeup */
 84 dcl       a_info_ptr          ptr;                          /* pointer to structure of process information */
 85 dcl       a_ips_signal_name   char (*);                     /* name of the ips signal to be sent */
 86 dcl       a_processid         bit (36) aligned parameter;   /* target process ID */
 87 dcl       a_timax             fixed bin (35) parameter;     /* value to set timax to */
 88 dcl       P_ipc_r_offset      fixed bin (18) parameter;     /* IPC validation operand */
 89 dcl       P_ipc_r_factor      fixed bin (35) parameter;     /* IPC validation operand */
 90 
 91 /*  Automatic  */
 92 
 93 dcl       arg_list_ptr        ptr;                          /* argument list pointer for ips_wakeup */
 94 dcl       code                fixed bin (35);               /* return code */
 95 dcl       delta_vcpu          fixed bin (71);               /* copy of increment to VCPU */
 96 dcl       ipc_r_offset        fixed bin (18);               /* automatic copy for wiring */
 97 dcl       ipc_r_factor        fixed bin (35);               /* automatic copy for wiring */
 98 dcl       ips_mask_index      fixed bin;                    /* do loop index */
 99 dcl       ips_signal_name     char (32);                    /* copy of ips signal name */
100 dcl       oldmask             fixed bin (71);               /* value of interrupt mask at wire_mask */
101 dcl       process_mp_state    fixed bin;                    /* loaded (ON=1) + eligible (ON=2) */
102 dcl       process_state       fixed bin;                    /* traffic control state */
103 dcl       process_timax       fixed bin (35);               /* copy of value to set timax for process */
104 dcl       processid           bit (36) aligned;             /* copy of process ID */
105 dcl       ptwp                ptr;                          /* pointer to page table for stack */
106 
107 /*  Based  */
108 
109 dcl       1 a_process_status  aligned based (a_info_ptr) like process_status_return;
110 dcl       1 my_arg_list       aligned based (arg_list_ptr) like arg_list;
111 
112 /*  Entry  */
113 
114 dcl       cu_$arg_list_ptr    entry (ptr);
115 dcl       lock$lock_fast      entry (ptr);
116 dcl       lock$unlock_fast    entry (ptr);
117 dcl       pmut$wire_and_mask  entry (fixed bin (71), ptr);
118 dcl       pmut$unwire_unmask  entry (fixed bin (71), ptr);
119 dcl       pxss$lock_apte      entry (bit (36) aligned, ptr, fixed bin (35));
120 dcl       pxss$ips_wakeup     entry (bit (36) aligned, bit (36) aligned);
121 dcl       pxss$suspend_getwork
122                               entry ();
123 dcl       pxss$unlock_apte    entry (ptr);
124 dcl       signal_             entry options (variable);
125 dcl       wire_proc$unwire_me entry;
126 dcl       wire_proc$wire_me   entry;
127 
128 /*  External  */
129 
130 dcl       error_table_$quit_term_abort
131                               fixed bin (35) external;
132 dcl       error_table_$process_unknown
133                               fixed bin (35) external;
134 dcl       pds$apt_ptr         ptr external;
135 dcl       tc_data$            external;
136 dcl       tc_data$abort_ips_mask
137                               bit (36) aligned external;
138 dcl       tc_data$apt         bit (36) aligned external;
139 dcl       tc_data$apt_size    fixed bin external;
140 dcl       tc_data$tc_suspend_lock
141                               bit (36) aligned external;
142 dcl       tc_data$timax       fixed bin (35) external;
143 
144 
145 /*  Builtin  */
146 
147 dcl       addr                builtin;
148 dcl       bin                 builtin;
149 dcl       divide              builtin;
150 dcl       mod                 builtin;
151 dcl       null                builtin;
152 dcl       ptr                 builtin;
153 dcl       rel                 builtin;
154 dcl       size                builtin;
155 dcl       unspec              builtin;
156 
157           return;                                           /* no tc_util entry */
158                                                             /* END OF DECLARATIONS */
159 %page;
160 
161 /* CHECK_ABORT - checks for quit or term IPS signal pending, or stop pending. */
162 
163 check_abort:
164      entry (a_code);
165 
166           a_code = 0;
167 
168           aptep = pds$apt_ptr;
169           if apte.flags.stop_pending | ((apte.ips_message & tc_data$abort_ips_mask) ^= ""b)
170           then a_code = error_table_$quit_term_abort;
171 
172           return;
173 %page;
174 
175 /* GET_APTEP            - validates that a processid corresponds to an active
176                           process and returns the apte pointer.
177 */
178 
179 get_aptep:
180      entry (a_processid, a_allow_special_procs) returns (ptr);
181 
182           aptep = PROCESSID_TO_APTE ((a_processid), (a_allow_special_procs));
183           return (aptep);
184 %page;
185 
186 /* IPS_WAKEUP            - Look up the given ips signal name in sys_info and
187                            send the corresponding ips signal bit string to
188                            pxss$ips_wakeup.
189 */
190 
191 ips_wakeup:
192      entry (a_processid, a_ips_signal_name);
193 
194 /* For release MR11, this entry will check its calling arguments
195    to see if the old calling sequence of (bit (36), char (4)) was
196    used.  If so a gate_error signal is raised.  This should be taken
197    out by the next release.
198 */
199           call cu_$arg_list_ptr (arg_list_ptr);
200           if my_arg_list.header.desc_count = 0
201           then call signal_ ("gate_err");
202           else do;
203                     processid = a_processid;
204                     ips_signal_name = a_ips_signal_name;
205                     do ips_mask_index = 1 to sys_info$ips_mask_data.count
206                          while (ips_signal_name ^= sys_info$ips_mask_data.mask (ips_mask_index).name);
207                     end;
208                     if ips_mask_index <= sys_info$ips_mask_data.count
209                     then call pxss$ips_wakeup (processid, sys_info$ips_mask_data.mask (ips_mask_index).mask);
210                end;
211           return;
212 %page;
213 
214 /* PROCESS_STATUS      - return information about a process.
215 
216                          fills in info structure like process_status_return.
217                          If processid not found, aptptr in structure is null.
218 
219 */
220 
221 process_status:
222      entry (a_info_ptr);
223 
224           processid = a_process_status.target_proc;         /* copy to stack to be wired */
225           a_process_status.up_exec = 0;
226           a_process_status.up_mp = 0;
227           a_process_status.aptptr = null ();
228 
229           process_mp_state = 1;
230 
231           aptep = PROCESSID_TO_APTE (processid, "0"b);
232           if aptep ^= null ()
233           then do;
234                     process_state = bin (apte.state, 17);
235                     if apte.flags.loaded
236                     then process_mp_state = process_mp_state + 2;
237                     if apte.flags.eligible
238                     then process_mp_state = process_mp_state + 1;
239                                                             /* fill in structure */
240                     a_process_status.total_page_faults = apte.page_faults;
241                     a_process_status.aptptr = aptep;
242                     a_process_status.up_exec = process_state;
243                     a_process_status.up_mp = process_mp_state;
244                     a_process_status.up_block = apte.state_change_time;
245                                                             /* mis-named */
246                     a_process_status.up_cpu = apte.time_used_clock;
247                     a_process_status.up_page = apte.paging_measure;
248                     a_process_status.virtual_cpu = apte.virtual_cpu_time;
249                     a_process_status.extra2 = 0;
250                end;
251 
252           return;
253 %page;
254 /* SET_CPU_MONITOR     - establishes a wakeup call to the term processid
255                          after a given amount of virtual CPU time has
256                          been used by a specified process.
257 
258    return code = 0     - wakeup established
259    = error_table_$process_unknown  - no such process
260 
261 */
262 
263 set_cpu_monitor:
264      entry (a_processid, a_delta_vcpu, a_code);
265 
266           processid = a_processid;                          /* copy to stack to be wired */
267           delta_vcpu = a_delta_vcpu;
268 
269           call WIRE_MASK;
270 
271 /* ---------- WIRED AND MASKED ---------- */
272 
273           call pxss$lock_apte (processid, aptep, code);     /* try to lock target APTE */
274           if code = 0
275           then do;
276                     if delta_vcpu < 0
277                     then apte.cpu_monitor = 0;
278                     else apte.cpu_monitor = divide (apte.virtual_cpu_time + delta_vcpu, 1024, 35);
279                     call pxss$unlock_apte (aptep);
280                end;
281 
282           call UNWIRE_UNMASK;
283 
284 /* ---------- UNWIRED AND and UNMASKED ---------- */
285 
286           if code ^= 0
287           then a_code = error_table_$process_unknown;
288           else a_code = 0;
289 
290           return;
291 %page;
292 /* SET_TIMAX           - sets timax for a process
293 
294    If the value is 0, it is reset to the system default
295 */
296 
297 set_timax:
298      entry (a_processid, a_timax);
299 
300           processid = a_processid;                          /* copy to stack to be wired */
301           process_timax = a_timax;
302           if process_timax <= 0
303           then process_timax = tc_data$timax;
304 
305           call WIRE_MASK;
306 
307 /* ---------- WIRED AND MASKED ---------- */
308 
309           call pxss$lock_apte (processid, aptep, code);     /* Try to lock target APTE */
310           if code = 0
311           then do;                                          /* Process exists and is locked */
312                     apte.timax = process_timax;
313                     call pxss$unlock_apte (aptep);
314                end;
315 
316           call UNWIRE_UNMASK;
317 
318 /* ---------- UNWIRED AND UNMASKED ---------- */
319 
320           return;
321 %page;
322 /* VALIDATE_PROCESSID  - validates that a processid corresponds to an active
323                          process.
324 
325    return code = 0     - process exists
326    = error_table_$process_unknown - no such process
327 
328 */
329 
330 validate_processid:
331      entry (a_processid, a_code);
332 
333           a_code = 0;
334 
335           aptep = PROCESSID_TO_APTE ((a_processid), "0"b);
336           if aptep = null ()
337           then a_code = error_table_$process_unknown;
338 
339           return;
340 %page;
341 /* SUSPEND_TC          - turn on the mechanism in getwork (of pxss fame) that
342                          suspends the running of processes, leaving only the
343                          idles and the caller available for running.  this
344                          state occurs only when tc_data$tc_suspend_lock is
345                          locked.  there are no parameters to this routine; its
346                          caller is guarenteed to be the only one running upon
347                          its return.
348 */
349 
350 suspend_tc:
351      entry ();
352 
353           call lock$lock_fast (addr (tc_data$tc_suspend_lock));
354                                                             /* get the lock, possibly */
355                                                             /* entering the WAIT state */
356 
357           call pxss$suspend_getwork ();                     /* connect all processors */
358                                                             /* and loop until only we remain */
359 
360           return;
361 
362 %page;
363 /* RESUME_TC           - disable the suspension mechanism in getwork. */
364 
365 resume_tc:
366      entry ();
367 
368           call lock$unlock_fast (addr (tc_data$tc_suspend_lock));
369                                                             /* possibly wake others */
370                                                             /* who want the suspend service */
371 
372           return;
373 %page;
374 get_ipc_operands:
375      entry (P_ipc_r_offset, P_ipc_r_factor);
376 
377 /**** This entry, target of hcs_$get_ipc_operands, allows a process
378       to determine the operands used for IPC validation.  It returns
379       only the operands for the calling process.  These values are
380       retrieved from the apte by the user-ring IPC at Event Channel
381       Table initialization time. */
382 
383           aptep = pds$apt_ptr;
384           P_ipc_r_offset = apte.ipc_r_offset;
385           P_ipc_r_factor = apte.ipc_r_factor;
386           return;
387 %page;
388 get_ipc_operands_priv:
389      entry (a_processid, P_ipc_r_offset, P_ipc_r_factor, a_code);
390 
391 /**** This entry is a highly priviledged entry to determine the operands
392       used for IPC validation for a specified process.  It is used by
393       ring-0 IPC (hc_ipc) and by the Initializer process through the
394       gate hphcs_$get_ipc_operands_priv. */
395 
396           processid = a_processid;
397 
398           call WIRE_MASK ();
399 
400 /***** WIRED AND MASKED *****/
401 
402           call pxss$lock_apte (processid, aptep, code);
403           if code = 0
404           then do;
405                     ipc_r_offset = apte.ipc_r_offset;       /* copy to wired stack frame */
406                     ipc_r_factor = apte.ipc_r_factor;       /* copy to wired stack frame */
407                     call pxss$unlock_apte (aptep);
408                end;
409           call UNWIRE_UNMASK ();
410 
411 /***** UNWIRED AND UNMASKED *****/
412 
413           if code ^= 0
414           then a_code = error_table_$process_unknown;
415           else do;
416                     P_ipc_r_offset = ipc_r_offset;
417                     P_ipc_r_factor = ipc_r_factor;
418                     a_code = 0;
419                end;
420           return;
421 %page;
422 /*  Internal procedure to validate that a process ID corresponds to
423     an active process. We're not concerned with races here, since they
424     can happen anyway (between now and when the process ID is used). */
425 
426 PROCESSID_TO_APTE:
427      proc (processid, allow_special_procs) returns (ptr);
428 
429 dcl       processid           bit (36) aligned;
430 dcl       allow_special_procs bit (1) aligned;
431 
432 
433 dcl       apte_offset         fixed bin (18);               /* Offset of APTE in tc_data */
434 dcl       first_apte_offset   fixed bin (18);               /* offset of first APTE in tc_data */
435 dcl       1 pid               aligned,                      /* decomposition of process ID */
436             2 offset          bit (18) unaligned,           /* offset of APTE */
437             2 unique          bit (18) unaligned;           /* unique number assigned by AS */
438 dcl       taptep              ptr;
439 dcl       1 tapte             aligned like apte based (taptep);
440 
441 
442           unspec (pid) = processid;
443           apte_offset = bin (pid.offset, 18);
444           taptep = ptr (addr (tc_data$), pid.offset);
445           first_apte_offset = bin (rel (addr (tc_data$apt)), 18);
446 
447           if apte_offset < first_apte_offset
448           then return (null ());
449           else if apte_offset >= first_apte_offset + tc_data$apt_size * size (apte)
450           then return (null ());
451           else if mod ((apte_offset - first_apte_offset), size (apte)) ^= 0
452           then return (null ());
453           else if tapte.processid ^= processid
454           then return (null ());
455           else if (^allow_special_procs & (tapte.flags.hproc | tapte.flags.idle))
456           then return (null ());
457           else return (taptep);
458 
459      end PROCESSID_TO_APTE;
460 %page;
461 /* Internal Procedure to wire this procedure (text and linkage), wire
462    stack, and mask to system level */
463 
464 WIRE_MASK:
465      proc;
466 
467           call wire_proc$wire_me;
468           call pmut$wire_and_mask (oldmask, ptwp);
469 
470      end WIRE_MASK;
471 
472 
473 
474 
475 
476 
477 
478 
479 /* Internal Procedure to reset mask to previous, unwire stack, unwire
480    text and linkage */
481 
482 UNWIRE_UNMASK:
483      proc;
484 
485           call pmut$unwire_unmask (oldmask, ptwp);
486           call wire_proc$unwire_me;
487 
488 
489      end UNWIRE_UNMASK;
490 
491 /* format: off */
492 %page; %include apte;
493 %page; %include process_status_return;
494 %page; %include ips_mask_data;
495 %page; %include arg_list;
496 /* format: on */
497 
498      end tc_util;