1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 /* format: style4 */
 13 
 14 create_hproc: proc (access_id, loaded, aptep, initial_procedure) returns (fixed bin (35));
 15 
 16 /* Created by Webber for 29-0 (= MR5.0) */
 17 /* Modified by VanVleck, Greenberg for in-hierarchy and hardcore-seg per-proc segments 4/77 */
 18 /* Modified by Mike Grady for stack 0 sharing. May 1979 */
 19 /* Modified by J. Bongiovanni to create a stack for non-early hprocs. December 1982 */
 20 /* Modified 1984-11-16 by E. Swenson for IPC event channel validation.  The
 21    values of R-Offset and R-Factor are initialized here for hprocs. */
 22 /* Modified 1984-11-20 by Keith Loepere to rename terminate to terminate_. */
 23 /* Modified 1984-12-11, BIM: give *.*.* RW In ring zero to segments.
 24    this permits ring_zero_peek_ and allows this to work outside
 25    of the Initializer. */
 26 
 27 /* Parameters */
 28 
 29 dcl  access_id char (*) aligned;
 30 dcl  loaded bit (1) aligned;
 31 dcl  initial_procedure ptr;
 32 
 33 dcl  adsp ptr;
 34 dcl  apdsp ptr;
 35 dcl  astkp ptr;
 36 
 37 /* Automatic */
 38 
 39 dcl  save_level uns fixed bin (3);
 40 dcl  highseg fixed bin (18);
 41 dcl  dseg_no fixed bin (18);
 42 dcl  dsp ptr;
 43 dcl  pds_ptr ptr;
 44 dcl  stk_ptr ptr;
 45 dcl  stk_astep ptr;
 46 dcl  tcode fixed bin (35);
 47 dcl  dseg_ptr ptr;
 48 dcl  1 pds_sdw aligned like sdw;
 49 dcl  1 dbr aligned like sdw;
 50 dcl  1 stk_sdw aligned like sdw;
 51 dcl  dstep ptr;
 52 dcl  astep ptr;
 53 dcl  proc_id bit (36) aligned;
 54 dcl  lock_id bit (36) aligned;
 55 dcl  pds_no fixed bin;
 56 dcl  append_entry bit (1);
 57 
 58 /* External */
 59 
 60 dcl  active_all_rings_data$hcscnt fixed bin (18) ext;
 61 dcl  active_all_rings_data$stack_base_segno fixed bin (18) ext;
 62 dcl  (dseg$, slt$) external;
 63 dcl  error_table_$namedup fixed bin (35) external;
 64 dcl  pds$apt_ptr ptr ext;
 65 dcl  pds$stack_0_sdwp ptr ext;
 66 dcl  pds$stack_0_ptr ptr ext;
 67 dcl  pds$stacks (0:7) ptr ext;
 68 dcl  pds$last_sp ptr ext;
 69 dcl  pds$initial_procedure ptr ext;
 70 dcl  pds$processid bit (36) aligned ext;
 71 dcl  pds$lock_id bit (36) aligned ext;
 72 dcl  pds$dstep bit (18) aligned ext;
 73 dcl  pds$process_group_id char (32) aligned ext;
 74 dcl  template_pds$ ext;
 75 dcl  tc_data$pdscopyl fixed bin ext;
 76 
 77 /* Based */
 78 
 79 dcl  copy_pds (tc_data$pdscopyl) fixed bin based;
 80 dcl  copy_id bit (36) aligned based;
 81 dcl  copy_ptr ptr based;
 82 dcl  copy_group_id char (32) aligned based;
 83 dcl  copy_dstep bit (18) aligned based;
 84 dcl  1 based_dseg (0:highseg) aligned like sdw based;
 85 dcl  1 stack aligned based (sb),
 86        2 header like stack_header,
 87        2 first_frame fixed bin;
 88 
 89 /* Constant */
 90 
 91 dcl  seg_rb (3) fixed bin init (0, 0, 0) static options (constant);
 92 dcl  dseg_size fixed bin static options (constant) init (3 * 1024);
 93 dcl  PDS_SIZE fixed bin internal static options (constant) init (4096);
 94 dcl  STACK_SIZE fixed bin internal static options (constant) init (16384);
 95 
 96 /* Entries */
 97 
 98 dcl  unique_chars_ entry (bit (*) aligned) returns (char (15));
 99 dcl  append$branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin, char (*) aligned,
100           fixed bin, fixed bin, fixed bin, fixed bin (35));
101 dcl  (level$get, level$set) entry (uns fixed bin (3));
102 dcl  grab_aste$prewithdraw entry (ptr, fixed bin, fixed bin (35)) returns (ptr);
103 dcl  get_ptrs_$given_astep entry (ptr) returns (1 aligned like sdw);
104 dcl  get_ptrs_$given_segno entry (fixed bin (18)) returns (ptr);
105 dcl  initiate$priv_init entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
106 dcl  terminate_$noname ext entry (ptr, fixed bin (35));
107 dcl  truncate$trseg entry (ptr, fixed bin (19), fixed bin (35));
108 dcl  pxss$get_entry entry (ptr);
109 dcl  getuid entry returns (bit (36) aligned);
110 dcl  pc_wired$wire_wait entry (ptr, fixed bin, fixed bin);
111 
112 /* Builtins */
113 
114 dcl  (addr, baseno, baseptr, bin, bit, divide, null, ptr, rel, size, unspec) builtin;
115 
116 dcl  cleanup condition;
117 
118 /*^L*/
119 /* First get a segment to be used as the PDS */
120 
121           append_entry = "1"b;
122           call pxss$get_entry (aptep);
123           if aptep = null then return (1);
124           proc_id = rel (aptep) || "666666"b3;
125 
126           call level$get (save_level);
127           on cleanup call level$set (save_level);
128           call level$set (0);
129 
130           call get_unique_segment ("pds", pds_ptr, astep, PDS_SIZE, tcode);
131           if tcode ^= 0 then do;
132 RETURN_ERROR:
133                call level$set (save_level);
134                return (tcode);
135           end;
136 
137 /* Now get a descriptor segment */
138 
139           call get_unique_segment ("dseg", dseg_ptr, dstep, dseg_size, tcode);
140           if tcode ^= 0 then goto RETURN_ERROR;
141 
142 /* Now get a stack segment */
143 
144           call get_unique_segment ("stack", stk_ptr, stk_astep, STACK_SIZE, tcode);
145           if tcode ^= 0 then goto RETURN_ERROR;
146 
147           highseg = active_all_rings_data$hcscnt - 1;
148           call level$set (save_level);
149           revert cleanup;
150 
151 /* Develop the DBR from the dstep. */
152 
153 join:
154           dbr = get_ptrs_$given_astep (dstep);
155           dsp = addr (dseg$);
156           dseg_no = bin (baseno (dsp), 18);
157 
158           dseg_ptr -> based_dseg = dsp -> based_dseg;
159           unspec (dseg_ptr -> sdwa (dseg_no)) = unspec (dbr);
160 
161 /* Fill in the stack base segno in the DBR so BOS will dump it. */
162 
163           if append_entry then
164                dbr.entry_bound = bit (divide (active_all_rings_data$stack_base_segno, 8, 14, 0), 14);
165 
166 /* Now get an APT entry and fill it in */
167 
168           apte.hproc = "1"b;
169           apte.state = bit (bin (4, 18), 18);               /* initial state is blocked */
170           apte.timax = 4000000;
171           apte.wct_index = pds$apt_ptr -> apte.wct_index;   /* use parent's water closet */
172           apte.processid = proc_id;
173           lock_id = getuid ();
174           apte.lock_id = lock_id;
175           apte.dseg = rel (dstep);
176           apte.pds = rel (astep);
177           unspec (apte.dbr) = unspec (dbr);
178 
179 /**** Here we set up apte.ipc_r_offset for the hardcore process.  This
180       is an 18-bit unsigned integer used by IPC to validate event channel
181       names in conjunction with apte.ipc_r_factor.  This latter number
182       is determined later, in init_proc.  This is done on order to provide
183       an undeterministic delay between the initialization of these two
184       numbers in order to make it difficult to guess one given the other. */
185 
186           apte.ipc_r_offset = binary (substr (bit (binary (clock (), 54), 54), 37, 18), 18);
187 
188 /**** We defer the setting of R-Factor until after we take a few pages
189       faults in order to make guessing R-Factor given R-Offset more
190       difficult. */
191 
192 /* Now initialize the PDS and fill in its SDW into the DSEG */
193 
194           pds_no = bin (baseno (addr (pds$processid)), 18);
195           pds_sdw = get_ptrs_$given_astep (astep);
196           pds_sdw.cache = "1"b;
197           dseg_ptr -> based_dseg (pds_no) = pds_sdw;
198 
199           pds_ptr -> copy_pds = addr (template_pds$) -> copy_pds;
200 
201           ptr (pds_ptr, rel (addr (pds$processid))) -> copy_id = proc_id;
202           ptr (pds_ptr, rel (addr (pds$lock_id))) -> copy_id = lock_id;
203           ptr (pds_ptr, rel (addr (pds$apt_ptr))) -> copy_ptr = aptep;
204           ptr (pds_ptr, rel (addr (pds$process_group_id))) -> copy_group_id = access_id;
205           ptr (pds_ptr, rel (addr (pds$dstep))) -> copy_dstep = rel (dstep);
206           ptr (pds_ptr, rel (addr (pds$initial_procedure))) -> copy_ptr = initial_procedure;
207 
208           sdwp = addr (dseg$);
209           if append_entry then do;                          /* fill in pds stack info with correct stuff */
210                stk_sdw = get_ptrs_$given_astep (stk_astep);
211                unspec (dseg_ptr -> sdwa (active_all_rings_data$stack_base_segno)) =
212                     unspec (stk_sdw);
213                ptr (pds_ptr, rel (addr (pds$stack_0_sdwp))) -> copy_ptr =
214                     addr (sdwa (active_all_rings_data$stack_base_segno));
215                ptr (pds_ptr, rel (addr (pds$stack_0_ptr))) -> copy_ptr,
216                     ptr (pds_ptr, rel (addr (pds$stacks (0)))) -> copy_ptr,
217                     sb = ptr (baseptr (active_all_rings_data$stack_base_segno), 0);
218                stk_ptr -> stack_header_overlay = pds$stack_0_ptr -> stack_header_overlay;
219                stk_ptr -> stack_header.stack_begin_ptr,
220                     stk_ptr -> stack_header.stack_end_ptr = ptr (sb, rel (addr (stack.first_frame)));
221           end;
222           else do;                                          /* or for early hprocs */
223                ptr (pds_ptr, rel (addr (pds$stack_0_sdwp))) -> copy_ptr =
224                     addr (sdwa (bin (baseno (stk_ptr), 18)));
225                ptr (pds_ptr, rel (addr (pds$stack_0_ptr))) -> copy_ptr,
226                     ptr (pds_ptr, rel (addr (pds$stacks (0)))) -> copy_ptr,
227                     sb = ptr (stk_ptr, 0);
228           end;
229 
230           ptr (pds_ptr, rel (addr (pds$last_sp))) -> copy_ptr =
231                addr (stack.first_frame);
232 
233 /* Now load the process if it must be loaded */
234 
235           if loaded then do;                                /* the process is always to be loaded */
236                apte.loaded = "1"b;
237                apte.always_loaded = "1"b;
238                call pc_wired$wire_wait (astep, 0, 1);       /* wire first page of PDS */
239                call pc_wired$wire_wait (dstep, 0, 1);       /* wire first page of DSEG */
240           end;
241 
242           if append_entry then do;
243                call terminate_$noname (pds_ptr, (0));
244                call terminate_$noname (dseg_ptr, (0));
245                call terminate_$noname (stk_ptr, (0));
246           end;
247 
248 /**** Now, after taking some page faults, we set R-Factor.  The clock
249       value should be unpredictably more advanced. */
250 
251           apte.ipc_r_factor =
252                binary (substr (bit (binary (clock (), 54), 54), 19, 36), 35);
253 
254           return (0);
255 
256 /*^L*/
257 early_hproc: entry (access_id, loaded, aptep, initial_procedure, adsp, apdsp, astkp) returns (fixed bin (35));
258 
259 /* This entry is called during initialization, when segments cannot be created via append. Pointers
260    to two hardcore segments, adsp and apdsp, are supplied to specify segments to be used as the DSEG and PDS
261    of the new process.  These segments should be hardcore if this process is never to be deleted,
262    or deciduous if they are later to be deleted. */
263 
264 
265           append_entry = "0"b;
266           dseg_ptr = adsp;                                  /* Copy args for common code. */
267           pds_ptr = apdsp;
268           stk_ptr = astkp;
269 
270           astep = get_ptrs_$given_segno (bin (baseno (pds_ptr), 18)); /* Get dseg-seg ptr */
271           dstep = get_ptrs_$given_segno (bin (baseno (dseg_ptr), 18)); /* Ditto the pds */
272           call pxss$get_entry (aptep);
273           if aptep = null then return (1);
274           proc_id = rel (aptep) || "666666"b3;              /* Fabricate process ID */
275           sltp = addr (slt$);
276           highseg = slt.last_sup_seg;
277           go to join;                                       /* Do all the rest */
278 
279 %page;
280 /* Internal Procedure to create, initiate, and entry-activate a segment. */
281 
282 get_unique_segment:
283      proc (segment_suffix, segment_ptr, aste_ptr, segment_size, rcode);
284 
285 dcl  segment_suffix char (*);
286 dcl  segment_ptr ptr;
287 dcl  aste_ptr ptr;
288 dcl  segment_size fixed bin;
289 dcl  rcode fixed bin (35);
290 
291 dcl  seg_name char (32);
292 
293 
294           seg_name = unique_chars_ (proc_id) || "." || segment_suffix;
295           call append$branchx (">system_library_1", seg_name, RW_ACCESS_BIN, seg_rb, "*.*.*", /* The acl term effects us if this is not the Initializer */
296                0, 0, 0, rcode);
297           if rcode ^= 0 then
298                if rcode ^= error_table_$namedup then return;
299 
300           call initiate$priv_init (">system_library_1", seg_name, "", 0, 0, segment_ptr, rcode);
301           if rcode ^= 0 then return;
302 
303           call truncate$trseg (segment_ptr, 0, rcode);
304           if rcode ^= 0 then return;
305 
306           aste_ptr = grab_aste$prewithdraw (segment_ptr, segment_size, rcode);
307           if rcode ^= 0 then return;
308 
309 
310      end get_unique_segment;
311 
312 /* format: off */
313 %page; %include access_mode_values;
314 %page; %include sdw;
315 %page; %include apte;
316 %page; %include slt;
317 %page; %include stack_header;
318 /* format: on */
319      end create_hproc;