1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23 isolts_: proc;
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 dcl tolts_util_$get_ttl_date entry (entry, char (6));
49 dcl tandd_$check_isolts_resources entry (fixed bin (5), fixed bin (5), fixed bin (5), fixed bin (35));
50 dcl tandd_$create_cpu_test_env entry (fixed bin (5), fixed bin (5), (4) bit (36), ptr, fixed bin (35));
51 dcl tandd_$destroy_cpu_test_env entry;
52 dcl tandd_$interrupt_test_cpu entry (fixed bin (35));
53 dcl tolts_pcd_ entry (char (6), char (*));
54 dcl tolts_util_$find_card entry (char (4), ptr);
55 dcl tolts_util_$query entry (char (*), char (132) aligned, fixed bin, (32) char (28) varying, fixed bin);
56 dcl tolts_util_$config entry (char (4), ptr, char (*) varying);
57 dcl tolts_util_$bci_to_ascii entry (bit (*), char (*) varying, fixed bin);
58 dcl tolts_util_$search entry (ptr, char (32), ptr, fixed bin, fixed bin (35));
59 dcl tolts_util_$on_off entry (char (6), char (3), char (6));
60 dcl tolts_util_$opr_msg entry;
61 dcl isolts_err_log_$init entry (fixed bin (35));
62 dcl isolts_err_log_$write entry (ptr, fixed bin, fixed bin, fixed bin (5), fixed bin (5));
63 dcl isolts_err_log_$display entry (fixed bin, fixed bin, bit (1));
64 dcl isolts_err_log_$dump entry (char (5), ptr, fixed bin (18), fixed bin, fixed bin (5), fixed bin (5));
65 dcl dump_segment_ entry (ptr, ptr, fixed bin, fixed bin (18), fixed bin (18), bit (*));
66 dcl timer_manager_$sleep entry (fixed bin (71), bit (2));
67 dcl gload_ entry (ptr, ptr, fixed bin (18), ptr, fixed bin (35));
68 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
69 dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
70 dcl cu_$cp entry (ptr, fixed bin (21), fixed bin (35));
71 dcl bcd_to_ascii_ entry (bit (*), char (*));
72 dcl tolts_alm_util_$ascii_to_bci_ entry (char (*) aligned, bit (*));
73 dcl continue_to_signal_ entry (fixed bin (35));
74 dcl (ioa_, signal, com_err_, ioa_$rsnnl, ioa_$nnl, opr_query_) entry options (variable);
75 dcl iox_$close entry (ptr, fixed bin (35));
76 dcl iox_$detach_iocb entry (ptr, fixed bin (35));
77
78
79
80 dcl code fixed bin (35);
81 dcl (cpu_tag, scu_tag, cpu_port) fixed bin (5);
82 dcl switches (4) bit (36);
83 dcl bf_sw bit (1) init ("0"b);
84 dcl (nxt_tst, new_tst) char (3);
85 dcl cpu_type char (4);
86 dcl (term, trm, trm1, pas_sw, mess_in_prog, ntype, run, option, trace_sw,
87 dump_in_prog, idump, car_nz) bit (1) init ("0"b);
88 dcl out_str char (136) varying;
89 dcl com_string char (132) aligned;
90 dcl add_opt char (6);
91 dcl tim char (12);
92 dcl delay_iter fixed bin init (300);
93 dcl ttl_date char (6);
94 dcl d_type char (5);
95 dcl args (32) char (28) varying;
96 dcl (pgm_offset, first, last) fixed bin (18);
97 dcl (cmd_cnt, delay, i, j, k, c_len, bcd_chars, mtype, mlen, count, limit) fixed bin;
98 dcl (pip, wseg_p, t_ptr, awcp, mptr, hdr_p) ptr;
99
100
101
102 dcl (quit, cleanup, finish) condition;
103 dcl pname char (6) static options (constant) init ("isolts");
104 dcl tags (0:7) char (1) static options (constant) init
105 ("a", "b", "c", "d", "e", "f", "g", "h");
106 dcl first_pft char (3) static options (constant) init ("01c");
107 dcl pas_exec char (3) static options (constant) init ("061");
108 dcl inv_tst_ids (22) char (3) static options (constant) init
109 ("781", "782", "783", "784", "891", "894", "895", "897", "899", "908", "920", "921", "922", "923",
110 "924", "927", "928", "929", "930", "975", "980", "990");
111 dcl illegal_pas_opt (2) char (8) varying static options (constant) init
112 ("cardin", "i/o");
113 dcl NL char (1) int static options (constant) init ("
114 ");
115 dcl pas_delay fixed bin static options (constant) init (2);
116 dcl pft_delay fixed bin static options (constant) init (2);
117 dcl p_err bit (1) int static init ("1"b);
118 dcl df_iocbp ptr int static init (null);
119 dcl isolate_cpu bit (1) int static;
120 dcl (cont_pas, restart, end_pas, eopt) label;
121 dcl iox_$user_output ptr ext;
122 dcl (addr, addrel, fixed, hbound, index, length, ltrim, mod, null, ptr, rel,
123 rtrim, search, string, substr, time) builtin;
124
125
126
127 dcl 1 wseg based (wseg_p) aligned,
128 2 int_vectors (0:31) bit (72),
129 2 flt_vectors (0:31) bit (72),
130 2 pad1 (32) bit (72),
131 2 COW bit (36),
132 2 pad2 (10) bit (36),
133 2 prt_out (30) bit (36),
134 2 cons_in (21) bit (36),
135 2 pad3 (322) bit (36),
136 2 opt_save (25) bit (36),
137 2 pad4 (31) bit (36),
138 2 is_mbx,
139 3 control fixed bin (35),
140 3 service fixed bin (35),
141 3 action_codes unaligned,
142 4 pad5 bit (21),
143 4 halt bit (1),
144 4 pad6 bit (4),
145 4 ld_spgm bit (1),
146 4 ld_mpgm bit (1),
147 4 wc_eop bit (1),
148 4 wc_opt bit (1),
149 4 read bit (1),
150 4 wc_type bit (1),
151 4 print bit (1),
152 4 err bit (1),
153 4 pad7 bit (2),
154 3 pgm_name bit (36),
155 3 pad8 (4) bit (36),
156 2 pad9 (64) bit (36),
157 2 wk_survey (16) bit (36),
158 2 pad10 (3359) bit (36),
159 2 imw unaligned,
160 3 pad bit (18),
161 3 base bit (18),
162 2 sys_survey unaligned,
163 3 iom0,
164 4 mbx bit (18),
165 4 port fixed bin,
166 3 iom1_3 (3) bit (36),
167 3 console,
168 4 chan fixed bin (8),
169 4 pad bit (27),
170 4 cons_iom bit (36),
171 3 printer,
172 4 chan fixed bin (8),
173 4 pad bit (27),
174 4 prt_iom bit (36),
175 3 cont_cpu,
176 4 f_vec bit (18),
177 4 port fixed bin,
178 3 hi_mem,
179 4 address fixed bin,
180 4 pad bit (18),
181 3 cpu_1,
182 4 f_vec bit (18),
183 4 port fixed bin,
184 3 cpu2_4 (3) bit (36),
185 3 boot,
186 4 chan fixed bin (8),
187 4 pad bit (27),
188 4 iom bit (36),
189 2 exec (28672) bit (36),
190 2 test_pgm (32768) bit (36);
191
192 dcl 1 slave_hdr based (hdr_p) aligned,
193 (
194 2 pgm_num bit (36),
195 2 erlink bit (18),
196 2 pgm_rev bit (18),
197 2 p_int_tab bit (18),
198 2 pgm_size bit (18),
199 2 tst_name bit (72),
200 2 num_tests bit (18),
201 2 xfer_p bit (18),
202 2 cksum bit (36),
203 2 program_name bit (108),
204 2 pad (9) bit (36)
205 ) unaligned;
206
207 dcl 1 action like is_mbx.action_codes unaligned;
208 dcl 1 pi like rsw_1_3.port_info based (pip) unaligned;
209 dcl wseg1 (65536) fixed bin based (wseg_p);
210 dcl bcd_str bit (bcd_chars * 6) based (mptr);
211 dcl add_wc (2) fixed bin unaligned based (awcp);
212
213
214 %include config_cpu_card;
215 %page;
216
217
218 isolate_cpu = "0"b;
219 on cleanup call clean_up;
220 on finish call clean_up;
221
222 call tolts_util_$get_ttl_date (isolts_, ttl_date);
223 call tolts_util_$on_off (pname, "on", ttl_date);
224
225
226
227 call isolts_err_log_$init (code);
228 if code ^= 0 then
229 go to t_off;
230
231
232
233
234
235
236
237
238
239
240 term = "0"b;
241 do while (^term);
242 call ioa_ ("^
243
244
245
246 ask:
247 call tolts_util_$query ("??? ", com_string, c_len, args, cmd_cnt);
248 if args (1) = "quit" | args (1) = "q" then
249 term = "1"b;
250 else if args (1) = "msg" then
251 call tolts_util_$opr_msg;
252 else if args (1) = "display_error" | args (1) = "display"
253 | args (1) = "derr" then do;
254 do i = 2 to cmd_cnt by 1;
255
256 if args (i) = "-type" then do;
257 p_err = "0"b;
258 args (i) = "";
259 cmd_cnt = cmd_cnt - 1;
260 end;
261 end;
262 cmd_cnt = cmd_cnt - 1;
263 if ^display_log () then
264
265 bad_rsp: call com_err_ (0, pname, "invalid response - ""^a""", com_string);
266 go to ask;
267 end;
268 else if cmd_cnt < 2 | args (1) ^= "test" then
269 go to bad_rsp;
270 else if args (2) = "pcd" then do;
271 if cmd_cnt = 3 then call tolts_pcd_ ("isolts", (args (3)));
272 else call tolts_pcd_ ("isolts", "");
273 end;
274 else if args (2) ^= "cpu" then
275 go to bad_rsp;
276 else do;
277 trace_sw = "0"b;
278 if cmd_cnt < 3 then
279 go to bad_rsp;
280 cpu_tag = search ("abcdefgh", args (3));
281 if cpu_tag = 0 then
282 go to bad_rsp;
283 term = "0"b;
284 scu_tag = -1;
285 if cmd_cnt > 3 then do;
286 trm = "0"b;
287 do i = 4 to cmd_cnt;
288 if ^trm then
289 if args (i) = "-memory"
290 | args (i) = "-mem" then trm = "1"b;
291 else if args (i) = "-brief"
292 | args (i) = "-bf" then bf_sw = "1"b;
293 else if args (i) = "-trace" then
294 trace_sw = "1"b;
295 else go to bad_rsp;
296 else do;
297 scu_tag = search ("abcdefgh", args (i));
298 if scu_tag = 0 then
299 go to bad_rsp;
300 else scu_tag = scu_tag - 1;
301 trm = "0"b;
302 end;
303 end;
304 end;
305
306 cpu_cardp = null;
307 do while (^term);
308 call tolts_util_$find_card ("cpu", cpu_cardp);
309 if cpu_cardp = null then term = "1"b;
310 else if cpu_card.tag = cpu_tag then do;
311 if cpu_card.type ^= "l68"
312 & substr (type, 1, 3) ^= "dps" then do;
313 call ioa_ ("isolts_: unable to determine cpu type for cpu ^a", tags (cpu_tag - 1));
314 reask: call tolts_util_$query ("enter l68 or dps8 ", com_string, c_len, args, cmd_cnt);
315 if args (1) = "l68 "
316 | args (1) = "dps8" then cpu_type = args (1);
317 else do;
318 call ioa_ ("isolts_: invalid input pls reenter.");
319 goto reask;
320 end;
321 end;
322 else cpu_type = cpu_card.type;
323 term = "1"b;
324 end;
325 end;
326 cpu_tag = cpu_tag - 1;
327
328
329
330 call tandd_$check_isolts_resources (cpu_tag, scu_tag, cpu_port, code);
331 if code ^= 0 then do;
332 call abort (code);
333 go to cmd_loop;
334 end;
335 isolate_cpu = "1"b;
336
337
338
339 if opr_com (cpu_tag, scu_tag) then
340 go to cmd_loop;
341
342
343
344 call tandd_$create_cpu_test_env (cpu_tag, scu_tag, switches, wseg_p, code);
345 if code ^= 0 then do;
346 call abort (code);
347 go to cmd_loop;
348 end;
349 call ioa_ ("^/reconfiguration complete");
350
351 hdr_p = addr (wseg.test_pgm);
352 wseg1 = 0;
353 restart = restart_label;
354
355
356
357 restart_label:
358 call run_pas;
359 end;
360 cmd_loop: call clean_up;
361 end;
362
363
364
365 t_off: call tolts_util_$on_off (pname, "off", ttl_date);
366 return;
367
368 %page;
369
370
371
372
373 run_pas: proc;
374
375 nxt_tst = first_pft;
376 awcp = addr (is_mbx.pgm_name);
377 cont_pas = continue_pas;
378 end_pas = end_tst;
379 pgm_offset = 0;
380 trm, pas_sw, mess_in_prog, ntype, run, option, car_nz = "0"b;
381
382 dump_in_prog, idump = "0"b;
383
384
385
386 on quit begin;
387
388 if pas_sw then do;
389 ntype = "0"b;
390 string (action_codes) = "0"b;
391 if dump_in_prog & ^idump then do;
392 dump_in_prog = "0"b;
393 go to eopt;
394 end;
395 if option then do;
396 call ioa_ ("^/");
397 car_nz = "0"b;
398 go to eopt;
399 end;
400 action_codes.halt = "1"b;
401 go to cont_pas;
402 end;
403 else call continue_to_signal_ (code);
404
405 end;
406
407 call ioa_ ("^/start pft ^a^/", nxt_tst);
408
409 do while (^trm);
410
411
412
413 call tolts_util_$search (df_iocbp, "pas." || nxt_tst, t_ptr, c_len, code);
414 if code ^= 0 then do;
415 call com_err_ (code, pname, "searching for pas.^a", nxt_tst);
416 ntype = "0"b;
417 string (action_codes) = "0"b;
418 action_codes.halt = "1"b;
419 go to cont_pas;
420 end;
421
422
423
424 tout_retry: call gload_ (t_ptr, addrel (wseg_p, pgm_offset), 0, addr (gload_data), code);
425 if code ^= 0 then do;
426 call com_err_ (code, pname, "^a^/attempting to load pas.^a",
427 gload_data.diagnostic, nxt_tst);
428 return;
429 end;
430
431
432
433 if ^pas_sw then
434 call set_survey;
435 else do;
436 delay = pas_delay;
437 slave_hdr.cksum = gload_data.checksum;
438 end;
439 if nxt_tst = "892" | nxt_tst = "893"
440 | nxt_tst = "955" then delay_iter = 600;
441 else delay_iter = 300;
442 string (is_mbx.action_codes) = "0"b;
443 is_mbx.pgm_name = "0"b;
444 continue_pas:
445 if is_mbx.control = 0 then
446 is_mbx.control = 65535;
447 is_mbx.service = 0;
448 if trace_sw then
449 if string (action_codes) ^= "0"b then
450 call itrace;
451
452
453
454 call tandd_$interrupt_test_cpu (code);
455 if code ^= 0 then do;
456 call com_err_ (code, pname, "attempting to interrupt cpu ^a", tags (cpu_tag));
457 return;
458 end;
459
460
461
462 do i = 1 to 1000 while (is_mbx.service = 0);
463 end;
464 if is_mbx.service = 0 then
465 wait: call sleep (delay);
466 if is_mbx.service = 0 then do;
467 call ioa_ (" ");
468 if ^pas_sw & nxt_tst ^= pas_exec then do;
469 call com_err_ (0, pname,
470 "time out after ^d seconds while executing PFT ^a",
471 delay * delay_iter, nxt_tst);
472 call com_err_ (0, pname,
473 "check cpu ^a's maintenence panel and consult program listing to determine failure",
474 tags (cpu_tag));
475 end;
476 else if nxt_tst = pas_exec then
477 call com_err_ (0, pname,
478 "time out after ^d seconds while initializing the pas2 executive",
479 delay * delay_iter);
480 else call com_err_ (0, pname,
481 "time out after ^d seconds while executing pas2 test ^a",
482 delay * delay_iter, nxt_tst);
483 trm1 = "0"b;
484 do while (^trm1);
485 call tolts_util_$query ("respond ""quit (q)"", ""retry (r)"", or ""continue (c)"" - ",
486 com_string, c_len, args, cmd_cnt);
487 if args (1) = "quit" | args (1) = "q" then
488 return;
489 else if args (1) = "retry"
490 | args (1) = "r" then
491 go to tout_retry;
492 else if args (1) = "continue"
493 | args (1) = "c" then
494 go to wait;
495 end;
496 end;
497 else do;
498 string (action) = string (is_mbx.action_codes);
499 if trace_sw then
500 call itrace;
501 string (is_mbx.action_codes) = "0"b;
502 call interpret_action;
503 end;
504 end_tst:
505 end;
506
507
508
509 end run_pas;
510
511 %page;
512
513
514
515 interpret_action: proc;
516
517 if action.ld_mpgm | action.ld_spgm then do;
518 call complete_err_mess;
519 call bcd_to_ascii_ (substr (pgm_name, 13, 18), new_tst);
520
521 if trace_sw then
522 call ioa_ ("load pgm^a", new_tst);
523 do i = 1 to hbound (inv_tst_ids, 1) while (new_tst ^= inv_tst_ids (i));
524 end;
525 if i <= hbound (inv_tst_ids, 1) then do;
526 ntype = "1"b;
527 action_codes.halt = "1"b;
528 go to cont_pas;
529 end;
530 if ^pas_sw & ^bf_sw then
531 call ioa_ ("*** end ^a, next ^a ***", nxt_tst, new_tst);
532 nxt_tst = new_tst;
533 if action.ld_spgm then
534 pgm_offset = fixed (rel (addr (wseg.test_pgm)), 18);
535 else pgm_offset = 0;
536 end;
537 else if action.wc_type | action.wc_eop | action.wc_opt then do;
538
539 call complete_err_mess;
540 mptr = ptr (wseg_p, add_wc (1));
541 bcd_chars = add_wc (2) * 6;
542 call tolts_util_$bci_to_ascii (bcd_str, out_str, bcd_chars);
543 if substr (out_str, 1, 1) = NL & length (out_str) > 2 then
544 out_str = substr (out_str, 2);
545 if action.wc_type & length (out_str) >= 1 then
546 car_nz = "1"b;
547 if action.wc_opt | action.wc_eop then option = "1"b;
548 else option = "0"b;
549
550 if ^ntype then do;
551 call ioa_$nnl ("^[^/^]^a^[^/^]", (car_nz & length (out_str) > 1),
552 out_str, (^action.wc_opt & length (out_str) > 1 & ^option));
553 if length (out_str) > 1 then car_nz = "0"b;
554 end;
555 go to cont_pas;
556 end;
557 else if action.read then
558 call enter_options;
559 else if action.print then do;
560 mptr = ptr (wseg_p, add_wc (1));
561 mlen = add_wc (2);
562 if dump_in_prog then
563 call isolts_err_log_$dump (d_type, mptr, (mlen), 1, cpu_tag, scu_tag);
564 else if action.err | mess_in_prog then do;
565 if mlen > 1 & mlen < 5 & ^mess_in_prog then do;
566 mptr = ptr (wseg_p, add_wc (1));
567 bcd_chars = add_wc (2) * 6;
568 call tolts_util_$bci_to_ascii (bcd_str, out_str, bcd_chars);
569
570 call ioa_ (" ^a", out_str);
571 go to cont_pas;
572 end;
573 else if action.err then do;
574 call complete_err_mess;
575 mess_in_prog = "1"b;
576 mtype = 1;
577 if ^run then do;
578 call ioa_ ("^
579
580 end;
581 end;
582 else mtype = 2;
583 call isolts_err_log_$write (mptr, mlen, mtype, cpu_tag, scu_tag);
584 end;
585 else do;
586 bcd_chars = mlen * 6;
587 call tolts_util_$bci_to_ascii (bcd_str, out_str, bcd_chars);
588
589 if ^bf_sw then do;
590 call ioa_ ("^[^/^]^a", car_nz, out_str);
591 car_nz = "0"b;
592 end;
593 end;
594 go to cont_pas;
595 end;
596
597 end interpret_action;
598
599 %page;
600
601
602
603 enter_options: proc;
604
605 add_opt = "";
606 mptr = ptr (wseg_p, add_wc (1));
607 eopt = opt_mess;
608 if dump_in_prog then do;
609 idump = "0"b;
610 call isolts_err_log_$dump (d_type, addrel (wseg_p, first), last,
611 2, cpu_tag, scu_tag);
612 idump, ntype, dump_in_prog = "0"b;
613 go to opt_mess;
614 end;
615 if ntype then do;
616 ntype = "0"b;
617 bcd_chars = 6;
618 call tolts_alm_util_$ascii_to_bci_ ("seq", bcd_str);
619
620 go to cont_pas;
621 end;
622
623 reenter:
624 call tolts_util_$query (" ", com_string, c_len, args, cmd_cnt);
625 if cmd_cnt = 0 then do;
626 option = "0"b;
627 go to cont_pas;
628 end;
629
630
631
632 if option then do;
633 if ck_isolts_opt () then
634 go to opt_mess;
635 else do;
636 k = 0;
637 trm1 = "0"b;
638 if cmd_cnt > 0 then do;
639 do i = 1 to cmd_cnt while (^trm1);
640 if length (args (i)) > 2 then do;
641 if substr (args (i), 1, 3) = "prg"
642 | substr (args (i), 1, 3) = "tst" then
643 k = i;
644 end;
645 else
646 do j = 1 to hbound (illegal_pas_opt, 1) while (^trm1);
647 if args (i) = illegal_pas_opt (j) then
648 trm1 = "1"b;
649 end;
650 end;
651 end;
652 if trm1 then do;
653 call com_err_ (0, pname, "^a option not supported by ^a", args (i - 1), pname);
654 opt_mess: call ioa_$nnl ("^a", out_str);
655 go to reenter;
656 end;
657 if k ^= 0 then do;
658 do i = 1 to hbound (inv_tst_ids, 1) while (substr (args (k), 4, 3) ^= inv_tst_ids (i));
659 end;
660 if i <= hbound (inv_tst_ids, 1) then do;
661 call com_err_ (0, pname, "^a not supported by ^a",
662 args (k), pname);
663 go to opt_mess;
664 end;
665 end;
666 if add_opt ^= "" then
667 com_string = rtrim (com_string) || " " || add_opt;
668 if index (com_string, "run") ^= 0 then
669 run = "1"b;
670 if index (com_string, "halt") ^= 0 then run = "0"b;
671 if index (com_string, "reset") ^= 0 then do;
672 run = "0"b;
673 p_err = "1"b;
674 end;
675 option = "0"b;
676 end;
677 end;
678 bcd_chars = length (rtrim (com_string));
679 if mod (bcd_chars, 6) ^= 0
680 then
681 bcd_chars = bcd_chars + (6 - mod (bcd_chars, 6));
682 call tolts_alm_util_$ascii_to_bci_ (com_string, bcd_str);
683 go to cont_pas;
684
685 end enter_options;
686
687
688
689 %page;
690
691
692
693 clean_up: proc;
694
695 if isolate_cpu then do;
696 call tandd_$destroy_cpu_test_env;
697 isolate_cpu = "0"b;
698 end;
699 if df_iocbp ^= null then do;
700 call iox_$close (df_iocbp, code);
701 call iox_$detach_iocb (df_iocbp, code);
702 df_iocbp = null;
703 end;
704
705 end clean_up;
706
707
708
709 sw_mess_1: proc (arg, mess);
710
711 dcl (arg, mess) char (*);
712
713 arg = rtrim (arg) || NL || mess;
714 return;
715
716 sw_mess_2: entry (arg, mess);
717
718 arg = rtrim (arg) || NL || "memory " || tags (i) || " " || mess;
719 return;
720
721 end sw_mess_1;
722
723 %page;
724
725
726
727 sleep: proc (t_delay);
728
729 dcl (t_delay, i) fixed bin;
730 dcl tm_delay fixed bin (71);
731
732 tm_delay = t_delay;
733 do i = 1 to delay_iter while (is_mbx.service = 0);
734 call timer_manager_$sleep (tm_delay, "11"b);
735 end;
736
737 end sleep;
738
739
740
741 complete_err_mess: proc;
742
743 if ^pas_sw then
744 if nxt_tst >= pas_exec then
745 pas_sw = "1"b;
746 if mess_in_prog then do;
747 mess_in_prog = "0"b;
748 call isolts_err_log_$write (null, 0, 3, 0, 0);
749 end;
750 end complete_err_mess;
751
752
753
754 set_survey: proc;
755
756 delay = pft_delay;
757 iom0.mbx = "001400"b3;
758 cont_cpu.f_vec, cpu_1.f_vec = "000100"b3;
759 iom0.port, cont_cpu.port, cpu_1.port = cpu_port;
760 imw.base = "001200"b3;
761
762 end set_survey;
763
764 %page;
765
766
767
768 itrace: proc;
769
770 tim = time;
771 call ioa_ ("^a.^a - action code = ^12.3b", substr (tim, 1, 4),
772 substr (tim, 5, 3), string (action_codes));
773 end itrace;
774
775
776
777 ck_isolts_opt: proc returns (bit (1));
778
779 if args (1) = "quit" | args (1) = "q" then do;
780 trm = "1"b;
781 go to end_pas;
782 end;
783 else if args (1) = "restart" then
784 go to restart;
785 else if args (1) = "itrace_on"
786 | args (1) = "itn" then
787 trace_sw = "1"b;
788 else if args (1) = "itrace_off"
789 | args (1) = "itf" then
790 trace_sw = "0"b;
791 else if args (1) = "type"
792 | args (1) = "atype" then do;
793 p_err = "0"b;
794 if args (1) = "type" then
795 add_opt = "print";
796 else add_opt = "aprint";
797 end;
798 else if args (1) = "print"
799 | args (1) = "aprint" then do;
800 p_err = "1"b;
801 add_opt = args (1);
802 end;
803 else if args (1) = "test"
804 & args (2) = "msg" then
805 call tolts_util_$opr_msg;
806 else if args (1) = "display_error"
807 | args (1) = "display"
808 | args (1) = "derr" then do;
809 if ^display_log () then do;
810 inv_display:
811 call com_err_ (0, pname, "invalid input - ""^a""", com_string);
812 return ("1"b);
813 end;
814 end;
815 else if args (1) = "E" then do;
816 com_string = ltrim (substr (com_string, 2));
817 call cu_$cp (addr (com_string), length (com_string), code);
818
819 end;
820 else if args (1) = "cdump" | args (1) = "mdump"
821 | args (1) = "xdump" | args (1) = "sdump" then do;
822 first = 0;
823 last = 65535;
824 d_type = args (1);
825 if cmd_cnt > 1 then do;
826 first = cv_oct_check_ ((args (2)), code);
827 if code ^= 0 | first > 65535 then
828 go to inv_display;
829 last = last - first;
830 if cmd_cnt > 2 then do;
831 last = cv_oct_check_ ((args (3)), code);
832 if code ^= 0 | first + last > 65536 then
833 go to inv_display;
834 end;
835 end;
836 if args (1) = "cdump" then do;
837 call ioa_ ("^/^a ""cdump"" from ^o to ^o of cpu ^a using memory ^a^/",
838 pname, first, last + first, tags (cpu_tag), tags (scu_tag));
839 call dump_segment_ (iox_$user_output, addrel (wseg_p, first), 0, first, last, "01000000000"b);
840 dump_in_prog = "0"b;
841 return ("1"b);
842 end;
843 else if args (1) = "sdump" then do;
844 first = fixed (rel (hdr_p), 17);
845 last = fixed (slave_hdr.pgm_size, 17);
846 if last = 0 then do;
847 call ioa_ ("slave program not loaded");
848 return ("1"b);
849 end;
850 else if last > hbound (wseg.test_pgm, 1) then
851 last = hbound (wseg.test_pgm, 1) - 1;
852 end;
853 dump_in_prog, ntype, idump = "1"b;
854 return ("0"b);
855 end;
856 else return ("0"b);
857 return ("1"b);
858
859 end ck_isolts_opt;
860
861 %page;
862
863
864
865 opr_com: proc (icpu, iscu) returns (bit (1));
866
867 dcl (icpu, iscu) fixed bin (5);
868 dcl timer_manager$sleep entry (fixed bin (71), bit (2));
869 dcl d fixed bin (71) init (1);
870
871 opr_query_info.q_sw = "1"b;
872 opr_query_info.prim = "grant";
873 opr_query_info.alt = "deny";
874 opr_query_info.r_comment = "";
875 call ioa_ ("asking operators permission to test cpu ""^a"" using memory ""^a""", tags (icpu), tags (iscu));
876 call opr_query_ (addr (opr_query_info),
877 "permission asked to test cpu ""^a"" using memory ""^a""", tags (icpu), tags (iscu));
878 if opr_query_info.answer = "deny" then do;
879 call ioa_ ("permission denied");
880 return ("1"b);
881 end;
882 call ioa_ ("permission granted");
883 call ioa_ ("asking operator to manually reconfigure cpu ^a", tags (icpu));
884 opr_query_info.q_sw = "0"b;
885 call opr_query_ (addr (opr_query_info),
886 "execute the following manual reconfiguration on cpu ""^a"":", tags (icpu));
887 call timer_manager_$sleep (d, "11"b);
888 call opr_query_ (addr (opr_query_info),
889 " 1. set all port and initialize enable switches and interlace switches to off.");
890 call timer_manager_$sleep (d, "11"b);
891 if cpu_type = "dps8"
892 then
893 call opr_query_ (addr (opr_query_info),
894 " 2. set the assignment switches for all ports to 000.");
895 else if cpu_type = "l68 "
896 then
897 call opr_query_ (addr (opr_query_info),
898 " 2. set all port assignment switches to 000 and the size switches to full");
899 call timer_manager_$sleep (d, "11"b);
900 if cpu_type = "dps8" then
901 call opr_query_ (addr (opr_query_info),
902 " 3. set store size switches to 2222.");
903 else if cpu_type = "l68 "
904 then
905 call opr_query_ (addr (opr_query_info),
906 " 3. remove the right free-edge connector on the 645pq wwb at slot ab28.");
907 call timer_manager_$sleep (d, "11"b);
908 if cpu_type = "dps8" then
909 call opr_query_ (addr (opr_query_info),
910 " 4. verify that the mode switch is in vms.");
911 else if cpu_type = "l68 " then
912 call opr_query_ (addr (opr_query_info),
913 " 4. install the ""cpu test"" on the right free-edge connector at slot ab28.");
914 call timer_manager_$sleep (d, "11"b);
915 call opr_query_ (addr (opr_query_info),
916 " 5. depress the initialize and clear push button.");
917 call timer_manager_$sleep (d, "11"b);
918 opr_query_info.q_sw = "1"b;
919 opr_query_info.prim = "done";
920 opr_query_info.alt = "unable";
921 opr_query_info.r_comment = "when reconfiguration complete";
922
923 call opr_query_ (addr (opr_query_info),
924 " 6. set the port enable switch ""on"" for port ""^a"".", tags (iscu));
925 if opr_query_info.answer = "unable" then do;
926 call ioa_ ("having problems reconfiguring");
927 return ("1"b);
928 end;
929
930 else return ("0"b);
931 end opr_com;
932
933
934
935
936
937
938 %page;
939
940
941
942 display_log: proc returns (bit (1));
943
944 if cmd_cnt = 1 then
945 count, limit = 1;
946 else if cmd_cnt >= 2 & cmd_cnt < 4 then
947 if args (2) = "-all" then
948 count, limit = -1;
949 else do;
950 count = cv_dec_check_ ((args (2)), code);
951 if code ^= 0 then
952 return ("0"b);
953 if cmd_cnt < 3 then
954 limit = 0;
955 else do;
956 limit = cv_dec_check_ ((args (3)), code);
957 if code ^= 0 then
958 return ("0"b);
959 end;
960 end;
961 else return ("0"b);
962 call isolts_err_log_$display (count, limit, p_err);
963 return ("1"b);
964 end display_log;
965
966 %page;
967
968
969
970 abort: proc (ecode);
971
972 dcl ecode fixed bin (35);
973 dcl (arg1, arg3, arg4) char (12);
974 dcl arg2 char (128);
975
976 dcl reconfig_err_message (18) char (64) static options (constant) init
977 ("System dynamic reconfiguration in progress, try later",
978 "cpu tag ^a is illegal",
979 "cpu ^a is online and unavailable for test",
980 "cpu ^a is not configured",
981 "there must be at least two online scus to run isolts",
982 "scu tag ^a is illegal",
983 "scu ^a is the bootload scu and cannot be used for testing",
984 "scu ^a is not online",
985 "requesting process is not running isolts",
986 "cpu ^a responded to interrupt cell ^a at loc ^a",
987 "cpu ^a responded to an interrupt cell ^a on scu ^a",
988 "cpu ^a responded to an interrupt cell ^a on scu ^a at loc ^a",
989 "cpu ^a failed to respond to an interrupt cell ^a interrupt",
990 "the following switches on cpu ^a are set incorrectly: ^a",
991 "a ""lda 2"" did not operate properly",
992 "a ""lda 65536"" (64k) failed to produce a store fault",
993 "scu ^a has no interrupt mask register assigned to cpu ^a",
994 "unable to set CPU required for cpu ^a");
995
996 call com_err_ (0, pname, "the following errors were detected while attempting reconfiguration:^/");
997 if ecode > 18 then
998 call com_err_ (ecode, pname, "attempting reconfiguration");
999
1000 else do;
1001 arg1, arg2, arg3, arg4 = "";
1002 if ecode > 9 & ecode < 14 then do;
1003 rswp = addr (switches (1));
1004 arg1 = tags (cpu_tag);
1005 call ioa_$rsnnl ("^d", arg2, i, rswp -> switch_w1.cell);
1006 if ecode > 10 & ecode < 13 then
1007 arg3 = tags (scu_tag);
1008 end;
1009 go to etype (ecode);
1010
1011 etype (2):
1012 etype (3):
1013 etype (4):
1014 etype (18):
1015 arg1 = tags (cpu_tag);
1016 go to display_err;
1017
1018 etype (6):
1019 etype (7):
1020 etype (8):
1021 arg1 = tags (scu_tag);
1022 go to display_err;
1023
1024 etype (10):
1025 call ioa_$rsnnl ("^o", arg3, i, rswp -> switch_w1.offset);
1026 go to display_err;
1027
1028 etype (12):
1029 call ioa_$rsnnl ("^o", arg4, i, rswp -> switch_w1.offset);
1030 go to display_err;
1031
1032 etype (17):
1033 arg1 = tags (scu_tag);
1034 arg2 = tags (cpu_tag);
1035 go to display_err;
1036
1037 etype (14):
1038 arg1 = tags (cpu_tag);
1039 rswp = addr (switches (2));
1040 if cpu_type = "l68 " then do;
1041 if dps_rsw_2.fault_base then
1042 call sw_mess_1 (arg2, "fault base");
1043 if dps_rsw_2.cpu_num ^= 0 then
1044 call sw_mess_1 (arg2, "processor number");
1045 end;
1046 else if cpu_type = "dps8" then do;
1047 if dps8_rsw_2.fault_base then
1048 call sw_mess_1 (arg2, "fault base");
1049 if dps8_rsw_2.cpu_num ^= 0 then
1050 call sw_mess_1 (arg2, "processor number");
1051 end;
1052 rswp = addr (switches (4));
1053 do i = 0 to 7;
1054 if i < 4 then
1055 pip = addr (addr (switches (1)) -> rsw_1_3.port_info (i));
1056 else pip = addr (addr (switches (3)) -> rsw_1_3.port_info (i - 4));
1057
1058 if pi.port_assignment then
1059 call sw_mess_2 (arg2, "port assignment");
1060 if pi.port_enable then
1061 call sw_mess_2 (arg2, "port enable");
1062 if pi.initialize_enable then
1063 call sw_mess_2 (arg2, "initialize enable");
1064 if pi.interlace_enable | rsw_4.four (i) then
1065 call sw_mess_2 (arg2, "interlace");
1066 if pi.mem_size ^= 0 then
1067 call sw_mess_2 (arg2, "size");
1068 if rsw_4.half (i) then
1069 call sw_mess_2 (arg2, "half/full");
1070 end;
1071
1072 go to display_err;
1073
1074 etype (1):
1075 etype (5):
1076 etype (9):
1077 etype (11):
1078 etype (13):
1079 etype (15):
1080 etype (16):
1081
1082 display_err: call com_err_ (0, pname, reconfig_err_message (ecode), arg1, arg2, arg3, arg4);
1083
1084 end;
1085
1086
1087
1088 end abort;
1089
1090 %page;
1091
1092 %include rcerr;
1093 %include rsw;
1094 %include opr_query_info;
1095 %include gload_data;
1096
1097 %page;
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231 end isolts_;