1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         *********************************************************** */
  8 
  9 
 10 /****^  HISTORY COMMENTS:
 11   1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
 12      audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
 13      Correct error message documentation.
 14                                                    END HISTORY COMMENTS */
 15 
 16 
 17 /*                            MAKESTACK
 18    *
 19    *      This is a  ring (0)  procedure which is called to make a stack for a ring.
 20    *      The number of the ring for which the stack is being made is passed as an argument to
 21    *      makestack.    All of the operations performed by  makestack  will be in behalf of this
 22    *       ring.
 23    *
 24    * Last modified (date and reason):
 25    *                3/85 by Keith Loepere to not append stacks through links.
 26    *                6/79 by C. Hornig to do less for prelinked rings
 27    *                11/77 by M. Weaver to set aside a special area for ref names
 28    *                6/77 by M. Weaver to set static handlers for isot_fault and lot_fault
 29    *                3/77 by M. Weaver to add initialize_rnt code and to initialize ect_ptr
 30    *                11/76 by M. Weaver to extend stack header
 31    *                10/75 by R. Bratt for prelinking and to cleanup
 32    *                9/74    by S.Webber as part of combining stacks, lots, and clrs
 33    *                Modified 12/73 by E. Stone to remove assumption that pl1_operators_ is the same in all rings
 34    *                ,i.e. the placing of pointers to the alm operators in the stack header.
 35    *                Modified 10/73 by E. Stone to set the max_length of the stack less than 256K
 36    *                and to terminate the process if the stack exists or if the segment number has been used
 37    *                and to place a pointer to operator_pointers_ in the stack header for B. Wolman
 38    *                Recoded to include new stack format  -  3/72  by  Bill Silver
 39    *                Recoded in  PL/I  -  8/70  by  N. I. Morris
 40    */
 41 
 42 
 43 makestack: procedure (a_ring_num);
 44 
 45 
 46 dcl  a_ring_num fixed bin (3);                              /* ring number for stack */
 47 
 48 dcl 1 instruction based aligned,
 49     2 tra_offset bit (18) unaligned,                        /* References  offset  portion of  tra  instruction
 50                                                                *  in transfer vector table in pl1_operators_.   These
 51                                                                *  tra   instructions transfer to  ALM linkage operators. */
 52     2 rest bit (18) unaligned;
 53 
 54 
 55 dcl  ring_num fixed bin (3),                                /* Work variable where the   ring number argument
 56                                                                is  copied.  */
 57      save_val fixed bin (3),                                /* Used to save the current validation level when the
 58                                                                procedure is entered.  */
 59      segno fixed bin,                                       /* segment number of new stack */
 60      dirname char (168),
 61      stack_name char (8),                                   /* The reference name  ( and entry name ) of the new
 62                                                                stack  segment.  */
 63      pl1_op_ptr ptr,                                        /* A pointer to the pl1 operators table. */
 64      workptr ptr,                                           /* A work pointer used in calls to  link_snap$make_ptr */
 65                                                             /* And to construct ptrs to operators in the stack header. */
 66      sctp (0:1) ptr unaligned based,
 67      1 local_create_branch_info aligned like create_branch_info,
 68      code fixed bin (35);                                   /* An internal  error  code.  */
 69 
 70 
 71 /*        The following declarations are made in order to reference data in the
 72    *      process  data  segment.
 73    */
 74 
 75 dcl  pds$stacks (0:7) pointer external;                     /* An array of stack pointers for all possible rings. */
 76 dcl  pds$prelinked_ring (7) bit (1) unaligned ext;
 77 dcl  active_all_rings_data$stack_base_segno fixed bin (18) ext; /* Segment number of ring 0 stack. */
 78 dcl  pds$process_dir_name char (32) ext;
 79 dcl  pds$process_group_id char (32) ext;
 80 dcl 1 pds$useable_lot aligned ext,
 81     2 flags (0:7) bit (1) unal;
 82 
 83 
 84 
 85 /*        MAKESTACK uses the following external  entry points.
 86    */
 87 
 88 dcl  level$get ext entry (fixed bin (3)),
 89      level$set ext entry (fixed bin (3)),
 90      link_man$get_initial_linkage entry (fixed bin (3)),
 91      link_snap$make_ptr ext entry (ptr, char (*), char (*), ptr, fixed bin (35)),
 92      append$create_branch_ ext entry (char (*), char (*), ptr, fixed bin (35)),
 93      initiate ext entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)),
 94      ref_name_$insert entry (char (32) varying, fixed bin, fixed bin (35)),
 95      set$max_length_ptr ext entry (ptr, fixed bin (19), fixed bin (35)),
 96      syserr$error_code ext entry options (variable),
 97      terminate_proc ext entry (fixed bin (35));
 98 
 99 dcl  sys_info$default_stack_length fixed bin (19) ext;
100 dcl  error_table_$invalid_stack_creation ext fixed bin (35);
101 
102 dcl (addr,
103      addrel,
104      baseno,
105      baseptr,
106      fixed,
107      null,
108      ptr,
109      rel,
110      size,
111      string,
112      substr,
113      unspec) builtin;
114 %page;
115           ring_num = a_ring_num;
116           sb, pds$stacks (ring_num)
117                = baseptr (ring_num + active_all_rings_data$stack_base_segno); /* Compute expected stack pointer. */
118           segno = fixed (baseno (sb), 17);
119 
120           if pds$prelinked_ring (ring_num)
121           then do;
122                stack_header.null_ptr = null ();             /* force the stack to be copied */
123                pds$useable_lot.flags (ring_num) = "1"b;     /* this saves trouble later */
124                return;
125           end;
126 
127           call level$get (save_val);
128           call level$set (ring_num);
129           dirname = pds$process_dir_name;
130           stack_name = "stack_" || substr ("1234567", ring_num, 1);
131 
132           unspec (local_create_branch_info) = "0"b;         /* describe new stack, no chasing allowed */
133           local_create_branch_info.version = create_branch_version_2;
134           local_create_branch_info.parent_ac_sw = "1"b;
135           local_create_branch_info.mode = REW_ACCESS;
136           local_create_branch_info.rings (*) = ring_num;
137           local_create_branch_info.userid = pds$process_group_id;
138 
139           call append$create_branch_ (dirname, stack_name, addr (local_create_branch_info), code);
140           if code ^= 0 then do;                             /* User cannot make his own stack */
141                call syserr$error_code (4, code, "makestack: error appending ^a", stack_name);
142                call terminate_proc (error_table_$invalid_stack_creation);
143           end;
144           call initiate (dirname, stack_name, "", 1, 1, sb, code);
145                                                             /* can't use reference names yet */
146           if code ^= 0 then do;                             /* Prevent user from using reserved segment number */
147                call syserr$error_code (4, code, "makestack: error initiating ^a", stack_name);
148                call terminate_proc (error_table_$invalid_stack_creation);
149           end;
150           call set$max_length_ptr (sb, sys_info$default_stack_length, code);
151           if code ^= 0
152           then call syserr$error_code (2, code, "makestack: error from set$max_length_ptr on ^a.", stack_name);
153 
154           stack_header.null_ptr,
155                stack_header.ect_ptr = null ();
156           stack_header.stack_begin_ptr,
157                stack_header.stack_end_ptr = ptr (sb, size (stack_header));
158           call link_man$get_initial_linkage (ring_num);
159           pds$useable_lot.flags (ring_num) = "1"b;
160           unspec (stack_header.lot_ptr -> lot.lp (segno)) = lot_fault;
161           call initialize_rnt;                              /* allocate RNT and set search rules */
162           call ref_name_$insert ((stack_name), segno, code); /* now we can add reference name */
163 
164 /*        Now fill in the fields in the  header  of the  new  stack.  */
165 
166           stack_header.signal_ptr = get_ptr ("signal_", "signal_");
167           stack_header.unwinder_ptr = get_ptr ("unwinder_", "unwinder_");
168           stack_header.trans_op_tv_ptr = get_ptr ("operator_pointers_", "operator_pointers_");
169           pl1_op_ptr = get_ptr ("pl1_operators_", "operator_table");
170 
171 
172 
173 /*        Get the following pl1 operator pointers from offsets within the pl1 operator table transfer vector */
174 
175           workptr = addrel (pl1_op_ptr, tv_offset);
176 
177           stack_header.pl1_operators_ptr = pl1_op_ptr;
178           stack_header.call_op_ptr =
179                ptr (workptr, addrel (workptr, call_offset) -> instruction.tra_offset);
180           stack_header.push_op_ptr =
181                ptr (workptr, addrel (workptr, push_offset) -> instruction.tra_offset);
182           stack_header.return_op_ptr =
183                ptr (workptr, addrel (workptr, return_offset) -> instruction.tra_offset);
184           stack_header.return_no_pop_op_ptr =
185                ptr (workptr, addrel (workptr, return_no_pop_offset) -> instruction.tra_offset);
186           stack_header.entry_op_ptr =
187                ptr (workptr, addrel (workptr, entry_offset) -> instruction.tra_offset);
188 
189 /*        set up essential static handlers */
190 
191           call link_snap$make_ptr (null (), "copy_on_write_handler_", "copy_on_write_handler_", workptr, code);
192           ptr (sb, rel (stack_header.sct_ptr)) -> sctp (no_write_permission_sct_index) = workptr;
193           ptr (sb, rel (stack_header.sct_ptr)) -> sctp (not_in_write_bracket_sct_index) = workptr;
194           call link_snap$make_ptr (null (), "isot_fault_handler_", "isot_fault_handler_", workptr, code);
195           ptr (sb, rel (stack_header.sct_ptr)) -> sctp (isot_fault_sct_index) = workptr;
196           call link_snap$make_ptr (null (), "lot_fault_handler_", "lot_fault_handler_", workptr, code);
197           ptr (sb, rel (stack_header.sct_ptr)) -> sctp (lot_fault_sct_index) = workptr;
198 
199 /*        We have finished setting up the header of the new  stack.   There are no more calls to be
200    *      made  so we will reset the validation level of this procedure to what it was when the procedure
201    *      was  called.    Then we will set up the two thread pointers in the first stack frame of the
202    *      new  stack.   Note the previous frame pointer is null since there is no previous frame.
203    *      The pointer to the first stack frame has been set up above in the stack_begin_ptr.
204    */
205 
206           call level$set (save_val);
207           sp = stack_header.stack_end_ptr;
208           sp -> stack_frame.prev_sp = null;
209           sp -> stack_frame.next_sp = addrel (stack_header.stack_end_ptr, stack_frame_min_length);
210 
211 
212 get_ptr:  proc (refname, defname) returns (ptr);
213 dcl (refname, defname) char (*);
214                call link_snap$make_ptr (null (), refname, defname, workptr, code);
215                if code ^= 0 then do;
216                     call syserr$error_code (0, code, "makestack: error finding ^a$^a for ^a.", refname, defname, stack_name);
217                     call terminate_proc (error_table_$invalid_stack_creation);
218                end;
219                return (workptr);
220           end get_ptr;
221 %page;
222 initialize_rnt: proc;
223 
224 dcl  rnt_space (2048) bit (36) aligned based;
225 dcl 1 ainfo aligned like area_info;
226 
227 dcl  size builtin;
228 
229 dcl  error_table_$termination_requested ext fixed bin (35);
230 dcl  terminate_proc entry (fixed bin (35));
231 dcl  define_area_ entry (ptr, fixed bin (35));
232 dcl  pds$processid bit (36) aligned ext;
233 dcl  initiate_search_rules$init_ring entry (ptr, fixed bin (35));
234 dcl  syserr$error_code entry options (variable);
235 
236 %include rnt;
237 
238 %include area_info;
239 
240 dcl 1 default_rules static options (constant) aligned,
241     2 number fixed bin init (1),
242     2 name char (168) init ("default");
243 %page;
244 /* obtain an rnt area */
245 
246                ainfo.version = area_info_version_1;
247                string (ainfo.control) = "0"b;
248                ainfo.control.zero_on_free = "1"b;
249                ainfo.control.system = "1"b;
250                ainfo.owner = "rnt";
251                ainfo.size = size (rnt_space);
252                allocate rnt_space in (stack_header.clr_ptr -> based_rnt_area) set (ainfo.areap);
253                call define_area_ (addr (ainfo), code);
254                if code ^= 0 then call terminate_proc (error_table_$termination_requested);
255 
256 
257 /*        initialize the RNT itself */
258 
259                allocate rnt in (ainfo.areap -> based_rnt_area) set (rntp);
260                unspec (rnt) = "0"b;
261                rnt.areap = ainfo.areap;
262                rnt.rnt_area_size = ainfo.size;
263                rnt.name_hash_table (*) = null ();
264                rnt.segno_hash_table (*) = null ();
265                rnt.srulep = null;
266                stack_header.rnt_ptr = rntp;
267 
268 /*        initialize the search rules */
269 
270                call initiate_search_rules$init_ring (addr (default_rules), code);
271                if code ^= 0 then do;
272                     call syserr$error_code (0, code, "makestack: error from initiate_search_rules.");
273                     call terminate_proc (error_table_$termination_requested);
274                     end;
275 
276                return;
277           end initialize_rnt;
278 %page;
279 % include access_mode_values;
280 % include create_branch_info;
281 % include lot;
282 % include stack_frame;
283 % include stack_header;
284 % include static_handlers;
285 %page;
286 /* BEGIN MESSAGE DOCUMENTATION
287 
288    Message:
289    makestack: error from set$max_length_ptr on STACKNAME.
290 
291    S:     $term
292 
293    T:     $init
294    Process/ring initialization.  Just prior to using a new ring.
295 
296    M:     The process directory is probably messed up.
297 
298    A:     Ignore unless it's the initializer, in which case bring the system back up.
299    If problem persists, contact the system administrator.
300 
301    Message:
302    makestack: error appending STACKNAME
303 
304    S:     $term
305 
306    T:     $init
307    Process/ring initialization.  Just prior to using a new ring.
308 
309    M:     The process directory is probably messed up.
310 
311    A:     Ignore unless it's the initializer, in which case bring the system back up.
312    If problem persists, contact the system administrator.
313 
314    Message:
315    makestack: error getting bit count for original prelinked STACK_NAME
316 
317    S:     $term
318 
319    T:     $init
320    Process/ring initialization.  Just prior to using a new ring.
321 
322    M:     A directory containing a prelinked subsystem is probably messed up.
323 
324    A:     The directory should be prelinked again.
325 
326    Message:
327    makestack: error initiating STACKNAME
328 
329    S:     $term
330 
331    T:     $init
332    Process/ring initialization.  Just prior to using a new ring.
333 
334    A:     Ignore unless it's the initializer, in which case bring the system back up.
335    If problem persists, contact the system administrator.
336 
337    Message:
338    makestack: error finding DIRNAME>ENAME for STACKNAME.
339 
340    S:     $term
341 
342    T:     $init
343    Process/ring initialization.
344 
345    A:     Ignore unless it's the initializer, in which case bring the system back up.
346    If problem persists, contact the system administrator.
347 
348    Message:
349    makestack: error from initiate_search_rules.
350 
351    S:     $term
352 
353    T:     Process/ring initialization.  Just prior to using new ring.
354 
355    M:     The default search rules are missing from ahd (active hardcore data).
356    These are usually loaded by the command set_system_search_rules.
357 
358    A:     $contact_sa
359 
360    END MESSAGE DOCUMENTATION */
361 
362      end makestack;