1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43 makestack: procedure (a_ring_num);
44
45
46 dcl a_ring_num fixed bin (3);
47
48 dcl 1 instruction based aligned,
49 2 tra_offset bit (18) unaligned,
50
51
52 2 rest bit (18) unaligned;
53
54
55 dcl ring_num fixed bin (3),
56
57 save_val fixed bin (3),
58
59 segno fixed bin,
60 dirname char (168),
61 stack_name char (8),
62
63 pl1_op_ptr ptr,
64 workptr ptr,
65
66 sctp (0:1) ptr unaligned based,
67 1 local_create_branch_info aligned like create_branch_info,
68 code fixed bin (35);
69
70
71
72
73
74
75 dcl pds$stacks (0:7) pointer external;
76 dcl pds$prelinked_ring (7) bit (1) unaligned ext;
77 dcl active_all_rings_data$stack_base_segno fixed bin (18) ext;
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
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);
118 segno = fixed (baseno (sb), 17);
119
120 if pds$prelinked_ring (ring_num)
121 then do;
122 stack_header.null_ptr = null ();
123 pds$useable_lot.flags (ring_num) = "1"b;
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;
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;
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
146 if code ^= 0 then do;
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;
162 call ref_name_$insert ((stack_name), segno, code);
163
164
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
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
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
200
201
202 Note
203
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
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
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
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
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362 end makestack;