1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   4         *                                                         *
   5         * Copyright (c) 1972 by Massachusetts Institute of        *
   6         * Technology and Honeywell Information Systems, Inc.      *
   7         *                                                         *
   8         *********************************************************** */
   9 
  10 
  11 
  12 
  13 
  14 /****^  HISTORY COMMENTS:
  15   1) change(2021-12-23,Swenson), approve(2021-12-23,MCR10107),
  16      audit(2021-12-23,GDixon), install(2022-01-04,MR12.8-1018):
  17      Fix incorrect error message shown by ISOLTS when user lacks permission to set the required processor.
  18                                                    END HISTORY COMMENTS */
  19 
  20 
  21 
  22 /* format: style4,ifthenstmt,ifthen,ind3,ll125,lineconind1 */
  23 isolts_: proc;
  24 
  25 /* isolts_ - the I^H_S^H_olated O^H_nL^H_ine T^H_est S^H_ystem (ISOLTS) driver
  26    initially coded by James A. Bush 6/78
  27    Modified 09/80 by R. Fakoury to make the operator message more understandable,
  28    to correct a bug when displaying the last error, to request input after invalid responce,
  29    to add a delay between operator request reconfig messages and to force the end pass message to the terminal.
  30    Modified 8102 by R. Fakoury to allow margin/nomargin options and to add the display_error in the initial request.
  31    Modified 8112 by R. Fakoury to correct an oversight in the operator message sequence,
  32    to add new numbers to inv_tst_ids.
  33    Modified 02/04/83 by R. Fakoury to add new test ids to the invalid test list.
  34    Modified 03/83 by R. Fakoury to allow -type option to the display request and the type option to a pas option request.
  35    Also put temp cludge to increase the timeout time for prg892/893.
  36    Modified 03/83 by Rick Fakoury to add call to tolts_util_$get_ttl_date, and
  37    tolts_util_$opr_msg.
  38    Modified 03/83 by Rick Fakoury to remove the (non_quick) option from interpret_action and run_pas.
  39    Modified 08/17/83 by Rick Fakoury to allow partial config printing & correct an error in display error of one.
  40    Modified 09/21/83 by R. Fakoury to check for a config card with no cpu type and to modify dps8 reconfig instructions.
  41    Modified 10/83 by R.Fakoury to implement auditor suggested changes.
  42    Modified 11/84 by R. Fakoury to changes the call from tolts_pcd_$config to tolts_util_$find_card, make tst893 invalid,
  43    and to use the system includes files for cpu.
  44 */
  45 
  46 /* External entries */
  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 /* Automatic */
  79 
  80 dcl  code fixed bin (35);                                   /* standard system error code */
  81 dcl  (cpu_tag, scu_tag, cpu_port) fixed bin (5);            /* cpu and scu tags */
  82 dcl  switches (4) bit (36);                                 /* read switch descrepency data */
  83 dcl  bf_sw bit (1) init ("0"b);                             /* brief option switch */
  84 dcl  (nxt_tst, new_tst) char (3);                           /* next test id for search */
  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 /* Constants */
 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);                  /* print error flag */
 118 dcl  df_iocbp ptr int static init (null);                   /* deck file iocb ptr */
 119 dcl  isolate_cpu bit (1) int static;                        /* cleanup flag */
 120 dcl  (cont_pas, restart, end_pas, eopt) label;              /* target of non_local gotos */
 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 /* Structures and based variables */
 126 
 127 dcl  1 wseg based (wseg_p) aligned,                         /* structure definition of PAS2 layout */
 128        2 int_vectors (0:31) bit (72),                       /* 0 - 77 interrupt vectors */
 129        2 flt_vectors (0:31) bit (72),                       /* 100 - 177 fault vectors */
 130        2 pad1 (32) bit (72),
 131        2 COW bit (36),                                      /* 300 Connect operand word */
 132        2 pad2 (10) bit (36),
 133        2 prt_out (30) bit (36),                             /* 313 - 350 printer output buffer */
 134        2 cons_in (21) bit (36),                             /* 351 - 375 console input buffer */
 135        2 pad3 (322) bit (36),
 136        2 opt_save (25) bit (36),                            /* 1100 - 1130 options save area */
 137        2 pad4 (31) bit (36),
 138        2 is_mbx,                                            /* 1170 - 1177 ISOLTS mailbox area */
 139          3 control fixed bin (35),                          /* ISOLTS in control, if non-zero */
 140          3 service fixed bin (35),                          /* ISOLTS service requested flag, If non-zero */
 141          3 action_codes unaligned,                          /* service action codes */
 142            4 pad5 bit (21),
 143            4 halt bit (1),                                  /* bit 21 - halt imediately */
 144            4 pad6 bit (4),
 145            4 ld_spgm bit (1),                               /* bit 26 - load slave mode program */
 146            4 ld_mpgm bit (1),                               /* bit 27 - load master mode program or PFT */
 147            4 wc_eop bit (1),                                /* bit 28 - write console, end of program */
 148            4 wc_opt bit (1),                                /* bit 29 - write console, option request flag */
 149            4 read bit (1),                                  /* bit 30 - read console */
 150            4 wc_type bit (1),                               /* bit 31 - write console, type message */
 151            4 print bit (1),                                 /* bit 32 - print message */
 152            4 err bit (1),                                   /* bit 33 - error flag */
 153            4 pad7 bit (2),
 154          3 pgm_name bit (36),                               /* word 3 - program name or ptr and wd count */
 155          3 pad8 (4) bit (36),
 156        2 pad9 (64) bit (36),
 157        2 wk_survey (16) bit (36),                           /* 1300 - 1317 working survey table */
 158        2 pad10 (3359) bit (36),
 159        2 imw unaligned,                                     /* 7757 - IOM interrupt multiplexor word */
 160          3 pad bit (18),
 161          3 base bit (18),                                   /* base address */
 162        2 sys_survey unaligned,                              /* 7760 - 7777 system survey table */
 163          3 iom0,                                            /* IOM 0 mailbox and port */
 164            4 mbx bit (18),
 165            4 port fixed bin,
 166          3 iom1_3 (3) bit (36),                             /* same info for IOMs 1, 2, and 3 */
 167          3 console,                                         /* info on system console */
 168            4 chan fixed bin (8),                            /* console channel number */
 169            4 pad bit (27),
 170            4 cons_iom bit (36),                             /* iom number that console is on */
 171          3 printer,                                         /* info about system printer */
 172            4 chan fixed bin (8),                            /* printer channel number */
 173            4 pad bit (27),
 174            4 prt_iom bit (36),                              /* iom number that printer is on */
 175          3 cont_cpu,                                        /* info about control cpu */
 176            4 f_vec bit (18),                                /* fault vector base address */
 177            4 port fixed bin,                                /* control cpu port number */
 178          3 hi_mem,                                          /* info about highest addressable memory location */
 179            4 address fixed bin,
 180            4 pad bit (18),
 181          3 cpu_1,                                           /* info about cpu # 1 */
 182            4 f_vec bit (18),                                /* fault vector base address */
 183            4 port fixed bin,                                /* cpu # 1 port number */
 184          3 cpu2_4 (3) bit (36),                             /* the same info for cpus 2, 3, and 4 */
 185          3 boot,                                            /* info on boot device */
 186            4 chan fixed bin (8),                            /* boot tape chan number */
 187            4 pad bit (27),
 188            4 iom bit (36),                                  /* iom number that boot tape is on */
 189        2 exec (28672) bit (36),                             /* 10000 - 77777 PAS2 exec area */
 190        2 test_pgm (32768) bit (36);                         /* 100000 - 177777 slave program area */
 191 
 192 dcl  1 slave_hdr based (hdr_p) aligned,                     /* slave program header template */
 193        (
 194        2 pgm_num bit (36),                                  /* pgm # in bcd (e.g. - pm700, pa864, ps955) */
 195        2 erlink bit (18),                                   /* error linkage pointer */
 196        2 pgm_rev bit (18),                                  /* program revision in bcd */
 197        2 p_int_tab bit (18),                                /* pseudo interrupt vector ptr */
 198        2 pgm_size bit (18),                                 /* program size in words */
 199        2 tst_name bit (72),                                 /* test name */
 200        2 num_tests bit (18),                                /* number of tests in program */
 201        2 xfer_p bit (18),                                   /* transfer table pointer */
 202        2 cksum bit (36),                                    /* check sum word before init. */
 203        2 program_name bit (108),                            /* program name */
 204        2 pad (9) bit (36)
 205        ) unaligned;                                         /* pad area */
 206 
 207 dcl  1 action like is_mbx.action_codes unaligned;           /* copy of action flags */
 208 dcl  1 pi like rsw_1_3.port_info based (pip) unaligned;
 209 dcl  wseg1 (65536) fixed bin based (wseg_p);                /* work seg as an array */
 210 dcl  bcd_str bit (bcd_chars * 6) based (mptr);              /* bcd message input */
 211 dcl  add_wc (2) fixed bin unaligned based (awcp);           /* address and word count */
 212 
 213 
 214 %include config_cpu_card;
 215 %page;
 216 
 217 
 218       isolate_cpu = "0"b;                                   /* reset cleanup flag */
 219       on cleanup call clean_up;                             /* establish cleanup and */
 220       on finish call clean_up;                              /* finish condition handlers */
 221 
 222       call tolts_util_$get_ttl_date (isolts_, ttl_date);
 223       call tolts_util_$on_off (pname, "on", ttl_date);      /* signon */
 224 
 225 /* now get a pointer to our error message file */
 226 
 227       call isolts_err_log_$init (code);
 228       if code ^= 0 then                                     /* if problem */
 229          go to t_off;                                       /* wrap up and return */
 230 
 231 
 232 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 233 /*                                                                                                            */
 234 /* Loop until user quits                                                                                      */
 235 /*                                                                                                            */
 236 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
 237 
 238 
 239 
 240       term = "0"b;                                          /* reset terminate cndition */
 241       do while (^term);
 242          call ioa_ ("^/***enter ""test cpu <tag>"", "" display_error"", ""test pcd"", ""msg"", or ""quit """);
 243 
 244 /* Now find out what user wants to do */
 245 
 246 ask:
 247          call tolts_util_$query ("??? ", com_string, c_len, args, cmd_cnt);
 248          if args (1) = "quit" | args (1) = "q" then         /* user wants to quit */
 249             term = "1"b;                                    /* so let him */
 250          else if args (1) = "msg" then                      /* user wants to send a msg to the operator */
 251             call tolts_util_$opr_msg;
 252          else if args (1) = "display_error" | args (1) = "display"
 253           | args (1) = "derr" then do;                      /* display error message */
 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                         /* go display requested log entries */
 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      /* bad input */
 269             go to bad_rsp;
 270          else if args (2) = "pcd" then do;                  /* user wants a list of avail. cpus and scus */
 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                     /* user goofed */
 275             go to bad_rsp;
 276          else do;                                           /* test cpu request */
 277             trace_sw = "0"b;                                /* reset trace switch if set */
 278             if cmd_cnt < 3 then                             /* not enough args */
 279                go to bad_rsp;
 280             cpu_tag = search ("abcdefgh", args (3));        /* convert cpu tag to number */
 281             if cpu_tag = 0 then                             /* not correct format */
 282                go to bad_rsp;
 283             term = "0"b;
 284             scu_tag = -1;                                   /* default, let hardcore decide */
 285             if cmd_cnt > 3 then do;                         /* additional args */
 286                trm = "0"b;                                  /* reset flag */
 287                do i = 4 to cmd_cnt;                         /* process rest of args */
 288                   if ^trm then                              /* if tag flag not set */
 289                      if args (i) = "-memory"
 290                       | args (i) = "-mem" then trm = "1"b;  /* set tag flag */
 291                      else if args (i) = "-brief"
 292                       | args (i) = "-bf" then bf_sw = "1"b; /* set brief mode */
 293                      else if args (i) = "-trace" then       /* user wants to trace action codes */
 294                         trace_sw = "1"b;                    /* set trace switch */
 295                      else go to bad_rsp;                    /* tell user about his typing problem */
 296                   else do;                                  /* ok lets find the memory tag */
 297                      scu_tag = search ("abcdefgh", args (i));
 298                      if scu_tag = 0 then                    /* did not find tag */
 299                         go to bad_rsp;
 300                      else scu_tag = scu_tag - 1;
 301                      trm = "0"b;                            /* reset tag flag */
 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;                          /* a = 0, h = 7, etc */
 327 
 328 /* Now lets go to hardcore and check if we can get resources to run */
 329 
 330             call tandd_$check_isolts_resources (cpu_tag, scu_tag, cpu_port, code);
 331             if code ^= 0 then do;                           /* can't get what we need */
 332                call abort (code);                           /* go display config error */
 333                go to cmd_loop;
 334             end;
 335             isolate_cpu = "1"b;                             /* set flag for cleanup handler */
 336 
 337 /* now  give the operator manual reconfiguration instructions */
 338 
 339             if opr_com (cpu_tag, scu_tag) then              /* if permission denied */
 340                go to cmd_loop;                              /* then go release resources */
 341 
 342 /* now go do actual reconfig and primitive cpu test */
 343 
 344             call tandd_$create_cpu_test_env (cpu_tag, scu_tag, switches, wseg_p, code);
 345             if code ^= 0 then do;                           /* some problem */
 346                call abort (code);                           /* go display config error */
 347                go to cmd_loop;
 348             end;
 349             call ioa_ ("^/reconfiguration complete");       /* tell user */
 350 
 351             hdr_p = addr (wseg.test_pgm);                   /* set test program header ptr */
 352             wseg1 = 0;                                      /* clear out our memory area */
 353             restart = restart_label;                        /* set restart label */
 354 
 355 /* now go run the pfts and pas2 */
 356 
 357 restart_label:                                              /* target of non-local gotos */
 358             call run_pas;
 359          end;
 360 cmd_loop: call clean_up;                                    /* go release resources if assigned */
 361       end;
 362 
 363 /* user is all done we can wrap up now */
 364 
 365 t_off: call tolts_util_$on_off (pname, "off", ttl_date);    /* signoff */
 366       return;
 367 
 368 %page;
 369 
 370 
 371 /* run_pas - internal procedure to run and do the test sequencing of the pfts and pas2 */
 372 
 373 run_pas: proc;
 374 
 375       nxt_tst = first_pft;                                  /* set up for first test */
 376       awcp = addr (is_mbx.pgm_name);                        /* set up address/word count templete ptr */
 377       cont_pas = continue_pas;                              /* set up continue label */
 378       end_pas = end_tst;                                    /* set up quit label */
 379       pgm_offset = 0;                                       /* preset loading offset for master mode program */
 380       trm, pas_sw, mess_in_prog, ntype, run, option, car_nz = "0"b;
 381                                                             /* reset flags */
 382       dump_in_prog, idump = "0"b;
 383 
 384 /* quit_handler - quit condition handler for isolts */
 385 
 386       on quit begin;                                        /* establish quit condition handler */
 387 
 388          if pas_sw then do;                                 /* if not in primitives */
 389             ntype = "0"b;                                   /* force options type out */
 390             string (action_codes) = "0"b;                   /* clear out any existing action code */
 391             if dump_in_prog & ^idump then do;               /* if dumping to file */
 392                dump_in_prog = "0"b;                         /* abort dump and return to options */
 393                go to eopt;
 394             end;
 395             if option then do;                              /* if we are in the option loop */
 396                call ioa_ ("^/");                            /* force new line */
 397                car_nz = "0"b;
 398                go to eopt;
 399             end;
 400             action_codes.halt = "1"b;                       /* set halt imediate flag */
 401             go to cont_pas;                                 /* perform non local go to */
 402          end;
 403          else call continue_to_signal_ (code);              /* if not in pas2 pass it on */
 404 
 405       end;
 406 
 407       call ioa_ ("^/start pft ^a^/", nxt_tst);
 408 
 409       do while (^trm);                                      /* loop until user quits */
 410 
 411 /* search for test page in file system */
 412 
 413          call tolts_util_$search (df_iocbp, "pas." || nxt_tst, t_ptr, c_len, code);
 414          if code ^= 0 then do;                              /* if couldn't find test page */
 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 /* load the core image into our work segment */
 423 
 424 tout_retry: call gload_ (t_ptr, addrel (wseg_p, pgm_offset), 0, addr (gload_data), code);
 425          if code ^= 0 then do;                              /* problem durring load */
 426             call com_err_ (code, pname, "^a^/attempting to load pas.^a",
 427              gload_data.diagnostic, nxt_tst);
 428             return;
 429          end;
 430 
 431 /* reset the isolts mailbox flags and set isolts control flag */
 432 
 433          if ^pas_sw then                                    /* if pft */
 434             call set_survey;                                /* go set up system survey */
 435          else do;
 436             delay = pas_delay;
 437             slave_hdr.cksum = gload_data.checksum;          /* set up deck checksum in pgm header */
 438          end;
 439          if nxt_tst = "892" | nxt_tst = "893"               /* thesetests cause timeouts */
 440           | nxt_tst = "955" then delay_iter = 600;          /* increase the delay until fixed */
 441          else delay_iter = 300;
 442          string (is_mbx.action_codes) = "0"b;               /* reset all action flags */
 443          is_mbx.pgm_name = "0"b;                            /* reset program name */
 444 continue_pas:                                               /* target of non local go tos */
 445          if is_mbx.control = 0 then                         /* if flag is reset */
 446             is_mbx.control = 65535;                         /* set it to indicate isolts in control */
 447          is_mbx.service = 0;                                /* reset service requested flag */
 448          if trace_sw then                                   /* if tracing action codes */
 449             if string (action_codes) ^= "0"b then           /* and we have  bit 21 set */
 450                call itrace;                                 /* go trace action code */
 451 
 452 /* send interrupt to the cpu under test */
 453 
 454          call tandd_$interrupt_test_cpu (code);
 455          if code ^= 0 then do;                              /* if couldn't interrupt */
 456             call com_err_ (code, pname, "attempting to interrupt cpu ^a", tags (cpu_tag));
 457             return;
 458          end;
 459 
 460 /* now go to sleep for awhile */
 461 
 462          do i = 1 to 1000 while (is_mbx.service = 0);
 463          end;                                               /* give pas2 a chance if intermediate I/O */
 464          if is_mbx.service = 0 then                         /* if didn't make it give up processor */
 465 wait:       call sleep (delay);
 466          if is_mbx.service = 0 then do;                     /* if time out */
 467             call ioa_ (" ");                                /* make sure we return to collum 1 */
 468             if ^pas_sw & nxt_tst ^= pas_exec then do;       /* if pft and not pas2 exec */
 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                 /* hung up while initializing pas exec */
 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);                               /* loop until user gets it right */
 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   /* user wants to get out */
 488                   return;
 489                else if args (1) = "retry"
 490                 | args (1) = "r" then                       /* user wants to retry test */
 491                   go to tout_retry;
 492                else if args (1) = "continue"
 493                 | args (1) = "c" then                       /* wait some more */
 494                   go to wait;
 495             end;
 496          end;
 497          else do;
 498             string (action) = string (is_mbx.action_codes); /* copy action codes */
 499             if trace_sw then                                /* if tracing action codes */
 500                call itrace;                                 /* go trace action code */
 501             string (is_mbx.action_codes) = "0"b;            /* and reset */
 502             call interpret_action;                          /* do what the test wants */
 503          end;
 504 end_tst:                                                    /* target of non-local gotos */
 505       end;
 506 
 507 
 508 
 509    end run_pas;
 510 
 511 %page;
 512 
 513 /* interpret_action - internal procedure to interpret  the isolts action flags */
 514 
 515 interpret_action: proc;
 516 
 517       if action.ld_mpgm | action.ld_spgm then do;           /* load next program request */
 518          call complete_err_mess;                            /* go complete error message if one active */
 519          call bcd_to_ascii_ (substr (pgm_name, 13, 18), new_tst);
 520                                                             /* convert tst id to ascii */
 521          if trace_sw then                                   /* if user tracing action codes... */
 522             call ioa_ ("load pgm^a", new_tst);              /* tell him what we want to load */
 523          do i = 1 to hbound (inv_tst_ids, 1) while (new_tst ^= inv_tst_ids (i));
 524          end;                                               /* check validity of test id */
 525          if i <= hbound (inv_tst_ids, 1) then do;           /* If this test is illegal for isolts */
 526             ntype = "1"b;                                   /* set flag so we don't type options message */
 527             action_codes.halt = "1"b;                       /* set halt imediate flag */
 528             go to cont_pas;                                 /* perform non local goto */
 529          end;
 530          if ^pas_sw & ^bf_sw then                           /* if PFT and not in brief mode ... */
 531             call ioa_ ("*** end ^a, next ^a ***", nxt_tst, new_tst); /* display test seq for user */
 532          nxt_tst = new_tst;                                 /* pick up new test id and go find it */
 533          if action.ld_spgm then                             /* if slave program to be loaded */
 534             pgm_offset = fixed (rel (addr (wseg.test_pgm)), 18); /* set slave base */
 535          else pgm_offset = 0;                               /* if master mode pgm then offset = 0 */
 536       end;                                                  /* fall through and return */
 537       else if action.wc_type | action.wc_eop | action.wc_opt then do;
 538                                                             /* write console */
 539          call complete_err_mess;                            /* go complete error message if one active */
 540          mptr = ptr (wseg_p, add_wc (1));
 541          bcd_chars = add_wc (2) * 6;                        /* get address and word count of message */
 542          call tolts_util_$bci_to_ascii (bcd_str, out_str, bcd_chars); /* convert bcd */
 543          if substr (out_str, 1, 1) = NL & length (out_str) > 2 then /* if new line strip it off */
 544             out_str = substr (out_str, 2);
 545          if action.wc_type & length (out_str) >= 1 then     /* if output to go on same line */
 546             car_nz = "1"b;
 547          if action.wc_opt | action.wc_eop then option = "1"b; /* if option type request */
 548          else option = "0"b;
 549 
 550          if ^ntype then do;                                 /* if no type flag is on ignore message */
 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;     /* reset carriage position switch */
 554          end;
 555          go to cont_pas;                                    /* perform non local goto */
 556       end;
 557       else if action.read then                              /* enter options request */
 558          call enter_options;
 559       else if action.print then do;                         /* output message to printer */
 560          mptr = ptr (wseg_p, add_wc (1));
 561          mlen = add_wc (2);                                 /* set word count of message */
 562          if dump_in_prog then                               /* if we are getting dump reg info from pas2 */
 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;         /* if new error message or one in progress */
 565             if mlen > 1 & mlen < 5 & ^mess_in_prog then do; /* must be end pass & ^message */
 566                mptr = ptr (wseg_p, add_wc (1));
 567                bcd_chars = add_wc (2) * 6;                  /* get address and word count of message */
 568                call tolts_util_$bci_to_ascii (bcd_str, out_str, bcd_chars);
 569                                                             /* convert bcd */
 570                call ioa_ (" ^a", out_str);                  /* print on terminal */
 571                go to cont_pas;
 572             end;
 573             else if action.err then do;                     /* if beginning of new message */
 574                call complete_err_mess;                      /* complete old one */
 575                mess_in_prog = "1"b;                         /* indicate an unfinished error message */
 576                mtype = 1;                                   /* set message type flag to start of message */
 577                if ^run then do;                             /* if run option not in force */
 578                   call ioa_ ("^/*** an error has occurred ***^/");
 579                                                             /* let user know about error */
 580                end;
 581             end;
 582             else mtype = 2;                                 /* must be intermediate message */
 583             call isolts_err_log_$write (mptr, mlen, mtype, cpu_tag, scu_tag);
 584          end;
 585          else do;                                           /* write it to users terminal for now */
 586             bcd_chars = mlen * 6;                           /* get word count of message */
 587             call tolts_util_$bci_to_ascii (bcd_str, out_str, bcd_chars);
 588                                                             /* convert bcd */
 589             if ^bf_sw then do;                              /* if not in brief mode */
 590                call ioa_ ("^[^/^]^a", car_nz, out_str);     /* display message for user */
 591                car_nz = "0"b;                               /* reset carriage position switch */
 592             end;
 593          end;
 594          go to cont_pas;                                    /* perform non local goto */
 595       end;
 596 
 597    end interpret_action;
 598 
 599 %page;
 600 
 601 /* enter_options - internal procedure to enter pas2 or isolts options and check for legality */
 602 
 603 enter_options: proc;
 604 
 605       add_opt = "";                                         /* pad additional option  with blanks */
 606       mptr = ptr (wseg_p, add_wc (1));                      /* get ptr to return options string */
 607       eopt = opt_mess;                                      /* set enter options label */
 608       if dump_in_prog then do;                              /* dumping and we get here, means we are ready to dump */
 609          idump = "0"b;                                      /* octal from the Multics side */
 610          call isolts_err_log_$dump (d_type, addrel (wseg_p, first), last,
 611           2, cpu_tag, scu_tag);                             /* dump it */
 612          idump, ntype, dump_in_prog = "0"b;                 /* dump finsihed, reset flags */
 613          go to opt_mess;                                    /* and go to enter options */
 614       end;
 615       if ntype then do;                                     /* if we are forcing seq option */
 616          ntype = "0"b;                                      /* reset it so we don't come back */
 617          bcd_chars = 6;
 618          call tolts_alm_util_$ascii_to_bci_ ("seq", bcd_str);
 619                                                             /* convert ascii to bcd */
 620          go to cont_pas;                                    /* and return to pas2 exec */
 621       end;
 622 
 623 reenter:
 624       call tolts_util_$query (" ", com_string, c_len, args, cmd_cnt);
 625       if cmd_cnt = 0 then do;                               /* if user typed NL char */
 626          option = "0"b;                                     /* reset options flag */
 627          go to cont_pas;                                    /* return to pas2 at point interrupted */
 628       end;
 629 
 630 /* check for ISOLTS only options first */
 631 
 632       if option then do;                                    /* execute only if options request */
 633          if ck_isolts_opt () then                           /* if isolts option, it has already been done */
 634             go to opt_mess;                                 /* go to options again */
 635          else do;                                           /* must be pas2 option, check them for legality */
 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;                              /* set flag for later */
 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;                        /* if illegal option */
 649                   end;
 650                end;
 651             end;
 652             if trm1 then do;                                /* if user has entered options not supported by ISOLTS */
 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;                              /* if "prgxxx" or "tstxxx" option specified */
 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;     /* found bad tst id */
 661                   call com_err_ (0, pname, "^a not supported by ^a",
 662                    args (k), pname);
 663                   go to opt_mess;                           /* let user try again */
 664                end;
 665             end;
 666             if add_opt ^= "" then                           /* if additional option */
 667                com_string = rtrim (com_string) || " " || add_opt; /* add it to end */
 668             if index (com_string, "run") ^= 0 then          /* if run option specified */
 669                run = "1"b;
 670             if index (com_string, "halt") ^= 0 then run = "0"b; /* reset run if halt option */
 671             if index (com_string, "reset") ^= 0 then do;    /* if reset option */
 672                run = "0"b;                                  /* reset run flag */
 673                p_err = "1"b;                                /* set print error flag */
 674             end;
 675             option = "0"b;                                  /* reset option flag */
 676          end;
 677       end;
 678       bcd_chars = length (rtrim (com_string));              /* get exact options string length */
 679       if mod (bcd_chars, 6) ^= 0
 680        then                                                 /* if not already mod 6 */
 681          bcd_chars = bcd_chars + (6 - mod (bcd_chars, 6));  /* make output mod 6 */
 682       call tolts_alm_util_$ascii_to_bci_ (com_string, bcd_str); /* convert it to bcd */
 683       go to cont_pas;                                       /* perform non_local goto */
 684 
 685    end enter_options;
 686 
 687 
 688 
 689 %page;
 690 
 691 /* clean_up - internal procedure to establish a cleanup and finish condition handler */
 692 
 693 clean_up: proc;
 694 
 695       if isolate_cpu then do;                               /* if cleanup flag set */
 696          call tandd_$destroy_cpu_test_env;
 697          isolate_cpu = "0"b;                                /* reset flag */
 698       end;
 699       if df_iocbp ^= null then do;                          /* detach deck file if attached */
 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 /* sw_mess_1, sw_mess_2 - subroutines to set up read switch error diagnostics */
 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 /* sleep - internal procedure to put process to sleep for specified time period */
 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);    /* loop until service requested or time out */
 734          call timer_manager_$sleep (tm_delay, "11"b);       /* sleep for specified seconds */
 735       end;
 736 
 737    end sleep;
 738 
 739 /* complete_err_mess - internal subroutine to check if an error message is in progress and complete it */
 740 
 741 complete_err_mess: proc;
 742 
 743       if ^pas_sw then                                       /* if still in primitives */
 744          if nxt_tst >= pas_exec then                        /* set pas switch if in pas exec or pas pgm */
 745             pas_sw = "1"b;
 746       if mess_in_prog then do;                              /* if error message in progress */
 747          mess_in_prog = "0"b;                               /* reset flag */
 748          call isolts_err_log_$write (null, 0, 3, 0, 0);     /* complete it */
 749       end;
 750    end complete_err_mess;
 751 
 752 /* set_survey - internal procdure to set up system survey table */
 753 
 754 set_survey: proc;
 755 
 756       delay = pft_delay;                                    /* set up pft delay value */
 757       iom0.mbx = "001400"b3;                                /* set up iom 0 mailbox address */
 758       cont_cpu.f_vec, cpu_1.f_vec = "000100"b3;             /* set up fault vector address */
 759       iom0.port, cont_cpu.port, cpu_1.port = cpu_port;      /* set port number */
 760       imw.base = "001200"b3;                                /* set interrupt multiplexor base */
 761 
 762    end set_survey;
 763 
 764 %page;
 765 
 766 /* itrace - internal procedure to trace action codes and time */
 767 
 768 itrace: proc;
 769 
 770       tim = time;                                           /* get current 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 /* ck_isolts_opt - internal procedure to check and perform isolts only options */
 776 
 777 ck_isolts_opt: proc returns (bit (1));
 778 
 779       if args (1) = "quit" | args (1) = "q" then do;        /* user wants to quit */
 780          trm = "1"b;                                        /* set terminate condition */
 781          go to end_pas;                                     /* perform non-local goto */
 782       end;
 783       else if args (1) = "restart" then                     /* user wants to restart from PFTs */
 784          go to restart;                                     /* perform non-local goto */
 785       else if args (1) = "itrace_on"
 786        | args (1) = "itn" then                              /* user wants to turn on trace */
 787          trace_sw = "1"b;
 788       else if args (1) = "itrace_off"
 789        | args (1) = "itf" then                              /* user wants to turn trace off */
 790          trace_sw = "0"b;
 791       else if args (1) = "type"
 792        | args (1) = "atype" then do;                        /* type messages */
 793          p_err = "0"b;                                      /* reset dprint error switch */
 794          if args (1) = "type" then                          /* pas2 still thinks he */
 795             add_opt = "print";                              /* is going to printer */
 796          else add_opt = "aprint";
 797       end;
 798       else if args (1) = "print"
 799        | args (1) = "aprint" then do;                       /* dprint messages */
 800          p_err = "1"b;                                      /* set dprint error switch */
 801          add_opt = args (1);                                /* set additional option */
 802       end;
 803       else if args (1) = "test"
 804        & args (2) = "msg" then                              /* user wants to communicate with the operator */
 805          call tolts_util_$opr_msg;
 806       else if args (1) = "display_error"
 807        | args (1) = "display"
 808        | args (1) = "derr" then do;                         /* display error message */
 809          if ^display_log () then do;                        /* go display requested log entries */
 810 inv_display:
 811             call com_err_ (0, pname, "invalid input - ""^a""", com_string);
 812             return ("1"b);                                  /* reneter options */
 813          end;
 814       end;
 815       else if args (1) = "E" then do;                       /* user wants to execute Multics command */
 816          com_string = ltrim (substr (com_string, 2));
 817          call cu_$cp (addr (com_string), length (com_string), code);
 818                                                             /* execute Multics command */
 819       end;
 820       else if args (1) = "cdump" | args (1) = "mdump"
 821        | args (1) = "xdump" | args (1) = "sdump" then do;
 822          first = 0;                                         /* set defaults */
 823          last = 65535;
 824          d_type = args (1);
 825          if cmd_cnt > 1 then do;                            /* if we have offset */
 826             first = cv_oct_check_ ((args (2)), code);       /* convert offset arg */
 827             if code ^= 0 | first > 65535 then               /* tell user what he typed wrong */
 828                go to inv_display;
 829             last = last - first;                            /* adjust length */
 830             if cmd_cnt > 2 then do;                         /* if length arg supplied */
 831                last = cv_oct_check_ ((args (3)), code);
 832                if code ^= 0 | first + last > 65536 then     /* tell user what he typed wrong */
 833                   go to inv_display;
 834             end;
 835          end;
 836          if args (1) = "cdump" then do;                     /* if console dump requested */
 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;                            /* entire cdump done from Multics side */
 841             return ("1"b);                                  /* return for next option */
 842          end;
 843          else if args (1) = "sdump" then do;                /* if slave dump to be taken */
 844             first = fixed (rel (hdr_p), 17);                /* set first to slave base */
 845             last = fixed (slave_hdr.pgm_size, 17);          /* dump this many words */
 846             if last = 0 then do;                            /* no slave program loaded */
 847                call ioa_ ("slave program not loaded");      /* tell user */
 848                return ("1"b);                               /* and return for next option */
 849             end;
 850             else if last > hbound (wseg.test_pgm, 1) then   /* in case there is garbage here */
 851                last = hbound (wseg.test_pgm, 1) - 1;        /* set it to last loc in wseg */
 852          end;
 853          dump_in_prog, ntype, idump = "1"b;                 /* set flags */
 854          return ("0"b);                                     /* let pas2 handle first part of dump */
 855       end;
 856       else return ("0"b);                                   /* not isolts option, go process pass options */
 857       return ("1"b);                                        /* isolts option has been processed */
 858 
 859    end ck_isolts_opt;
 860 
 861 %page;
 862 
 863 /* opr_com - internal procedure to relay manual reconfiguration intructions to operator */
 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;                           /* must wait for opr to grant or deny permission */
 872       opr_query_info.prim = "grant";                        /* set primary expected response */
 873       opr_query_info.alt = "deny";                          /* set alternate expected response */
 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;            /* if opr doesn't want us to use cpu */
 879          call ioa_ ("permission denied");                   /* tell user the sad news */
 880          return ("1"b);                                     /* return and indicate denial */
 881       end;
 882       call ioa_ ("permission granted");                     /* operator says it ok to test cpu */
 883       call ioa_ ("asking operator to manually reconfigure cpu ^a", tags (icpu));
 884       opr_query_info.q_sw = "0"b;                           /* no operator response needed */
 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);                 /* To prevent console messages from getting out of sync */
 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);                 /* To prevent console messages from getting out of sync */
 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);                 /* To prevent console messages from getting out of sync */
 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);                 /* To prevent console messages from getting out of sync */
 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);                 /* To prevent console messages from getting out of sync */
 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);                 /* To prevent console messages from getting out of sync */
 918       opr_query_info.q_sw = "1"b;                           /* must wait for opr response */
 919       opr_query_info.prim = "done";                         /* set primary expected response */
 920       opr_query_info.alt = "unable";                        /* set alternate response */
 921       opr_query_info.r_comment = "when reconfiguration complete";
 922                                                             /* set response comment */
 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);                                   /* return and indicate manual reconfig complete */
 931    end opr_com;
 932 
 933 
 934 
 935 
 936 
 937 
 938 %page;
 939 
 940 /* display_log - internal procedure to display messages in the isolts_err_log */
 941 
 942 display_log: proc returns (bit (1));
 943 
 944       if cmd_cnt = 1 then                                   /* if only last message wanted */
 945          count, limit = 1;
 946       else if cmd_cnt >= 2 & cmd_cnt < 4 then               /* count, limit or -all */
 947          if args (2) = "-all" then                          /* print entire log */
 948             count, limit = -1;
 949          else do;
 950             count = cv_dec_check_ ((args (2)), code);       /* convert count */
 951             if code ^= 0 then                               /* must be dec number */
 952                return ("0"b);                               /* return error */
 953             if cmd_cnt < 3 then                             /* no limit specified, set to 1 */
 954                limit = 0;
 955             else do;
 956                limit = cv_dec_check_ ((args (3)), code);
 957                if code ^= 0 then                            /* must be dec number */
 958                   return ("0"b);                            /* return error */
 959             end;
 960          end;
 961       else return ("0"b);                                   /* no more than 3 args allowed, return error */
 962       call isolts_err_log_$display (count, limit, p_err);   /* display requested err messages */
 963       return ("1"b);                                        /* return with no error */
 964    end display_log;
 965 
 966 %page;
 967 
 968 /* abort - internal subroutine to display reconfiguration error messages */
 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", /* rcerr_isolts_locked */
 978       "cpu tag ^a is illegal",                              /* rcerr_isolts_illegal_cpu */
 979       "cpu ^a is online and unavailable for test",          /* rcerr_isolts_cpu_online */
 980       "cpu ^a is not configured",                           /* rcerr_isolts_no_config */
 981       "there must be at least two online scus to run isolts", /* rcerr_isolts_two_scu */
 982       "scu tag ^a is illegal",                              /* rcerr_isolts_illegal_scu */
 983       "scu ^a is the bootload scu and cannot be used for testing", /* rcerr_isolts_bootload_scu */
 984       "scu ^a is not online",                               /* rcerr_isolts_scu_not */
 985       "requesting process is not running isolts",           /* rcerr_isolts_not */
 986       "cpu ^a responded to interrupt cell ^a at loc ^a",    /* rcerr_isolts_wrong_cell */
 987       "cpu ^a responded to an interrupt cell ^a on scu ^a", /* rcerr_isolts_wrong_scu */
 988       "cpu ^a responded to an interrupt cell ^a on scu ^a at loc ^a", /* rcerr_isolts_wrong_scu_cell */
 989       "cpu ^a failed to respond to an interrupt cell ^a interrupt", /* rcerr_isolts_no_response */
 990       "the following switches on cpu ^a are set incorrectly: ^a", /* rcerr_isolts_bad_switches */
 991       "a ""lda 2"" did not operate properly",               /* rcerr_isolts_lda_fail */
 992       "a ""lda 65536"" (64k) failed to produce a store fault", /* rcerr_isolts_no_str_flt */
 993       "scu ^a has no interrupt mask register assigned to cpu ^a", /* rcerr_isolts_no_mask */
 994       "unable to set CPU required for cpu ^a");             /* could not set CPU required */
 995 
 996       call com_err_ (0, pname, "the following errors were detected while attempting reconfiguration:^/");
 997       if ecode > 18 then                                    /* if standard error code */
 998          call com_err_ (ecode, pname, "attempting reconfiguration");
 999 
1000       else do;                                              /* reconfig error message */
1001          arg1, arg2, arg3, arg4 = "";                       /* initialize args */
1002          if ecode > 9 & ecode < 14 then do;                 /* if codes 10 - 13 */
1003             rswp = addr (switches (1));                     /* set ptr to cpu switch data */
1004             arg1 = tags (cpu_tag);                          /* set cpu tag arg */
1005             call ioa_$rsnnl ("^d", arg2, i, rswp -> switch_w1.cell); /* set int cell number */
1006             if ecode > 10 & ecode < 13 then                 /* if codes 11 or 12 */
1007                arg3 = tags (scu_tag);                       /* set scu_tag */
1008          end;
1009          go to etype (ecode);                               /* go set up correct message */
1010 
1011 etype (2):                                                  /* rcerr_isolts_illegal_cpu */
1012 etype (3):                                                  /* rcerr_isolts_cpu_online */
1013 etype (4):                                                  /* rcerr_isolts_no_config */
1014 etype (18):                                                 /* rcerr_isolts_sprq_failed */
1015          arg1 = tags (cpu_tag);                             /* cpu tag only */
1016          go to display_err;                                 /* display message */
1017 
1018 etype (6):                                                  /* rcerr_isolts_illegal_scu */
1019 etype (7):                                                  /* rcerr_isolts_bootload_scu */
1020 etype (8):                                                  /* rcerr_isolts_scu_not */
1021          arg1 = tags (scu_tag);                             /* scu_tag only */
1022          go to display_err;                                 /* display message */
1023 
1024 etype (10):                                                 /* rcerr_isolts_wrong_cell */
1025          call ioa_$rsnnl ("^o", arg3, i, rswp -> switch_w1.offset);
1026          go to display_err;                                 /* display message */
1027 
1028 etype (12):                                                 /* rcerr_isolts_wrong_scu_cell */
1029          call ioa_$rsnnl ("^o", arg4, i, rswp -> switch_w1.offset);
1030          go to display_err;                                 /* display message */
1031 
1032 etype (17):                                                 /* rcerr_isolts_no_mask */
1033          arg1 = tags (scu_tag);
1034          arg2 = tags (cpu_tag);
1035          go to display_err;                                 /* display message */
1036 
1037 etype (14):                                                 /* rcerr_isolts_bad_swiches */
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;                                 /* display_message */
1073 
1074 etype (1):                                                  /* rcerr_isolts_locked */
1075 etype (5):                                                  /* rcerr_isolts_two_scu */
1076 etype (9):                                                  /* rcerr_isolts_not */
1077 etype (11):                                                 /* rcerr_isolts_wrong_scu */
1078 etype (13):                                                 /* rcerr_isolts_no_response */
1079 etype (15):                                                 /* rcerr_isolts_lda_fail */
1080 etype (16):                                                 /* rcerr_isolts_no_str_flt */
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 /* BEGIN MESSAGE DOCUMENTATION
1100 
1101    Message:   <Person>.<Project>.a: permission asked to test cpu <cpu_tag> using memory <mem_tag>
1102 
1103    S:  $beep
1104 
1105    T:  $run
1106 
1107    M:  <person>.<Project> is asking permission to test the indicated cpu that
1108    is currently deconfigured from the system. The indicated memory will be usurped
1109    until a primitive test is made on the processor to verify switch settings and
1110    to assure that a memory address above 64k cannot be generated without a store fault
1111    occurring. After this primitive test is complete, all memory in the indicated
1112    SCU above 64k will be given back to the system.
1113    Until processor testing is completed, the reconfiguration data base is locked
1114    thereby not allowing dynamic reconfiguration of processors, memories,
1115    or bulk store.
1116 
1117    A:  $info
1118 
1119    Message:   <Person>.<Project>.a: respond "grant" or "deny".
1120 
1121    S:  $beep
1122 
1123    T:  $run
1124 
1125    M:  <Person>.<Project> is expecting an operator response to either grant or
1126    deny  permission to test the indicated processor.
1127    The indicated response must be made via the opr_query_response command.
1128 
1129    A:  Operator must respond "grant" or "deny" via the opr_query_response command
1130    (or with the oqr entry in the admin ec; e.g. x oqr grant) to either grant or deny the test request.
1131 
1132    Message:   <Person>.<Project>.a: execute the following manual reconfiguration on cpu <tag>:
1133 
1134    S:  $beep
1135 
1136    T:  $run
1137 
1138    M:  <person>.<Project> is asking the operator to manually reconfigure
1139    the indicated processor.
1140 
1141    A:  $ignore
1142 
1143    Message:   <Person>.<Project>.a:  1. set all port and initialize enable switches to off.
1144 
1145    S:  $beep
1146 
1147    T:  $run
1148 
1149    M:  The first step of the manual reconfiguration instructions.
1150 
1151    A:  $ignore
1152 
1153    Message:   <Person>.<Project>.a:  2. set the assignment switches for all ports to 000.
1154 
1155    S:  $beep
1156 
1157    T:  $run
1158 
1159    M:  The second step of the manual reconfiguration instructions.
1160 
1161    A:  $ignore
1162 
1163    Message:   <Person>.<Project>.a:  3. remove the right free-edge connector on the
1164 
1165    S:  $beep
1166 
1167    T:  $run
1168 
1169    M:  The third step of the manual reconfiguration instructions.
1170    The indicated free-edge connector contains the port size plugs
1171    (maximum of 4) for the configured SCU ports.
1172 
1173    A:  $ignore
1174 
1175    Message:   <Person>.<Project>.a:     645pq wwb at slot 28l.
1176 
1177    S:  $beep
1178 
1179    T:  $run
1180 
1181    M:  Continuation of above message.
1182 
1183    A:  $ignore
1184 
1185    Message:   <Person>.<Project>.a:  4. install the "cpu test" free-edge connector at slot 28l.
1186 
1187    S:  $beep
1188 
1189    T:  $run
1190 
1191    M:  The fourth step of the manual reconfiguration instructions.
1192    The "cpu test" free-edge connector referred to is a special tool
1193    provided by Field Engingeering. It is simply a port free-edge connector with
1194    all 4 port groups wired for 64k.
1195 
1196    A:  $ignore
1197 
1198    Message:   <Person>.<Project>.a:  5. depress the initialize and clear push button.
1199 
1200    S:  $beep
1201 
1202    T:  $run
1203 
1204    M:  The fifth step of the manual reconfiguration instructions.
1205 
1206    A:  $ignore
1207 
1208    Message:   <Person>.<Project>.a:  6. set the port enable switch on for port <mem_tag>.
1209 
1210    S:  $beep
1211 
1212    T:  $run
1213 
1214    M:  The sixth and last step of the manual reconfiguration instructions.
1215 
1216    A:  $ignore
1217 
1218    Message:   <Person>.<Project>.a: respond "done" when reconfiguration complete.
1219 
1220    S:  $beep
1221 
1222    T:  $run
1223 
1224    M:  The indicated response must be made via the opr_query_response command.
1225 
1226    A:  Operator must respond "done" via the opr_query_response command
1227    (x oqr done), when reconfiguration is complete.
1228 
1229    END MESSAGE DOCUMENTATION */
1230 
1231    end isolts_;