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 
 14 /****^  HISTORY COMMENTS:
 15   1) change(88-05-09,Fawcett), approve(88-05-10,MCR7904),
 16      audit(88-06-24,Farley), install(88-08-22,MR12.2-1087):
 17      This change provides a cleanup based on the evolution of process creation.
 18                                                    END HISTORY COMMENTS */
 19 
 20 
 21 /* format: style4 */
 22 
 23 /* ACT_PROC -       Procedure to create and/or activate a process
 24    .                This procedure assumes that the calling process has directory privileges,
 25    .                so that it can create the KST, PDS, and PIT in the new, upgraded process directory.
 26 
 27    Last Modified: (Date and reason)
 28    08/05/71 by Richard H. Gumpertz to combine pds, pdf
 29    08/10/72 by Richard G. Bratt to implement "no permanent storage" users
 30    740726 by PG to add AIM & audit info
 31    741210 by PG to use privileged initiate on KST, PDS, and PIT.
 32    750601 by RE Mullen (for priority scheduler) to call set_work_class
 33    10/13/75 by R. Bratt for prelinking
 34    760101 by REM for for deadline scheduler
 35    03/23/76 by S. Webber for new reconfiguration
 36    02/22/77 by THVV for dsegs with branches
 37    May 1978 by T. Casey to use active_hardcore_data$pdir_quota as a default value rather than an upper limit on pdir quotas,
 38    .                giving system and project administrators complete flexibility in using the per-user pdir quota mechanism.
 39    August 1978 by Greenberg for variable-size DSEG's and KST's.
 40    May 1979 by Mike Grady for ring 0 stack sharing.
 41    Modified July 1979 by T. Casey for MR8.0 to add set_pit_tty_info entry point for process preservation across hangups.
 42    Modified January 1981 by Benson I. Margulies for change of outer module on reconnection.
 43    Modified February 1983 by E. N. Kittlitz for default kst 256k connection enabling.
 44    Modified October 1984 by Keith Loepere to use fs_modes.
 45    Modified 1984-11-11 by E. Swenson for IPC event channel validation;
 46    act_proc$create initializes apte.ipc_r_offset.
 47    Modified December 1984 by Keith Loepere to set pds$throttle_segment_state_changes.
 48    Modified December 1984 by Keith Loepere for pdir_dir_quota.
 49 */
 50 
 51 act_proc: procedure;
 52 
 53 /* Variables */
 54 
 55 dcl  PRELINKED_DIR char (64);
 56 dcl  abs_ptr ptr;
 57 dcl  bc fixed bin (24);
 58 dcl  evolution fixed bin (17);                              /* tracks the creation of a process */
 59 dcl  1 branch_info like create_branch_info aligned;         /* need auto store for this structure  */
 60 dcl  clr_size fixed bin;
 61 dcl  code fixed bin (35);
 62 dcl  ignore_code fixed bin (35);
 63 dcl  cp ptr;
 64 dcl  daemon_sw bit (1) aligned;
 65 dcl  dbr fixed bin (71);
 66 dcl  1 dir_acl (3) aligned,                                 /* structure for placing 3 ACLs on directories */
 67        2 userid char (32),
 68        2 mode bit (36),
 69        2 status_code fixed bin (35);
 70 dcl  dir_aclp ptr;
 71 dcl  dseg_ptr ptr;
 72 dcl  dseg_size fixed bin (19);
 73 dcl  dstep ptr;
 74 dcl  esw fixed bin;
 75 dcl  hd char (32);
 76 dcl  i fixed bin;
 77 dcl  is_absentee bit (1) aligned;
 78 dcl  kst_ptr ptr;
 79 dcl  kst_size fixed bin (19);
 80 dcl  local_audit_event_flags bit (36) aligned;
 81 dcl  lot_size fixed bin;
 82 dcl  max_authorization bit (72) aligned;
 83 dcl  max_lot fixed bin;
 84 dcl  n fixed bin;
 85 dcl  p ptr;
 86 dcl  p1 ptr;
 87 dcl  p2 ptr;
 88 dcl  pdir_dir_quota fixed bin (17);
 89 dcl  pdir_entry char (15);
 90 dcl  pdir_path char (32);
 91 dcl  pdir_quota fixed bin (17);
 92 dcl  pds_astep ptr;
 93 dcl  pds_ptr ptr;
 94 dcl  pid bit (36) aligned;
 95 dcl  process_authorization bit (72) aligned;
 96 dcl  process_group char (32) aligned;
 97 dcl  rings (3) fixed bin (3);
 98 dcl  savring fixed bin;
 99 dcl  1 seg_acl (3) aligned,                                 /* structure for placing 3 ACLs on segments */
100        2 userid char (32),
101        2 mode bit (36),
102        2 exmode bit (36),
103        2 status_code fixed bin (35);
104 dcl  seg_aclp ptr;
105 dcl  seg_rb (3) fixed bin;
106 dcl  segno fixed bin;
107 dcl  stop_type bit (1) aligned;
108 dcl  template_dsegp ptr;
109 dcl  template_kstp ptr;
110 dcl  tsdw fixed bin (71);
111 dcl  work_class fixed bin;
112 
113 /* Based */
114 
115 dcl  1 ack_name aligned based,
116        2 person char (32),
117        2 project char (32),
118        2 tag char (1);
119 dcl  based_dseg (0:n) fixed bin (71) based;
120 dcl  copy_audit bit (36) aligned based;
121 dcl  copy_authorization bit (72) aligned based;
122 dcl  copy_chn_name fixed bin (71) based;
123 dcl  copy_data (n) fixed bin based;
124 dcl  copy_dir_name char (32) aligned based;
125 dcl  copy_dstep bit (18) aligned based;
126 dcl  copy_event_count fixed bin based;
127 dcl  copy_group_id char (32) aligned based;
128 dcl  copy_home_dir char (64) aligned based;
129 dcl  copy_id bit (36) aligned based;
130 dcl  copy_prelinked_ring (7) bit (1) unaligned based;
131 dcl  copy_ptr ptr based;
132 dcl  copy_ring fixed bin based;
133 dcl  copy_size (0:7) fixed bin based;
134 dcl  copy_throttle_seg_state_chg bit (1) aligned based;
135 dcl  copy_time fixed bin (71) based;
136 dcl  1 stack aligned based (sb),
137        2 header like stack_header,
138        2 first_frame fixed bin;
139 
140 /* External */
141 
142 dcl  abs_seg$ fixed bin ext;
143 dcl  active_all_rings_data$default_max_segno fixed bin (17) ext;
144 dcl  active_all_rings_data$hcscnt fixed bin (18) ext;
145 dcl  active_all_rings_data$max_segno fixed bin (17) ext;
146 dcl  active_all_rings_data$stack_base_segno fixed bin (18) ext;
147 dcl  active_hardcore_data$pdir_dir_quota fixed bin ext;
148 dcl  active_hardcore_data$pdir_quota fixed bin ext;
149 dcl  dseg$ fixed bin ext;
150 dcl  error_table_$ai_restricted fixed bin (35) external static;
151 dcl  error_table_$apt_full fixed bin (35) external static;
152 dcl  error_table_$invalid_subsystem fixed bin (35) ext;
153 dcl  error_table_$smallarg fixed bin (35) external static;
154 dcl  kst_seg$ fixed bin ext;
155 dcl  pds$ fixed bin ext;
156 dcl  pds$access_authorization bit (72) aligned external static;
157 dcl  1 pds$access_name aligned external,
158        2 person char (32),
159        2 project char (32),
160        2 tag char (1);
161 dcl  pds$account_id bit (36) aligned external;
162 dcl  pds$apt_ptr ptr ext;
163 dcl  pds$audit_flags bit (36) aligned external static;
164 dcl  pds$clr_stack_size (0:7) fixed bin ext;
165 dcl  pds$covert_event_count fixed bin ext;
166 dcl  pds$dstep bit (18) aligned ext;
167 dcl  pds$first_covert_event_time fixed bin (71) ext;
168 dcl  pds$highest_ring fixed bin ext;
169 dcl  pds$home_dir char (168) aligned external;
170 dcl  pds$initial_procedure ptr ext;
171 dcl  pds$initial_ring fixed bin ext;
172 dcl  pds$interrupt_ring fixed bin ext;
173 dcl  pds$last_sp ptr ext aligned;
174 dcl  pds$lock_id bit (36) aligned ext;
175 dcl  pds$lot_stack_size (0:7) fixed bin ext;
176 dcl  pds$max_access_authorization bit (72) aligned external static;
177 dcl  pds$max_lot_size (0:7) fixed bin ext;
178 dcl  pds$prelinked_ring (7) bit (1) unaligned ext;
179 dcl  pds$process_dir_name char (32) aligned ext;
180 dcl  pds$process_group_id char (32) aligned ext;
181 dcl  pds$processid bit (36) aligned ext;
182 dcl  pds$term_channel fixed bin (71) ext;
183 dcl  pds$term_proc bit (36) aligned external;
184 dcl  pds$throttle_segment_state_changes bit (1) aligned ext;
185 dcl  sst$seg_state_change_limit fixed bin external;
186 dcl  sys_info$access_class_ceiling bit (72) aligned external static;
187 dcl  sys_info$default_256K_enable fixed bin ext;
188 dcl  sys_info$page_size fixed bin ext;
189 dcl  sys_info$time_of_bootload fixed bin (71) ext;
190 dcl  tc_data$pdscopyl fixed bin ext;
191 dcl  tc_data$stat (0:5) fixed bin ext;
192 dcl  tc_data$timax fixed bin ext;
193 dcl  template_pds$ fixed bin ext;
194 
195 /* Entries */
196 
197 dcl  acc_name_$elements entry (ptr, ptr, fixed bin (35));
198 dcl  access_audit_$check_general_user entry (bit (36) aligned, bit (36) aligned, bit (72) aligned, bit (36) aligned) returns (bit (1) aligned);
199 dcl  aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
200 dcl  append$branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin, char (*) aligned, fixed bin, fixed bin, fixed bin (24), fixed bin (35));
201 dcl  append$create_branch_ entry (char (*), char (*), ptr, fixed bin (35));
202 dcl  asd_$replace_dall entry (char (*), char (*), ptr, fixed bin, bit (1) aligned, fixed bin (35));
203 dcl  asd_$replace_sall entry (char (*), char (*), ptr, fixed bin, bit (1) aligned, fixed bin (35));
204 dcl  chname$cfile entry (char (*), char (*), char (*), char (*), fixed bin (35));
205 dcl  delentry$dfile entry (char (*), char (*), fixed bin (35));
206 dcl  del_dir_tree entry (char (*), char (*), fixed bin (35));
207 dcl  fs_modes entry (ptr, bit (36) aligned, bit (36) aligned, (3) fixed bin (3), fixed bin (35));
208 dcl  get_ptrs_$given_astep ext entry (ptr) returns (fixed bin (71));
209 dcl  getuid ext entry returns (bit (36) aligned);
210 dcl  grab_aste entry (ptr, fixed bin (18), fixed bin (35)) returns (ptr);
211 dcl  grab_aste$prewithdraw entry (ptr, fixed bin (18), fixed bin (35)) returns (ptr);
212 dcl  init_proc entry;
213 dcl  initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
214 dcl  initiate$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35));
215 dcl  initiate$priv_init entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
216 dcl  level$get ext entry (fixed bin);
217 dcl  level$set ext entry (fixed bin);
218 dcl  pxss$empty_t ext entry (ptr);
219 dcl  pxss$get_entry ext entry (ptr);
220 dcl  pxss$set_work_class ext entry (bit (36) aligned, fixed bin, fixed bin, fixed bin (35));
221 dcl  syserr$error_code entry options (variable);
222 dcl  terminate_$noname ext entry (ptr, fixed bin (35));
223 dcl  unique_chars_ entry (bit (*)) returns (char (15));
224 
225 /* constants */
226 
227 dcl  CREATE init (0) fixed bin static options (constant);
228 dcl  INFO init (1) fixed bin static options (constant);
229 dcl  NORMAL_EVOLUTION_TERMINATION init (1) fixed bin static options (constant);
230 dcl  REW_bit bit (5) static options (constant) init ("1110"b);
231 dcl  RW_mode fixed bin (5) initial (01010b) static options (constant); /* mode bits for segments we create */
232 dcl  SMA_bit bit (5) static options (constant) init ("111"b);
233 dcl  SMA_mode fixed bin (5) initial (01011b) static options (constant); /* mode bits for directories we create */
234 dcl  dir_rb (3) fixed bin static options (constant) init (7, 7, 7);
235 
236 /* builtins */
237 
238 dcl  (addr, baseno, baseptr, binary, bin, bit, clock, divide, fixed, length, max, min, null, ptr, rel, rtrim, size, string, substr, unspec) builtin;
239 
240 /* Parameters */
241 
242 dcl  a_code fixed bin (35) parameter;
243 dcl  ci_ptr ptr parameter;
244 %page;
245 create: entry (ci_ptr, a_code);
246 
247 
248           evolution = NORMAL_EVOLUTION_TERMINATION;         /* the normal evolution exit */
249 
250           esw = CREATE;                                     /* set entry switch indicating create entry */
251           cp = ci_ptr;                                      /* copy input pointer */
252           call level$get (savring);                         /* save validation level */
253           call level$set (0);                               /* and reset to zero */
254 
255 /* Validate the process authorization & max authorization against the system access_ceiling */
256 
257           process_authorization = cp -> create_info.process_authorization;
258           max_authorization = cp -> create_info.max_process_authorization;
259 
260           if ^aim_check_$greater_or_equal (sys_info$access_class_ceiling, max_authorization)
261           then go to return_ai_error;
262 
263           if ^aim_check_$greater_or_equal (max_authorization, process_authorization) then do;
264 
265 return_ai_error:
266                code = error_table_$ai_restricted;           /* auth <= max <= ceiling */
267                go to EVOLUTION_CLEANUP (evolution);
268           end;
269 
270           call pxss$get_entry (aptep);                      /* get an APT entry for the new process */
271           if aptep = null then do;                          /* if null, no more room */
272                code = error_table_$apt_full;                /* return non-zero code */
273                go to EVOLUTION_CLEANUP (evolution);
274           end;
275 
276           evolution = evolution + 1;                        /* ADD apte removal */
277 
278           cp -> create_info.processid.rel_apte = rel (aptep); /* return rest of processid */
279           pid = string (cp -> create_info.processid);       /* copy the processid */
280           pdir_entry = unique_chars_ ((pid));
281           pdir_path = ">process_dir_dir>" || pdir_entry;    /* get path name */
282 
283           process_group = cp -> create_info.process_group_id; /* copy process group id */
284 
285           stop_type = "1"b;                                 /* assume this is answering service 7.4 or higher */
286 
287 /* Create an upgraded process directory */
288 
289           pdir_quota = cp -> create_info.record_quota;
290           if pdir_quota = 0 then                            /* if they blow it with the new pdir quota mechanism */
291                pdir_quota = active_hardcore_data$pdir_quota;/* be reasonable */
292           pdir_quota = max (pdir_quota, 20);                /* make sure it's enough to get running */
293 
294           pdir_dir_quota = cp -> create_info.dir_quota;
295           if pdir_dir_quota = 0 then
296                pdir_dir_quota = active_hardcore_data$pdir_dir_quota;
297           pdir_dir_quota = max (pdir_dir_quota, 10);        /* make sure it's enough to get running */
298 
299           unspec (branch_info) = "0"b;
300           branch_info.version = create_branch_version_2;
301           branch_info.mode = substr (SMA_bit, 1, length (branch_info.mode));
302           branch_info.rings (1) = dir_rb (1);
303           branch_info.rings (2) = dir_rb (2);
304           branch_info.rings (3) = dir_rb (3);
305           branch_info.userid = pds$process_group_id;
306           branch_info.switches.dir_sw = "1"b;
307           branch_info.switches.copy_sw = "0"b;
308           branch_info.switches.chase_sw = "0"b;             /* don't chase links */
309           branch_info.parent_ac_sw = "0"b;                  /* Upgrade the dir */
310           branch_info.switches.priv_upgrade_sw = "0"b;      /* really move quota from >pdd */
311           branch_info.bitcnt = 0;
312           branch_info.quota = pdir_quota;
313           branch_info.dir_quota = pdir_dir_quota;
314           branch_info.access_class = process_authorization;
315 
316           call append$create_branch_ (">process_dir_dir", pdir_entry, addr (branch_info), code);
317           if code ^= 0 then go to EVOLUTION_CLEANUP (evolution);
318 
319 
320           do i = 1 to 3;                                    /* set up access control lists */
321                seg_acl (i).mode = REW_bit;                  /* Default access for process dir segments is REW */
322                seg_acl (i).exmode = "0"b;                   /* and no extended mode set */
323                dir_acl (i).mode = SMA_bit;                  /* Default access for process dir is SMA */
324           end;
325 
326           evolution = evolution + 1;                        /* increment the evolution to include the process_dir */
327 
328           seg_acl (1).userid = process_group;               /* give access to created process first */
329           dir_acl (1).userid = process_group;
330           seg_acl (2).userid = pds$process_group_id;        /* give access to system control */
331           dir_acl (2).userid = pds$process_group_id;
332           seg_acl (3).userid = "*.*.*";                     /* ... everybody else */
333           dir_acl (3).userid = "*.*.*";
334           seg_acl (3).mode,                                 /* give null access to everyone else */
335                dir_acl (3).mode = "0"b;
336 
337           seg_aclp = addr (seg_acl (1).userid);             /* get pointer to segment ACL */
338           dir_aclp = addr (dir_acl (1).userid);             /* get pointer to directory ACL */
339 
340           daemon_sw = "1"b;                                 /* Don't add "*.SysDaemon.*" to ACLs */
341           call asd_$replace_dall (">process_dir_dir", pdir_entry, dir_aclp, 3, daemon_sw, code); /* directory branch acl */
342           if code ^= 0 then go to EVOLUTION_CLEANUP (evolution);
343 
344           call create_hardcore_seg ("dseg", dseg_ptr);      /* create descriptor segment */
345           if dseg_ptr = null then go to EVOLUTION_CLEANUP (evolution);
346 
347           evolution = evolution + 1;                        /* increment the evolution to show the creation of segments */
348 
349           call create_hardcore_seg ("kst", kst_ptr);        /* create known segment table KST */
350           if kst_ptr = null then go to EVOLUTION_CLEANUP (evolution);
351 
352 
353           call create_hardcore_seg ("pds", pds_ptr);        /* create process data segment (PDS) */
354           if pds_ptr = null then go to EVOLUTION_CLEANUP (evolution);
355 
356           n = tc_data$pdscopyl;                             /* copy the template PDS */
357           pds_ptr -> copy_data = addr (template_pds$) -> copy_data;
358 
359           if cp -> create_info.version > 4
360           then PRELINKED_DIR = cp -> create_info.subsystem;
361           else PRELINKED_DIR = "";
362 
363           if PRELINKED_DIR ^= "" then do;
364                template_dsegp, template_kstp = null ();     /* init for cleanup */
365                call initiate (PRELINKED_DIR, "template_kst", "", 0, 0, template_kstp, code);
366                if template_kstp = null ()
367                then do;
368 bad_subsystem:
369                     code = error_table_$invalid_subsystem;
370                     go to EVOLUTION_CLEANUP (evolution);
371                end;
372                evolution = evolution + 1;                   /* Need to terminate reference to template_kst if abort */
373                if template_kstp -> kst.time_of_bootload ^= sys_info$time_of_bootload | ^template_kstp -> kst.template
374                then go to bad_subsystem;
375                call fs_modes (template_kstp, ("0"b), ("0"b), rings, code);
376                if code ^= 0 | rings (1) ^= 0 then go to bad_subsystem;
377                n = bin (rel (addr (template_kstp -> kst.kst_entry (template_kstp -> kst.highseg + 1))));
378                kst_ptr -> copy_data = template_kstp -> copy_data;
379                ptr (pds_ptr, rel (addr (pds$prelinked_ring))) -> copy_prelinked_ring = kst_ptr -> kst.prelinked_ring;
380                call terminate_$noname (template_kstp, code);
381                if code ^= 0 then go to bad_subsystem;
382                evolution = evolution - 1;                   /* decrement because reference to template_kst terminated */
383           end;
384                                                             /* Compute the sizes and locations of the LOT and CLR */
385 
386           lot_size = cp -> create_info.lot_size;
387           clr_size = cp -> create_info.cls_size;
388           max_lot = cp -> create_info.kst_size;
389           if max_lot = 0 then max_lot = active_all_rings_data$default_max_segno + 1;
390           max_lot = min (max_lot, active_all_rings_data$max_segno + 1);
391           if max_lot <= active_all_rings_data$hcscnt
392           then do;
393                code = error_table_$smallarg;
394                call syserr$error_code (LOG, code, "act_proc: KST size specified (^d) less than minimum (^d). Creating process for ^a.", max_lot, active_all_rings_data$hcscnt, cp -> create_info.process_group_id);
395                go to EVOLUTION_CLEANUP (evolution);
396           end;
397 
398 /* Now fill in the per-process variables into the new pds */
399           if cp -> create_info.lot_in_stack then do;
400                p = ptr (pds_ptr, rel (addr (pds$lot_stack_size (0))));
401                do i = 0 to 7;
402                     p -> copy_size (i) = lot_size;
403                end;
404           end;
405 
406           if cp -> create_info.cls_in_stack then do;
407                p = ptr (pds_ptr, rel (addr (pds$clr_stack_size (0))));
408                do i = 0 to 7;
409                     p -> copy_size (i) = clr_size;
410                end;
411           end;
412 
413           p = ptr (pds_ptr, rel (addr (pds$max_lot_size (0))));
414           do i = 0 to 7;
415                p -> copy_size (i) = max_lot;
416           end;
417 
418           p = ptr (pds_ptr, rel (addr (pds$processid)));    /* fill in process id */
419           p -> copy_id = pid;
420 
421           p = ptr (pds_ptr, rel (addr (pds$lock_id)));
422           p -> copy_id = getuid ();                         /* Get lock ID */
423 
424           p = ptr (pds_ptr, rel (addr (pds$apt_ptr)));      /* fill in APT entry pointer */
425           p -> copy_ptr = aptep;
426 
427           p = ptr (pds_ptr, rel (addr (pds$account_id)));   /* initialize pds$account id */
428           p -> copy_id = pds$account_id;
429 
430           p = ptr (pds_ptr, rel (addr (pds$process_dir_name))); /* initialize pds$process_dir_name */
431           p -> copy_dir_name = pdir_path;
432 
433           p = ptr (pds_ptr, rel (addr (pds$process_group_id))); /* initialize pds$process_group_id */
434           p -> copy_group_id = process_group;
435 
436           p = ptr (pds_ptr, rel (addr (pds$initial_ring))); /* copy intial ring into pds */
437           p -> copy_ring = cp -> create_info.initial_ring;
438 
439           p = ptr (pds_ptr, rel (addr (pds$initial_procedure)));
440           p -> copy_ptr = addr (init_proc);                 /* Set initial procedure for process. */
441 
442           p = ptr (pds_ptr, rel (addr (pds$last_sp)));
443           sb = baseptr (active_all_rings_data$stack_base_segno);
444           p -> copy_ptr = addr (stack.first_frame);         /* Setup first time stack ptr */
445 
446           p = ptr (pds_ptr, rel (addr (pds$interrupt_ring))); /* copy interrupt ring into pds */
447           p -> copy_ring = cp -> create_info.initial_ring;  /* use initial ring for users */
448 
449           p = ptr (pds_ptr, rel (addr (pds$highest_ring))); /* copy highest ring into pds */
450           p -> copy_ring = cp -> create_info.highest_ring;
451 
452           p = ptr (pds_ptr, rel (addr (pds$access_name)));  /* fill in 3 part access name in pds */
453           call acc_name_$elements (addr (process_group), p, code);
454           if code ^= 0 then go to EVOLUTION_CLEANUP (evolution);
455           if p -> ack_name.tag = "m" then is_absentee = "1"b;
456           else is_absentee = "0"b;
457 
458           p1 = ptr (pds_ptr, rel (addr (pds$term_proc)));   /* copy terminate process id into pds */
459           p1 -> copy_id = cp -> create_info.term_processid;
460 
461           p1 = ptr (pds_ptr, rel (addr (pds$term_channel)));/* copy terminate channel name into pds */
462           p1 -> copy_chn_name = cp -> create_info.term_channel;
463 
464           p = ptr (pds_ptr, rel (addr (pds$access_authorization)));
465           p -> copy_authorization = process_authorization;
466 
467           p = ptr (pds_ptr, rel (addr (pds$max_access_authorization)));
468           p -> copy_authorization = max_authorization;
469 
470           p = ptr (pds_ptr, rel (addr (pds$audit_flags)));
471           p -> copy_audit = cp -> create_info.audit;
472 
473           seg_rb (1) = 0;                                   /* create pit with rb of (0, 5, 5) */
474           seg_rb (2), seg_rb (3) = cp -> create_info.highest_ring;
475           pit_ptr = null;
476           call append$branchx (pdir_path, "pit", (RW_mode), seg_rb, process_group, 0, 0, 0, code);
477           if code ^= 0 then go to EVOLUTION_CLEANUP (evolution);
478 
479           call asd_$replace_sall (pdir_path, "pit", seg_aclp, 3, daemon_sw, code);
480           if code ^= 0 then go to EVOLUTION_CLEANUP (evolution);
481 
482           call initiate$priv_init (pdir_path, "pit", "", 0, 0, pit_ptr, code);
483           if pit_ptr = null then go to EVOLUTION_CLEANUP (evolution);
484           n = cp -> create_info.words_of_pit;               /* copy the pit template */
485           pit_ptr -> copy_data = cp -> create_info.pit_ptr -> copy_data;
486           p2 = ptr (pds_ptr, rel (addr (pds$home_dir)));
487           if substr (ptr (pit_ptr, cp -> create_info.homedir) -> copy_home_dir, 1, 5) ^= "[pd]>"
488           then p2 -> copy_home_dir = ptr (pit_ptr, cp -> create_info.homedir) -> copy_home_dir;
489           else do;
490                hd = substr (ptr (pit_ptr, cp -> create_info.homedir) -> copy_home_dir, 6, 32);
491                call append$branchx (pdir_path, hd, (SMA_mode), dir_rb, process_group, 1, 0, 0, code);
492                if code ^= 0 then go to EVOLUTION_CLEANUP (evolution);
493                call asd_$replace_dall (pdir_path, hd, dir_aclp, 3, daemon_sw, code); /* directory acl */
494                if code ^= 0 then go to EVOLUTION_CLEANUP (evolution);
495                                                             /* fill in true home directory in PIT */
496                p2 -> copy_home_dir = rtrim (pdir_path) || ">" || rtrim (hd);
497                ptr (pit_ptr, cp -> create_info.homedir) -> copy_home_dir = p2 -> copy_home_dir;
498           end;
499 
500           call terminate_$noname (pit_ptr, code);           /* terminate copy */
501           if code ^= 0 then go to EVOLUTION_CLEANUP (evolution);
502 
503           aptep -> apte.processid = pid;                    /* set up process id in KPT entry */
504 
505           aptep -> apte.access_authorization = cp -> create_info.process_authorization;
506           work_class = cp -> create_info.work_class;        /* Yes */
507           call pxss$set_work_class (pid, work_class, 0, code); /* Set it */
508           if code ^= 0 then go to EVOLUTION_CLEANUP (evolution); /* Unable to set it */
509 
510 /*        go to common;                                     /* go to activate this process */
511 /*^L*/
512 /* activate: entry(aaptep, a_code);                         /* entry to activate an inactive process */
513 
514 /* dcl  aaptep ptr;                                         /* pointer to KPT (APT) entry */
515 /* dcl  ACTIVATE init (2) fixed bin static options (constant); */
516 
517 /*        esw = ACTIVATE;                                   /* set entry switch for activate entry */
518 /*        evolution = NORMAL_EVOLUTION_TERMINATION */
519 /*        stop_type = "1"b;                                 /* I guess. */
520 /*        aptep = aaptep;                                   /* pick up pointer to KPT entry */
521 /*        pid = aptep -> apte.processid;                    /* pick up process id */
522 /*        call level$get(savring);                          /* save validation level */
523 /*        call level$set(0);                                /* reset validation level to zero */
524 /*        pdir_entry = unique_chars_((pid));                /* compute process directory entry name */
525 /*        pdir_path = ">process_dir_dir>" || pdir_entry; */
526 /*        call initiate$priv_init (pdir_path, "dseg", "", 0, 0, dseg_ptr, code); /* initiate dseg */
527 /*        if dseg_ptr = null then go to EVOLUTION_CLEANUP (evolution); */
528 /*        call initiate$priv_init (pdir_path, "kst", "", 0, 0, kst_ptr, code); /* initiate KST */
529 /*        if kst_ptr = null then go to EVOLUTION_CLEANUP (evolution); */
530 /*        call initiate$priv_init (pdir_path, "pds", "", 0, 0, pds_ptr, code); /* initiate PDS */
531 /*        if pds_ptr = null then go to  EVOLUTION_CLEANUP (evolution); */
532 /* COMMENTED OUT BECAUSE IT'S NOT PRESENTLY USED. */
533 /* CAUTION: if the activate entry point is ever revieved then PRELINKED_DIR */
534 /*          must be stored in the guys pds.  Some where the segments need to */
535 /*          be terminated if the activation is aborted. This should be in  */
536 /*          EVOLUTION_CLEANUP condition by the value of esw */
537 
538 common:   abs_ptr = addr (abs_seg$);                        /* create process code joins activate code here */
539           n = active_all_rings_data$hcscnt - 1;             /* Set up descriptor segment for new process. */
540                                                             /* copy all SDW's up to first stacks (ring 0) SDW */
541           dseg_ptr -> based_dseg = addr (dseg$) -> based_dseg;
542           dseg_size = size (sdw) * max_lot;
543           call set_ehs (dseg_ptr, "1"b, divide (dseg_size + sys_info$page_size - 1, sys_info$page_size, 17, 0));
544           segno = bin (baseno (addr (dseg$)), 18);          /* Get segno of dseg */
545           dseg_ptr -> sdwa (segno).add = addr (tsdw) -> sdw.add; /* Fill in page table addr */
546           dseg_ptr -> sdwa (segno).bound = bit (fixed (divide (dseg_size + 15, 16, 17, 0) - 1, 14), 14);
547           dseg_ptr -> sdwa (segno).entry_bound = bit (divide (active_all_rings_data$stack_base_segno, 8, 14, 0), 14);
548           dstep = astep;                                    /* Save ptr to ASTE for dseg */
549           unspec (dbr) = string (dseg_ptr -> sdwa (segno));
550 
551           if PRELINKED_DIR ^= "" then do;
552                call initiate$initiate_count (PRELINKED_DIR, "template_dseg", "", bc, 0, template_dsegp, code);
553                if template_dsegp = null () then go to bad_subsystem;
554                evolution = evolution + 1;                   /* Need to terminate reference to template_dseg if abort */
555                call fs_modes (template_dsegp, ("0"b), ("0"b), rings, code);
556                if code ^= 0 then go to bad_subsystem;
557                if rings (1) ^= 0 then go to bad_subsystem;
558                n = divide (bc, 72, 17, 0) - active_all_rings_data$hcscnt;
559                if n <= 0 then go to bad_subsystem;
560                addr (dseg_ptr -> sdwa (active_all_rings_data$hcscnt)) -> based_dseg =
561                     addr (template_dsegp -> sdwa (active_all_rings_data$hcscnt)) -> based_dseg;
562                call terminate_$noname (template_dsegp, code);
563                evolution = evolution - 1;                   /* decrement because reference to template_dseg terminated */
564           end;
565 
566           p = ptr (pds_ptr, rel (addr (pds$dstep)));        /* save pointer to hardcore DST entry */
567           p -> copy_dstep = rel (dstep);
568           kst_size = size (kst) + size (kste) * (max_lot - active_all_rings_data$hcscnt + 1);
569           if kst_ptr -> kst.highseg = 0 then kst_ptr -> kst.highseg = max_lot - 1;
570           kst_ptr -> kst.allow_256K_connect = sys_info$default_256K_enable ^= 0;
571                                                             /* Init for non pre-linked process */
572           call set_ehs (kst_ptr, "0"b, divide (kst_size + sys_info$page_size - 1, sys_info$page_size, 17, 0));
573           segno = bin (baseno (addr (kst_seg$)), 18);
574           dseg_ptr -> based_dseg (segno) = tsdw;
575 
576           call set_ehs (pds_ptr, "1"b, 4);                  /* Force PDS active and prewithdraw */
577           segno = bin (baseno (addr (pds$)), 18);
578           dseg_ptr -> based_dseg (segno) = tsdw;
579           pds_astep = astep;
580 
581           aptep -> apte.timax = tc_data$timax;              /* initialize to default timax */
582           aptep -> apte.flags.state = bit (bin (4, 18), 18);/* set execution state to blocked */
583           tc_data$stat (4) = tc_data$stat (4) + 1;          /* up count of blocked processes */
584           aptep -> apte.asteps.pds = rel (pds_astep);       /* save ptr to PDS-AST entry */
585           aptep -> apte.asteps.dseg = rel (dstep);          /* save ptr to hardcore DST entry */
586           aptep -> apte.dbr = dbr;                          /* save descriptor segment base register value */
587           aptep -> apte.flags2.batch = is_absentee;         /* DIGS wants to know .. */
588           aptep -> apte.lock_id = ptr (pds_ptr, rel (addr (pds$lock_id))) -> copy_id;
589                                                             /* Place in pds as well */
590           aptep -> apte.ws_size = 0;                        /* assume no pages to start */
591           aptep -> apte.term_processid = ptr (pds_ptr, rel (addr (pds$term_proc))) -> copy_id;
592           aptep -> apte.term_channel = ptr (pds_ptr, rel (addr (pds$term_channel))) -> copy_chn_name;
593           aptep -> apte.deadline,                           /* set deadline here */
594                aptep -> apte.state_change_time = clock ();  /* Initialize it */
595 
596           local_audit_event_flags = "0"b;                   /* set throttle_segment_state_changes */
597           addr (local_audit_event_flags) -> audit_event_flags.grant = "1"b;
598           addr (local_audit_event_flags) -> audit_event_flags.cc_10_100 = "1"b;
599           ptr (pds_ptr, rel (addr (pds$throttle_segment_state_changes))) -> copy_throttle_seg_state_chg =
600                access_audit_$check_general_user (local_audit_event_flags, "0"b, process_authorization, cp -> create_info.audit);
601 
602           ptr (pds_ptr, rel (addr (pds$covert_event_count))) -> copy_event_count = -sst$seg_state_change_limit; /* page_fault counts up to 0 */
603           ptr (pds_ptr, rel (addr (pds$first_covert_event_time))) -> copy_time = clock ();
604 
605 /**** Here we set up apte.ipc_r_offset.  This is an 18-bit unsigned
606       integer used by IPC to validate event channel names in conjunction
607       with apte.ipc_r_factor.  This latter number is determined later,
608       when the process first runs, to provide an indeterminate delay between
609       the creation of these values.  The delay is necessary to make it
610       difficult to guess the value of apte.ipc_r_factor given the value
611       of apte.ipc_r_offset. */
612 
613           aptep -> apte.ipc_r_offset =
614                binary (substr (bit (binary (clock (), 54), 54), 37, 18), 18);
615 
616 /**** Set the value of apte.ipc_r_factor to zero for debugging purposes
617       so that we can determine whether it is getting set or not later. */
618 
619           aptep -> apte.ipc_r_factor = 0;
620 
621           call terminate_$noname (dseg_ptr, code);          /* Terminate dseg */
622           if code ^= 0 then go to EVOLUTION_CLEANUP (evolution);
623           call terminate_$noname (kst_ptr, code);           /* terminate KST */
624           if code ^= 0 then go to EVOLUTION_CLEANUP (evolution);
625           call terminate_$noname (pds_ptr, code);           /* terminate PDS */
626           if code ^= 0 then go to EVOLUTION_CLEANUP (evolution);
627 
628           if esw = CREATE then do;                          /* some special stuff left to do if create entry */
629 
630                if cp -> create_info.timax > 0 then aptep -> apte.timax = cp -> create_info.timax;
631                if cp -> create_info.user_processid ^= " " then do; /* additional name for process directory */
632                     call chname$cfile (">process_dir_dir", pdir_entry, "", (cp -> create_info.user_processid), code);
633                     if code ^= 0 then go to EVOLUTION_CLEANUP (evolution);
634                end;
635 
636           end;
637 
638           code = 0;
639 
640           go to EVOLUTION_CLEANUP (NORMAL_EVOLUTION_TERMINATION); /* go set level and return */
641 
642 
643 EVOLUTION_CLEANUP (5):
644           if esw = CREATE then do;
645                if template_kstp ^= null ()
646                then call terminate_$noname (template_kstp, ignore_code);
647                if template_dsegp ^= null ()
648                then call terminate_$noname (template_dsegp, ignore_code);
649           end;
650 
651 EVOLUTION_CLEANUP (4):                                      /* delete any segments that have been created */
652           if esw = CREATE then
653                call del_dir_tree (">process_dir_dir", pdir_entry, ignore_code);
654 
655 EVOLUTION_CLEANUP (3):                                      /* delete the process dir */
656           if esw = CREATE then
657                call delentry$dfile (">process_dir_dir", pdir_entry, ignore_code);
658 
659 EVOLUTION_CLEANUP (2):                                      /* Give back the APTE */
660           if esw = CREATE then
661                call pxss$empty_t (aptep);
662 
663 EVOLUTION_CLEANUP (1):                                      /* restore validation level */
664           call level$set (savring);
665                                                             /* tell caller what went wrong if any thing did. */
666           a_code = code;
667           return;
668 ^L
669 set_pit_tty_info: entry (a_pid, a_pitp, a_code);
670 
671 dcl  a_pid bit (36) aligned parameter;
672 dcl  a_pitp ptr parameter;
673 
674 dcl  pitp ptr;
675 
676           esw = INFO;
677 
678 /* Copy args */
679           pid = a_pid;
680           pitp = a_pitp;
681           code = 0;
682                                                             /* Bookkeeping */
683 
684           call level$get (savring);                         /* save current validation level and set it to zero */
685           call level$set (0);
686           evolution = NORMAL_EVOLUTION_TERMINATION;
687           pdir_entry = unique_chars_ ((pid));               /* compute entry name of user's pdir */
688           pdir_path = ">process_dir_dir>" || pdir_entry;    /* get full pathname of pdir */
689           pit_ptr = null;
690           call initiate$priv_init (pdir_path, "pit", "", 0, 0, pit_ptr, code); /* initiate exiting pit */
691           if pit_ptr = null then go to EVOLUTION_CLEANUP (evolution);
692 
693 /* Copy new tty info from template pit into user's pit */
694 
695           pit_ptr -> pit.tty = pitp -> pit.tty;
696           pit_ptr -> pit.old_tty = pitp -> pit.old_tty;
697           pit_ptr -> pit.terminal_access_class = pitp -> pit.terminal_access_class;
698           pit_ptr -> pit.line_type = pitp -> pit.line_type;
699           pit_ptr -> pit.term_type_name = pitp -> pit.term_type_name;
700           pit_ptr -> pit.service_type = pitp -> pit.service_type;
701           pit_ptr -> pit.charge_type = pitp -> pit.charge_type;
702           pit_ptr -> pit.tty_answerback = pitp -> pit.tty_answerback;
703           pit_ptr -> pit.tty_type = pitp -> pit.tty_type;
704           pit_ptr -> pit.outer_module = pitp -> pit.outer_module;
705 
706 /* Clean up and return */
707 
708           call terminate_$noname (pit_ptr, code);
709           go to EVOLUTION_CLEANUP (evolution);              /* go set level and return */
710 ^L
711 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
712 
713 
714 
715 create_hardcore_seg: procedure (seg_name, seg_ptr);         /* internal procedure to create hardcore segments */
716 
717 dcl  seg_name char (*) parameter;                           /* segment branch name */
718 dcl  seg_ptr ptr parameter;                                 /* pointer to segment (returned) */
719 
720           seg_rb (1), seg_rb (2), seg_rb (3) = 0;           /* ring brackets of 0-0-0 on pds and kst */
721           seg_ptr = null;
722           call append$branchx (pdir_path, seg_name, (RW_mode), seg_rb, process_group, 0, 0, 0, code); /* create branch */
723           if code ^= 0 then return;
724 
725           call asd_$replace_sall (pdir_path, seg_name, seg_aclp, 3, daemon_sw, code);
726           if code ^= 0 then return;
727 
728           call initiate$priv_init (pdir_path, seg_name, "", 0, 0, seg_ptr, code); /* initiate created segment */
729 
730      end create_hardcore_seg;
731 
732 set_ehs: proc (segptr, prw, size1);
733 
734 dcl  prw bit (1) aligned parameter;
735 dcl  segptr ptr parameter;
736 dcl  size1 fixed bin parameter;
737 
738 dcl  size2 fixed bin (18);
739 
740           size2 = 1024 * size1;
741           if prw then astep = grab_aste$prewithdraw (segptr, size2, code);
742           else astep = grab_aste (segptr, size2, code);     /* force activate the entry */
743           if code ^= 0 then call syserr$error_code (1, code, "act_proc: from grab_aste");
744           tsdw = get_ptrs_$given_astep (astep);
745           addr (tsdw) -> sdw.cache = "1"b;                  /* KST and PDS are non-shared */
746           return;
747 
748      end set_ehs;
749 
750 /* format: off */
751 %page; %include access_audit_eventflags;
752 %page; %include apte;
753 %page; %include aste;
754 %page; %include create_branch_info;
755 %page; %include create_info;
756 %page; %include kst;
757 %page; %include pit;
758 %page; %include sdw;
759 %page; %include stack_header;
760 %page; %include syserr_constants;
761 %page; %include user_attributes;
762 %page;
763 /* BEGIN MESSAGE DOCUMENTATION
764    Message:
765    act_proc: from grab_aste ERRORMESSAGE
766 
767    S: $crash
768 
769    T: $run
770 
771    M: In attempting to create a process, the system could not force the
772    PDS or descriptor segment of that process to be activated and held active.
773    ERRORMESSAGE is an error_table_ message.
774    $err
775 
776    A: $recover
777 
778 
779    Message:
780    act_proc: KST size specified (SIZE) less than minimum (MIN_SIZE).
781    Creating process for GROUPID.
782 
783    S: $log
784 
785    T: $run
786 
787    M: The project administrator (or system administrator) for user GROUPID
788    set the kst_size parameter in the PDT to SIZE, which is less than
789    the valid minimum MIN_SIZE. The process is not created. Note that
790    a process with MINIMUM KST size will probably not be of any use. The
791    minimum useful KST size is on the order of MINIMUM + 50.
792 
793    A: Change the PMF/PDT.
794 
795    END MESSAGE DOCUMENTATION */
796 /* format: on */
797 
798      end act_proc;