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
44
45
46
47
48
49
50
51
52
53
54
55
56
57 debug
58
59
60
61 debug
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96 mtdsim_: proc;
97
98
99
100
101 dcl bcd_to_ascii_ entry (bit (*) aligned, char (*));
102 dcl com_err_ entry () options (variable);
103 dcl continue_to_signal_ entry (fixed bin (35));
104 dcl convert_dial_message_$return_io_module entry (fixed bin (71), char (*), char (*), fixed bin, 1 aligned,
105 2 bit (1) unal, 2 bit (1) unal, 2 bit (1) unal, 2 bit (33) unal, fixed bin (35));
106 dcl convert_status_code_ entry (fixed bin (35), char (*), char (*));
107 dcl cpu_time_and_paging_ entry (fixed bin, fixed bin (71), fixed bin);
108 dcl cu_$arg_count entry (fixed bin);
109 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
110 dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
111 dcl dial_manager_$privileged_attach entry (ptr, fixed bin (35));
112 dcl dial_manager_$release_channel entry (ptr, fixed bin (35));
113 dcl dial_manager_$release_channel_no_listen entry (ptr, fixed bin (35));
114 dcl dial_manager_$tandd_attach entry (ptr, fixed bin (35));
115 dcl db_fnp_eval_ entry (ptr, fixed bin, char (*), ptr, char (*), fixed bin, fixed bin (35));
116 dcl db_fnp_memory_$fetch entry (ptr, fixed bin, fixed bin, fixed bin, ptr, fixed bin (35));
117 dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35));
118 dcl gload_ entry (ptr, ptr, fixed bin (18), ptr, fixed bin (35));
119 dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), ptr, fixed bin (35));
120 dcl hcs_$get_ips_mask entry (bit (36) aligned);
121 dcl hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned);
122 dcl (ioa_, ioa_$rsnnl) entry () options (variable);
123 dcl ioi_$connect entry (fixed bin (12), fixed bin (18), fixed bin (35));
124 dcl ioi_$release_devices entry (fixed bin (12), fixed bin (35));
125 dcl ioi_$set_channel_required entry (fixed bin (12), fixed bin (3), fixed bin (6), fixed bin (35));
126 dcl ioi_$set_status entry (fixed bin (12), fixed bin (18), fixed bin (8), fixed bin (35));
127 dcl ioi_$suspend_devices entry (fixed bin (12), fixed bin (35));
128 dcl ioi_$timeout entry (fixed bin (12), fixed bin (52), fixed bin (35));
129 dcl ioi_$workspace entry (fixed bin (12), ptr, fixed bin, fixed bin (35));
130 dcl iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35));
131 dcl iox_$close entry (ptr, fixed bin (35));
132 dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35));
133 dcl iox_$detach_iocb entry (ptr, fixed bin (35));
134 dcl iox_$get_chars entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
135 dcl iox_$modes entry (ptr, char (*), char (*), fixed bin (35));
136 dcl iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
137 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35));
138 dcl ioi_$connect_pcw entry (fixed bin (12), fixed bin (18), bit (36), fixed bin (35));
139 dcl ipc_$block entry (ptr, ptr, fixed bin (35));
140 dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35));
141 dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
142 dcl ipc_$read_ev_chn entry (fixed bin (71), fixed bin, ptr, fixed bin (35));
143 dcl mca_$attach_ipc entry (char (*), fixed bin, fixed bin, fixed bin (35));
144 dcl mca_$attach_mca entry (char (*), fixed bin (71), fixed bin, fixed bin (35));
145 dcl mca_$detach_ipc entry (char (*), fixed bin, bit (1), fixed bin (35));
146 dcl mca_$detach_mca entry (fixed bin, fixed bin (35));
147 dcl mca_$load_ipc entry (fixed bin, fixed bin, bit (36), fixed bin (35));
148 dcl mca_$tandd_read_data entry (fixed bin, ptr, fixed bin, bit (36), fixed bin (35));
149 dcl mca_$tandd_write_data entry (fixed bin, ptr, fixed bin, bit (36), fixed bin (35));
150 dcl mca_$tandd_write_text entry (fixed bin, ptr, fixed bin, bit (36), fixed bin (35));
151 dcl mca_$reset entry (fixed bin, bit (36), fixed bin (35));
152 dcl opr_query_ entry () options (variable);
153 dcl rcp_$attach entry (char (*) aligned, ptr, fixed bin (71), char (*), bit (36) aligned, fixed bin (35));
154 dcl rcp_$check_attach entry (bit (36) aligned, ptr, char (*), fixed bin (12),
155 fixed bin (19) aligned, fixed bin (71) aligned, fixed bin, fixed bin (35));
156 dcl rcp_$detach entry (bit (36) aligned, bit (*), fixed bin, char (*), fixed bin (35));
157 dcl rcp_priv_$attach entry (char (*) aligned, ptr, fixed bin (71), char (*), bit (36) aligned, fixed bin (35));
158 dcl probe entry options (variable);
159 dcl terminate_process_ entry (char (*), ptr);
160 dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71));
161 dcl timer_manager_$sleep entry (fixed bin (71), bit (2));
162 dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71));
163 dcl tolts_alm_util_$ascii_to_bcd_ entry (char (*), bit (*));
164 dcl tolts_alm_util_$enter_ccc_req_ entry (ptr, bit (36));
165 dcl tolts_alm_util_$enter_slave_ entry (ptr);
166 dcl tolts_alm_util_$gen_ck_sum entry (ptr);
167 dcl tolts_alrm_util_$quit entry;
168 dcl tolts_device_info_ entry (ptr, fixed bin, fixed bin);
169 dcl tolts_file_util_$close entry;
170 dcl tolts_file_util_$open entry (fixed bin (35));
171 dcl tolts_file_util_$snap entry (ptr);
172 dcl tolts_file_util_$wdump entry (ptr);
173 dcl tolts_load_firmware_ entry (fixed bin, fixed bin (35));
174 dcl tolts_init_ entry (char (4), fixed bin (35));
175 dcl tolts_init_$clean_up entry;
176 dcl tolts_init_$cr_event_chan entry (fixed bin (71), bit (1), entry, ptr, fixed bin, fixed bin (35));
177 dcl tolts_io_int_ entry;
178 dcl tolts_qttyio_ entry (char (*), fixed bin);
179 dcl tolts_qttyio_$dcw_list entry (ptr, fixed bin);
180 dcl tolts_qttyio_$dcw_ptr entry (ptr, fixed bin, fixed bin);
181 dcl tolts_qttyio_$rcw entry (ptr);
182 dcl tolts_qttyio_$rs entry () options (variable);
183 dcl tolts_util_$cata_sel entry (ptr, char (32), ptr, fixed bin (35));
184 dcl tolts_util_$find_card entry (char (4), ptr);
185 dcl tolts_init_$gc_tod entry (bit (36));
186 dcl tolts_util_$get_ttl_date entry (entry, char (6));
187 dcl tolts_util_$search entry (ptr, char (32), ptr, fixed bin, fixed bin (35));
188
189
190
191 dcl bufp ptr;
192 dcl (nargs, return_value, c_len, n_dialed, len, tio, dealc_err, ev_occurred,
193 i, j, mesg_len, ndcws, tally, t_err) fixed bin init (0);
194 dcl (chan_name, io_module) char (32);
195 dcl (error, c_error, mem_needed) fixed bin (35) init (0);
196 dcl filename_idx fixed bin;
197 dcl lvl_idx fixed bin;
198 dcl imu_found bit (1) init ("0"b);
199 dcl iom_found bit (1) init ("0"b);
200 dcl iom fixed bin (3), chan fixed bin (6), tio_off fixed bin (18), timeout_time fixed bin (52) init (0);
201 dcl cpu_time fixed bin (71);
202 dcl wake_time fixed bin (71) init (500000);
203 dcl mem_now fixed bin (19);
204 dcl (pcwa, bcd_callname, gcos_tod) bit (36);
205 dcl b18 bit (18);
206 dcl bit_buf bit (72);
207 dcl pad_char bit (6);
208 dcl sb_data_idx fixed bin;
209 dcl ws_data_idx fixed bin;
210 dcl (argptr, train_ptr, tp, cltp, t_ptr, ioe_ptr, l_ptr, gcatp, info_ptr) ptr;
211 dcl coment char (256), shortinfo char (8), lginfo char (100), message char (512), ac_name char (6);
212 dcl workspace_move char (c_len * 4) based (bufp);
213
214
215
216
217 dcl (gicm_count, io_sel, isc_cntdn, last_mme, mme_number, nr_cnt) fixed bin int static init (0);
218 dcl (term, gndc_flag, found, gelbar, glb_brk, in_ccc, isc_ccc_rqt, mpc_io, trace_save, debug, debugging,
219 rd_blk, flt_flag, alt_flag, q_flag, rd_flag, tcd, trace_io, trace, itr_run) bit (1) aligned int static init ("0"b);
220 dcl tolts_active bit (1) aligned int static init ("0"b);
221 dcl db_addr fixed dec int static;
222 dcl exec char (4) int static;
223 dcl ttl_date char (6) int static;
224 dcl (old_mask, new_mask) bit (36) aligned int static;
225 dcl clt_sw char (32) varying int static;
226 dcl io_block_len fixed bin;
227 dcl (gicmp, icmp, mvp, ricmp, ticmp, wicmp) ptr int static init (null);
228 dcl (l, k) fixed bin (6) int static;
229 dcl code fixed bin (35) init (0) int static;
230 dcl db_sv_wd bit (36) int static;
231 dcl (gerout_num, icm_tally, fnp_addr, fnp_num, remote_inquiry_ic) fixed bin int static;
232 dcl att_desc char (40) int static;
233 dcl (mmep, genp) ptr int static;
234 dcl (arglen, n_read) fixed bin (21) int static;
235 dcl blk_lbl label int static;
236 dcl emsg char (40) int static;
237 dcl term_lbl label int static;
238 dcl no_blk label int static;
239
240
241
242 dcl error_table_$bad_command_name fixed bin (35) ext static;
243 dcl error_table_$force_unassign external fixed bin (35);
244 dcl error_table_$resource_unavailable external fixed bin (35);
245 dcl printer_images_$n_images fixed bin external;
246 dcl printer_images_$image_base external;
247 dcl printer_images_$image_offsets (10) fixed bin (18) external;
248 dcl printer_images_$image_numbers (10) fixed bin external;
249 dcl sys_info$alrm_mask bit (36) aligned ext;
250
251
252
253 dcl arg char (arglen) based (argptr);
254 dcl data_move char (c_len * 4) based (mvp);
255 dcl prt_image (64) char (288) based unaligned;
256 dcl exec_wd (0:210000) bit (36) based (execp);
257 dcl ioe (11) bit (36) based (ioe_ptr);
258 dcl reg_move bit (36 * 8) based aligned;
259 dcl fix_wd (2) fixed bin (18) unsigned unaligned based (genp);
260 dcl sctwrk (12) bit (36) based (genp);
261 dcl mme_call_w (0:11) bit (36) based (mmep) aligned;
262 dcl 1 mme_call_hw (0:11) based (mmep) aligned,
263 (2 upper bit (18),
264 2 lower bit (18)) unaligned;
265
266 dcl 1 mme_call_hf (0:11) based (mmep) aligned,
267 (2 upper fixed bin,
268 2 lower fixed bin) unaligned;
269
270
271
272
273
274
275
276 dcl 1 spa based (execp) aligned,
277 (2 user_fault (0:10) bit (36),
278 2 abort,
279 3 add bit (18),
280 3 code bit (18),
281 2 pad1 (5) bit (36),
282 2 glbtmr bit (36),
283 2 glbici,
284 3 ic bit (18),
285 3 ind bit (18),
286 2 glbflt bit (36),
287 2 pad2 (3) bit (36),
288 2 wrapup_add bit (18),
289 2 pad3 bit (18),
290 2 pad4 bit (36),
291 2 acc_fault bit (36),
292 2 enter,
293 3 lreg bit (36),
294 3 lbar,
295 4 bar bit (18),
296 4 inst bit (18),
297 3 ret bit (36),
298 3 icivlu,
299 4 ic bit (18),
300 4 ind bit (18),
301 2 ccc_icivlu bit (36),
302 2 pad5 bit (36),
303 2 regs like mc.regs,
304 2 ccc_regs like mc.regs,
305 2 pad6 (16) bit (36)) unaligned;
306
307 dcl 1 fatal_desc aligned,
308 2 version fixed bin,
309 2 fatal_code fixed bin (35);
310
311 dcl 1 ci aligned like condition_info;
312
313 dcl 1 event_out static aligned like event_wait_info;
314
315 dcl 1 flags aligned,
316 2 dialed_up bit (1) unal,
317 2 hung_up bit (1) unal,
318 2 control bit (1) unal,
319 2 pad bit (33) unaligned;
320
321 dcl 1 cata based (io_info.catp) aligned,
322 2 n fixed bin,
323 2 key (1 refer (cata.n)) char (24);
324
325 dcl 1 mca_gcata (100) based (gcatp) aligned,
326 (2 equip_type bit (36),
327 2 cat_index fixed bin,
328 2 nblk fixed bin (13),
329 2 dipper_flag bit (4),
330 2 filename,
331 3 filename bit (48),
332 3 diskette_prod_tab bit (12),
333 3 prog_tab bit (12)) unaligned;
334
335
336 dcl 1 gcata (1000) based (gcatp) aligned,
337 (2 edit_rev bit (36),
338 2 cat_index fixed bin,
339 2 pad1 bit (3),
340 2 nblk fixed bin (14),
341 2 ident bit (36),
342 2 purpose bit (36)) unaligned;
343
344
345
346
347
348 dcl 1 io_entry based (ioe_ptr) aligned,
349 (2 pad1 bit (36),
350 2 ext_sts fixed bin,
351 2 pad2 bit (18),
352 2 pad3 bit (5),
353 2 sct_add bit (13),
354 2 pad4 bit (18),
355 2 pad5 bit (36),
356 2 prim,
357 3 dev_cmd bit (6),
358 3 dev bit (6),
359 3 pad6 bit (6),
360 3 io_cmd bit (6),
361 3 pad7 bit (6),
362 3 record_count bit (6),
363 2 first_dcw like dcw,
364 2 pad8 bit (36),
365 2 second,
366 3 dev_cmd bit (6),
367 3 prex bit (12),
368 3 io_cmd bit (6),
369 3 pad9 bit (5),
370 3 ignore_term bit (1),
371 3 record_count bit (6),
372 2 dcw_ptr fixed bin,
373 2 pad10 bit (18),
374 2 stat_p bit (18),
375 2 ccc_p bit (18),
376 2 pad11 bit (36)) unaligned;
377
378 dcl 1 colts_op_flags aligned ext static,
379 2 colt_flag bit (1) unaligned init ("0"b),
380 2 dm_attach bit (1) unaligned init ("0"b),
381 2 dm_detach bit (1) unaligned init ("0"b),
382 2 sicm bit (1) unaligned init ("0"b),
383 2 gicm bit (1) unaligned init ("0"b);
384
385 dcl 1 gicm based (gicmp) aligned,
386 2 cltp ptr init (null),
387 2 ricmp ptr init (null),
388 2 cc_addr bit (36),
389 2 st_addr fixed bin,
390 2 tally fixed bin (21);
391
392
393 dcl 1 ricm like icm based (ricmp);
394 dcl 1 wicm like icm based (wicmp);
395 dcl 1 ticm like icm based (ticmp);
396 dcl 1 icm based (icmp) aligned,
397 (2 word_total bit (18),
398 2 rbuf_addr bit (18),
399 2 cksum bit (18),
400 2 test_id bit (18),
401 2 host_opcode bit (18),
402 2 fnp_opcode bit (18),
403 2 icm_buf (icm_tally) bit (36)) unaligned;
404
405 dcl 1 info_struct based (info_ptr) aligned,
406 2 ev_chan fixed bin (71),
407 2 out_pend bit;
408
409
410
411
412 dcl (quit, lockup, illop, illegal_modifier, illegal_opcode, illegal_procedure,
413 store, program_interrupt, cleanup, tolts_error_) condition;
414 dcl (addr, addrel, bin, bit, divide, fixed, index, length, null, rel, rtrim, string, substr, time, unspec) builtin;
415 %page;
416
417
418 debug, debugging, q_flag, trace_io, trace = "0"b;
419 exec = "";
420 call cu_$arg_count (nargs);
421 call cu_$arg_ptr (1, argptr, arglen, code);
422 if arg ^= "polt" & arg ^= "molt" & arg ^= "colt" then do;
423 call com_err_ (0, "mtdsim_", "Invalid executive code - ""^a""", exec);
424 return;
425 end;
426 exec = arg;
427 term = "0"b;
428 if nargs > 1 then do;
429 do i = 2 to nargs;
430 call cu_$arg_ptr (i, argptr, arglen, code);
431 if arg = "-debug" | arg = "-db" then debug = "1"b;
432
433 else if arg = "-quit" | arg = "-q" then q_flag = "1"b;
434
435 else if arg = "-trace" | arg = "-tc" then trace = "1"b;
436 else if arg = "-trace_cata_data" | arg = "-tcd" then tcd = "1"b;
437 else if arg = "-tio" then trace_io = "1"b;
438 else if arg = "-probe" | arg = "-pb" then call probe (mtdsim_);
439 end;
440 debugging = "1"b;
441 end;
442
443
444 last_mme, isc_cntdn, tio = 0;
445 trace_save, in_ccc, isc_ccc_rqt, rd_blk, gelbar, glb_brk, itr_run = "0"b;
446 gicm_count = 0;
447 gicmp, ricmp, ticmp, wicmp = null;
448 call tolts_init_ (exec, error);
449 if error ^= 0 then return;
450 on cleanup call clean_up;
451 gndc_flag = "0"b;
452 call tolts_util_$get_ttl_date (mtdsim_, ttl_date);
453 tolts_active = "1"b;
454
455
456
457 call tolts_util_$search (tolts_info.df_iocbp, substr (exec, 1, 1) || "lt." || exec || "cm", t_ptr, c_len, error);
458 if error ^= 0 then do;
459 call com_err_ (error, exec, "searching for ^alt.^acm", substr (exec, 1, 1), exec);
460 call tolts_init_$clean_up;
461 return;
462 end;
463 call gload_ (t_ptr, execp, 0, addr (gload_data), error);
464 if error ^= 0 then do;
465 call com_err_ (error, exec, "^a^/attempting to load ^alt.^acm",
466 gload_data.diagnostic, substr (exec, 1, 1), exec);
467 call tolts_init_$clean_up;
468 return;
469 end;
470
471 if debugging then call ioa_ (" execp = ^p", execp);
472
473 if debug then do;
474 debug = "0"b;
475 tolts_info.mult_ans = "";
476 db_query:
477 call tolts_qttyio_$rs (19, "tolts_debugger: enter break point address");
478 call message_wait;
479 if mult_ans ^= "" then do;
480 db_addr = cv_oct_check_ ((rtrim (mult_ans)), code);
481 if code ^= 0 | db_addr > 65535 then do;
482 call ioa_ ("Debugger: invalid address supplied");
483 goto db_query;
484 end;
485 db_sv_wd = exec_wd (db_addr);
486 exec_wd (db_addr) = "777650001000"b3;
487 end;
488 end;
489
490
491 blk_lbl = block_disp;
492 term_lbl = done;
493 no_blk = no_blk_disp;
494 spa.enter.lreg = rel (addr (spa.regs)) || "073200"b3;
495 if exec = "molt" then string (spa.enter.lbar) = "000630230203"b3;
496 else string (spa.enter.lbar) = "000201230203"b3;
497 spa.enter.ret = rel (addr (spa.enter.icivlu)) || "630200"b3;
498 spa.enter.icivlu.ic = gload_data.definition (1).offset;
499 spa.enter.icivlu.ind = "0"b;
500 scup = null;
501 on lockup begin;
502 call ioa_ ("^a encountered a lockup fault ^[a dump will be taken^]", exec, ^flt_flag);
503 if ^flt_flag then call fault_dump;
504 else call continue_to_signal_ (error);
505 end;
506 on illop begin;
507 call ioa_ ("^a encountered a illop fault ^[a dump will be taken ^]", exec, ^flt_flag);
508 if ^flt_flag then call fault_dump;
509 else call continue_to_signal_ (error);
510 end;
511 on illegal_modifier begin;
512 call ioa_ ("^a encountered an illegal_modifier fault ^[a dump will be taken ^]", exec, ^flt_flag);
513 if ^flt_flag then call fault_dump;
514 else call continue_to_signal_ (error);
515 end;
516 on illegal_opcode begin;
517 call ioa_ ("^a encountered an illegal_opcode fault ^[a dump will be taken ^]", exec, ^flt_flag);
518 if ^flt_flag then call fault_dump;
519 else call continue_to_signal_ (error);
520 end;
521 on illegal_procedure begin;
522 call ioa_ ("^a encountered an illegal_procedure fault ^[a dump will be taken ^]", exec, ^flt_flag);
523 if ^flt_flag then call fault_dump;
524 else call continue_to_signal_ (error);
525 end;
526 on store begin;
527 call ioa_ ("^a encountered a store fault ^[a dump will be taken ^]", exec, ^flt_flag);
528 if ^flt_flag then call fault_dump;
529 else call continue_to_signal_ (error);
530 end;
531 on tolts_error_ begin;
532 call probe (mtdsim_);
533 call clean_up;
534 end;
535
536 on quit begin;
537 if ^q_flag then
538 call tolts_alrm_util_$quit;
539 else call continue_to_signal_ (error);
540 end;
541 on program_interrupt begin;
542 call hcs_$wakeup (tolts_info.process, tolts_info.quith_event, null, error);
543 end;
544 call tolts_qttyio_ ("??? ", 9);
545 %page;
546
547
548 term = "0"b;
549 do while (^term);
550 block_disp:
551 call ipc_$block (addr (tolts_info.wait_list), addr (event_out), error);
552 if error ^= 0 then do;
553 call com_err_ (error, exec, "*** fatal error, terminating process");
554 fatal_desc.version = 0;
555 fatal_desc.fatal_code = error;
556 if ^debugging then
557 call terminate_process_ ("fatal_error", addr (fatal_desc));
558 else signal tolts_error_;
559 end;
560 if tolts_info.wait_list.nchan > 1 then do;
561 if event_out.channel_id ^= wait_list.wait_event_id (2)
562 | event_out.channel_id ^= tolts_info.dm_event
563 then do;
564 ev_occurred = 0;
565 call ipc_$read_ev_chn (wait_list.wait_event_id (2),
566 ev_occurred, addr (event_out), code);
567 if code ^= 0 then do;
568 call com_err_ (code, exec, "Error calling ipc_$read_ev_chn");
569 if debugging then signal tolts_error_;
570 end;
571 if ev_occurred ^= 1 then do;
572 if nr_cnt < 20 then do;
573 if debugging then call ioa_ ("nr_cnt = ^d", nr_cnt);
574 wake_time = 500000;
575 call timer_manager_$sleep (wake_time, "10"b);
576 nr_cnt = nr_cnt + 1;
577 call wake_disp;
578 end;
579 else do;
580 if substr (clt_sw, 3, 4) = "c000" then do;
581 call tolts_qttyio_$rs (0, "^as: timeout error attempting attach of ^a",
582 tolts_info.exec, clt_sw);
583 call tolts_abort ("$c1");
584 end;
585 else do;
586 call rel_tst_chan (l);
587 colts_pages (l).in_use = "0"b;
588 call tolts_qttyio_$rs (0, "^as: timeout error attempting a tandd_attach of ^a",
589 tolts_info.exec, substr (colts_pages (l).cdt_name, 1, 6));
590 colts_op_flags.colt_flag = "0"b;
591 colts_op_flags.sicm = "0"b;
592 colts_op_flags.dm_attach = "0"b;
593 if mme_call_hf (2).lower ^= 0 then do;
594 exec_wd (mme_call_hf (2).upper) = "000000000004"b3;
595 call tolts_alm_util_$enter_ccc_req_ (addr (tolts_info.ccc_queue),
596 (mme_call_hw (2).lower || "000000"b3));
597 end;
598 colts_pages (l).status_word = "000000000002"b3;
599 end;
600 end;
601 end;
602 end;
603 tolts_info.wait_list.nchan = tolts_info.wait_list.nchan - 1;
604 chan_name, io_module = "";
605 n_dialed = 0;
606 flags = ""b;
607 call convert_dial_message_$return_io_module (event_out.message,
608 chan_name, io_module, n_dialed, flags, code);
609 if code ^= 0 then do;
610 call ioa_$rsnnl ("error attaching channel ^a", emsg, mesg_len, chan_name);
611 call output_status_code (code, emsg);
612 end;
613 if trace_io then
614 call ioa_ ("Channel ^a, IO Module ^a, N_dialed ^d, flags^[ dialed_up^]^[ hung_up^]^[ control^]",
615 chan_name, io_module, n_dialed, flags.dialed_up, flags.hung_up, flags.control);
616
617 if flags.control
618 | (^flags.control
619 & ^flags.dialed_up & ^flags.control) then do;
620
621 if substr (clt_sw, 3, 4) = "c000" then do;
622 call tolts_qttyio_$rs (0, "^as: control error attempting dial_manager_attach of ^a",
623 tolts_info.exec, substr (clt_sw, 1, 6));
624 call tolts_abort ("$c0");
625 end;
626 else do;
627 call rel_tst_chan (l);
628 colts_pages (l).in_use = "0"b;
629 call tolts_qttyio_$rs (0, "^as: control error attempting a tandd_attach of ^a",
630 tolts_info.exec, substr (colts_pages (l).cdt_name, 1, 6));
631 colts_op_flags.colt_flag = "0"b;
632 colts_op_flags.sicm = "0"b;
633 colts_op_flags.dm_attach = "0"b;
634 if mme_call_hf (2).lower ^= 0 then do;
635 exec_wd (mme_call_hf (2).upper) = "000000000002"b3;
636 call tolts_alm_util_$enter_ccc_req_ (addr (tolts_info.ccc_queue),
637 (mme_call_hw (2).lower || "000000"b3));
638 end;
639 colts_pages (l).status_word = "000000000002"b3;
640 end;
641 end;
642
643 if flags.dialed_up & colts_op_flags.dm_attach then do;
644 call iox_$attach_name ((clt_sw), cltp, att_desc, null, code);
645 if code ^= 0 then goto sw_err;
646 call iox_$open (cltp, 3, "0"b, code);
647 if code ^= 0 then goto sw_err;
648 call iox_$modes (cltp, "rawi,rawo", "", code);
649 if code ^= 0 then do;
650 sw_err: if substr (clt_sw, 3, 4) = "c000" then do;
651 call convert_status_code_ (code, shortinfo, lginfo);
652 call tolts_qttyio_$rs (0, "^as: ^a/ attempting a switch operation for ^a",
653 tolts_info.exec, lginfo, clt_sw);
654 call tolts_abort ("$c1");
655 end;
656 else do;
657 colts_pages (l).status_word = "000000000002"b3;
658 colts_pages (l).in_use = "0"b;
659 end;
660 end;
661 if code = 0 then do;
662 if substr (clt_sw, 3, 4) = "c000" then do;
663 tolts_info.fnp (k).exec_active = "1"b;
664 fnp (k).fnp_execp = cltp;
665 exec_wd (remote_inquiry_ic) = "0000000500"b3 || "1"b
666 || substr (bit (k), 2, 5);
667 end;
668 else do;
669 colts_pages (l).chanp = cltp;
670 colts_pages (l).status_word = "000000000004"b3;
671 exec_wd (remote_inquiry_ic) = "0000000500"b3 || "0"b
672 || substr (bit (l), 2, 5);
673 end;
674 colts_op_flags.colt_flag = "0"b;
675 colts_op_flags.dm_attach = "0"b;
676 remote_inquiry_ic = 0;
677 end;
678 end;
679 end;
680
681 if colts_op_flags.sicm then do;
682 call iox_$put_chars (fnp (k).fnp_execp, wicmp, (bin (wicm.word_total) + 1) * 4, code);
683 if code ^= 0 then do;
684 call convert_status_code_ (code, shortinfo, lginfo);
685 call tolts_qttyio_$rs (0, "^as: ^a/ error on data xfer to fnp colt exec ^a",
686 tolts_info.exec, lginfo, fnp (k).fnp_execp);
687 call tolts_abort ("$c1");
688 end;
689 gicmp = addr (gicm);
690 gicm_count = gicm_count + 1;
691
692 if gicm_count = 17 then do;
693 call tolts_qttyio_$rs (0, "^as: execessive outstanding io's", tolts_info.exec);
694 call tolts_abort ("$c2");
695 end;
696 gicm.cltp = fnp (k).fnp_execp;
697 gicm.ricmp = ricmp;
698 gicm.tally = bin (wicm.word_total) + 1;
699 if mme_call_hf (2).lower ^= 0 then do;
700 gicm.cc_addr = mme_call_hw (2).lower || "000000"b3;
701 gicm.st_addr = mme_call_hf (2).upper;
702 end;
703 colts_op_flags.sicm = "0"b;
704 end;
705
706 if tolts_info.special_fault then do;
707 tolts_info.special_fault = "0"b;
708 call tolts_abort ("$b6");
709 end;
710 else if tolts_info.exec_term_io_wait then term = "1"b;
711 else if tolts_info.first_request_done then do;
712 no_blk_disp:
713 if gicm_count ^= 0 then do;
714 alloc info_struct;
715 info_ptr = addr (info_struct);
716
717 if gicm.cltp ^= null then do;
718 call iox_$control (gicm.cltp, "read_status", info_ptr, code);
719 if info_struct.out_pend then do;
720 call iox_$get_chars (gicm.cltp, gicm.ricmp, gicm.tally * 4, n_read, code);
721 if code ^= 0 then do;
722 call convert_status_code_ (code, shortinfo, lginfo);
723 call tolts_qttyio_$rs (0, "^as: ^a/ error on data xfer from fnp", tolts_info.exec, lginfo);
724 call tolts_abort ("$c1");
725 end;
726 if gicm.cc_addr ^= "0"b3 then do;
727 if fnp (k).fnp_execp = gicm.cltp then
728 exec_wd (gicm.st_addr) = fnp (k).status_word;
729 else exec_wd (gicm.st_addr) = colts_pages (l).status_word;
730 call tolts_alm_util_$enter_ccc_req_ (addr (tolts_info.ccc_queue),
731 (gicm.cc_addr));
732 end;
733 gicm_count = gicm_count - 1;
734 gicm.cltp = null;
735 gicm.ricmp = null;
736 if gicm_count = 0
737 then do;
738 free gicm;
739 gicmp = null;
740 end;
741 end;
742 end;
743
744 free info_struct;
745 end;
746
747 if isc_ccc_rqt then do;
748 if tolts_info.exec_dta_cnt = 0 then isc_cntdn = isc_cntdn - 1;
749 if isc_cntdn = 0 | tolts_info.exec_dta_cnt ^= 0 then do;
750 isc_ccc_rqt = "0"b;
751 call tolts_alm_util_$enter_ccc_req_ (addr (tolts_info.ccc_queue), (isc_queue.icivlu));
752 exec_wd (isc_queue.status_add + 1) = "0"b;
753 if tolts_info.exec_dta_cnt = 0 then
754 exec_wd (isc_queue.status_add) = "400006000000"b3;
755 else call pop_isc (isc_queue.status_add, isc_queue.data_add);
756 end;
757 end;
758 if ^in_ccc & ^gndc_flag then
759 if tolts_info.ccc_requests ^= 0 & ^gelbar then do;
760 unspec (spa.ccc_regs) = addr (spa.regs) -> reg_move;
761 spa.ccc_icivlu = string (spa.enter.icivlu);
762 string (spa.enter.icivlu) = tolts_info.ccc_queue (1).icivlu;
763 tolts_info.ccc_requests = tolts_info.ccc_requests - 1;
764 do i = 1 to tolts_info.ccc_requests;
765 tolts_info.ccc_queue.icivlu (i) = tolts_info.ccc_queue.icivlu (i + 1);
766 end;
767 in_ccc = "1"b;
768 end;
769 else if rd_blk then do;
770 if isc_ccc_rqt then call wake_disp;
771 rd_blk = "0"b;
772 end;
773 if trace | (trace_save & in_ccc) then
774 call tolts_qttyio_$rs (10,
775 "^a ^a ^12.3b^[, ^a^;^s^]^[, ^a ^6.3b^;^2s^]^[, ^a ^a ^12.3b, ^a ^12.3b^]",
776 ctime (), "Dispatch to ici -", string (spa.enter.icivlu), in_ccc,
777 "in courtesy call", gelbar, "in gelbar, BAR -", spa.enter.lbar.bar, glb_brk,
778 "gelbar break,", "gb ici -", string (spa.glbici), "gbfv -", spa.glbflt);
779 glb_brk = "0"b;
780 gndc_flag = "0"b;
781 if ^flt_flag then
782 call tolts_alm_util_$enter_slave_ (addr (spa.enter));
783 end;
784 done:
785 end;
786 if ^tolts_active then return;
787 tolts_info.exec_term_io_wait = "1"b;
788 call clean_up;
789 return;
790 %page;
791
792
793
794 mme_fault: entry (mcptr, cname, tptr1, tptr2, tcont);
795
796 dcl (mcptr, tptr1, tptr2) ptr;
797 dcl cname char (*);
798 dcl tcont bit (1);
799 dcl tags (1:8) char (1) static options (constant) init
800 ("a", "b", "c", "d", "e", "f", "g", "h");
801 dcl fnp_state (0:4) char (7) static options (constant) init
802 ("free ", "unknown", "down ", "booting", "up ");
803
804
805 mcp = mcptr;
806 scup = addr (mc.scu);
807 unspec (spa.regs) = addr (mc.regs) -> reg_move;
808 spa.enter.icivlu.ind = string (scu.ir);
809
810 if gelbar then
811 call set_gelbar;
812 mmep = addrel (execp, scu.ilc);
813
814 if substr (mme_call_w (0), 19, 10) ^= "0000000010"b then
815 go to undefm;
816
817 if in_ccc then
818 if mme_call_hw (0).upper ^= "000016"b3 then do;
819 call tolts_qttyio_$rs (0, "^as: Illegal mme in ccc (^12.3b) @ ^p",
820 exec, mme_call_w (0), mmep);
821 call tolts_abort ("$a4");
822 end;
823 mme_number = mme_call_hf (0).upper;
824 if (mme_number < -127 | mme_number > 31)
825 | (mme_number < -66 & mme_number > -87)
826 | (mme_number < -94 & mme_number > -127) then
827 go to undefm;
828 if trace | trace_save then do;
829 if trace then do;
830 if (mme_number = -1 & last_mme = -39)
831 | (mme_number = -39 & last_mme = -1)
832 | mme_number = last_mme then do;
833 trace_save = "1"b;
834 trace = "0"b;
835 end;
836 end;
837 else if mme_number ^= last_mme then do;
838 trace = "1"b;
839 trace_save = "0"b;
840 end;
841 end;
842 last_mme = mme_number;
843 go to mme_typ (mme_number);
844 %page;
845
846
847
848
849
850
851
852
853
854 mme_typ (-1): if trace then call tolts_qttyio_$rs (10, "^a MME ABSTIM @ ^p", ctime (), mmep);
855 call tolts_init_$gc_tod (spa.regs.a);
856 call return_plus (1);
857
858
859
860
861
862
863
864
865
866
867 mme_typ (-2): if trace then call tolts_qttyio_$rs (10, "^a MME ACCWRT @ ^p", ctime (), mmep);
868 call return_plus (1);
869
870
871
872
873
874
875
876
877
878
879 mme_typ (-5): if trace then call tolts_qttyio_$rs (10, "^a MME ASGPAT @ ^p", ctime (), mmep);
880 spa.regs.x (2) = "0"b;
881 call return_plus (1);
882 %page;
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908 mme_typ (-4): if trace then call tolts_qttyio_$rs (10, "^a MME ALLOCR @ ^p", ctime (), mmep);
909 call get_px_sct ("ALLOCR", bin (spa.regs.x (1), 17), "0"b);
910 call set_sctwrk (io_sel);
911 if spa.regs.x (2) ^= "0"b then do;
912 if fixed (spa.regs.x (2)) = m_iv_iom then
913 spa.regs.x (2) = "0"b;
914 call return_plus (5);
915 end;
916 io_info_ptr = addr (pages (io_sel));
917
918
919
920 if ^io_info.ev_ch_ass then do;
921 call tolts_init_$cr_event_chan (io_info.status_event,
922 "1"b, tolts_io_int_, io_info_ptr, 2, error);
923 if error ^= 0 then
924 call tolts_abort ("$a9");
925 io_info.ev_ch_ass = "1"b;
926 end;
927
928 if mme_call_hf (1).lower = 0 then do;
929 alt_flag, rd_flag = "0"b;
930 if io_info.devsct.type_code = "22"b3
931 & ^io_info.ccu_pun then rd_flag = "1"b;
932 if ^io_info.alloc_wait & ^io_info.p_att then do;
933
934 if io_info.io_type = mca_io_type
935 & io_info.mca_attach_state = MCA_NOT_CONFIGURED then do;
936 call mca_$attach_mca ((io_info.device_name), io_info.status_event,
937 io_info.mca_ioi_idx, error);
938 io_info.mca_attach_state = MCA_FREE;
939 end;
940 else do;
941
942 attach: if ^alt_flag then do;
943 call ioa_$rsnnl ("T&D is attaching for a ^[write^]^[read^] ^a",
944 att_desc, mesg_len, (^rd_flag), (rd_flag), io_info.device_name);
945 call rcp_priv_$attach (io_info.rcp_name, addr (io_info.rcp_area (1)), io_info.status_event,
946 att_desc, io_info.rcp_id, error);
947 end;
948 else do;
949 call ioa_$rsnnl ("T&D is attaching for a ^[write^]^[read^] ^a",
950 att_desc, mesg_len, (^rd_flag), (rd_flag), io_info.alt_device_name);
951 call rcp_priv_$attach (io_info.rcp_name, addr (io_info.alt_rcp_area (1)), io_info.status_event,
952 att_desc, io_info.alt_rcp_id, error);
953 end;
954
955 if error ^= 0 then do;
956 call output_status_code (error, "rcp attach error");
957 call dealcp_sub;
958 spa.regs.x (2) = bit (os_deny);
959 call return_plus (5);
960 end;
961 if ^alt_flag then
962 call rcp_$check_attach (io_info.rcp_id, addr (io_info.rcp_area (1)), coment, io_info.device_index,
963 tolts_info.max_wks_sz, tolts_info.max_to, io_info.rcp_state, io_info.attach_err);
964 else call rcp_$check_attach (io_info.alt_rcp_id, addr (io_info.alt_rcp_area (1)), coment,
965 io_info.alt_device_index, tolts_info.max_wks_sz,
966 tolts_info.max_to, io_info.rcp_state, io_info.attach_err);
967
968 end;
969 end;
970 end;
971
972
973
974
975
976
977
978
979
980
981 if io_info.io_type = mtar_io_type
982 & (^io_info.p_att | io_info.alt_dev_flag) then do;
983 if io_info.attach_err = error_table_$force_unassign then do;
984 if ^alt_flag then disk_info_ptr = addr (io_info.rcp_area (1));
985 else disk_info_ptr = addr (io_info.alt_rcp_area (1));
986 if ^rd_flag then do;
987 disk_info.write_flag = "0"b;
988 rd_flag = "1"b;
989 goto attach;
990 end;
991 else do;
992 call output_status_code (io_info.attach_err, "ioi_assign error
993 call dealcp_sub;
994 spa.regs.x (2) = bit (os_deny);
995 call return_plus (5);
996 end;
997 end;
998 end;
999
1000 if ^io_info.p_att | ^io_info.p2_att then do;
1001
1002 if io_info.attach_err ^= 0
1003 | error ^= 0 then do;
1004 if io_info.attach_err = error_table_$resource_unavailable then do;
1005 spa.regs.x (2) = bit (dev_busy);
1006 if ^io_info.dev_busy then do;
1007 call tolts_qttyio_$rs (0, "^a device busy, allocation queued", io_info.test_hdr);
1008 io_info.dev_busy = "1"b;
1009 end;
1010 call return_plus (7);
1011 end;
1012 if io_info.io_type ^= mca_io_type then
1013 call output_status_code (io_info.attach_err, "ioi_assign error
1014 else call output_status_code (error, " mca assign error");
1015 call dealcp_sub;
1016 spa.regs.x (2) = bit (os_deny);
1017 call return_plus (5);
1018 end;
1019 if io_info.rcp_state ^= 0
1020 | (io_info.io_type = mca_io_type
1021 & io_info.mca_attach_state < MCA_ATTACHED) then do;
1022 io_info.alloc_wait = "1"b;
1023 io_info.icivlu.ic = mme_call_hw (4).upper;
1024 io_info.icivlu.ind = "0"b;
1025 call tolts_qttyio_$dcw_list (addrel (execp, mme_call_hf (4).lower), 0);
1026 tolts_info.glob_int_cnt = tolts_info.glob_int_cnt + 1;
1027 call return_plus (10);
1028 end;
1029
1030 if io_info.io_type = mdr_io_type & ^io_info.p2_att then
1031 if substr (io_info.device_name, 1, 3) = "tap"
1032 | substr (io_info.device_name, 1, 3) = "dsk" then do;
1033 io_info.p2_att = "1"b;
1034 io_info.alt_rcp_id = io_info.rcp_id;
1035 go to mme_typ (-4);
1036 end;
1037 if ^alt_flag then io_info.p_att = "1"b;
1038 else io_info.p2_att = "1"b;
1039 io_info.dev_busy = "0"b;
1040 end;
1041
1042
1043
1044
1045
1046
1047
1048 if io_info.io_type = mtar_io_type & io_info.alt_dev_flag
1049 & io_info.p_att & ^io_info.p2_att then do;
1050
1051 if rd_flag then do;
1052 disk_info_ptr = addr (io_info.alt_rcp_area (1));
1053 disk_info.write_flag = "0"b;
1054 rd_flag, alt_flag = "1"b;
1055 goto attach;
1056 end;
1057 else do;
1058 disk_info_ptr = addr (io_info.alt_rcp_area (1));
1059 disk_info.write_flag = "1"b;
1060 rd_flag = "0"b;
1061 alt_flag = "1"b;
1062 goto attach;
1063 end;
1064 end;
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078 if ^rd_flag then
1079 exec_wd (mme_call_hf (2).lower) = exec_wd (mme_call_hf (2).lower) & "777777000000"b3;
1080 else exec_wd (mme_call_hf (2).lower) = (exec_wd (mme_call_hf (2).lower)) | ("000000000010"b3);
1081 if io_info.rcp_name = DEVICE_TYPE (TAPE_DRIVE_DTYPEX) then
1082 call decode_den;
1083
1084 if io_info.io_type = mca_io_type then
1085 call get_temp_segment_ ("mca_workspace", io_info.workspace_ptr, error);
1086 else call ioi_$workspace (io_info.device_index, io_info.workspace_ptr, tolts_info.wks_sz, error);
1087 if error ^= 0 then do;
1088 call output_status_code (error, "workspace assign error");
1089 call dealcp_sub;
1090 spa.regs.x (2) = bit (os_deny);
1091 call return_plus (5);
1092 end;
1093 io_info.cur_wks_sz = tolts_info.wks_sz;
1094 if io_info.io_type ^= mca_io_type then do;
1095 ioi_wksp = io_info.workspace_ptr;
1096 call ioi_$set_status (io_info.device_index, fixed (rel (addr (tolts_workspace.status)), 18), 1, error);
1097 if error ^= 0 then do;
1098 call output_status_code (error, "set_status error");
1099 call dealcp_sub;
1100 spa.regs.x (2) = bit (os_deny);
1101 call return_plus (5);
1102 end;
1103 if io_info.nff then do;
1104 iom = fixed (substr (io_info.devsct.icc, 1, 3), 3) + 1;
1105 chan = fixed (substr (io_info.devsct.icc, 6, 6), 6);
1106 end;
1107 else do;
1108 iom = fixed (substr (io_info.devsct.icc, 1, 3), 3) + 1;
1109 chan = fixed (substr (io_info.devsct.icc, 4, 6), 6);
1110 end;
1111 call ioi_$set_channel_required (io_info.device_index, iom, chan, error);
1112 if error ^= 0 then do;
1113 call output_status_code (error, "set_channel error");
1114 call dealcp_sub;
1115 spa.regs.x (2) = bit (os_deny);
1116 call return_plus (5);
1117 end;
1118
1119 timeout_time = 30000000;
1120 if io_info.io_type = mdr_io_type
1121 & io_info.devsct.type_code = "001110"b then
1122 timeout_time = 390000000;
1123 else if io_info.io_type = itr_io_type
1124 & io_info.devsct.cr501_pr54 then
1125 timeout_time = 60000000;
1126 else if io_info.io_type = mtar_io_type then
1127 timeout_time = 90000000;
1128 io_info.lostit_time =
1129 divide ((timeout_time + 1000000) * 64, 1000, 35);
1130 call ioi_$timeout (io_info.device_index, timeout_time, error);
1131 if error ^= 0 then do;
1132 call output_status_code (error, "set timeout error");
1133 call dealcp_sub;
1134 spa.regs.x (2) = bit (os_deny);
1135 call return_plus (5);
1136 end;
1137 end;
1138 io_info.allocated = "1"b;
1139 call return_plus (8);
1140 %page;
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156 dcl 1 cata_call based (genp) aligned,
1157 (2 fdcwp bit (18),
1158 2 statp bit (18),
1159 2 patp bit (18),
1160 2 nblk fixed bin) unaligned;
1161
1162 mme_typ (-50): if trace | tcd then call tolts_qttyio_$rs (10, "^a MME CATA. @ ^p", ctime (), mmep);
1163 if substr (spa.regs.q, 7, 1) then
1164 call get_px_tcx ("CATA. ", substr (spa.regs.q, 8, 11));
1165 else call get_px_tcx ("CATA. ", substr (spa.regs.q, 10, 9));
1166 if io_info.io_type = mca_io_type then do;
1167 if io_info.mcata_idx = 0 then do;
1168 call tolts_util_$cata_sel (tolts_info.df_iocbp, "cata.nio.mca", addr (io_info.n_keys), error);
1169 if error ^= 0 then do;
1170 call output_status_code (error, "selecting catalog subset of cata." || io_info.cat_name);
1171 call return_plus (1);
1172 end;
1173 call tolts_util_$search (tolts_info.df_iocbp, (io_info.cata_keys (1)), io_info.catp, c_len, error);
1174 if error ^= 0 then do;
1175 call output_status_code (error, "searching for " || io_info.cata_keys (io_info.mcata_idx));
1176 call return_plus (1);
1177 end;
1178 do io_info.mcata_nkeys = 1 to cata.n;
1179 io_info.mcata_keys (io_info.mcata_nkeys) = cata.key (io_info.mcata_nkeys);
1180 end;
1181 io_info.mcata_idx = 1;
1182 end;
1183 io_info.cat_name = substr (io_info.mcata_keys (io_info.mcata_idx), 6, 7);
1184 end;
1185 if io_info.catx = 0 then do;
1186 call tolts_util_$cata_sel (tolts_info.df_iocbp, "cata." || io_info.cat_name, addr (io_info.n_keys), error);
1187 if error ^= 0 then do;
1188 call output_status_code (error, "selecting catalog subset of cata." || io_info.cat_name);
1189 call return_plus (1);
1190 end;
1191 io_info.catx = io_info.n_keys;
1192 if io_info.io_type ^= mca_io_type
1193 & io_info.n_keys > 1 then do;
1194 call tolts_qttyio_$rs (0, "^a Multiple catalog files (^d) for ^a ^a catalog.",
1195 io_info.test_hdr, io_info.n_keys, substr (io_info.cat_name, 5), substr (io_info.cat_name, 1, 3));
1196 do io_info.catx = 1 to io_info.n_keys;
1197 i = search (substr (io_info.cata_keys (io_info.catx), 10), ".");
1198
1199 call tolts_qttyio_$rs (0, "^a ^a catalog, ^[firmware rev ^a^] - ",
1200 substr (io_info.cata_keys (io_info.catx), 10, i - 1),
1201 substr (io_info.cata_keys (io_info.catx), 6, 3),
1202 (substr (io_info.cata_keys (io_info.catx), 6, 3) = "itr"),
1203 substr (io_info.cata_keys (io_info.catx), 10 + i));
1204 end;
1205 call tolts_qttyio_$rs (0, "^a^/^a",
1206 "Indicate which one is to be used by answering yes to",
1207 "one of the following catalog entrys:");
1208 tolts_info.mult_ans = "";
1209 do io_info.catx = 1 to io_info.n_keys while (mult_ans = "" | mult_ans = "no" | mult_ans = "n");
1210 i = search (substr (io_info.cata_keys (io_info.catx), 10), ".");
1211 requery:
1212 call tolts_qttyio_$rs (19, "^a ^a catalog, ^[firmware rev ^a^] - ",
1213 substr (io_info.cata_keys (io_info.catx), 10, i - 1),
1214 substr (io_info.cata_keys (io_info.catx), 6, 3),
1215 (substr (io_info.cata_keys (io_info.catx), 6, 3) = "itr"),
1216 substr (io_info.cata_keys (io_info.catx), 10 + i));
1217 call message_wait;
1218 if tolts_info.mult_ans ^= ""
1219 & (mult_ans ^= "yes" & mult_ans ^= "y")
1220 & (mult_ans ^= "no" & mult_ans ^= "n") then do;
1221 call tolts_qttyio_ ("Please answer yes, no, or eom", 0);
1222 go to requery;
1223 end;
1224 end;
1225 io_info.catx = io_info.catx - 1;
1226 if io_info.catx > io_info.n_keys
1227 | (mult_ans ^= "yes" & mult_ans ^= "y") then
1228 call return_plus (1);
1229 end;
1230 end;
1231 else if io_info.io_type = mca_io_type then do;
1232 if ^io_info.cata_cycle then io_info.cata_cycle = "1"b;
1233 else do;
1234 if io_info.catx > 1 then
1235 io_info.catx = io_info.catx - 1;
1236 else do;
1237 io_info.mcata_idx = io_info.mcata_idx + 1;
1238 io_info.catx = 0;
1239 end;
1240 io_info.cata_cycle = "0"b;
1241 end;
1242 spa.regs.a = "0"b;
1243 end;
1244 if io_info.catx ^= 0 then do;
1245 call tolts_util_$search (tolts_info.df_iocbp, (io_info.cata_keys (io_info.catx)), io_info.catp, c_len, error);
1246 if error ^= 0 then do;
1247 call output_status_code (error, "searching for " || io_info.cata_keys (io_info.catx));
1248 call return_plus (1);
1249 end;
1250 genp = addrel (execp, spa.regs.x (1));
1251 dcwp = addrel (execp, cata_call.fdcwp);
1252 gcatp = addrel (execp, dcw.address);
1253 if trace | tcd then call tolts_qttyio_$rs (10, "MME CATA.; loading catalog ""cata.^a"" @ ^p",
1254 io_info.cat_name, gcatp);
1255 do i = 1 to cata.n;
1256 if io_info.io_type = mca_io_type then do;
1257 unspec (mca_gcata (i)) = "0"b;
1258 mca_gcata (i).cat_index, mca_gcata (i).nblk = i;
1259 if index (cata.key (i), "HDR") ^= 0 then do;
1260 mca_gcata (i).dipper_flag = "0100"b;
1261 filename_idx = index (cata.key (i),
1262 after (cata.key (i), "HDR."));
1263 end;
1264
1265 else if index (cata.key (i), "DIR") ^= 0 then do;
1266 mca_gcata (i).dipper_flag = "0101"b;
1267 filename_idx = index (cata.key (i), "DIR");
1268 end;
1269
1270 else if index (cata.key (i), "cata") ^= 0 then do;
1271 mca_gcata (i).dipper_flag = "0100"b;
1272 filename_idx = index (cata.key (i),
1273 after (cata.key (i), "nio."));
1274 end;
1275
1276 else filename_idx = index (cata.key (i),
1277 after (cata.key (i), "nio."));
1278 call tolts_alm_util_$ascii_to_bcd_
1279 (substr (cata.key (i), filename_idx, 12), bit_buf);
1280 unspec (mca_gcata (i).filename) = bit_buf;
1281 end;
1282
1283 else do;
1284 unspec (gcata (i)) = "0"b;
1285 j = length (rtrim (cata.key (i)));
1286 ac_name = substr (cata.key (i), j - 6, 4) || substr (cata.key (i), j - 1, 2);
1287 call tolts_alm_util_$ascii_to_bcd_ (ac_name, gcata (i).edit_rev);
1288 gcata (i).cat_index, gcata (i).nblk = i;
1289 if j < 13 then
1290 call tolts_alm_util_$ascii_to_bcd_ (substr (cata.key (i), j, 6), gcata (i).ident);
1291 else call tolts_alm_util_$ascii_to_bcd_ (substr (cata.key (i), j - 13, 6), gcata (i).ident);
1292 if index (cata.key (i), ".") > 4 then
1293 call tolts_alm_util_$ascii_to_bcd_ (substr (cata.key (i), 1, 6), gcata (i).purpose);
1294 else do;
1295 call tolts_alm_util_$ascii_to_bcd_ (substr (cata.key (i), 1, 3), b18);
1296 substr (gcata (i).purpose, 19, 18) = b18;
1297 end;
1298 end;
1299 end;
1300 spa.regs.a = bit (bin (cata.n * 4, 36));
1301 end;
1302 if io_info.mcata_idx <= io_info.mcata_nkeys
1303 & io_info.io_type = mca_io_type then call return_plus (2);
1304 else call return_plus (3);
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317 mme_typ (-6): if trace then call tolts_qttyio_$rs (10, "^a MME CHANTM @ ^p", ctime (), mmep);
1318 call get_px_sct ("CHANTM", bin (spa.regs.x (1), 17), "1"b);
1319 spa.regs.a = bit (bin (pages (io_sel).chan_time, 36));
1320 call return_plus (1);
1321
1322
1323
1324
1325
1326
1327
1328
1329 mme_typ (-7): if trace then call tolts_qttyio_$rs (10, "^a MME CLEARQ @ ^p", ctime (), mmep);
1330 isc_ccc_rqt = "0"b;
1331 if isc_cntdn ^= 1 then isc_cntdn = 0;
1332 call return_plus (1);
1333 %page;
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359 mme_typ (-62): if trace then call tolts_qttyio_$rs (10, "^a MME COINIT @ ^p", ctime (), mmep);
1360 exec_wd (mme_call_hf (2).upper) = "0"b;
1361 spa.wrapup_add = mme_call_hw (4).upper;
1362 call tolts_alm_util_$ascii_to_bcd_ (ttl_date, bcd_callname);
1363 exec_wd (mme_call_hf (5).upper) = bcd_callname;
1364 substr (exec_wd (mme_call_hf (5).upper - 1), 19, 18) = "622017"b3;
1365 genp = addrel (execp, mme_call_hf (3).upper);
1366 if fix_wd (1) ^= 0 then
1367 mem_now, fix_wd (1) = fix_wd (1) + 49152;
1368 else mem_now, fix_wd (1) = fixed (gload_data.text_len) + 49152;
1369 call cpu_time_and_paging_ (i, cpu_time, j);
1370 tolts_info.init_time = cpu_time;
1371 exec_wd (mme_call_hf (6).upper) = "000000000002"b3;
1372 exec_wd (mme_call_hf (7).upper) = "000001001000"b3;
1373 fnp.status_word, colts_pages.status_word = "000000000004"b3;
1374 call return_plus (8);
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389 mme_typ (-8): if trace then call tolts_qttyio_$rs (10, "^a MME CONTML @ ^p", ctime (), mmep);
1390 spa.regs.x (1) = "000004"b3;
1391 call return_plus (5);
1392
1393 %page;
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412 mme_typ (-51): if trace | tcd then do;
1413 call tolts_qttyio_$rs (10, "^a MME DATA. @ ^p to load ^a",
1414 ctime (), mmep, cata.key (cata_call.nblk));
1415 genp = addrel (execp, spa.regs.x (1));
1416 end;
1417
1418 if substr (spa.regs.q, 7, 1) then
1419 call get_px_tcx ("DATA. ", substr (spa.regs.q, 8, 11));
1420 else call get_px_tcx ("DATA. ", substr (spa.regs.q, 10, 9));
1421 genp = addrel (execp, spa.regs.x (1));
1422 dcwp = addrel (execp, cata_call.fdcwp);
1423 l_ptr = addrel (execp, dcw.address);
1424 call tolts_util_$search (tolts_info.df_iocbp, (cata.key (cata_call.nblk)), t_ptr, c_len, error);
1425 if error ^= 0 then do;
1426 call output_status_code (error, "searching for " || cata.key (cata_call.nblk));
1427 call return_plus (1);
1428 end;
1429
1430 if io_info.io_type = mca_io_type then do;
1431 if spa.regs.x (4) ^= "777777"b3 then do;
1432 io_info.catx = 0;
1433 io_info.mcata_idx = 1;
1434 t_ptr = addrel (t_ptr, fixed (spa.regs.x (4)) * 64);
1435 if bin (dcw.tally) = 0 then tally = 4096;
1436 else tally = bin (dcw.tally);
1437 if c_len < (fixed (spa.regs.x (4)) * 64) + tally then
1438 c_len = c_len - fixed (spa.regs.x (4)) * 64;
1439 else c_len = tally;
1440 if c_len < 0 then call return_plus (1);
1441 mvp = addrel (execp, dcw.address);
1442 data_move = t_ptr -> data_move;
1443 spa.regs.a = bit (bin (c_len, 36));
1444 end;
1445 else spa.regs.a = "0"b;
1446 end;
1447 else do;
1448 call gload_ (t_ptr, l_ptr, fixed (spa.regs.x (3), 18), addr (gload_data), error);
1449 if error ^= 0 then do;
1450 call output_status_code (error,
1451 gload_data.diagnostic || " loading module " || cata.key (cata_call.nblk));
1452 call return_plus (1);
1453 end;
1454 spa.regs.a = bit (bin (gload_data.text_len, 36));
1455 end;
1456 if trace | tcd then call tolts_qttyio_$rs (10, "MME DATA.; loaded ""^a"" @ ^p to ^p for ^d",
1457 cata.key (cata_call.nblk), t_ptr, l_ptr, spa.regs.a);
1458
1459 call return_plus (3);
1460
1461 %page;
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472 mme_typ (-9): if trace then call tolts_qttyio_$rs (10, "^a MME DEALCP @ ^p", ctime (), mmep);
1473 call get_px_sct ("DEALCP", bin (spa.regs.x (1), 17), "0"b);
1474 call dealcp_sub;
1475 if dealc_err ^= 0 then
1476 call tolts_abort ("$b3");
1477 else call return_plus (1);
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502 mme_typ (-89): if trace | trace_io then call tolts_qttyio_$rs
1503 (10, "^a MME DOFPIO ^p, type - ^12.3b", ctime (), mmep, substr (spa.regs.a, 25));
1504
1505 tolts_fpinfo_ptr = addrel (execp, spa.regs.x (1));
1506
1507 do io_sel = 1 to hbound (tolts_info.pages, 1)
1508 while (pages (io_sel).fnp_num ^= tolts_fpinfo.pcw_info.fnp_num);
1509 end;
1510
1511 if io_sel > hbound (tolts_info.pages, 1) then call tolts_abort ("$c3");
1512 io_info_ptr = addr (pages (io_sel));
1513 io_info.fpinfo_ptr = tolts_fpinfo_ptr;
1514 tolts_rspd_wksp = io_info.tolts_rspd_wksp;
1515 tolts_fpinfo.fnpdcw.address =
1516 bin (bin (spa.regs.x (3), 18) + bin (substr (spa.regs.a, 1, 18), 18), 18);
1517 direct_channel_pcw_ptr =
1518 addr (tolts_rspd_workspace.mailbox.pcw);
1519 substr (unspec (direct_channel_pcw), 19) = substr (spa.regs.a, 19);
1520 substr (unspec (tolts_fpinfo.pcw_info), 19) =
1521 substr (spa.regs.a, 19);
1522 io_info.dcw_list (1) = exec_wd (tolts_fpinfo.fnpdcw.address);
1523 direct_channel_tcw_ptr = addr (tolts_rspd_workspace.tcw);
1524 unspec (direct_channel_tcw) = unspec (io_info.dcw_list (1));
1525 if direct_channel_pcw.operation = "75"b3
1526 | direct_channel_pcw.operation = "76"b3 then do;
1527 substr (spa.regs.a, 1, 18) = unspec (tolts_fpinfo.fnpdcw.address);
1528 direct_channel_pcw.tcw_address = wordno (addr (tolts_rspd_workspace.tcw));
1529 end;
1530
1531 else direct_channel_pcw.tcw_address = 0;
1532 io_info.pcwa = spa.regs.a;
1533 if direct_channel_pcw.operation = "76"b3 then do;
1534 c_len = direct_channel_tcw.host_word_count;
1535 mvp = addrel (execp, bin (substr (spa.regs.a, 1, 18)) + 1);
1536 bufp = addr (tolts_rspd_workspace.data_buf);
1537 workspace_move = mvp -> workspace_move;
1538 end;
1539
1540 tolts_rspd_workspace.pcw = direct_channel_pcw;
1541 unspec (tolts_rspd_workspace.tcw) = unspec (direct_channel_tcw);
1542 tio_off = wordno (direct_channel_pcw_ptr);
1543 io_info.lostit_time = bin (tolts_fpinfo.timeout_time);
1544 call tolts_init_$gc_tod ((tolts_fpinfo.timeout_time));
1545 tolts_fpinfo.timeout_time = bit (bin (tolts_fpinfo.timeout_time, 36) + io_info.lostit_time, 35);
1546 tolts_fpinfo.io_rq_cnt = tolts_fpinfo.io_rq_cnt + 1;
1547
1548 io_info.io_in_progress = "1"b;
1549 io_info.num_connects = io_info.num_connects + 1;
1550 call ioi_$connect (io_info.device_index, tio_off, error);
1551 if error ^= 0 then do;
1552 call output_status_code (error, "io connect error");
1553 call tolts_abort ("$c7");
1554 end;
1555
1556 wake_time = 500000;
1557 call timer_manager_$sleep (wake_time, "10"b);
1558 tolts_info.glob_int_cnt = tolts_info.glob_int_cnt + 1;
1559 call return_plus (1);
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570 mme_typ (-12): if trace then call tolts_qttyio_$rs (10, "^a MME EXPDEV @ ^p", ctime (), mmep);
1571 call get_px_sct ("EXPDEV", bin (spa.regs.x (1), 17), "1"b);
1572 spa.regs.a = unspec (io_info.devsct.w1);
1573 spa.regs.q = unspec (io_info.devsct.w2);
1574 call return_plus (1);
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586 mme_typ (-59): if trace then call tolts_qttyio_$rs (10, "^a MME FEPTYP @ ^p", ctime (), mmep);
1587
1588
1589 cdtp = cdtptr;
1590 j = bin (spa.regs.x (2));
1591 tolts_info.fnp (j).type = (fnp_entry (j + 1).type);
1592 if tolts_info.fnp (j).type = 1 then spa.regs.x (2) = "000002"b3;
1593 else if tolts_info.fnp (j).type = 3
1594 then spa.regs.x (2) = "000001"b3;
1595 else if tolts_info.fnp (j).type = 0
1596 then spa.regs.x (2) = "777777"b3;
1597 if fnp_entry (j + 1).mpxe.current_service_type ^= 1
1598 & fnp_entry (j + 1).state ^= 4 then do;
1599 spa.regs.x (2) = "777777"b3;
1600 call tolts_qttyio_$rs (0, "^as: fnp ^a is ^a", exec, tags (j + 1),
1601 fnp_state (fnp_entry (j + 1).mpxe.state));
1602 end;
1603 call return_plus (1);
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614 mme_typ (-93): if trace then call tolts_qttyio_$rs (10, "^a MME FPWRAP @ ^p", ctime (), mmep);
1615
1616 tolts_fpinfo_ptr = addrel (execp, spa.regs.x (1));
1617
1618 do io_sel = 1 to hbound (pages, 1)
1619
1620 while (pages (io_sel).fnp_num ^= tolts_fpinfo.pcw_info.fnp_num);
1621 end;
1622
1623 if io_sel > hbound (pages, 1) then call tolts_abort ("$c3");
1624 io_info_ptr = addr (pages (io_sel));
1625 tolts_rspd_wksp = io_info.tolts_rspd_wksp;
1626 tolts_fpinfo.partrs = 0;
1627 if ^io_info.io_in_progress then tolts_fpinfo.io_rq_cnt = 0;
1628 unspec (tolts_rspd_workspace.mailbox.num_int) = "0"b;
1629 tolts_rspd_workspace.mailbox.status_word = "0"b;
1630 call dealcp_sub;
1631 call return_plus (1);
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645 mme_typ (-53): if trace then call tolts_qttyio_$rs (10, "^a MME FREEZE @ ^p", ctime (), mmep);
1646 spa.regs.x (5) = "0"b;
1647 call return_plus (1);
1648 %page;
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662 mme_typ (18): call bcd_to_ascii_ (mme_call_w (1), ac_name);
1663 if trace then call tolts_qttyio_$rs (10, "^a MME GECALL (^a) @ ^p", ctime (), ac_name, mmep);
1664 coment = "";
1665 l_ptr = addrel (execp, mme_call_hf (2).upper);
1666 call tolts_util_$search (tolts_info.df_iocbp,
1667 substr (tolts_info.exec, 1, 1) || "lt." || ac_name, t_ptr, c_len, error);
1668 if error ^= 0 then
1669 call tolts_util_$search (tolts_info.df_iocbp, "utl." || ac_name, t_ptr, c_len, error);
1670 if error ^= 0 then
1671 call ioa_$rsnnl ("searching for test page ^a", coment, mesg_len, ac_name);
1672 if error = 0 then
1673 call gload_ (t_ptr, l_ptr, fixed (spa.regs.x (3), 18), addr (gload_data), error);
1674 if error ^= 0 then do;
1675 if coment = "" then
1676 call ioa_$rsnnl ("^a loading test page ^a", coment, mesg_len, gload_data.diagnostic, ac_name);
1677 call output_status_code (error, coment);
1678 if mme_call_hw (2).lower = "0"b
1679 then spa.enter.icivlu = spa.wrapup_add;
1680 else do;
1681 spa.enter.icivlu.ic = mme_call_hw (2).lower;
1682 mme_call_hw (2).lower = "0"b;
1683 spa.regs.q = "63"b3;
1684 end;
1685 end;
1686 else spa.enter.icivlu.ic = mme_call_hw (3).upper;
1687 call wake_disp;
1688
1689
1690
1691
1692
1693
1694
1695
1696 mme_typ (14): if trace | trace_io then call tolts_qttyio_$rs (10, "^a MME GEENDC @ ^p", ctime (), mmep);
1697 if ^in_ccc then do;
1698 call tolts_qttyio_$rs (0, "^as: MME GEENDC while not in courtesy call", exec);
1699 call tolts_abort ("$a6");
1700 end;
1701 gndc_flag = "1"b;
1702 in_ccc = "0"b;
1703 unspec (spa.regs) = addr (spa.ccc_regs) -> reg_move;
1704 string (spa.enter.icivlu) = spa.ccc_icivlu;
1705 call wake_disp;
1706 %page;
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716 mme_typ (1): if trace then call tolts_qttyio_$rs (10, "^a MME GEINOS @ ^p, type - ^12.3b", ctime (), mmep, mme_call_w (1));
1717 if mme_call_w (1) ^= "130000000000"b3 & mme_call_w (1) ^= "010000000000"b3 then do;
1718 call tolts_qttyio_$rs (0, "^as: MME GEINOS type ^12.3b not supported", exec, mme_call_w (1));
1719 call tolts_abort ("$a7");
1720 end;
1721 dcwp = addrel (execp, mme_call_hf (2).lower);
1722 exec_wd (mme_call_hf (3).upper), exec_wd (mme_call_hf (3).upper + 1) = "0"b;
1723 if mme_call_hw (1).upper = "010000"b3 then do;
1724 if dcw.type ^= "0"b then do;
1725 call tolts_qttyio_$rs (0, "^as: MME GEINOS; Read isc dcw type not iotd. DCW = 12.3b",
1726 exec, string (dcw));
1727 call tolts_abort ("$a7");
1728 end;
1729 if dcw.tally ^= "0003"b3 then do;
1730 call tolts_qttyio_$rs (0, "^as: MME GEINOS; Read isc word count ^= 3. DCW = 12.3b",
1731 exec, string (dcw));
1732 call tolts_abort ("$a7");
1733 end;
1734 if tolts_info.exec_dta_cnt ^= 0 then do;
1735 j = mme_call_hf (3).upper;
1736 call pop_isc (j, bin (dcw.address, 17));
1737 if mme_call_hf (3).lower ^= 0 then
1738 call tolts_alm_util_$enter_ccc_req_ (addr (tolts_info.ccc_queue),
1739 mme_call_hw (3).lower || "000000"b3);
1740 end;
1741 else do;
1742 isc_cntdn = 10000;
1743 if mme_call_hf (3).lower ^= 0 then do;
1744 isc_ccc_rqt = "1"b;
1745 isc_queue.icivlu = mme_call_hw (3).lower || "000000"b3;
1746 isc_queue.status_add = mme_call_hf (3).upper;
1747 isc_queue.data_add = fixed (dcw.address);
1748 end;
1749 end;
1750 end;
1751 else do;
1752 if mme_call_hf (3).lower ^= 0 then
1753 call tolts_alm_util_$enter_ccc_req_ (addr (tolts_info.ccc_queue),
1754 mme_call_hw (3).lower || "000000"b3);
1755 call tolts_qttyio_$dcw_list (dcwp, 0);
1756 end;
1757 call return_plus (4);
1758 %page;
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769 dcl 1 gelbar_temp based (genp) aligned,
1770 (2 bar bit (18),
1771 2 reg_ptr bit (18),
1772 2 ic bit (18),
1773 2 ind bit (18)) unaligned;
1774
1775 mme_typ (31): if trace then call tolts_qttyio_$rs (10, "^a MME GELBAR @ ^p", ctime (), mmep);
1776 spa.glbtmr = spa.regs.q;
1777 genp = addrel (execp, substr (spa.regs.a, 1, 18));
1778 spa.enter.icivlu.ic = gelbar_temp.ic;
1779 spa.enter.icivlu.ind = gelbar_temp.ind;
1780 spa.enter.lbar.bar = gelbar_temp.bar;
1781 spa.acc_fault = gelbar_temp.bar || "000000"b3;
1782 call tolts_init_$gc_tod (gcos_tod);
1783 string (spa.glbici) = gcos_tod;
1784 genp = addrel (execp, gelbar_temp.reg_ptr);
1785 unspec (spa.regs) = genp -> reg_move;
1786 gelbar = "1"b;
1787 call wake_disp;
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798 mme_typ (9): if trace then call tolts_qttyio_$rs (10, "^a MME GEMORE @ ^p", ctime (), mmep);
1799 call return_plus (3);
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811 mme_typ (21): if trace then call tolts_qttyio_$rs (10, "^a MME GEMREL @ ^p", ctime (), mmep);
1812 spa.enter.icivlu.ic = substr (spa.regs.a, 1, 18);
1813 call wake_disp;
1814 %page;
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825 mme_typ (-13): if trace then call tolts_qttyio_$rs (10, "^a MME GEPROC @ ^p", ctime (), mmep);
1826 call return_plus (3);
1827
1828
1829
1830
1831
1832
1833
1834
1835 mme_typ (15): if trace then call tolts_qttyio_$rs (10, "^a MME GERELC @ ^p", ctime (), mmep);
1836 call return_plus (1);
1837
1838
1839
1840
1841
1842
1843
1844 mme_typ (2): if trace then call tolts_qttyio_$rs (10, "^a MME GEROAD @ ^p", ctime (), mmep);
1845 rd_blk = "1"b;
1846 call return_plus (1);
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866 mme_typ (24): if trace then call tolts_qttyio_$rs (10, "^a MME GEROUT ^p, type - ^12.3b", ctime (), mmep, mme_call_w (1));
1867
1868 gerout_num = bin (substr (mme_call_hw (1).lower, 1, 6));
1869 if gicm_count > 0 then call return_plus (0);
1870 else go to gerout (gerout_num);
1871 %page;
1872
1873
1874 gerout (4): wicmp = addrel (execp, mme_call_hf (1).upper);
1875 ricmp = addrel (execp, bin (wicm.rbuf_addr) - 1);
1876 if gicmp = null then alloc gicm;
1877 gicmp = addr (gicm);
1878 icm_tally = bin (wicm.word_total) * 2;
1879 k = bin (substr (mme_call_hw (1).lower, 15, 4));
1880 if substr (mme_call_hw (1).lower, 13, 1) = "1"b then do;
1881 if substr (wicm.host_opcode, 10, 9) = "042"b3 then do;
1882 alloc ticm;
1883 ticmp = addr (ticm);
1884 ticm = wicm;
1885 fnp_num = bin (substr (mme_call_hw (1).lower, 16, 3)) + 1;
1886 do i = 1 to 2;
1887 if substr (ticm.icm_buf (1), 1, 18) = "777777"b3 then do;
1888 call db_fnp_eval_ (null (), fnp_num, ".criom", null (), exec, fnp_addr, code);
1889
1890 if code ^= 0 then go to db_err;
1891 icm_tally = 1;
1892 end;
1893 else do;
1894 i = 2;
1895 icm_tally = bin (wicm.word_total) * 2;
1896 fnp_addr = bin (substr (ticm.icm_buf (1), 1, 18));
1897 end;
1898 call db_fnp_memory_$fetch (null (), fnp_num, fnp_addr, icm_tally, addr (ticm.icm_buf), code);
1899
1900 db_err: if code ^= 0 then do;
1901 call convert_status_code_ (code, shortinfo, lginfo);
1902 call tolts_qttyio_$rs (0, "^as: ^a error reading fnp memory", tolts_info.exec, lginfo);
1903
1904 ticm.fnp_opcode = "000051"b3;
1905 end;
1906 else ticm.fnp_opcode = "000041"b3;
1907 end;
1908 ticm.rbuf_addr = "0"b;
1909 call tolts_alm_util_$gen_ck_sum (ticmp);
1910 ricm = ticm;
1911 free ticm;
1912 ticmp = null;
1913 if mme_call_hf (2).lower ^= 0 then do;
1914 exec_wd (mme_call_hf (2).upper) = "000000000004"b3;
1915 call tolts_alm_util_$enter_ccc_req_ (addr (tolts_info.ccc_queue),
1916 mme_call_hw (2).lower || "000000"b3);
1917 end;
1918 end;
1919 else if substr (wicm.host_opcode, 10, 9) = "001"b3 then do;
1920 do i = 1 to 8 while (colts_pages (i).in_use);
1921 end;
1922 if i = 8 & colts_pages (8).in_use then do;
1923 call tolts_qttyio_$rs (0, "^a: mme gerout 04; no vacant test page slot found", exec);
1924 call tolts_abort ("$c1");
1925 end;
1926
1927 colts_pages (i).in_use = "1"b;
1928
1929 do j = 1 to 8;
1930 if substr (fnp (k).cdt_name (j), 1, 5) ^= "empty" then do;
1931 colts_pages (i).cdt_name = tolts_info.fnp (k).cdt_name (j);
1932
1933 tolts_info.fnp (k).cdt_name (j) = "empty";
1934 j = 8;
1935 end;
1936 end;
1937 tolts_info.exec_page_count = tolts_info.exec_page_count + 1;
1938 dmap = addr (tolts_info.colts_pages (i).dm_arg);
1939 colts_pages (i).dm_arg.version = dial_manager_arg_version_2;
1940 colts_pages (i).dm_arg.dial_qualifier = substr (colts_pages (i).cdt_name, 1, 22);
1941 colts_pages (i).dm_arg.dial_channel = tolts_info.dm_event;
1942 colts_pages (i).dm_arg.channel_name = colts_pages (i).cdt_name;
1943 colts_pages (i).type_code = substr (wicm.icm_buf (1), 22, 6);
1944 nr_cnt = 0;
1945 call dial_manager_$tandd_attach (dmap, code);
1946 if code ^= 0 then do;
1947 if debugging then call com_err_ (code, "mtdsim_", "Error on tandd_attachment of ^a.",
1948 colts_pages (i).cdt_name);
1949 colts_pages (i).in_use = "0"b;
1950 call convert_status_code_ (code, shortinfo, lginfo);
1951 call tolts_qttyio_$rs (0, "^as: ^a/ error attempting a tandd_attach of ^a",
1952 tolts_info.exec, lginfo, substr (colts_pages (i).cdt_name, 1, 6));
1953 colts_op_flags.colt_flag = "0"b;
1954 alloc ticm;
1955 ticmp = addr (ticm);
1956 ticm = wicm;
1957 ticm.fnp_opcode = "000051"b3;
1958 ticm.rbuf_addr = "0"b;
1959 call tolts_alm_util_$gen_ck_sum (ticmp);
1960 ricm = ticm;
1961 free ticm;
1962 ticmp = null;
1963 if mme_call_hf (2).lower ^= 0 then do;
1964 exec_wd (mme_call_hf (2).upper) = "000000000004"b3;
1965
1966 call tolts_alm_util_$enter_ccc_req_ (addr (tolts_info.ccc_queue),
1967 mme_call_hw (2).lower || "000000"b3);
1968 end;
1969 call return_plus (3);
1970 end;
1971 tolts_info.wait_list.nchan = tolts_info.wait_list.nchan + 1;
1972 tolts_info.wait_event_id (tolts_info.wait_list.nchan) = tolts_info.dm_event;
1973 clt_sw = substr (colts_pages (i).cdt_name, 1, 6) || ".sw";
1974 att_desc = "tty_ " || substr (colts_pages (i).cdt_name, 1, 6);
1975 colts_op_flags.dm_attach = "1"b;
1976 colts_op_flags.colt_flag = "1"b;
1977 colts_op_flags.sicm = "1"b;
1978 l = i;
1979 end;
1980 else do;
1981 call iox_$put_chars (fnp (k).fnp_execp, wicmp, (bin (wicm.word_total) + 1) * 4, code);
1982 if code ^= 0 then do;
1983 call convert_status_code_ (code, shortinfo, lginfo);
1984 call tolts_qttyio_$rs (0, "^as: ^a/ error on data xfer to fnp", tolts_info.exec, lginfo);
1985 call tolts_abort ("$c1");
1986 end;
1987 gicm_count = gicm_count + 1;
1988
1989 if gicm_count = 17 then do;
1990 call tolts_qttyio_$rs (0, "^as: excessive outstanding io's", tolts_info.exec);
1991 call tolts_abort ("$c1");
1992 end;
1993
1994 gicm.cltp = fnp (k).fnp_execp;
1995 gicm.ricmp = ricmp;
1996 gicm.tally = bin (wicm.word_total) + 1;
1997 if mme_call_hf (2).lower ^= 0 then do;
1998 gicm.cc_addr = mme_call_hw (2).lower || "000000"b3;
1999 gicm.st_addr = mme_call_hf (2).upper;
2000 end;
2001 end;
2002 end;
2003 else do;
2004
2005 call iox_$put_chars (colts_pages (k).chanp, wicmp, (bin (wicm.word_total) + 1) * 4, code);
2006 if code ^= 0 then do;
2007 call convert_status_code_ (code, shortinfo, lginfo);
2008 call tolts_qttyio_$rs (0, "^as: ^a/ error on data xfer to chan ^a",
2009 tolts_info.exec, lginfo, substr (colts_pages (k).cdt_name, 1, 6));
2010 colts_pages (k).status_word = "000000000002"b3;
2011 end;
2012
2013 gicm_count = gicm_count + 1;
2014
2015 if gicm_count = 17 then do;
2016 call tolts_qttyio_$rs (0, "as: excessive outstanding io count", tolts_info.exec);
2017 call tolts_abort ("$c1");
2018 end;
2019 gicm.cltp = colts_pages (k).chanp;
2020 gicm.ricmp = ricmp;
2021 gicm.tally = bin (wicm.word_total) + 1;
2022 if mme_call_hf (2).lower ^= 0 then do;
2023 gicm.cc_addr = mme_call_hw (2).lower || "000000"b3;
2024 gicm.st_addr = mme_call_hf (2).upper;
2025 end;
2026 end;
2027 call return_plus (3);
2028
2029
2030
2031 gerout (5): remote_inquiry_ic = bin (rel (addr (mme_call_w (1))));
2032 call return_plus (3);
2033
2034 gerout (06):
2035 k = bin (substr (mme_call_hw (1).lower, 15, 4));
2036 if substr (mme_call_hw (1).lower, 13, 1) = "1"b then
2037 mme_call_hw (1).upper = tolts_info.fnp (k).exec_type_code || "0000"b3;
2038
2039 else substr (mme_call_hw (1).upper, 1, 6) = colts_pages (k).type_code;
2040 call return_plus (3);
2041
2042
2043 gerout (7): if remote_inquiry_ic ^= 0 then do;
2044
2045 k = bin (substr (mme_call_hw (1).upper, 1, 3));
2046
2047 if ^tolts_info.fnp (k).exec_active then do;
2048 dmap = addr (tolts_info.fnp (k).dm_arg);
2049 fnp (k).dm_arg.version = dial_manager_arg_version_2;
2050 fnp (k).dm_arg.dial_qualifier = substr (fnp (k).exec_chan, 1, 22);
2051 tolts_info.fnp (k).dm_arg.dial_channel = tolts_info.dm_event;
2052 tolts_info.fnp (k).dm_arg.channel_name = fnp (k).exec_chan;
2053
2054 nr_cnt = 0;
2055 call dial_manager_$privileged_attach (dmap, code);
2056 if code ^= 0 then do;
2057 call convert_status_code_ (code, shortinfo, lginfo);
2058 call tolts_qttyio_$rs (0, "^as: ^a/ error attempting a priviledged_attatch of ^a",
2059 tolts_info.exec, lginfo, fnp (k).channel_name);
2060 call tolts_abort ("$c1");
2061 end;
2062
2063 tolts_info.wait_list.nchan = wait_list.nchan + 1;
2064 tolts_info.wait_event_id (tolts_info.wait_list.nchan) = tolts_info.dm_event;
2065 clt_sw = substr (fnp (k).exec_chan, 1, 6) || ".sw";
2066
2067 att_desc = "tty_ " || substr (fnp (k).exec_chan, 1, 6);
2068 colts_op_flags.colt_flag = "1"b;
2069 colts_op_flags.dm_attach = "1"b; ;
2070 fnp (k).exec_type_code = substr (mme_call_hw (1).lower, 13, 6);
2071 end;
2072 call return_plus (2);
2073 end;
2074 else do;
2075 call tolts_qttyio_$rs (0, "^as: MME GEROUT 07 - no outstanding GEROUT 05", exec);
2076 call tolts_abort ("$c9");
2077 end;
2078
2079
2080 gerout (15): if mme_call_hw (1).lower = "170000"b3 then call return_plus (3);
2081 k = bin (substr (mme_call_hw (1).lower, 15, 4));
2082 if substr (mme_call_hw (1).lower, 13, 3) = "4"b3 then call rel_exec_chan (k);
2083
2084 else call rel_tst_chan (k);
2085
2086 if mme_call_hf (2).lower ^= 0 then do;
2087 exec_wd (mme_call_hf (2).upper) = "000000000002"b3;
2088 call tolts_alm_util_$enter_ccc_req_ (addr (tolts_info.ccc_queue), mme_call_hw (2).lower || "000000"b3);
2089 end;
2090
2091 call return_plus (3);
2092
2093
2094
2095 gerout (16): k = bin (substr (mme_call_hw (1).lower, 15, 4));
2096 if substr (mme_call_hw (1).lower, 13, 1) = "1"b then
2097 exec_wd (mme_call_hf (2).upper) = "000000000004"b3;
2098 else exec_wd (mme_call_hf (2).upper) = colts_pages (k).status_word;
2099 call return_plus (3);
2100
2101
2102 %page;
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112 mme_typ (5): if trace then call tolts_qttyio_$rs (10, "^a MME GESNAP @ ^p", ctime (), mmep);
2113 if tolts_info.file_attach then
2114 call tolts_file_util_$snap (addrel (mmep, 1));
2115 call return_plus (2);
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125 mme_typ (17): if trace then call tolts_qttyio_$rs (10, "^a MME GETIME @ ^p", ctime (), mmep);
2126 call tolts_init_$gc_tod (spa.regs.q);
2127 spa.regs.a = tolts_info.gc_date;
2128 call return_plus (1);
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140 mme_typ (-16): if trace then call tolts_qttyio_$rs (10, "^a MME HUNGTM @ ^p", ctime (), mmep);
2141 call get_px_sct ("HUNGTM", bin (substr (spa.regs.a, 1, 18), 17), "1"b);
2142 if substr (spa.regs.a, 1, 18) = "0"b then do;
2143 call tolts_qttyio_$rs (0, "^a MME HUNGTM illegal test page index @ ^p", ctime (), mmep);
2144 call tolts_abort ("$b6");
2145 end;
2146 call tolts_init_$gc_tod (gcos_tod);
2147 if bin (gcos_tod, 36) >= io_info.con_time + io_info.lostit_time then do;
2148 spa.regs.x (1) = "000005"b3;
2149 exec_wd (io_info.status_add) = "510006000000"b3;
2150 call tolts_alm_util_$enter_ccc_req_ (addr (tolts_info.ccc_queue),
2151 string (io_info.icivlu));
2152 spa.regs.q = "0"b;
2153 end;
2154 else do;
2155 spa.regs.x (1) = "000003"b3;
2156 spa.regs.q = bit ((io_info.con_time + io_info.lostit_time) - bin (gcos_tod, 35, 0), 35);
2157 end;
2158 call return_plus (2);
2159 %page;
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169 mme_typ (-17): if trace then call tolts_qttyio_$rs (10, "^a MME IOCONS @ ^p", ctime (), mmep);
2170 call get_px_sct ("IOCONS", bin (spa.regs.x (1), 17), "1"b);
2171 spa.regs.a = bit (bin (pages (io_sel).num_connects, 36));
2172 call return_plus (1);
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184 mme_typ (-55): if trace then call tolts_qttyio_$rs (10, "^a MME IPCW. @ ^p", ctime (), mmep);
2185 if substr (spa.regs.x (1), 7, 1) then
2186 call get_px_tcx ("IPCW. ", substr (spa.regs.x (1), 8, 11));
2187 else call get_px_tcx ("IPCW. ", substr (spa.regs.x (1), 10, 9));
2188 pcwa = "0"b;
2189 pcwp = addr (pcwa);
2190 pcw.code = "111"b;
2191 pcw.mask = "1"b;
2192 pcw.control = "11"b;
2193 ioi_wksp = io_info.workspace_ptr;
2194 tio_off = fixed (rel (addr (tolts_workspace.p_idcw)));
2195 idcwp = addr (tolts_workspace.p_idcw);
2196 string (idcw) = "0"b;
2197 idcw.code = "7"b3;
2198 io_info.to_no_cc = "1"b;
2199 call ioi_$connect_pcw (io_info.device_index, tio_off, pcwa, error);
2200 if error ^= 0 then do;
2201 call output_status_code (error, "io connect error");
2202 call tolts_abort ("$m5");
2203 end;
2204 call return_plus (1);
2205 %page;
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216 mme_typ (-18): if trace then call tolts_qttyio_$rs (10, "^a MME LODIMG @ ^p", ctime (), mmep);
2217 call return_plus (1);
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229 mme_typ (-19): if trace then call tolts_qttyio_$rs (10, "^a MME LODVFC @ ^p", ctime (), mmep);
2230 call return_plus (1);
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241 mme_typ (-52): if trace then call tolts_qttyio_$rs (10, "^a MME LPW. @ ^p", ctime (), mmep);
2242 if substr (spa.regs.x (1), 7, 1) then
2243 call get_px_tcx ("LPW. ", substr (spa.regs.x (1), 8, 11));
2244 else call get_px_tcx ("LPW. ", substr (spa.regs.x (1), 10, 9));
2245 ioi_wksp = pages (io_sel).workspace_ptr;
2246 spa.regs.a = tolts_workspace.lpw (1);
2247 call return_plus (1);
2248
2249
2250
2251
2252 mme_typ (30):
2253 call return_plus (1);
2254
2255
2256
2257 %page;
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273 mme_typ (-90): if trace then call tolts_qttyio_$rs (10, "^a MME MBXCMP @ ^p", ctime (), mmep);
2274
2275 tolts_fpinfo_ptr = addrel (execp, spa.regs.x (5));
2276 do io_sel = 1 to hbound (pages, 1)
2277 while (pages (io_sel).fnp_num ^= tolts_fpinfo.pcw_info.fnp_num);
2278 end;
2279 if io_sel > hbound (pages, 1) then call tolts_abort ("$c3");
2280 io_info_ptr = addr (pages (io_sel));
2281 tolts_rspd_wksp = io_info.tolts_rspd_wksp;
2282 lvl_idx = (bin (substr (spa.regs.x (1), 13, 3)));
2283 ws_data_idx = (bin (substr (spa.regs.x (1), 16, 3)));
2284 sb_data_idx = (bin (substr (spa.regs.x (2), 16, 3)));
2285 if tolts_rspd_workspace.ima_level (lvl_idx).word (sb_data_idx)
2286 ^= tolts_rspd_workspace.ima_level (lvl_idx).word (ws_data_idx) then do;
2287 spa.regs.a = tolts_rspd_workspace.ima_level (lvl_idx).word (ws_data_idx);
2288 call return_plus (1);
2289 end;
2290 else call return_plus (2);
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356 mme_typ (-65): if trace then call tolts_qttyio_$rs (10, "^a MME MBXDAT ^p, type - ^6.3b", ctime (), mmep, spa.regs.x (2));
2357
2358 tolts_fpinfo_ptr = addrel (execp, spa.regs.x (1));
2359 do io_sel = 1 to hbound (pages, 1)
2360 while (pages (io_sel).fnp_num ^= tolts_fpinfo.pcw_info.fnp_num);
2361 end;
2362 if io_sel > hbound (pages, 1) then call tolts_abort ("$c3");
2363 io_info_ptr = addr (pages (io_sel));
2364 io_info.fpinfo_ptr = tolts_fpinfo_ptr;
2365 goto sub_cmnd (bin (spa.regs.x (2)));
2366
2367
2368 sub_cmnd (1):
2369
2370
2371 call tolts_device_info_ (addr (io_info.test_req), io_sel, t_err);
2372 if t_err ^= 0 then call tolts_abort ("$c4");
2373
2374
2375
2376 if ^io_info.ev_ch_ass then do;
2377 call tolts_init_$cr_event_chan (io_info.status_event,
2378 "1"b, tolts_io_int_, io_info_ptr, 2, error);
2379 if error ^= 0 then
2380 call tolts_abort ("$a9");
2381 io_info.ev_ch_ass = "1"b;
2382 end;
2383 call ioa_$rsnnl ("T&D is attaching for a ^[write^]^[read^] ^a",
2384 att_desc, mesg_len, (^rd_flag), (rd_flag), io_info.device_name);
2385 call rcp_$attach (io_info.rcp_name, addr (io_info.rcp_area (1)), io_info.status_event,
2386 att_desc, io_info.rcp_id, error);
2387
2388 if error ^= 0 then do;
2389 call output_status_code (error, "rcp attach error");
2390 call dealcp_sub;
2391 call tolts_abort ("$c5");
2392 end;
2393
2394 call rcp_$check_attach (io_info.rcp_id, addr (io_info.rcp_area (1)), coment, io_info.device_index,
2395 tolts_info.max_wks_sz, tolts_info.max_to, io_info.rcp_state, io_info.attach_err);
2396 if io_info.attach_err ^= 0
2397 | io_info.rcp_state ^= 0 then do;
2398 if io_info.attach_err ^= 0 then
2399 call output_status_code (io_info.attach_err, "workspace assign error");
2400 call dealcp_sub;
2401 call tolts_abort ("$c6");
2402 end;
2403 io_info.p_att = "1"b;
2404 io_info.tolts_rspd_wksp = addr (tolts_rspd_workspace);
2405 call ioi_$workspace (io_info.device_index, io_info.tolts_rspd_wksp, tolts_info.wks_sz, error);
2406 if error ^= 0 then do;
2407 call output_status_code (error, "workspace assign error");
2408 call dealcp_sub;
2409 call tolts_abort ("$c6");
2410 end;
2411 io_info.cur_wks_sz = tolts_info.wks_sz;
2412 call ioi_$set_status (io_info.device_index, fixed (rel (addr (tolts_rspd_workspace.mailbox.status_word)), 18), 1, error);
2413
2414 tolts_fpinfo.mbxloc = 0;
2415 spa.regs.q = "0"b;
2416 tolts_fpinfo.partrs = -1;
2417
2418 call return_plus (4);
2419
2420
2421 sub_cmnd (2):
2422
2423 tolts_rspd_wksp = io_info.tolts_rspd_wksp;
2424 unspec (tolts_rspd_workspace.num_int) = "0"b;
2425
2426 call return_plus (4);
2427
2428
2429 sub_cmnd (3):
2430
2431 tolts_rspd_wksp = io_info.tolts_rspd_wksp;
2432 spa.regs.a = unspec (tolts_rspd_workspace.mailbox.pcw);
2433
2434 call return_plus (4);
2435
2436 sub_cmnd (6):
2437
2438 tolts_rspd_wksp = io_info.tolts_rspd_wksp;
2439 unspec (tolts_fpinfo.temp03.word1) = unspec (tolts_rspd_workspace.mailbox.num_int);
2440
2441 call return_plus (4);
2442
2443 sub_cmnd (7):
2444
2445 tolts_rspd_wksp = io_info.tolts_rspd_wksp;
2446 unspec (tolts_fpinfo.temp03.word2) = unspec (tolts_rspd_workspace.mailbox.num_int);
2447 unspec (tolts_rspd_workspace.mailbox.num_int) = "0"b;
2448
2449 call return_plus (4);
2450
2451 sub_cmnd (11):
2452
2453 tolts_rspd_wksp = io_info.tolts_rspd_wksp;
2454 k = bin (substr (tolts_fpinfo.temp03.word1.upper, 13, 3));
2455 unspec (tolts_rspd_workspace.ima_level (k)) = "0"b;
2456 do i = 1 to bin (tolts_fpinfo.temp02.word1.upper);
2457 ima_level (k).word (i) = spa.regs.a;
2458 end;
2459
2460 call return_plus (4);
2461
2462 %page;
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484 dcl 1 chan_list aligned based (clp),
2485 (2 base_chan fixed bin (9) uns,
2486 2 num_chans fixed bin (9) uns,
2487 2 flags,
2488 3 reboot bit (1),
2489 3 pad bit (17)) unaligned;
2490 dcl clp ptr;
2491 dcl p99 pic "99" based;
2492
2493
2494 mme_typ (-87): if trace then call tolts_qttyio_$rs (10, "^a MME PACMAN @ ^p", ctime (), mmep);
2495
2496 if substr (spa.regs.q, 7, 1) then
2497 call get_px_tcx ("PACMAN", substr (spa.regs.q, 8, 11));
2498 else call get_px_tcx ("PACMAN", substr (spa.regs.q, 10, 9));
2499 clp = addrel (execp, fixed (spa.regs.x (2)));
2500 if spa.regs.a = "0"b then do;
2501 if io_info.ipc_attached then do;
2502 call mca_$detach_ipc ((io_info.ipc_id), io_info.mca_ioi_idx, "0"b, code);
2503 call tolts_qttyio_$rs (0, "^a ipc was still attached will detach leaving the device suspended", io_info.ipc_id);
2504 end;
2505 io_info.ipc_id = substr (io_info.device_name, 4, 1) || convert (p99, (chan_list.base_chan));
2506 call mca_$attach_ipc ((io_info.ipc_id), io_info.mca_ioi_idx, io_info.ipc_number, code);
2507 if code ^= 0 then do;
2508 if code = error_table_$resource_unavailable then do;
2509 spa.regs.x (2) = bit (dev_busy);
2510 call tolts_qttyio_$rs (0, "^a ipc ^a busy", io_info.test_hdr, io_info.ipc_id);
2511 call return_plus (1);
2512 end;
2513 else do;
2514 call output_status_code (code, "ipc attach error");
2515 spa.regs.x (2) = bit (os_deny);
2516 call return_plus (1);
2517 end;
2518 end;
2519 io_info.ipc_attached = "1"b;
2520 end;
2521 else if io_info.ipc_attached then do;
2522 call mca_$detach_ipc ((io_info.ipc_id), io_info.mca_ioi_idx,
2523 chan_list.flags.reboot, code);
2524 if code ^= 0 then call tolts_abort ("$p2");
2525 else io_info.ipc_attached = "0"b;
2526 end;
2527 call return_plus (4);
2528
2529
2530 %page;
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564 mme_typ (-20): if trace then call tolts_qttyio_$rs (10, "^a MME POINIT @ ^p", ctime (), mmep);
2565 exec_wd (mme_call_hf (1).upper) = "0"b;
2566 if mme_call_hf (1).lower ^= 0 then
2567 exec_wd (mme_call_hf (1).lower) = "000000000002"b3;
2568 exec_wd (mme_call_hf (3).upper) = "122436506274"b3;
2569 iom_cardp = null;
2570 term = "0"b;
2571 do while (^term);
2572 call tolts_util_$find_card ("iom ", iom_cardp);
2573 if iom_cardp = null then term = "1"b;
2574 else do;
2575 if iom_card.model = "imu " then imu_found = "1"b;
2576 else if iom_card.model = "iom" then iom_found = "1"b;
2577 end;
2578 end;
2579
2580 if imu_found then
2581 exec_wd (mme_call_hf (4).upper) = "777777000000"b3;
2582 else if iom_found then
2583 exec_wd (mme_call_hf (4).upper) = "777777777777"b3;
2584 else exec_wd (mme_call_hf (4).upper) = "0"b3;
2585
2586 spa.wrapup_add = mme_call_hw (5).upper;
2587 call tolts_alm_util_$ascii_to_bcd_ (ttl_date, bcd_callname);
2588 exec_wd (mme_call_hf (7).upper) = bcd_callname;
2589 substr (exec_wd (mme_call_hf (7).upper - 1), 19, 18) = "622017"b3;
2590 genp = addrel (execp, mme_call_hf (2).upper);
2591 if exec = "molt" then do;
2592 if fix_wd (1) ^= 0 then
2593 mem_now, fix_wd (1) = fix_wd (1) + 196608;
2594 else mem_now, fix_wd (1) = fixed (gload_data.text_len) + 196608;
2595 end;
2596 else do;
2597 if fix_wd (1) ^= 0 then
2598 mem_now, fix_wd (1) = fix_wd (1) + 32768;
2599 else mem_now, fix_wd (1) = fixed (gload_data.text_len) + 32768;
2600 end;
2601 call cpu_time_and_paging_ (i, cpu_time, j);
2602 tolts_info.init_time = cpu_time;
2603 call return_plus (10);
2604 %page;
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614 mme_typ (-21): if trace then call tolts_qttyio_$rs (10, "^a MME PROCTM @ ^p", ctime (), mmep);
2615 call cpu_time_and_paging_ (i, cpu_time, j);
2616 cpu_time = cpu_time - tolts_info.init_time;
2617 spa.regs.a = bit (bin (divide (cpu_time * 64, 1000, 71, 0), 36));
2618 call return_plus (1);
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631 mme_typ (-22): if trace then call tolts_qttyio_$rs (10, "^a MME PRTRAN @ ^p", ctime (), mmep);
2632 call get_px_sct ("PRTRAN", bin (spa.regs.x (1), 17), "1"b);
2633 do i = 1 to printer_images_$n_images while (io_info.devsct.ptrain ^= printer_images_$image_numbers (i));
2634 end;
2635 if i > printer_images_$n_images then do;
2636 call tolts_qttyio_$rs (0, "^as: MME PRTRAN; No such train number - ^d",
2637 exec, io_info.devsct.ptrain);
2638 call tolts_abort ("$b1");
2639 end;
2640 tp = addrel (addr (printer_images_$image_base), printer_images_$image_offsets (i));
2641 train_ptr = addrel (execp, mme_call_hf (1).upper);
2642 train_ptr -> prt_image = tp -> prt_image;
2643 call return_plus (3);
2644 %page;
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657 dcl 1 opt_temp based (genp) aligned,
2658 (2 bcd_o_dash bit (18),
2659 2 tdpcn_add fixed bin,
2660 2 bufnum fixed bin,
2661 2 nu1 bit (6),
2662 2 exec_num bit (6),
2663 2 nu2 bit (6),
2664 2 opt_ptr fixed bin,
2665 2 nu3 bit (6),
2666 2 phy_term bit (12)) unaligned;
2667
2668 dcl bcd_options bit (6 * 84) based (genp);
2669
2670 mme_typ (-24): if trace then call tolts_qttyio_$rs (10, "^a MME READIO @ ^p", ctime (), mmep);
2671 genp = addrel (execp, spa.regs.x (4));
2672 i = opt_temp.bufnum;
2673 tolts_info.tadio (i).inuse = "0"b;
2674 genp = addrel (execp, opt_temp.opt_ptr);
2675 bcd_options = tolts_info.tadio (i).option;
2676 call return_plus (3);
2677 %page;
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698 mme_typ (-56): if trace then call tolts_qttyio_$rs (10, "^a MME RELEAS @ ^p", ctime (), mmep);
2699 if spa.regs.x (7) ^= "0"b then
2700 if substr (spa.regs.x (7), 1, 6) = "23"b3 then do;
2701 call get_px_sct ("RELEAS", bin (spa.regs.x (1), 17), "1"b);
2702 if io_info.chan_suspended then do;
2703 call tolts_load_firmware_ (io_sel, error);
2704 if error ^= 0 then
2705 call ck_release;
2706 end;
2707 end;
2708 call return_plus (2);
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719 mme_typ (-26): if trace then call tolts_qttyio_$rs (10, "^a MME RLSMPC @ ^p", ctime (), mmep);
2720 call return_plus (1);
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731 mme_typ (-28): if trace then call tolts_qttyio_$rs (10, "^a MME RLSPAT @ ^p", ctime (), mmep);
2732 call return_plus (1);
2733 %page;
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747 mme_typ (-91): if trace then call tolts_qttyio_$rs (10, "^a MME RSPCHK @ ^p", ctime (), mmep);
2748
2749 tolts_fpinfo_ptr = addrel (execp, spa.regs.x (1));
2750 do io_sel = 1 to hbound (pages, 1)
2751 while (pages (io_sel).fnp_num ^= tolts_fpinfo.pcw_info.fnp_num);
2752 end;
2753 if io_sel > hbound (pages, 1) then call tolts_abort ("$c3");
2754 io_info_ptr = addr (pages (io_sel));
2755 tolts_rspd_wksp = io_info.tolts_rspd_wksp;
2756 call tolts_init_$gc_tod (gcos_tod);
2757 if tolts_rspd_workspace.mailbox.status_word ^= "0"b then do;
2758 if tolts_fpinfo.io_rq_cnt > 0 then
2759 tolts_fpinfo.io_rq_cnt = tolts_fpinfo.io_rq_cnt - 1;
2760 if substr (tolts_rspd_workspace.status_word, 4, 1) = "1"b
2761 | bin (tolts_fpinfo.timeout_time) - bin (gcos_tod) < 1 then
2762 call return_plus (2);
2763 else do;
2764 spa.regs.q = tolts_rspd_workspace.status_word;
2765 call return_plus (1);
2766 end;
2767 end;
2768 else do;
2769 tolts_fpinfo.spec_cnt =
2770 tolts_rspd_workspace.mailbox.num_int.lvl7;
2771 tolts_fpinfo.term_cnt =
2772 tolts_rspd_workspace.mailbox.num_int.lvl3;
2773 tolts_fpinfo.lvl3_cnt =
2774 tolts_fpinfo.term_cnt - bin (unspec (tolts_fpinfo.temp01.word2));
2775 tolts_fpinfo.lvl7_cnt =
2776 tolts_fpinfo.spec_cnt - bin (unspec (tolts_fpinfo.temp01.word1));
2777 if (tolts_fpinfo.lvl3_cnt = 0 & tolts_fpinfo.lvl3_flag)
2778 | (tolts_fpinfo.lvl7_cnt = 0 & tolts_fpinfo.lvl7_flag)
2779 & (bin (tolts_fpinfo.timeout_time) < 0) then
2780 call return_plus (3);
2781 else do;
2782 if tolts_fpinfo.io_rq_cnt > 0 then
2783 tolts_fpinfo.io_rq_cnt = tolts_fpinfo.io_rq_cnt - 1;
2784 if (tolts_fpinfo.lvl3_cnt = 1 | ^tolts_fpinfo.lvl3_flag)
2785 & (tolts_fpinfo.lvl7_cnt = 1 | ^tolts_fpinfo.lvl7_flag) then
2786 call return_plus (4);
2787 end;
2788 end;
2789
2790 %page;
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805 mme_typ (-29): if trace then call tolts_qttyio_$rs (10, "^a MME SCTCMP @ ^p", ctime (), mmep);
2806 do i = 1 to 8 while (pages (i).in_use);
2807 end;
2808 if i = 8 & pages (8).in_use then do;
2809 call tolts_qttyio_$rs (0, "^a: MME SCTCMP; No vacant test page slot found", exec);
2810 call tolts_abort ("$a1");
2811 end;
2812 unspec (pages (i)) = "0"b;
2813 call set_sctwrk (i);
2814 if spa.regs.x (2) ^= "0"b then do;
2815 if fixed (spa.regs.x (2)) = m_iv_iom then
2816 spa.regs.x (2) = "0"b;
2817 call return_plus (5);
2818 end;
2819 pages (i).in_use = "1"b;
2820 tolts_info.exec_page_count = tolts_info.exec_page_count + 1;
2821 if pages (i).io_type = polt_io_type then
2822 itr_run = "1"b;
2823 call return_plus (4);
2824 %page;
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836 mme_typ (-30):
2837 mme_typ (-31): if trace then call tolts_qttyio_$rs (10, "^a MME SET^[PRT^;PR2^] @ ^p", ctime (), (mme_number = -33), mmep);
2838 if ^tolts_info.file_attach then do;
2839 call tolts_file_util_$open (error);
2840 if error = 0 then
2841 call return_plus (5);
2842 end;
2843 call return_plus (3);
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857 mme_typ (-32): if trace then call tolts_qttyio_$rs (10, "^a MME SETPUN @ ^p", ctime (), mmep);
2858 call get_px_sct ("SETPUN", bin (spa.regs.x (1), 17), "0"b);
2859 io_info.ccu_pun = "1"b;
2860 call return_plus (1);
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871 mme_typ (-11):
2872 mme_typ (-33): if trace then call tolts_qttyio_$rs (10, "^a MME ^[SETTYP^;DISPRT^] @ ^p", ctime (), (mme_number = -33), mmep);
2873 if tolts_info.file_attach then
2874 call tolts_file_util_$close;
2875 call return_plus (3);
2876 %page;
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899 mme_typ (-34): if trace then call tolts_qttyio_$rs (10, "^a MME TADIOD @ ^p", ctime (), mmep);
2900 ndcws = mme_call_hf (1).upper;
2901 if ndcws < 1 | ndcws > 5 then do;
2902 call tolts_qttyio_$rs (0, "^as: MME TADIOD; Number of dcws = ^d", exec, ndcws);
2903 call tolts_abort ("$b2");
2904 end;
2905 do i = 1 to 8 while (tolts_info.tadio (i).inuse);
2906 end;
2907 if i = 8 & tolts_info.tadio (8).inuse then do;
2908 call tolts_qttyio_$rs (0, "^as: MME TADIOD; No vacant queue entry", exec);
2909 call tolts_abort ("$b2");
2910 end;
2911 tolts_info.tadio (i).inuse = "1"b;
2912 tolts_info.tadio (i).return_word (3) = "000000006361"b3;
2913 tolts_info.tadio (i).return_word (2) = bit (bin (i, 18)) || "000000"b3;
2914 if substr (mme_call_w (2), 20, 1) = "1"b then do;
2915 tolts_info.tadio (i).optrd = "1"b;
2916 tolts_info.tadio (i).return_word (1) = "204652"b3 || substr (spa.regs.a, 1, 18);
2917 pad_char = substr (spa.regs.a, 19, 6);
2918 do j = 0 to 83;
2919 substr (tolts_info.tadio (i).option, (j * 6) + 1, 6) = pad_char;
2920 end;
2921 end;
2922 else do;
2923 tolts_info.tadio (i).optrd = "0"b;
2924 tolts_info.tadio (i).return_word (1) = "206252"b3 || substr (spa.regs.a, 1, 18);
2925 end;
2926 call tolts_qttyio_$dcw_ptr (addrel (mmep, 2), ndcws, i);
2927 spa.enter.icivlu.ic = rel (addr (mme_call_w (5 + ndcws)));
2928 call wake_disp;
2929 %page;
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943 mme_typ (-36): ioe_ptr = addrel (execp, mme_call_hf (1).upper);
2944 if trace then do;
2945 call tolts_qttyio_$rs (10, "^a MME TDIO @ ^p", ctime (), mmep);
2946 call ioa_$rsnnl ("^/io_entry:^-^4(^12.3b ^)^/^-^4(^12.3b ^)^/^-^3(^12.3b ^)",
2947 message, mesg_len, ioe, ioe (5), ioe (9));
2948 call tolts_qttyio_ (message, 10);
2949 end;
2950 if trace_io then do;
2951 call tolts_qttyio_$rs (10, "^a MME TDIO @ ^p", ctime (), mmep);
2952 call ioa_$rsnnl ("^/io_entry:^-^4(^12.3b ^)^/^-^4(^12.3b ^)^/^-^3(^12.3b ^)",
2953 message, mesg_len, ioe, ioe (5), ioe (9));
2954 call tolts_qttyio_ (message, 10);
2955 tio = tio + 1;
2956 call tolts_qttyio_$rs (10, " MME TDIO = ^b @ ^a", tio, ctime ());
2957 end;
2958 call get_px_sct ("TDIO ", bin (io_entry.sct_add, 17), "1"b);
2959 if io_info.io_type = mca_io_type then call mca_io_setup;
2960 else call io_setup;
2961 if io_info.suspend_chan then do;
2962 call ioi_$suspend_devices (io_info.device_index, error);
2963 if error ^= 0 then do;
2964 call output_status_code (error, "suspend devices error");
2965 call tolts_alm_util_$enter_ccc_req_ (addr (tolts_info.ccc_queue),
2966 string (io_info.icivlu));
2967 io_info.suspend_chan = "0"b;
2968 io_info.io_in_progress = "0"b;
2969 if tolts_info.gewake_active then do;
2970 call timer_manager_$reset_alarm_wakeup (tolts_info.gewake_event);
2971 call ipc_$drain_chn (tolts_info.gewake_event, error);
2972 tolts_info.gewake_active = "0"b;
2973 end;
2974
2975 call tolts_abort ("$b5");
2976 end;
2977 io_info.chan_suspended = "1"b;
2978 end;
2979 if io_info.io_type = mca_io_type then do;
2980 if io_entry.prim.dev_cmd = "40"b3 then
2981 call mca_$reset (io_info.mca_ioi_idx, "0"b, error);
2982 else if io_entry.prim.dev_cmd = "15"b3 then
2983 call mca_$tandd_write_data (io_info.mca_ioi_idx,
2984 io_info.workspace_ptr, io_block_len, "0"b, error);
2985 else if io_entry.prim.dev_cmd = "13"b3 then
2986 call mca_$tandd_write_text (io_info.mca_ioi_idx,
2987 io_info.workspace_ptr, io_block_len, "0"b, error);
2988 else if io_entry.prim.dev_cmd = "03"b3 then
2989 call mca_$tandd_read_data (io_info.mca_ioi_idx,
2990 io_info.workspace_ptr, io_block_len, "0"b, error);
2991 else error = error_table_$bad_command_name;
2992 end;
2993 else call ioi_$connect_pcw (io_info.device_index, tio_off, pcwa, error);
2994 if error ^= 0 then do;
2995 call output_status_code (error, "doing io for a tdio");
2996 call tolts_alm_util_$enter_ccc_req_ (addr (tolts_info.ccc_queue),
2997 string (io_info.icivlu));
2998 io_info.io_in_progress = "0"b;
2999 if tolts_info.gewake_active then do;
3000 call timer_manager_$reset_alarm_wakeup (tolts_info.gewake_event);
3001 call ipc_$drain_chn (tolts_info.gewake_event, error);
3002 tolts_info.gewake_active = "0"b;
3003 end;
3004
3005 call tolts_abort ("$b5");
3006 end;
3007 call tolts_init_$gc_tod (spa.regs.a);
3008 io_info.con_time = bin (spa.regs.a, 35);
3009 spa.regs.q = bit (bin (io_info.lostit_time, 36));
3010 spa.regs.x (4) = bit (bin (io_sel * 4, 18));
3011 tolts_info.glob_int_cnt = tolts_info.glob_int_cnt + 1;
3012 call return_plus (5);
3013 %page;
3014
3015
3016
3017
3018
3019
3020
3021 mme_typ (-35): if trace then call tolts_qttyio_$rs (10, "^a MME TERMIN @ ^p", ctime (), mmep);
3022 term = "1"b;
3023 go to term_lbl;
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033 mme_typ (-88):
3034 if ^debugging then call return_plus (1);
3035 call probe (mtdsim_);
3036 exec_wd (db_addr) = db_sv_wd;
3037 tolts_info.mult_ans = "";
3038 call tolts_qttyio_$rs (19, "tolts_debugger: enter break point address");
3039 call message_wait;
3040 if mult_ans ^= "" then do;
3041 db_addr = cv_oct_check_ ((rtrim (mult_ans)), code);
3042 db_sv_wd = exec_wd (db_addr);
3043 exec_wd (db_addr) = "777650001000"b3;
3044 end;
3045 call return_plus (0);
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056 mme_typ (-37): if trace then call tolts_qttyio_$rs (10, "^a MME TOLDIS @ ^p", ctime (), mmep);
3057 call return_plus (3);
3058
3059
3060
3061
3062
3063
3064 mme_typ (-38): if trace then call tolts_qttyio_$rs (10, "^a MME TOLGON @ ^p", ctime (), mmep);
3065 call return_plus (1);
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078 mme_typ (-39): if trace then call tolts_qttyio_$rs (10, "^a MME TOLTIN @ ^p", ctime (), mmep);
3079
3080 wake_time = divide (fixed (spa.regs.q) * 1000, 64, 71, 0);
3081 call timer_manager_$alarm_wakeup (wake_time, "10"b, tolts_info.gewake_event);
3082 tolts_info.gewake_active = "1"b;
3083 spa.enter.icivlu.ic = rel (addr (mme_call_w (2)));
3084 go to blk_lbl;
3085 %page;
3086
3087
3088
3089
3090
3091
3092
3093
3094 mme_typ (-40): if trace then call tolts_qttyio_$rs (10, "^a MME TRACIO @ ^p", ctime (), mmep);
3095 call return_plus (2);
3096
3097
3098
3099
3100
3101
3102
3103
3104 mme_typ (-54): if trace then call tolts_qttyio_$rs (10, "^a MME UNFREZ @ ^p", ctime (), mmep);
3105 call return_plus (1);
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119 mme_typ (-42): if trace then call tolts_qttyio_$rs (10, "^a MME WRDUMP @ ^p", ctime (), mmep);
3120 if tolts_info.file_attach then do;
3121 call tolts_file_util_$wdump (addr (spa.regs));
3122 call tolts_file_util_$close;
3123 end;
3124 else call tolts_qttyio_$rcw (addr (spa.regs.a));
3125 call return_plus (1);
3126 %page;
3127 mme_typ (-60): mme_typ (-58): mme_typ (-57):
3128 mme_typ (-49): mme_typ (-48): mme_typ (-47): mme_typ (-46): mme_typ (-45):
3129 mme_typ (-44): mme_typ (-43): mme_typ (-41): mme_typ (-27): mme_typ (-23): mme_typ (-10):
3130 mme_typ (-25): mme_typ (-15): mme_typ (-14):
3131 mme_typ (-3): mme_typ (0): mme_typ (3): mme_typ (4): mme_typ (6): mme_typ (7):
3132 mme_typ (8): mme_typ (10): mme_typ (11): mme_typ (12): mme_typ (13): mme_typ (16):
3133 mme_typ (19): mme_typ (20): mme_typ (22): mme_typ (23): mme_typ (25):
3134 mme_typ (26): mme_typ (27): mme_typ (28): mme_typ (29):
3135 undefm:
3136
3137 in_ccc = "0"b;
3138 call tolts_qttyio_$rs (0, "^as: Improper MME @ ^p; MME type - ^d; Instruction - ^12.3b",
3139 exec, mmep, mme_call_hf (0).upper, mme_call_w (0));
3140 call tolts_abort ("$b6");
3141
3142
3143
3144 epilogue: entry;
3145
3146 if tolts_active then do;
3147 tolts_info.finish_cond = "1"b;
3148 call hcs_$get_ips_mask (old_mask);
3149 new_mask = old_mask | sys_info$alrm_mask;
3150 call hcs_$set_ips_mask (new_mask, new_mask);
3151 call clean_up;
3152 call hcs_$set_ips_mask (old_mask, old_mask);
3153 end;
3154 return;
3155 %page;
3156
3157
3158
3159 return_plus: proc (ic_inc);
3160
3161 dcl ic_inc fixed bin;
3162
3163 spa.enter.icivlu.ic = rel (addr (mme_call_w (ic_inc)));
3164
3165
3166
3167
3168
3169
3170 wake_disp: entry;
3171
3172 if (tolts_info.term_io_req_cnt = 0 & tolts_info.glob_int_cnt = 0
3173 & ^tolts_info.exec_term_io_wait & ^colts_op_flags.colt_flag) then
3174 go to no_blk;
3175
3176 call hcs_$wakeup (tolts_info.process, tolts_info.wait_list.wait_event_id (1), null, error);
3177 if error ^= 0 then do;
3178 call com_err_ (error, exec, "***fatal error, terminating process");
3179 fatal_desc.version = 0;
3180 fatal_desc.fatal_code = error;
3181 if ^debugging then
3182 call terminate_process_ ("fatal_error", addr (fatal_desc));
3183 else signal tolts_error_;
3184 end;
3185 go to blk_lbl;
3186
3187 end return_plus;
3188
3189
3190
3191
3192
3193
3194
3195
3196 fault_dump: proc;
3197 flt_flag = "1"b;
3198 if ^tolts_info.file_attach then
3199 call tolts_file_util_$open (error);
3200 if error ^= 0 then do;
3201 call com_err_ (error, exec, "encountered an error while attempting to open a point file for ^a", error);
3202 call tolts_abort ("$t1");
3203 end;
3204 if debugging then call probe (mtdsim_);
3205 if tolts_info.file_attach then do;
3206 call display_mc;
3207 call tolts_file_util_$wdump (execp);
3208 call tolts_file_util_$close;
3209
3210 in_ccc = "0"b;
3211 call tolts_abort ("$t2");
3212 end;
3213 end fault_dump;
3214
3215
3216
3217
3218
3219 tolts_abort: proc (a_code);
3220
3221 dcl a_code char (3);
3222 dcl tfc bit (18);
3223
3224 call tolts_alm_util_$ascii_to_bcd_ (a_code, tfc);
3225 spa.abort.code = tfc;
3226 if scup = null then
3227 spa.abort.add = "0"b;
3228 else
3229 spa.abort.add = scu.ilc;
3230 if spa.wrapup_add = "0"b
3231 | flt_flag then do;
3232 call clean_up;
3233 term = "1"b;
3234 go to term_lbl;
3235 end;
3236 spa.enter.icivlu.ic = spa.wrapup_add;
3237 call wake_disp;
3238
3239 end tolts_abort;
3240
3241
3242
3243 display_mc: proc;
3244
3245 dcl cu_$stack_frame_ptr entry (ptr);
3246 dcl dump_machine_cond_ entry (ptr, ptr, char (32) aligned, fixed bin);
3247 dcl find_condition_frame_ entry (ptr) returns (ptr);
3248 dcl find_condition_info_ entry (ptr, ptr, fixed bin (35));
3249 dcl hran_$hranl entry (ptr, ptr, bit (1));
3250 dcl ioa_ entry () options (variable);
3251 dcl ioa_$ioa_switch entry () options (variable);
3252 dcl (faultsp, hreg_ptr, stackp) ptr;
3253 dcl code fixed bin (35);
3254
3255
3256 call cu_$stack_frame_ptr (stackp);
3257 faultsp = find_condition_frame_ (stackp);
3258 if faultsp = null () then do;
3259 call ioa_ ("^a: Cannot find condition frame.", "exec_name");
3260 return;
3261 end;
3262
3263 call find_condition_info_ (faultsp, addr (ci), code);
3264 if ci.mc_ptr = null () then do;
3265 call ioa_ ("^a: Cannot find condition frame.", "exec_name");
3266 return;
3267 end;
3268
3269
3270 call ioa_$ioa_switch (tolts_info.pf_iocbp, "^/MACHINE CONDITIONS AT ^p:^/", ci.mc_ptr);
3271 call dump_machine_cond_ (addr (ci), faultsp, "err_file", 2);
3272
3273 HREGS:
3274 if mcptr ^= null then hreg_ptr = addrel (mcptr, 96);
3275 if hreg_ptr = null then do;
3276 call ioa_$ioa_switch (tolts_info.pf_iocbp, "History Registers are not available");
3277 return;
3278 end;
3279 else do;
3280 call ioa_$ioa_switch (tolts_info.pf_iocbp, "CPU HISTORY REGISTERS AT TIME OF FAULT");
3281 call hran_$hranl (hreg_ptr, tolts_info.pf_iocbp, "0"b);
3282 end;
3283
3284 return;
3285 end display_mc;
3286
3287
3288 %page;
3289
3290
3291
3292 set_sctwrk: proc (px);
3293
3294 dcl px fixed bin;
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312 genp = addrel (execp, mme_call_hf (2).upper);
3313 spa.regs.x (2), sctwrk = "0"b;
3314 t_err = 0;
3315 call tolts_device_info_ (addrel (execp, mme_call_hf (1).upper), px, t_err);
3316 spa.regs.x (2) = bit (bin (t_err, 18));
3317 substr (sctwrk (2), 19, 6) = pages (px).devsct.type_code;
3318 if ^pages (px).devsct.com_prph then do;
3319 pages (px).sct_info.cntsct = bit (bin (px * 4 + 1024, 18));
3320 sctwrk (3) = unspec (pages (px).sct_info);
3321 substr (sctwrk (4), 1, 18) = bit (bin (px * 4 + 1024, 18));
3322 end;
3323 sctwrk (5) = unspec (pages (px).crcst);
3324 sctwrk (6) = unspec (pages (px).crcst);
3325 sctwrk (9) = unspec (pages (px).devsct.w1);
3326 sctwrk (10) = unspec (pages (px).devsct.w2);
3327 substr (sctwrk (1), 1, 18) = bit (bin (px * 4, 18));
3328
3329
3330
3331 if (pages (px).alt_dev_flag) then do;
3332 sctwrk (11) = unspec (pages (px).altsct.w1);
3333 sctwrk (12) = unspec (pages (px).altsct.w2);
3334 substr (sctwrk (2), 1, 18) = bit (bin (px * 4 + 512, 18));
3335 end;
3336
3337 end set_sctwrk;
3338 %page;
3339
3340
3341
3342 mca_io_setup: proc;
3343
3344
3345 dcwp = addrel (execp, dcw_ptr);
3346 mca_work_space_ptr = io_info.workspace_ptr;
3347 unspec (mca_work_space) = "0"b;
3348 c_len = 4;
3349 mvp = addrel (execp, dcw_ptr - 1);
3350 bufp = addr (mca_work_space.list_of_dcw);
3351 workspace_move = mvp -> workspace_move;
3352 bufp = addr (io_info.dcw_list);
3353 workspace_move = mvp -> workspace_move;
3354 if dcw.tally = "0"b3 then c_len = 4096;
3355 else c_len = bin (dcw.tally);
3356 io_block_len = c_len + 4096 + 2;
3357 mvp = addrel (execp, dcw.address);
3358 bufp = addr (mca_work_space.data_header_1);
3359 workspace_move = mvp -> workspace_move;
3360 data_size_1 = fixed (data_header_1.dest_len_msb || data_header_1.dest_len_lsb, 16);
3361 io_info.icivlu.ic = io_entry.ccc_p;
3362 io_info.icivlu.ind = "0"b;
3363 io_info.status_add = fixed (io_entry.stat_p);
3364 exec_wd (io_info.status_add) = "0"b;
3365 exec_wd (io_info.status_add + 1) = "0"b;
3366 io_info.pcwa = pcwa;
3367 io_info.tio_off = 0;
3368 io_info.rew_wait = "0"b;
3369 io_info.io_in_progress = "1"b;
3370 io_info.num_connects = io_info.num_connects + 1;
3371 io_info.int_time = 0;
3372
3373 end mca_io_setup;
3374
3375
3376
3377
3378
3379
3380
3381 io_setup: proc;
3382
3383 dcl (continue, first, idcw_io) bit (1);
3384 dcl (cbuf_add, lstloc, nxtloc) fixed bin;
3385 dcl dcwb fixed bin (18) uns;
3386
3387 ioi_wksp = io_info.workspace_ptr;
3388 continue = "0"b;
3389 unspec (wks_init) = "0"b;
3390 tolts_workspace.l_pad.e = "525252525252"b3;
3391 tolts_workspace.l_pad.o = "525252525252"b3;
3392 tio_off = fixed (rel (addr (tolts_workspace.p_idcw)));
3393 idcwp = addr (tolts_workspace.p_idcw);
3394 idcw.code = "7"b3;
3395 if io_entry.prim.io_cmd = "40"b3
3396 | io_entry.prim.io_cmd = "24"b3
3397 & io_info.io_type = mhp_io_type then do;
3398 idcw_io = "1"b;
3399 idcw.command = io_entry.prim.dev_cmd;
3400 if (idcw.command = "31"b3 & io_info.chan_suspended)
3401 | io_entry.prim.dev ^= "00"b3 then
3402 idcw.chan_cmd = "00"b3;
3403 else if io_entry.prim.io_cmd = "24"b3
3404 & io_info.io_type = mhp_io_type then
3405 idcw.chan_cmd = "00"b3;
3406 else if io_info.io_type = mtar_io_type then
3407 idcw.chan_cmd = "00"b3;
3408 else idcw.chan_cmd = "40"b3;
3409 idcw.count = io_entry.prim.record_count;
3410 if idcw.count ^= "00"b3 & idcw.count ^= "01"b3 then do;
3411 idcw.control = "10"b;
3412 continue = "1"b;
3413 end;
3414 if idcw.command = "00"b3 then
3415 io_info.suspend_chan = "1"b;
3416 if idcw.command = "20"b3 then
3417 io_info.release_chan = "1"b;
3418 end; note
3419 else do;
3420 idcw_io = "0"b;
3421 idcw.command = io_entry.second.dev_cmd;
3422 idcw.chan_cmd = io_entry.second.io_cmd;
3423 idcw.count = io_entry.second.record_count;
3424 if io_info.io_type = itr_io_type
3425 then io_info.suspend_chan = "0"b;
3426 if io_entry.prim.dev_cmd ^= io_entry.second.dev_cmd then do;
3427 idcwp = addr (tolts_workspace.seek_idcw);
3428 idcw.command = io_entry.prim.dev_cmd;
3429 if bin (io_entry.sct_add, 13) >= 512
3430 then idcw.device = io_info.altsct.device_no;
3431 else idcw.device = io_info.devsct.device_no;
3432 idcw.code = "7"b3;
3433 idcw.control = "10"b;
3434 idcw.chan_cmd = io_entry.prim.io_cmd;
3435 idcw.count = io_entry.prim.record_count;
3436 dcwp = addr (tolts_workspace.seek_dcw);
3437 string (dcw) = "0"b;
3438 dcw.address = rel (addr (tolts_workspace.seek_add));
3439 dcw.tally = "0001"b3;
3440 i = fixed (rel (addrel (execp, first_dcw.address)));
3441 tolts_workspace.seek_add = exec_wd (i);
3442 tio_off = fixed (rel (addr (tolts_workspace.seek_idcw)));
3443 end;
3444 end;
3445
3446
3447
3448 idcwp = addr (tolts_workspace.p_idcw);
3449
3450 if ^mpc_io then
3451 if bin (io_entry.sct_add, 13) >= 512
3452 then idcw.device = io_info.altsct.device_no;
3453 else idcw.device = io_info.devsct.device_no;
3454 dcwp = addrel (execp, io_entry.dcw_ptr);
3455 if string (dcw) = "0"b then do;
3456 tolts_workspace.buf_size, c_len = 1;
3457 dcwp = addr (tolts_workspace.dcw_list (1));
3458 string (dcw) = "0"b;
3459 dcw.address = rel (addr (tolts_workspace.data_buf));
3460 dcw.tally = "0001"b3;
3461 if continue then
3462 idcw.control = "00"b;
3463 go to non_data;
3464 end;
3465 io_info.page_base = bin (dcw.address);
3466 first, found = "0"b;
3467 unspec (io_info.dcw_list) = "0"b;
3468 lstloc, nxtloc, j = 1;
3469 bufp = addr (tolts_workspace.data_buf (1));
3470 do i = 1 to hbound (tolts_workspace.dcw_list, 1) while (^found);
3471 tolts_workspace.dcw_list (j) = string (dcw);
3472 io_info.dcw_list (j) = string (dcw);
3473 if dcw.char_pos = "7"b3 then do;
3474 idcwp = addr (tolts_workspace.dcw_list (j));
3475 if idcw.control = "10"b then
3476 continue = "1"b;
3477 else continue = "0"b;
3478
3479 if ^mpc_io then
3480 if bin (io_entry.sct_add, 13) >= 512
3481 then idcw.device = io_info.altsct.device_no;
3482 else idcw.device = io_info.devsct.device_no;
3483 j = j + 1;
3484 end;
3485 else if dcw.type = "10"b then
3486 dcwp = addrel (execp, bin (dcw.address) - 1);
3487 else do;
3488 if ^first then do;
3489 first = "1"b;
3490 dcwb = bin (dcw.address);
3491 end;
3492 mvp = addrel (execp, dcw.address);
3493 c_len = bin (dcw.tally);
3494 if string (dcw) = "0"b then do;
3495 c_len = 1;
3496 dcw.address = io_entry.stat_p;
3497 call tolts_qttyio_$rs
3498 (0, "Tolts: Last io_entry contains an illegal dcw. Please investigate");
3499 end;
3500 if c_len = 0 then c_len = 4096;
3501 cbuf_add = bin (dcw.address) - dcwb;
3502 if cbuf_add = 0 then
3503 cbuf_add = lstloc;
3504 else cbuf_add = nxtloc;
3505 tolts_workspace.buf_size = cbuf_add;
3506 bufp = addr (tolts_workspace.data_buf (cbuf_add));
3507 workspace_move = mvp -> workspace_move;
3508 mvp = addr (tolts_workspace.dcw_list (j));
3509 mvp -> dcw.address = rel (bufp);
3510 lstloc = bin (mvp -> dcw.address) - bin (rel (addr (tolts_workspace.data_buf (1)))) + 1;
3511 nxtloc = lstloc + c_len;
3512 dcwb = bin (dcw.address);
3513 if idcw_io then do;
3514 bufp = addrel (bufp, c_len);
3515 c_len = 0;
3516 end;
3517 j = j + 1;
3518 if dcw.type = "00"b then
3519 if ^continue then
3520 found = "1"b;
3521 end;
3522 dcwp = addrel (dcwp, 1);
3523 end;
3524 tolts_workspace.buf_size = (bin (rel (bufp)) + c_len) - bin (rel (addr (tolts_workspace.data_buf (1))));
3525 non_data:
3526 tolts_workspace.h_pad.e = "252525252525"b3;
3527 tolts_workspace.h_pad.o = "252525252525"b3;
3528 if io_info.devsct.com_prph then do;
3529 pcwa = tolts_workspace.p_idcw;
3530 tio_off = fixed (rel (addr (tolts_workspace.dcw_list (1))));
3531 end;
3532 else pcwa = "000000700000"b3;
3533 if substr (mme_call_w (4), 1, 1) = "1"b then do;
3534 io_info.io_trc_flag = "1"b;
3535 call ioa_$rsnnl ("^/ ^
3536
3537 call ioa_$rsnnl ("^a^/seek idcw: - ^12.3b, seek dcw: - ^12.3b, seek address: - ^12.3b",
3538 message, mesg_len, message, tolts_workspace.seek_idcw,
3539 tolts_workspace.seek_dcw, tolts_workspace.seek_add);
3540 call ioa_$rsnnl ("^a^/^[pcw^;idcw^]: - ^12.3b^/dcw list:^/",
3541 message, mesg_len, message, io_info.devsct.com_prph, tolts_workspace.p_idcw);
3542 do i = 1 by 4 while (tolts_workspace.dcw_list (i) ^= "0"b);
3543 call ioa_$rsnnl ("^12.3b ", lginfo, mesg_len, tolts_workspace.dcw_list (i));
3544 do j = 1 to 3 while (tolts_workspace.dcw_list (i + j) ^= "0"b);
3545 call ioa_$rsnnl ("^a ^12.3b ", lginfo, mesg_len, lginfo, tolts_workspace.dcw_list (i + j));
3546 end;
3547 call ioa_$rsnnl ("^a^/", lginfo, mesg_len, lginfo);
3548 message = rtrim (message) || lginfo;
3549 end;
3550 call tolts_qttyio_ (message, 10);
3551 end;
3552 else io_info.io_trc_flag = "0"b;
3553 io_info.ext_status_add = io_entry.ext_sts;
3554 io_info.ignore_term = io_entry.second.ignore_term;
3555 io_info.icivlu.ic = io_entry.ccc_p;
3556 io_info.icivlu.ind = "0"b;
3557 io_info.status_add = fixed (io_entry.stat_p);
3558 exec_wd (io_info.status_add) = "0"b;
3559 exec_wd (io_info.status_add + 1) = "0"b;
3560 io_info.pcwa = pcwa;
3561 io_info.tio_off = tio_off;
3562 io_info.rew_wait = "0"b;
3563 io_info.io_in_progress = "1"b;
3564 io_info.num_connects = io_info.num_connects + 1;
3565 io_info.int_time = 0;
3566
3567 end io_setup;
3568 %page;
3569
3570
3571
3572 get_px_sct: proc (mname, px, ck_alloc);
3573
3574 dcl mname char (6);
3575 dcl px fixed bin;
3576 dcl ck_alloc bit (1);
3577
3578 if px >= 1024 then do;
3579 mpc_io = "1"b;
3580 io_sel = px - 1024;
3581 end;
3582 else if px >= 512 then do;
3583 mpc_io = "0"b;
3584 io_sel = px - 512;
3585 end;
3586 else do;
3587 mpc_io = "0"b;
3588 io_sel = px;
3589 end;
3590 io_sel = divide (io_sel, 4, 17, 0);
3591 if io_sel < 1 | io_sel > 8 | ^pages (io_sel).in_use |
3592 (ck_alloc & ^pages (io_sel).allocated) then do;
3593 call tolts_qttyio_$rs (0, "^as: MME ^a; Invalid SCT - ^6.3b",
3594 exec, mname, bit (bin (px, 18)));
3595 call tolts_abort ("$a2");
3596 end;
3597 io_info_ptr = addr (pages (io_sel));
3598
3599 end get_px_sct;
3600
3601
3602
3603
3604 get_px_tcx: proc (mname, tci);
3605
3606 dcl mname char (6);
3607 dcl tci bit (11);
3608
3609 do io_sel = 1 to (hbound (pages, 1))
3610 while (tci ^= pages (io_sel).devsct.icc);
3611 end;
3612 if io_sel > (hbound (pages, 1)) then do;
3613 call tolts_qttyio_$rs (0, "^as: MME ^a; no matching page found for true chan. index - ^3.3b",
3614 exec, mname, tci);
3615 call tolts_abort ("$m1");
3616 end;
3617 else io_info_ptr = addr (pages (io_sel));
3618
3619 end get_px_tcx;
3620 %page;
3621
3622
3623
3624 output_status_code: proc (ecode, mess);
3625
3626 dcl ecode fixed bin (35);
3627 dcl mess char (*);
3628
3629 call convert_status_code_ (ecode, shortinfo, lginfo);
3630 call tolts_qttyio_$rs (0, "^as: ^a^/^a", tolts_info.exec, lginfo, mess);
3631 end output_status_code;
3632
3633 dealcp_sub: proc;
3634
3635 dealc_err = 0;
3636 if io_info.p_att | io_info.alloc_wait then do;
3637 call ck_release;
3638 if io_info.io_type = mca_io_type then do;
3639 if io_info.ipc_attached then do;
3640 call tolts_qttyio_$rs (0, "^a IPC ^a not reloaded.^/^a^/", io_info.test_hdr, io_info.ipc_number,
3641 "Do you wish to quit leaving IPC unloaded?");
3642 ask_again: call tolts_qttyio_$rs (19, "Please answer yes or no. - ");
3643 call message_wait;
3644 if tolts_info.mult_ans = "yes"
3645 | tolts_info.mult_ans = "y" then do;
3646 io_info.suspend_chan = "1"b;
3647 opr_query_info.q_sw = "0"b;
3648 call ioa_$rsnnl ("^/^a Unrecoverable error running ipc ^a firmware.^/^-^a",
3649 message, i, io_info.test_hdr, io_info.ipc_number,
3650 "IPC will not be reloaded");
3651 call opr_query_ (addr (opr_query_info),
3652 substr (message, 1, i));
3653 end;
3654 else if mult_ans = "no"
3655 | mult_ans = "n" then do;
3656 io_info.io_in_progress = "1"b;
3657 io_info.num_connects = io_info.num_connects + 1;
3658 call mca_$load_ipc (io_info.mca_ioi_idx, io_info.ipc_number,
3659 "0"b, code);
3660 end;
3661 else goto ask_again;
3662
3663 call mca_$detach_ipc ((io_info.ipc_id), io_info.mca_ioi_idx,
3664 ^io_info.suspend_chan, code);
3665 io_info.ipc_attached = "0"b;
3666 end;
3667 if io_info.mca_attach_state ^= MCA_NOT_CONFIGURED then do;
3668 io_info.io_in_progress = "1"b;
3669 io_info.num_connects = io_info.num_connects + 1;
3670 call mca_$reset (io_info.mca_ioi_idx, "0"b, code);
3671 io_info.io_in_progress = "1"b;
3672 io_info.num_connects = io_info.num_connects + 1;
3673 call mca_$detach_mca (io_info.mca_ioi_idx, code);
3674 end;
3675 end;
3676 else call rcp_$detach (io_info.rcp_id, "0"b, 0, "T&D is detaching " || io_info.device_name, error);
3677 if error ^= 0 then do;
3678 dealc_err = 1;
3679 call output_status_code (error, "unassign error");
3680 end;
3681 end;
3682
3683
3684
3685
3686 if io_info.p2_att then do;
3687 call rcp_$detach (io_info.alt_rcp_id, "0"b, 0, "t&d is detaching " || io_info.alt_device_name, error);
3688 if error ^= 0 then do;
3689 dealc_err = 1;
3690 call output_status_code (error, "unassign error");
3691 end;
3692 end;
3693 if io_info.ev_ch_ass then do;
3694 call ipc_$delete_ev_chn (io_info.status_event, error);
3695 if error ^= 0 then do;
3696 dealc_err = 1;
3697 call output_status_code (error, " deleting test io event channel ");
3698 end;
3699 end;
3700 unspec (io_info) = "0"b;
3701 tolts_info.exec_page_count = tolts_info.exec_page_count - 1;
3702 end dealcp_sub;
3703
3704
3705
3706 rel_exec_chan: proc (k);
3707
3708 dcl k fixed bin (6);
3709 dmap = addr (tolts_info.fnp (k).dm_arg);
3710 fnp (k).dm_arg.version = dial_manager_arg_version_2;
3711 fnp (k).dm_arg.dial_qualifier = substr (fnp (k).exec_chan, 1, 22);
3712 tolts_info.fnp (k).dm_arg.dial_channel = tolts_info.dm_event;
3713 tolts_info.fnp (k).dm_arg.channel_name = fnp (k).exec_chan;
3714
3715 call dial_manager_$release_channel (dmap, code);
3716 if code ^= 0 then do;
3717 if debugging then call com_err_ (code, "mtdsim_", "Error releasing ^a.", dmap -> dial_manager_arg.channel_name);
3718 call convert_status_code_ (code, shortinfo, lginfo);
3719 call tolts_qttyio_$rs (0, "^as: ^a/ error doing exec channel release", tolts_info.exec, lginfo);
3720 call com_err_ (error, exec, "*** fatal error, terminating process");
3721 fatal_desc.version = 0;
3722 fatal_desc.fatal_code = error;
3723 if ^debugging
3724 then call terminate_process_ ("fatal_error", addr (fatal_desc));
3725 else signal tolts_error_;
3726 end;
3727 cltp = fnp (k).fnp_execp;
3728 call close_sw (cltp);
3729 tolts_info.fnp (k).exec_active = "0"b;
3730 return;
3731 end rel_exec_chan;
3732
3733
3734
3735 rel_tst_chan: proc (k);
3736
3737 dcl k fixed bin (6);
3738
3739 dmap = addr (tolts_info.colts_pages (k).dm_arg);
3740 tolts_info.colts_pages (k).dm_arg.version = dial_manager_arg_version_2;
3741 tolts_info.colts_pages (k).dm_arg.dial_qualifier = substr (colts_pages (k).cdt_name, 1, 22);
3742 tolts_info.colts_pages (k).dm_arg.dial_channel = tolts_info.dm_event;
3743 tolts_info.colts_pages (k).dm_arg.channel_name = colts_pages (k).cdt_name;
3744 call tolts_qttyio_$rs (0, "Do you want to return the channel ^a to service?", tolts_info.colts_pages (k).cdt_name);
3745 reask: call tolts_qttyio_$rs (19, "Please answer yes or no - ");
3746 call message_wait;
3747 if tolts_info.mult_ans = "yes" | mult_ans = "y" then
3748 call dial_manager_$release_channel (dmap, code);
3749 else if tolts_info.mult_ans = "no" | mult_ans = "n" then
3750 call dial_manager_$release_channel_no_listen (dmap, code);
3751 else goto reask;
3752 if code ^= 0 then do;
3753 if debugging then call com_err_ (code, "mdtsim_", "Error releasing channel ^a.", dmap -> dial_manager_arg.channel_name);
3754 call convert_status_code_ (code, shortinfo, lginfo);
3755 call tolts_qttyio_$rs (0, "^as: ^a/ error doing channel detach", tolts_info.exec, lginfo);
3756 call com_err_ (error, exec, "*** fatal error, terminating process");
3757 fatal_desc.version = 0;
3758 fatal_desc.fatal_code = error;
3759 if debugging
3760 then call terminate_process_ ("fatal_error", addr (fatal_desc));
3761 else signal tolts_error_;
3762 end;
3763 cltp = colts_pages (k).chanp;
3764 call close_sw (cltp);
3765 colts_pages (k).in_use = "0"b;
3766 tolts_info.exec_page_count = tolts_info.exec_page_count - 1;
3767 return;
3768 end rel_tst_chan;
3769
3770
3771
3772
3773
3774
3775
3776 close_sw: proc (cltp);
3777
3778 dcl cltp ptr;
3779 call iox_$close (cltp, code);
3780 if code ^= 0 then do;
3781 call convert_status_code_ (code, shortinfo, lginfo);
3782 call tolts_qttyio_$rs (0, "^as: ^a/ doing iox_$close", tolts_info.exec, lginfo);
3783 call com_err_ (error, exec, "*** fatal error, terminating process");
3784 fatal_desc.version = 0;
3785 fatal_desc.fatal_code = error;
3786 if ^debugging
3787 then call terminate_process_ ("fatal_error", addr (fatal_desc));
3788 else signal tolts_error_;
3789 end;
3790 call iox_$detach_iocb (cltp, code);
3791 if code ^= 0 then do;
3792 call convert_status_code_ (code, shortinfo, lginfo);
3793 call tolts_qttyio_$rs (0, "^as: ^a/ doing iox_$detach", tolts_info.exec, lginfo);
3794 call com_err_ (error, exec, "*** fatal error, terminating process");
3795 fatal_desc.version = 0;
3796 fatal_desc.fatal_code = error;
3797 if ^debugging
3798 then call terminate_process_ ("fatal_error", addr (fatal_desc));
3799 else signal tolts_error_;
3800 end;
3801 return;
3802 end close_sw;
3803
3804
3805
3806 ctime: proc returns (char (16));
3807
3808 dcl tim char (12);
3809 dcl ptime char (16);
3810 dcl plen fixed bin;
3811
3812 tim = time;
3813 call ioa_$rsnnl ("^2a:^2a:^2a.^6a:", ptime, plen, substr (tim, 1, 2), substr (tim, 3, 2),
3814 substr (tim, 5, 2), substr (tim, 7, 6));
3815 return (ptime);
3816
3817 end ctime;
3818 %page;
3819
3820
3821
3822 clean_up: entry;
3823
3824 if exec = "colt" then do;
3825 do k = 1 to hbound (pages, 1);
3826 if colts_pages (k).in_use then call rel_tst_chan (k);
3827 end;
3828 do k = 0 to hbound (fnp, 1);
3829 if fnp (k).exec_active then call rel_exec_chan (k);
3830 end;
3831 end;
3832 do io_sel = 1 to hbound (pages, 1);
3833 io_info_ptr = addr (pages (io_sel));
3834 if io_info.in_use then
3835 call dealcp_sub;
3836 end;
3837 if gicmp ^= null then free gicm;
3838 if ticmp ^= null then free ticm;
3839 term = "1"b;
3840 if tolts_info.file_attach then do;
3841 call tolts_file_util_$wdump (addr (spa.regs));
3842 call tolts_file_util_$close;
3843 end;
3844
3845 if tolts_info.term_io_req_cnt ^= 0 & ^tolts_info.finish_cond
3846 & ^q_flag then
3847 go to blk_lbl;
3848 call tolts_init_$clean_up;
3849 tolts_active = "0"b;
3850
3851 return;
3852
3853
3854
3855
3856 decode_den: proc;
3857
3858 tape_info_ptr = addr (io_info.rcp_area);
3859 if substr (tape_info.density, 1, 6) = "00"b3 then do;
3860 ask:
3861 call tolts_qttyio_$rs (0, " ^a RCP returned incorrect device info ^/^a^/", io_info.test_hdr,
3862 "Please input density capabilities of device to be tested");
3863 call tolts_qttyio_$rs (19, "Please input densities in the form: 200,556,800,1600,6250 ^-");
3864 call message_wait;
3865 if tolts_info.mult_ans = "200,556,800" then
3866 io_info.devsct.w2.den_cap = "0001"b;
3867 else if tolts_info.mult_ans = "200,556,800,1600" then
3868 io_info.devsct.w2.den_cap = "0100"b;
3869 else if tolts_info.mult_ans = "556,800,1600" then
3870 io_info.devsct.w2.den_cap = "0101"b;
3871 else if tolts_info.mult_ans = "556,800" then
3872 io_info.devsct.w2.den_cap = "1001"b;
3873 else if tolts_info.mult_ans = "800,1600" then
3874 io_info.devsct.w2.den_cap = "1000"b;
3875 else if tolts_info.mult_ans = "1600" then
3876 io_info.devsct.w2.den_cap = "1100"b;
3877 else if tolts_info.mult_ans = "1600,6250" then
3878 io_info.devsct.w2.den_cap = "1011"b;
3879 else if tolts_info.mult_ans = "6250" then
3880 io_info.devsct.w2.den_cap = "1010"b;
3881 else do;
3882 call tolts_qttyio_$rs (0, "Incorrect reply. ^/ ^a ^/",
3883 "Do you want to run with default density");
3884 call tolts_qttyio_$rs (19, "Please answer yes or no");
3885 call message_wait;
3886 if tolts_info.mult_ans = "no" | mult_ans = "n" then goto ask;
3887 else if io_info.crcst.mtp610 then do;
3888 io_info.devsct.w2.den_cap = "1100"b;
3889 call tolts_qttyio_$rs (0, "Test will be run at 1600bpi ^/");
3890 end;
3891 else do;
3892 io_info.devsct.w2.den_cap = "1000"b;
3893 call tolts_qttyio_$rs (0, "Test will be run at 500/1600bpi ^/");
3894 end;
3895 end;
3896 end;
3897 else if substr (tape_info.density, 1, 6) = "70"b3 then
3898 io_info.devsct.w2.den_cap = "0001"b;
3899 else if substr (tape_info.density, 1, 6) = "74"b3 then
3900 io_info.devsct.w2.den_cap = "0100"b;
3901 else if substr (tape_info.density, 1, 6) = "30"b3 then
3902 io_info.devsct.w2.den_cap = "1001"b;
3903 else if substr (tape_info.density, 1, 6) = "14"b3 then
3904 io_info.devsct.w2.den_cap = "1000"b;
3905 else if substr (tape_info.density, 1, 6) = "04"b3 then
3906 io_info.devsct.w2.den_cap = "1100"b;
3907 else if substr (tape_info.density, 1, 6) = "06"b3 then
3908 io_info.devsct.w2.den_cap = "1011"b;
3909 else if substr (tape_info.density, 1, 6) = "02"b3 then
3910 io_info.devsct.w2.den_cap = "1010"b;
3911 else if substr (tape_info.density, 1, 6) = "34"b3 then
3912 io_info.devsct.w2.den_cap = "0101"b;
3913 end decode_den;
3914
3915
3916
3917 pop_isc: proc (s_add, d_add);
3918
3919 dcl (s_add, d_add) fixed bin;
3920
3921 exec_wd (s_add) = "400000000000"b3;
3922 exec_wd (d_add) = tolts_info.exec_dta (1).word (1);
3923 exec_wd (d_add + 1) = tolts_info.exec_dta (1).word (2);
3924 exec_wd (d_add + 2) = tolts_info.exec_dta (1).word (3);
3925 tolts_info.exec_dta_cnt = tolts_info.exec_dta_cnt - 1;
3926 do i = 1 to tolts_info.exec_dta_cnt;
3927 tolts_info.exec_dta (i) = tolts_info.exec_dta (i + 1);
3928 end;
3929
3930 end pop_isc;
3931 %page;
3932
3933
3934 ck_release: proc;
3935
3936 if io_info.io_in_progress then do;
3937 call timer_manager_$reset_alarm_wakeup (tolts_info.gewake_event);
3938 call ipc_$drain_chn (tolts_info.gewake_event, error);
3939 call timer_manager_$alarm_wakeup (10, "11"b, tolts_info.gewake_event);
3940 tolts_info.gewake_active = "1"b;
3941 do while (tolts_info.gewake_active);
3942 call ipc_$block (addr (tolts_info.wait_list), addr (event_out), error);
3943 end;
3944
3945 if io_info.chan_suspended then
3946 if io_info.io_type = itr_io_type
3947 | io_info.io_type = firm_ld_io_type then do;
3948 retry_ld:
3949 call tolts_load_firmware_ (io_sel, error);
3950 if error ^= 0 then do;
3951 if tolts_info.finish_cond then
3952 go to tell_opr;
3953 call tolts_qttyio_$rs (0, "^a Error loading mpc firmware.^/^a^/", io_info.test_hdr,
3954 "Do you wish to retry or quit leaving mpc suspended?");
3955 retype:
3956 call tolts_qttyio_$rs (19, "Please answer retry or quit. - ");
3957 call message_wait;
3958 if tolts_info.mult_ans = "retry" then go to retry_ld;
3959 else if tolts_info.mult_ans = "quit" then do;
3960 tell_opr:
3961 opr_query_info.q_sw = "0"b;
3962 call ioa_$rsnnl ("^/^a ^a^/^-^a", message, i, io_info.test_hdr,
3963 "Unrecoverable error loading mpc firmware.", "I/O will remain suspended");
3964 call opr_query_ (addr (opr_query_info), substr (message, 1, i));
3965 end;
3966 else go to retype;
3967 end;
3968 end;
3969
3970 else if io_info.io_type ^= mca_io_type then do;
3971 ioi_wksp = io_info.workspace_ptr;
3972 unspec (wks_init) = "0"b;
3973 idcwp = addr (tolts_workspace.p_idcw);
3974 idcw.code = "7"b3;
3975 idcw.command = "20"b3;
3976 idcw.chan_cmd = "40"b3;
3977 pcwa = "000000700000"b3;
3978 tio_off = fixed (rel (addr (tolts_workspace.p_idcw)));
3979 io_info.release_chan = "1"b;
3980 call timer_manager_$reset_alarm_wakeup (tolts_info.gewake_event);
3981 call ipc_$drain_chn (tolts_info.gewake_event, error);
3982 call timer_manager_$alarm_wakeup (10, "11"b, tolts_info.gewake_event);
3983 tolts_info.gewake_active = "1"b;
3984 if pages (io_sel).p_att then do;
3985 call ioi_$connect_pcw (io_info.device_index, tio_off, pcwa, error);
3986 if error ^= 0 then
3987 call output_status_code (error, "cleanup io connect error");
3988 tolts_info.glob_int_cnt = tolts_info.glob_int_cnt + 1;
3989 end;
3990 do while (tolts_info.gewake_active);
3991 call ipc_$block (addr (tolts_info.wait_list), addr (event_out), error);
3992 end;
3993 if io_info.io_in_progress then do;
3994 call ioa_$rsnnl ("^/^a ^a^/^-^a", message, i, io_info.test_hdr,
3995 "Unable to release mpc,", "manually reset and branch to reinitialize mpc");
3996 opr_query_info.q_sw = "0"b;
3997 call opr_query_ (addr (opr_query_info), substr (message, 1, i));
3998 call ioi_$release_devices (io_info.device_index, error);
3999 end;
4000 end;
4001 end;
4002 end ck_release;
4003
4004
4005
4006 message_wait: proc;
4007
4008 do while (tolts_info.term_io_req_cnt > 0);
4009 call ipc_$block (addr (tolts_info.wait_list), addr (event_out), error);
4010 end;
4011
4012 end message_wait;
4013 %page;
4014
4015
4016
4017 set_gelbar: proc;
4018
4019 dcl fwd bit (36);
4020
4021 dcl 1 acc_over based (addr (fwd)) aligned,
4022 (2 bar bit (18),
4023 2 nu1 bit (1),
4024 2 fault bit (1),
4025 2 nu2 bit (1),
4026 2 overflow bit (1),
4027 2 ex_over bit (1),
4028 2 ex_under bit (1),
4029 2 ipr bit (1),
4030 2 nu3 bit (4),
4031 2 dcf bit (1),
4032 2 f_type fixed bin (5)) unaligned;
4033
4034 fwd = "0"b;
4035 acc_over.fault = "1"b;
4036 acc_over.bar = substr (spa.acc_fault, 1, 18);
4037 spa.acc_fault = fwd;
4038 spa.enter.lbar.bar = "000630"b3;
4039 spa.enter.icivlu.ic = rel (addr (spa.glbflt));
4040 call tolts_init_$gc_tod (gcos_tod);
4041 spa.glbtmr = bit (fixed (gcos_tod, 35, 0) - fixed (string (spa.glbici), 35, 0), 36);
4042 spa.glbici.ic = bit (bin (scu.ilc, 17) + 1, 18);
4043 spa.glbici.ind = string (scu.ir);
4044 gelbar, in_ccc = "0"b;
4045 glb_brk = "1"b;
4046 call wake_disp;
4047
4048 end set_gelbar;
4049
4050
4051
4052 %page;
4053 %include author_dcl;
4054 %page;
4055 %include cdt;
4056 %page;
4057 %include condition_info;
4058 %page;
4059 %include config_iom_card;
4060 %page;
4061 %include event_wait_info;
4062 %page;
4063 %include gload_data;
4064 %page;
4065 %include mc;
4066 %page;
4067 %include mca_data;
4068 %page;
4069 %include mca_data_area;
4070 %page;
4071 %include opr_query_info;
4072 %page;
4073 %include rcp_disk_info;
4074 %page;
4075 %include rcp_resource_types;
4076 %page;
4077 %include rcp_tape_info;
4078 %page;
4079 %include tolts_err_codes;
4080 %page;
4081 %include tolts_fpinfo;
4082 %page;
4083 %include tolts_info;
4084 %page;
4085 %include tolts_rspd_workspace;
4086 %page;
4087 %include tolts_workspace;
4088
4089
4090
4091
4092
4093 end mtdsim_;
4094