1 /*        prime tdl entry point       */
   2 
   3 
   4 try_assign:
   5 if tdl.train_number = -2 then do;  /* duplicate trains--must ask */
   6     pnum = substr(page_no_char,tdl.pageno,1);
   7     call ioa_$rsnnl("^/^/**^a(^ac) duplicate trains configured^/enter train # to use:",
   8          message,mesg_len,pnum,tdl.iccdd);
   9     tdl.optrd = 1;
  10     tdl.rtnopt = try_assign;
  11     goto request_and_wait_for_tty_write;
  12 end;
  13 tdl.tdlret = nxlin;
  14 tape_info_ptr = addr(rcp_area);
  15 tape_info.version_num = 1;  /* structure version 1 */
  16 tape_info.usage_time = 0;  /* T&D will use resource for an indefinite time */
  17 tape_info.wait_time = 0;  /* T&D will not wait for the resource */
  18 tape_info.system_flag = "0"b;  /* T&D is not a system process */
  19 tape_info.tracks = 0;
  20   tape_info.device_name = tdl.device_name;
  21 if substr(tdl.device_name,1,3) = "dsk" then do;
  22 disk_info_ptr = addr(rcp_area);
  23           rcp_name = "disk";
  24           disk_info.volume_name = string("t&d scratch");
  25           disk_info.write_flag = "1"b;
  26 disk_info.version_num = 1;  /* structure version 1 */
  27 disk_info.usage_time = 0;  /* T&D will use resource for an indefinite time */
  28 disk_info.wait_time = 0;  /* T&D will not wait for the resource */
  29 disk_info.system_flag = "0"b;  /* T&D is not a system process */
  30 disk_info.device_name = string(tdl.device_name);
  31 end;
  32 if substr(tdl.device_name,1,3) = "tap" then do;
  33           rcp_name = "tape";
  34           tape_info.volume_name = string("scratch");
  35           tape_info.write_flag = "1"b;
  36 end;
  37 if substr(tdl.device_name,1,3) = "prt" then rcp_name = "printer";
  38 if substr(tdl.device_name,1,3) = "pun" then rcp_name = "punch";
  39 if substr(tdl.device_name,1,3) = "rdr" then rcp_name = "reader";
  40 if substr(tdl.device_name,1,3) = "opc" then rcp_name = "console";
  41 
  42 
  43 attach_loop:
  44   if rcp_name = "disk" then
  45 call rcp_priv_$attach(string  (rcp_name),disk_info_ptr,tdl.status_event,"T&D is attaching  "||tdl.device_name,
  46           tdl.rcp_id,error);
  47   else
  48 call rcp_priv_$attach(string  (rcp_name),tape_info_ptr,tdl.status_event,"T&D is attaching  "||tdl.device_name,
  49           tdl.rcp_id,error);
  50 if error = 0 then goto attach_ok;
  51 call com_err_$convert_status_code_(error,shortinfo,longinfo);
  52 call ioa_$rsnnl("^/ioi_assign error--couldnt find^/^a"
  53  ,term_reason,output_length,longinfo);
  54 call set_polts_abort(term_reason);
  55 goto main_dispatch_queue_service;
  56 
  57 
  58 attach_ok:
  59 if tdl.allocated ^=0 then goto main_dispatch_queue_service;  /* dont try if assigned already--CISL BUGGGGG */
  60 if tdl.stop ^= 0 then do;
  61     tdl.force = 1;
  62     goto alloc_end_page;
  63 end;
  64 tdl.lst,tdl.trycnt = -1;
  65 /*  attempt to assign the per. if not busy */
  66 call assign(tdp,tip,tdl.asgn_flag);
  67 tdl.io_dispatch = attach_ok;  /* for code 1 and 2 */
  68 if tdl.asgn_flag = 4|tdl.asgn_flag = 1|tdl.asgn_flag = 2 then if tdl.nxt = 0 then do;
  69     pnum = substr(page_no_char,tdl.pageno,1);
  70     if tdl.asgn_flag = 4 then call ioa_$rsnnl("^/^/**^a(^ac) device busy--allocation queued",
  71          message,mesg_len,pnum,tdl.iccdd);
  72     if tdl.asgn_flag = 1 then call ioa_$rsnnl("^/^/**^a(^ac) short wait for device--allocation queued",
  73          message,mesg_len,pnum,tdl.iccdd);
  74     if tdl.asgn_flag = 2 then call ioa_$rsnnl("^/^/**^a(^ac) long wait for device--allocation queued",
  75          message,mesg_len,pnum,tdl.iccdd);
  76     tdl.ttyret = busy_said;
  77           tdl.nxt = -1;
  78     goto request_and_wait_for_tty_write;
  79 end;
  80 
  81 
  82 busy_said:
  83 tdl.nxt = -1;
  84 if tdl.stop ^= 0 then do;
  85     tdl.force = 1;
  86     goto alloc_end_page;
  87     end;
  88 if tdl.asgn_flag = 0 then goto init_alloc;
  89 if tdl.asgn_flag = 1|tdl.asgn_flag = 2|tdl.asgn_flag = 3 |tdl.asgn_flag = 7 then do;
  90     tdl.asgn_flag = 7;
  91     goto main_dispatch_queue_service;
  92     end;
  93 /* short wait---long wait--or assign error  */
  94 tdl.clock_dispatch = attach_loop;
  95 tdl.clock_going = 1;  /* set clock going */
  96 call timer_manager_$alarm_wakeup(1000000,"10"b,tdl.clock_event);
  97 /*  time is in micro seconds
  98   1000000 = 1 sec  */
  99 goto main_dispatch_queue_service; /* go away untill called */
 100 
 101 
 102 init_alloc:
 103 tdl.allocated = 1;
 104 goto select_next_test_or_seg_or_start_or_end;
 105 
 106 
 107 /*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$*/
 108 /*
 109 
 110        isolate current tdl instruction
 111 
 112 
 113 */
 114 eoline:
 115 tdl.tdlret = eoline_do_return;
 116 goto do;
 117 
 118 
 119 eoline_do_return:
 120 if tst.linetab(tdl.line_number+2) ^= 0 then do;
 121      inv_data = "end of line sequencing would proceed on a non-tdl line";
 122      goto say_invalid_instruction;
 123  end;
 124 
 125 
 126 tdl.line_number = tdl.line_number + 1;
 127 goto nxlin;
 128 
 129 
 130 skipf:
 131 call isol;
 132 if isol_flag = 1 then goto isol_er;
 133 if isol_flag = 0 then goto eoline;
 134 call look_up_mnemonic;
 135 call bump_per_op_number_if_per_op;
 136 goto nxfld;
 137 
 138 
 139 fldct:
 140 tdl.next_field_number,tdl.per_op_number = 0;
 141 do dovar3 = 1 to skip_field_no;
 142      call isol;
 143      if isol_flag = 0 then goto eoline;
 144      if isol_flag = 1 then goto isol_er;
 145      call look_up_mnemonic;
 146      call bump_per_op_number_if_per_op;
 147 end;
 148 goto nxfld;
 149 
 150 
 151 nxlin:
 152 if tst.linetab(tdl.line_number+1) ^= 0 then do;
 153      term_message = "
 154 tdl implimentation error-non tdl line at ""nxlin""";
 155 call set_polts_abort(term_message);
 156 goto main_dispatch_queue_service;
 157 /* go to common code */
 158  end;
 159 
 160 
 161 tdl.tlscan = (tdl.line_number*56)+1;
 162 tdl.next_field_number,tdl.per_op_number = 0;
 163 
 164 
 165 nxfld:
 166 if tdl.tmiflg = 0 then goto skip_do;
 167 tdl.tdlret = skip_do;  /* set do return  */
 168 goto do;
 169 
 170 
 171 skip_do:
 172 call isol;
 173 if isol_flag = 2 then goto isol_ok;
 174 if isol_flag = 0 then goto eoline;
 175 /*
 176 
 177 
 178       isolation error--->6 alpha,>12 numbers
 179 
 180 */
 181 isol_er:
 182 inv_data = "> 6 alpha or >12 numbers";
 183 goto say_invalid_instruction;
 184 /*
 185 
 186 
 187        go to selected tdl routine
 188 
 189 
 190 */
 191 bump_per_op_number_if_per_op:proc;
 192 if substr(inst$tdlr_type_conv_control((dovar1-1)*12+23),3,1) ="1"b then
 193 tdl.per_op_number = tdl.per_op_number + 1; /* bump per op on line */
 194 end bump_per_op_number_if_per_op;
 195 
 196 
 197 look_up_mnemonic:proc;
 198 do dovar1 = 1 to inst$tlen/2 by 2;
 199      if tdl.talpha = inst$tdli(dovar1) then return;
 200 end;
 201 inv_data = "unknown mnemonic";
 202 goto say_invalid_instruction;
 203 end look_up_mnemonic;
 204 
 205 
 206 isol_ok:
 207 call look_up_mnemonic;
 208 /*    format of instruction type field
 209 
 210          type field = bits 24 thru 29
 211 
 212              bit 24 = not defined
 213              bit 25 = not defined
 214              bit 26 = perif operation(wtb,aop,dup,cmp,sa)
 215              bit 27 = perform "do" first
 216              bit 28 = right justification required
 217              bit 29 = octal conversion if 1, dec if 0
 218 
 219 */
 220 tdl.inst_index = dovar1;
 221 if substr(inst$tdlr_type_conv_control((dovar1-1)*12+23),4,1) ^="1"b then goto no_do;
 222 tdl.tdlret = do_return;
 223 goto do;
 224 
 225 
 226 do_return:
 227 dovar1 = tdl.inst_index;
 228 /*
 229 
 230 
 231         perform required numeric conversion
 232 
 233              Numeric conversion for a tdl instruction is under
 234         the control of an instruction defining word associated
 235         with each tdl instruction.  This word has the format of:
 236 
 237         vfd 6/nd1,6/nd2,6/nd3,6/ovd4,6/type,6/con
 238 
 239         type = the type field defined above
 240         1.  The count of the numeric characters isolated in the
 241             instruction must be >= nd1+nd2+nd3 and must be
 242             <= nd1+nd2+nd3+ovd4.  That is, the first sum is the
 243             lower limit of how many numerics are legal, and
 244             the second sum is the upper limit of  how many
 245             numerics are legal.  This is true regardless of
 246             whether the type of conversion is octal or decimal.
 247 
 248             1a.  OCTAL CONVERSION:   The constants nd1,nd2,nd3
 249                  and ovd4 are used only to define the lower
 250                  and upper limits of the count of numeric characters
 251                  that are to be considered legal.
 252 
 253                  nd1 should be set to the lower limit, and ovd4
 254                  to the range (upper limit - lower limit).
 255 
 256                  with nd2 = nd3 = 0 examples are:
 257                  2 octal digits is specified as 2,0 for nd1,ovd4
 258                  0 to 12 octal digits is specified as 0,12 for nd1,ovd4
 259                  2 to 6 octal digits is specified as 2,4 for nd1,ovd4
 260 
 261                  All octal conversion places the converted number
 262                  into the declared binary variable "octnum".
 263 
 264                  Justification may be either left or right into
 265                  the target.  This is under the control of the
 266                  "type" field of the control word.  If bit 28 is
 267                  0, left justification is assumed.  Justification
 268                  for octal numbers will always be within a 12
 269                  octal character field.
 270 
 271             1b.  DECIMAL CONVERSION:
 272 
 273                  For decimal conversion, nd1,nd2,nd3,ovd4 are
 274                  used for both the limits checks above and to
 275                  allow separation of the numeric characters into
 276                  up to four fields as distinct decimal numbers.
 277 
 278                  A TDL instruction is considered to have only
 279                  one numeric field during isolation of the
 280                  characters comprising the field.  That is,
 281                  a TDL instruction such as "aannanan", where "a" is
 282                  any alpha character and "n" is any numeric character
 283                  is separated into "aaaa" as an alpha part and into
 284                  "nnnn" as a numeric part.
 285 
 286                  The "nnnn" part of the separated TDL instruction
 287                  is then split, for decimal conversion, up into
 288                  a distinct part for each instance of nd1,nd2,nd3, and
 289                  ovd4 non-zero.  If, for example, those controls
 290                  were, respectively, 2,3,0,5 then 3 of them
 291                  would be non-zero and there would be as a result
 292                  3 partitions of the "nnnnnnnn" number.  The actual value
 293                  of nd1,nd2 etc. will control how many characters
 294                  of the "nnnnnnnn" number are to be used for each
 295                  partition.
 296 
 297                  In comment on the above, as time permits a routine
 298                  will probably be developed to insure that
 299                  the "nnnnn" numeric characters are distributed
 300                  in groups (separated by alpha characters) that
 301                  match the fixed specifiers.  Too much trouble has
 302                  occurred where a TDL programmer has written
 303                  such as LPx.nnn which was interpreted as LPxx.nn
 304                  by TDL.
 305 
 306 
 307                  nd1 specifies that the first nd1 characters
 308                  are to be converted to decimal and placed in
 309                  "fdec1".
 310 
 311                  nd2 specifies that the next nd2 characters
 312                  after nd1 characters are similarly converted and
 313                  placed in "fdec2".
 314 
 315                  nd3 is as nd2 for the characters after nd2
 316                  and placed in "fdec3".
 317 
 318                  Note that nd1,nd2 and nd3 specify an exact number
 319                  characters to convert.  These are the fixed decimal
 320                  conversion characters.  ovd4, for decimal conversion,
 321                  is the variable decimal conversion specifier.
 322                  That is, any number of characters from 0 to "ovd4"
 323                  are converted.  If there are any characters after
 324                  the fixed conversion is done, then all remaining
 325                  characters are converted.  Note that ovd4 is only
 326                  used in the limits check.  If the limits check is
 327                  passed then there can only be 0 to "ovd4" characters
 328                  remaining after the first nd1+nd2+nd3 characters.
 329 
 330                  All decimal conversion results in a right justified
 331                  number.
 332 
 333 
 334 */
 335 no_do:
 336 call bump_per_op_number_if_per_op;
 337 if inst$tdlr_num_conv_control((dovar1-1)*12+19)+
 338    inst$tdlr_num_conv_control((dovar1-1)*12+20)+
 339    inst$tdlr_num_conv_control((dovar1-1)*12+21) >tdl.tnmwrd
 340       then do;
 341           inv_data = "insufficient fixed numerics";
 342           goto say_invalid_instruction;
 343       end;
 344 
 345 
 346 if inst$tdlr_num_conv_control((dovar1-1)*12+19)+
 347    inst$tdlr_num_conv_control((dovar1-1)*12+20)+
 348    inst$tdlr_num_conv_control((dovar1-1)*12+21)+
 349    inst$tdlr_num_conv_control((dovar1-1)*12+22) < tdl.tnmwrd
 350    then do;
 351           inv_data = "more numerics than defined for instruction";
 352           goto say_invalid_instruction;
 353    end;
 354 
 355 
 356 fdec1,fdec2,fdec3,vdec4,octnum = 0;
 357 if substr(inst$tdlr_type_conv_control((dovar1-1)*12+23),6,1)  ="1"b then goto octal_conversion;
 358 vdec4 = inst$tdlr_num_conv_control((dovar1-1)*12+19)+
 359                      inst$tdlr_num_conv_control((dovar1-1)*12+20)+
 360                      inst$tdlr_num_conv_control((dovar1-1)*12+21)+1;
 361 vdec4 = fixed(substr(tdl.tnmbr,vdec4));
 362 fdec1 = fixed(substr(tdl.tnmbr,1,inst$tdlr_num_conv_control((dovar1-1)*12+19)));
 363 fdec2 = fixed(substr(tdl.tnmbr,inst$tdlr_num_conv_control((dovar1-1)*12+19)+1,
 364                      inst$tdlr_num_conv_control((dovar1-1)*12+20)));
 365 fdec3 = fixed(substr(tdl.tnmbr,inst$tdlr_num_conv_control((dovar1-1)*12+19)+
 366                     inst$tdlr_num_conv_control((dovar1-1)*12+20)+1,
 367                     inst$tdlr_num_conv_control((dovar1-1)*12+21)));
 368 goto num_conv_done;
 369 
 370 
 371 octal_conversion:
 372 if tdl.tnmwrd = 0 then goto num_conv_done;
 373 if search(tdl.tnmbr,"89") ^=0 then do;
 374      inv_data ="only octal numerics allowed";
 375      goto say_invalid_instruction;
 376   end;
 377 
 378 
 379 do dovar3 = 1 to 12;
 380 if tdl.tnmwrd <dovar3 then goto left_justify;
 381 octnum = octnum*8 + binary(substr(tdl.tnmbr,dovar3,1));
 382 goto justify_done;
 383 
 384 
 385 left_justify:
 386 if substr(inst$tdlr_type_conv_control((dovar1-1)*12+23),5,1) ="1"b then goto num_conv_done;
 387 octnum = octnum*8;
 388 justify_done:
 389 end;
 390 
 391 
 392 num_conv_done:
 393 tdl.tdlret = nxfld;  /*  set to go to nxfld  */
 394 if pdata.simulation = 0 then goto no_bump;
 395 inst$tdlr_no((dovar1-1)*4+5)= mod(inst$tdlr_no((dovar1-1)*4+5)+1,65536);
 396 /* bump usage count so we can check instruction usage  */
 397 
 398 
 399 no_bump:
 400 goto tdlr(inst$tdlr_no((dovar1-1)*4+6));
 401 
 402 
 403 say_end_page:
 404 tdl.cyccnt = tdl.cyccnt + 1;
 405 
 406 
 407 alloc_end_page:
 408 pnum = substr(page_no_char,tdl.pageno,1);
 409 page_term = "normal";
 410 if tdl.force ^=0 then page_term = "forced";
 411 call ioa_$rsnnl("^/^/**^a(^ac) ^a term ^d: ^d status and ^d data errors"
 412 ,message,mesg_len,pnum,tdl.iccdd,page_term,tdl.cyccnt,tdl.toterr.sta,
 413 tdl.toterr.dat);
 414 if (tdl.tottrn.read ^=0)|(tdl.tottrn.write ^=0) then do;
 415      call ioa_$rsnnl("^a^/transient errors: ^d read and ^d write",
 416      message,mesg_len,(message),tdl.tottrn.read,tdl.tottrn.write);
 417 end;
 418 tdl.ttyret = remove_page;
 419 tdl.end = 1;
 420 
 421 
 422 request_and_wait_for_tty_write:
 423 tdl.iocnt = tdl.iocnt + 1; /* bump test pages i/o count  */
 424 call buffer_tty_output(message,tdl.pageno);
 425 goto main_dispatch_queue_service;
 426 /*  go back to common code */
 427 
 428 
 429 isol:proc;
 430 /*
 431 
 432 
 433        isolate current tdl instruction
 434 
 435 
 436 */
 437 tdl.topfld = tdl.next_field_number;
 438 /* will be this field number */
 439 isol_flag = 0; /* preset for end of line */
 440 dovar1 = 1; /* and count also */
 441 if lines(tdl.tlscan) = " " then goto isol_er_return;
 442 if lines(tdl.tlscan) = "," then goto isol_er_return;
 443 tdl.tnmbr = "";
 444 tdl.talpha = "";
 445 tdl.next_field_number = tdl.next_field_number + 1;
 446 do dovar1 = 1 to 19;
 447 if lines(tdl.tlscan+dovar1-1) = " " then goto break_char;
 448 if lines(tdl.tlscan+dovar1-1) = "," then goto break_char;
 449 if lines(tdl.tlscan+dovar1-1) <"0" then goto tis_alpha;
 450 if lines(tdl.tlscan+dovar1-1) > "9" then goto tis_alpha;
 451 if length(tdl.tnmbr) = 12 then goto length_error;
 452 tdl.tnmbr = tdl.tnmbr||lines(tdl.tlscan+dovar1-1);
 453 goto tis_number;
 454 
 455 
 456 tis_alpha:
 457 if length(tdl.talpha) = 6 then goto length_error;
 458 tdl.talpha = tdl.talpha||lines(tdl.tlscan+dovar1-1);
 459 
 460 
 461 tis_number:
 462 end;
 463 
 464 
 465 length_error:
 466 isol_flag = 1;
 467 goto isol_er_return;
 468 
 469 
 470 break_char:
 471 tdl.tnmwrd = length(tdl.tnmbr);
 472 isol_flag = 2;
 473 
 474 
 475 isol_er_return:
 476 tdl.tlscan = tdl.tlscan+dovar1;
 477 end isol;
 478 
 479 
 480 do:
 481 lpprct = lpprct + 1;
 482 if lpprct <275 then goto no_tdl_loop;
 483 inv_data = "tdl language lockup fault, no io for 275 major instructions";
 484 goto say_invalid_instruction;
 485 
 486 
 487 no_tdl_loop:
 488 if chgmode = 0 then goto tdl.tdlret;
 489 if chgmode >0 then goto set_up_io;
 490 tdl.tdatas = tdl.tdata;
 491 tdl.tpmb.op_code = tdl.tpmbs.op_code;
 492 tdl.tdcws.wc = fixed(tio.tdcw.wc);
 493 tdl.tadwds = tio.tadwd;
 494 tdl.tdtyps = tdl.tdtyp;
 495 tdl.tcwdls = tdl.tcwdl;
 496 tdl.testas = tdl.testat;
 497 chgmode = 0;
 498 goto tdl.tdlret;
 499 
 500 
 501 set_up_io:
 502 /*                   data change rules
 503 
 504 
 505                      Lxxx                             LCWx
 506             write     read      non_data     write     read      non_data
 507 
 508 in standards
 509 Dxxxxxx      at-io     at-io     none         none      none      none
 510 ADxxxxxx     at-io     at-io     none         none      none      none
 511 DRAN         at-io     fol-io    none         none      fol-io    none
 512 DROT         at-io     at-io     none         none      none      none
 513 ADROT        at-io     at-io     none         none      none      none
 514 DLNxx        at-io     at-io     none         none      none      none
 515 PHDLNxx      at-io     at-io     none         none      none      none
 516 UHDLNxx      at-io     at-io     none         none      none      none
 517 DREAD        radd      none      none         none      none      none
 518 NOTE:  ADxxx,DROT and ADROT when they come from standards will only be
 519 used 1 time.  The data will be set up just before the io is issued
 520 and if the same data type is in both standards and the call sequence
 521 (both ADxxx,DROT or ADROT) then the standard data type will be zeroed.
 522 
 523 modifiers
 524 data type request encountered modifying per-op or in range of dcw list
 525         due to a "CW---" or LCW or stds.
 526 if encountered alone has no effect
 527 Dxxxxxx      at-io     at-io     at-mod       at-mod    at-mod    at-mod
 528 ADxxxxxx     at-io     at-io     at-mod       at-mod    at-mod    at-mod
 529 DRAN         at-io     fol-io    at-mod       at-mod    fol-io    at-mod
 530 DROT         at-io     at-io     at-mod       at-mod    at-mod    at-mod
 531 ADROT        at-io     at-io     at-mod       at-mod    at-mod    at-mod
 532 DLNxx        at-io     at-io     at-mod       at-mod    at-mod    at-mod
 533 PHDLNxx      at-io     at-io     at-mod       at-mod    at-mod    at-mod
 534 UHDLNxx      at-io     at-io     at-mod       at-mod    at-mod    at-mod
 535 DREAD        radd      none      radd         lcwradd   none      radd
 536 NOTE:For all data types except DRAN, the call sequence data type will
 537 be zeroed when the data is actually set up to preclude doing it again.
 538 
 539 
 540 */
 541 tdl.terflg,tdl.tinint = 0;
 542 if tdl.tcwdl ^=0 then goto skip_data_setup;
 543 call lset;
 544 if tdl.topcd.op_type = 0|tdl.tdtyp = 0 then goto skip_data_setup;
 545 if tdl.tdtyp <1|tdl.tdtyp >10 then goto io_data_type_illegal;
 546 goto io_setup_data(tdl.tdtyp);
 547 
 548 
 549 io_data_type_illegal:
 550 term_message ="
 551 tdl.tdtyp > 10 in set_up_io";
 552 call set_polts_abort(term_message);
 553 goto main_dispatch_queue_service;
 554 /* go to common code */
 555 
 556 
 557 io_setup_data(1):
 558 if tdl.topcd.op_type =1 then call setup_random_data; /* no setup if not write */
 559 goto skip_data_setup;
 560 
 561 
 562 io_setup_data(2):
 563 if tdl.topcd.op_type = 1 then tio.tdcw.add = rel(addr(tio.trarea)); /* skip if not write */
 564 goto skip_data_setup;
 565 
 566 
 567 io_setup_data(3):
 568 call setup_octal_data;
 569 goto skip_data_setup;
 570 
 571 
 572 io_setup_data(4):
 573 if tdl.tdtyps =4 then tdl.tdtyps = 0;
 574 call setup_add_to_data;
 575 goto skip_data_setup;
 576 
 577 
 578 io_setup_data(5):
 579 call setup_data_from_line;
 580 goto skip_data_setup;
 581 
 582 
 583 io_setup_data(6):
 584 if tdl.tdtyps =6 then tdl.tdtyps = 0;
 585 call setup_drot;
 586 goto skip_data_setup;
 587 
 588 
 589 io_setup_data(10):
 590 if tdl.tdtyps =10 then tdl.tdtyps = 0;
 591 call setup_adrot;
 592 goto skip_data_setup;
 593 
 594 
 595 io_setup_data(8):
 596 call setup_packed_hex_data;
 597 goto skip_data_setup;
 598 
 599 
 600 io_setup_data(9):
 601 call setup_unpacked_hex_data;
 602 
 603 
 604 io_setup_data(7):
 605 skip_data_setup:
 606 if cmpflg ^=0  then goto io_setup_cmp;
 607 if tdl.topcd.op_type ^= 3 then goto check_for_ram;
 608 /*    its a read  */
 609 if tdl.tcwdl ^=0 then goto check_for_ram;
 610 call lset;
 611 do dovar1 = 1 to tdl.tdtcal_wc+1;
 612 tio.trarea(dovar1) = tdl.tpadwd;
 613 end;
 614 tio.redpre = tdl.tpadwd;
 615 
 616 
 617 check_for_ram:
 618   if tdl.tmiflg ^= 0 then go to io_setup_cmp;
 619 /*   if manual interventio flag is on then treat as single io*/
 620   if tdl.dual_io_device = 0 then goto io_setup_cmp;
 621   if (tdl.do_dual_io = 1) & (tdl.dual_io_count = 0) then goto io_setup_cmp;
 622   if (tdl.do_dual_io = 0) & (tdl.dual_io_count = 0) then goto save_first_of_dual;
 623   if (tdl.do_dual_io = 0) & (tdl.dual_io_count = 1) then goto io_setup_cmp;
 624   inv_data = "inconsistant dual  io command setup";
 625   goto say_invalid_instruction;
 626 /*
 627 
 628 
 629 */
 630 save_first_of_dual:
 631 tio.tskpmb = tdl.tpmb.op_code||tdl.tpmb.dev||"0000001110000"b||
 632       tdl.tpmb.iom_cmd||"0"b||tdl.tpmb.reccnt;
 633   tio.tsdcwv = tio.tdcw;
 634   tdl.dual_io_count = 1;
 635   chgmode = 0;
 636   goto tdl.tdlret;
 637 /*
 638 
 639 
 640 */
 641 
 642 
 643 io_setup_cmp:
 644 if tdl.tdtyp ^=7 then goto io_setup_trace_dcws;
 645 if tdl.tpmb.iom_cmd ^= "0100"b then do;
 646           inv_data = "wrong ioc command used with ""loc"" data type";
 647           goto say_invalid_instruction;
 648     end;
 649 tdl.tpmb.reccnt = substr(tdl.tdata,31,6);
 650 
 651 
 652 io_setup_trace_dcws:
 653 chgmode = 0;
 654 continue,allow_branch_dcw,dcw_count,fmtflg = 0;
 655 current_dcw_add = tdl.tfdcwp; /* start with first dcw */
 656   if (dual_io_device = 1) & (tdl.tpmb.op_code = "001111"b) then
 657     fmtflg = 1;
 658 
 659 
 660 get_next_dcw:
 661 tdl.tldcw = current_dcw_add->dcw_peek;
 662 dcw_count = dcw_count +1;
 663 dcw_list.dcws(dcw_count) = tdl.tldcw;
 664 current_dcw_add = addrel(current_dcw_add,1); /* bump dcw address */
 665 if dcw_count > 10 then goto say_dcw_loop;
 666 if tdl.tldcw.char = "111"b then goto trace_idcw;
 667 if tdl.tldcw.typ = "00"b then goto trace_stop_dcw;
 668 if tdl.tldcw.typ = "01"b then goto trace_proceed_dcw;
 669 if tdl.tldcw.typ = "10"b then goto trace_branch_dcw;
 670 /*   must be "11"b non data xfer and proceed  */
 671 
 672 
 673 trace_proceed_dcw:
 674   if fmtflg = 1 then do;
 675     call set_hbs_bit;
 676     end;
 677 allow_branch_dcw = 1; /* permit branch now  */
 678 goto get_next_dcw;
 679 
 680 
 681 trace_branch_dcw:
 682 if allow_branch_dcw = 0 then goto say_branch_bad;
 683 allow_branch_dcw = 0;
 684 current_dcw_add = addrel(tip,fixed(tdl.tldcw.add));
 685 goto get_next_dcw;
 686 
 687 
 688 trace_stop_dcw:
 689   if fmtflg = 1 then do;
 690     call set_hbs_bit;
 691     end;
 692 if continue = 1 then do;
 693 continue = 0;
 694 goto get_next_dcw;
 695 end;
 696 if cmpflg ^=0 then go to error_check;
 697 if tdl.trace = 0 then goto issue_test_io;
 698 tdl.ttyret = issue_test_io;
 699 call output_trace(tdp,tip,dcw_count,addr(dcw_list.dcws));
 700 goto main_dispatch_queue_service;
 701 /* go to common code */
 702 
 703 
 704 trace_idcw:
 705 allow_branch_dcw = 0;
 706 if substr(tdl.tldcw.typ,1,1) = "1"b then continue = 1;
 707 goto get_next_dcw;
 708 
 709 
 710 issue_test_io:
 711 tdl.interrupts.term = "0"b;
 712 tdl.interrupts.init = "0"b;
 713 tdl.interrupts.spec = "0"b;
 714 tdl.interrupts.falt = "0"b;
 715 tdl.interrupts.timeout = "0"b;
 716 tdl.gespec = 0;
 717 lpprct = 0; /* reset----we are issuing io  */
 718 tdl.test_io_cnt = tdl.test_io_cnt + 1;  /* count i/os */
 719 
 720 tio.tpcw = tdl.tpmb.op_code||tdl.tpmb.dev||"0000001110000"b||
 721       tdl.tpmb.iom_cmd||"0"b||tdl.tpmb.reccnt;
 722 /* note that the tpmb iom_cmd is multiplied by two to get iom type cmd */
 723 tio_off = fixed(rel(tdl.tfdcwp));
 724 if tdl.com_per_flag ^=0 then do;
 725                pcwa = "000000000000000000111000000000000000"b ;
 726                if tdl.tpxdio ^=0 then goto aye_o_go;  /* point to first idcw */
 727                substr(tio.ttdcw,19,18) = "000010000000000000"b;
 728                substr(tio.ttdcw,1,18) = rel(tdl.tfdcwp);
 729                tio_off = fixed(rel(addr(tio.tpcw)));;
 730                goto aye_o_go;
 731           end;
 732 
 733           pcwa = tio.tpcw;
 734 aye_o_go:
 735 /*        check for dual io if yes the link firt to second*/
 736   if (tdl.dual_io_device = 1) & (tdl.dual_io_count = 1) then do;
 737     tio_off = fixed(rel(addr(tio.tskpmb)));
 738     tio.tskpmb = substr(tio.tskpmb,1,22)||"1"b||substr(tio.tskpmb,24,13);
 739     tdl.dual_io_count = 0;
 740     end;
 741 /*
 742 
 743 
 744 */
 745 tdl.io_in_progress = 1;
 746 tdl.io_dispatch = page_reentry;
 747 if pdata.simulation = 1 then goto sim_connect;
 748 call ioi_$connect_pcw(tdl.device_index,tio_off,pcwa,error);
 749     tdl.do_dual_io = 0;
 750 if error ^=0 then goto aye_o_error;
 751 goto main_dispatch_queue_service;
 752 
 753 
 754 sim_connect:
 755 call sioi_$connect_pcw(tdl.device_index,tio_off,pcwa,error);
 756 if error = 0 then goto main_dispatch_queue_service;
 757 
 758 
 759 aye_o_error:
 760 call com_err_$convert_status_code_(error,shortinfo,longinfo);
 761 call ioa_$rsnnl("^/io connect error on page ^a^/^a",
 762      term_reason,output_length,tst.name,longinfo);
 763      call set_polts_abort(term_reason);
 764      goto main_dispatch_queue_service;
 765 
 766 
 767 gespec_timeout:
 768 /* the 30 sec timer for gespec waits has timed out */
 769 tdl.io_in_progress = 0;
 770 tdl.interrupts.timeout = "1"b;
 771 
 772 
 773 page_reentry:
 774 goto error_check;
 775 
 776 
 777 say_dcw_loop:
 778 inv_data = "use of tdcw (cwxby) has caused dcw string loop without iotd (cwxs)";
 779 goto say_invalid_instruction;
 780 
 781 
 782 say_branch_bad:
 783 inv_data = "illegal use of tdcw (cwxby), two tdcws in a row";
 784 goto say_invalid_instruction;
 785 
 786 
 787 error_check:
 788 pos = "";
 789 if (tdl.tpxdio = 0)&(tdl.eep_tally = 0) then goto not_xdio;
 790 tdl.tpxdio = 0;
 791 /* ignore ss o/e bit 2ss bits res rec and ae below */
 792 if (bool(string(status),"111111000000010001111111000000000000"b,"0001"b)
 793      = "100000000000000000000000000000000000"b)&
 794      (tdl.interrupts.timeout = "0"b)&(tdl.interrupts.falt = "0"b)
 795           then goto tdl.tdlret;  /* dont honor options while in eep */
 796 if tdl.interrupts.falt = "1"b then
 797      call ioa_$rsnnl("^/iom fault ^w",
 798      inv_data,mesg_len,addr(tdl.status)->falt_peek);
 799 if tdl.interrupts.timeout = "1"b then do;
 800      if tdl.gespec = 0 then
 801      inv_data = "
 802 io timeout on connect";
 803      if tdl.gespec ^= 0 then
 804      inv_data = "
 805 io timeout waiting for special";
 806 end;
 807 tdl.interrupts.falt,
 808      tdl.interrupts.timeout = "0"b;
 809 tdl.gespec = 0;
 810 if tdl.eep_in_progress ^=0 then goto report_eep_error;
 811 call ioa_$rsnnl("^/^/**^a(^ac) extended status unreadable^/status was ^12w"||inv_data,
 812 message,mesg_len,
 813 substr(page_no_char,tdl.pageno,1),
 814 tdl.iccdd,addr(tdl.status)->falt_peek);
 815 
 816 
 817 post_eep_com:
 818 inv_data = "";
 819 tdl.iocnt = tdl.iocnt + 1;
 820 tdl.ttyret = post_eep_err;
 821 call buffer_tty_output(message,tdl.pageno);
 822 goto main_dispatch_queue_service;
 823 /* goto common code */
 824 
 825 
 826 report_eep_error:
 827 call ioa_$rsnnl("^/extended status unreadable^/status was ^12w"||inv_data,
 828 message,mesg_len,
 829 addr(tdl.status)->falt_peek);
 830 message = tdl.eep_msg||message;
 831 goto post_eep_com;
 832 
 833 
 834 post_eep_err:
 835 tdl.eep_tally = 0;
 836 tdl.eep_in_progress = 0;
 837 tdl.tflag(10) = 0;  /* reset eep flag 9 */
 838 tdl.do_opt = 1;
 839 tdl.optrtn = end_page;
 840 goto process_options;
 841 
 842 
 843 not_xdio:
 844 if (tdl.interrupts.falt = "1"b)|(tdl.interrupts.timeout = "1"b) then do;
 845      tdl.terflg = 1;  /* set error */
 846      tdl.interrupts.term = "0"b;
 847      tdl.interrupts.spec = "0"b;
 848      tdl.interrupts.init = "1"b;   /* set to preclude data checks */
 849 end;
 850 cmpflg,tdl.tdecnt = 0;
 851 tdl.tesmb.add = bit(fixed(fixed(tdl.tldcw.add)+fixed(tdl.tldcw.wc) + tdl.absaddr
 852      ,length(tdl.tesmb.add)),length(tdl.tesmb.add));
 853 if tdl.tpsflg = 0 then goto check_status_and_interrupts;
 854 if tdl.tpmb.op_code = "00"b then goto check_status_and_interrupts;
 855 /*  request status not positioning */
 856 if fixed(tdl.tpmb.op_code) >31 then goto not_read_or_write;
 857 /* An op_code from 01 to 37 octal is assumed to be a read or write
 858    this means that invalid or illegal commands should not be issued
 859    when the positioning flag is on.
 860    For a mpc tape, these commands are all invalids and:
 861                       lfd
 862                       cso
 863                       mmo
 864                       wcrg
 865                       wtime
 866                       diag
 867                       wrap
 868 */
 869 
 870 
 871 wef_command:
 872 if tdl.interrupts.init ^= "1"b then
 873 /* all invalid commands are taken care of here by the initiate interrupt
 874    and all command rejects for the valid read or writes */
 875 tdl.tppos = tdl.tppos + 1;  /* read,write, or wef---bump by 1 */
 876 goto check_status_and_interrupts;
 877 
 878 
 879 not_read_or_write:
 880 if tdl.tpmb.op_code = "100101"b|tdl.tpmb.op_code = "100111"b then
 881      goto use_explicit_position;
 882 if tdl.tpmb.op_code = "100100"b then goto add_record_count; /* fsr */
 883 if tdl.tpmb.op_code = "100110"b then goto sub_record_count; /* bsr */
 884 if tdl.tpmb.op_code = "111000"b|
 885    tdl.tpmb.op_code = "111010"b|
 886    tdl.tpmb.op_code = "111101"b then goto set_initial; /* rew,rews, or load */
 887 if tdl.tpmb.op_code = "101101"b then goto wef_command; /* wef */
 888 goto check_status_and_interrupts; /* invalid command or non_positioning */
 889 
 890 set_initial:
 891 tdl.tppos = 0;
 892 goto check_status_and_interrupts;
 893 
 894 add_record_count:
 895 if tdl.interrupts.init = "1"b then goto check_status_and_interrupts;
 896 tdl.tppos = tdl.tppos + fixed(tdl.tpmb.reccnt);
 897 goto check_status_and_interrupts;
 898 
 899 sub_record_count:
 900 if tdl.interrupts.init = "1"b then goto check_status_and_interrupts;
 901 tdl.tppos = tdl.tppos - fixed(tdl.tpmb.reccnt);
 902 goto check_status_and_interrupts;
 903 
 904 use_explicit_position:
 905 /* for fsf and bsf we cant tell how many records have been passed
 906    so the command itself has to contain the target position.
 907    For example:  fsf05 or bsf11   */
 908 if tdl.interrupts.init ^= "1"b then
 909 tdl.tppos = tdl.tppos_save; /* get saved fsf,bsf, or bkf data */
 910 goto check_status_and_interrupts;
 911 /*
 912 
 913           op_code map for tape positioning
 914 
 915 opcd.  td11ca     td12ca     td13ca     td14ca
 916 
 917 00     req        req        req        req
 918 01
 919 02
 920 03                rtn                   rtn
 921 04     rtd        rtd        rtd        rtd
 922 05     rtb        rtb        rtb(lfd *) rtb(lfd *)  *= dev. # mb = 0
 923 06     rrtd       rrtd       rrtd       rrtd
 924 07     rrtb       rrtb       rrtb       rrtb
 925 10                           cso***     cso***
 926 11                           mmo***     mmo***   *** = illegal
 927 12
 928 13                wtn                   wtn
 929 14     wtd        wtd        wtd        wtd
 930 15     wtb        wtb        wtb        wtb
 931 16                           wcrg***    wcrg***
 932 17
 933 20
 934 21
 935 22
 936 23
 937 24                                      rebc
 938 25                                      rase
 939 26                           rcrg       rcrg
 940 27                                      rasc
 941 30                           wtime***   wtime***
 942 31                           diag***    diag***
 943 32                           wrap***    wrap***
 944 33
 945 34                                      webc
 946 35                                      wase
 947 36
 948 37                                      wasc
 949 40     res        res        res        res
 950 41
 951 42                           shd        shd
 952 43                           sld        sld
 953 44     fsr**      fsr**      fsr**      fsr**   ** = uses record count
 954 45     fsf        fsf        fsf        fsf
 955 46     bsr**      bsr**      bsr**      bsr**   ** = uses record count
 956 47     bsf        bsf        bsf        bsf
 957 50                           rqs        rqs
 958 51                           rss        rss
 959 52
 960 53
 961 54     ers        ers        ers        ers
 962 55     wef        wef        wef        wef
 963 56
 964 57                           survd*     survd* *= dev. # mb = 0, also illegal for polts
 965 60     shd        shd        shd        shd
 966 61     sld        sld        sld        sld
 967 62     sfp        sfp        sfp        sfp
 968 63                           sfpm       sfpm
 969 64                           set2       set2
 970 65                           set16      set16
 971 66                           resv***    resv***
 972 67                           relc***    relc***
 973 70     rwd        rwd        rwd        rwd
 974 71
 975 72     rews       rews       rewu       rewu
 976 73
 977 74
 978 75                           load       load
 979 76
 980 77
 981 
 982 */
 983 /*                   status and interrupts check               */
 984 check_status_and_interrupts:
 985 if tdl.status.iocstat ^= "000000"b then tdl.terflg = 1;
 986 if tdl.interrupts.term ^= tdl.testat.expected_interrupts.term then goto interrupts_error;
 987 if tdl.interrupts.init ^= tdl.testat.expected_interrupts.init then goto interrupts_error;
 988 goto interrupts_ok; /* presume ok */
 989 /* if tdl.interrupts.spec = tdl.testat.expected_interrupts.spec then goto interrupts_ok;
 990   ignore specials for now   */
 991 
 992 
 993 interrupts_error:
 994 tdl.terflg = 1;
 995 
 996 
 997 interrupts_ok:
 998 if tdl.status.major_status ^= tdl.testat.major_status then
 999      tdl.terflg = 1;
1000 if tdl.testat.ignore_ss ^="0"b then goto sub_status_ok;
1001 if tdl.status.sub_status ^= tdl.testat.sub_status then
1002      tdl.terflg = 1;
1003 
1004 
1005 /*                   residual record count check         */
1006 sub_status_ok:
1007 if tdl.interrupts.init ="0"b then goto no_init_int_occured;
1008 tdl.tinint = 1;
1009 goto check_non_data_io;
1010 
1011 
1012 no_init_int_occured:
1013 if tdl.tnrflg =0 then goto check_non_data_io;
1014 if tdl.status.rrc ^= tdl.trrec then
1015     tdl.terflg = 1;
1016 
1017 
1018 /*               smb #1 check                    */
1019 check_non_data_io:
1020 if tdl.topcd.op_type = 0 then goto error_check_done; /* non-data */
1021 if tdl.tpmb.iom_cmd ^= "0100"b then goto not_sing_char_ioc_cmd;
1022 goto error_check_done;
1023 
1024 
1025 not_sing_char_ioc_cmd:
1026 if tdl.tinint ^= 0 then goto error_check_done;
1027 if tdl.tnmflg ^= 0 then goto check_read;
1028 if tdl.tnrflg = 0 then goto check_res_wc;
1029 goto check_res_add;
1030 
1031 
1032 check_res_wc:
1033 if tdl.dcwres.wrd = tdl.trwrd then goto check_res_add;
1034 if (tdl.trwrd = "000000000000"b|
1035      tdl.topcd.op_type = 3) = "0"b then goto check_read;
1036 tdl.terflg = 1;
1037 
1038 
1039 check_res_add:
1040 if tdl.dcwres.wrd ^="000000000000"b then goto check_read;
1041 if tdl.tesmb.add = tdl.dcwres.add then goto check_read;
1042 tdl.terflg = 1;
1043 
1044 
1045 check_read:
1046 if tdl.topcd.op_type ^=3|
1047      tdl.tncflg ^=0 then goto error_check_done;
1048 current_dcw_add = tdl.tfdcwp; /* start with first dcw */
1049 tdl.tldcw = current_dcw_add->dcw_peek;
1050 /* pre_fol word check here */
1051 if tdl.tdtyp ^=1 then goto dont_initialize_random;
1052 dvran = addrel(tip,tdl.tldcw.add)->data_peek.data;  /* get first word of write area */
1053 if fixed(tdl.tdata) ^= 0 then
1054      dvran = tio.tadwd; /* use address as data */
1055 if tdl.tpsflg = 0 then goto no_pos_check;
1056 /********************positioning check***********************/
1057 /*
1058 
1059       During tape positioning checking(tdl.tpsflg ^=0), if DRAN or DRAN1 data
1060       type is used, the random base for data comparision is sset to:
1061 
1062        upper = comp (tdl.tppos+1)     lower = tdl.tppos+1
1063 
1064       If there is a match of either the lower or upper half of this
1065       word with the corresponding lower or upper half of the data in the
1066       read area, the position is assumed to be good.
1067 
1068       If both the above lower or upper match fails, the complement
1069       of the lower half of the first word for the read area is compared
1070       with the upper half of the same word.  If they do not compare
1071       it is assumed that a positioning check is invalid because of
1072       a data error that messed up the first word of the read area.
1073 
1074       If the latter comparision indicates that we can assume no
1075       read data error, then a positioning error is assumed.
1076       tdl.tppos will be set to the value in the lower half of the
1077       data in the first word of the read area to reset
1078       the current tape position to where the first word of the read
1079       area indicates the tape to be at present and a position error
1080       message will be included in the error message.
1081 
1082 */
1083 dvran = bool(bit(fixed(tdl.tppos,18),18),"111111111111111111"b,"1100"b)||bit(fixed(tdl.tppos,18),18);
1084 if (tdl.tldcw.typ = "00"b|tdl.tldcw.typ = "01"b) = "0"b then goto no_pos_check;
1085 /* cant check position unless word is xfer */
1086 if substr(addrel(tip,tdl.tldcw.add)->data_peek.data,1,18) = substr(dvran,1,18)|
1087    substr(addrel(tip,tdl.tldcw.add)->data_peek.data,19,18) = substr(dvran,19,18)
1088      then goto position_good;
1089 if substr(addrel(tip,tdl.tldcw.add)->data_peek.data,1,18) =
1090    bool(substr(addrel(tip,tdl.tldcw.add)->data_peek.data,19,18),"111111111111111111"b,"1100"b)
1091      then goto position_error;
1092 /* must be  data error */
1093 pos = "---";
1094 goto no_pos_check;
1095 
1096 
1097 position_error:
1098 pos = translate(substr(character(tdl.tppos),
1099      length(character(tdl.tppos))-2),"0"," ");
1100 tdl.tppos = fixed(substr(addrel(tip,tdl.tldcw.add)->data_peek.data,19,18));
1101 dvran = bool(bit(fixed(tdl.tppos,18),18),"111111111111111111"b,"1100"b)||bit(fixed(tdl.tppos,18),18);
1102 /* set dvran to this position */
1103 tdl.terflg = 1;
1104 goto no_pos_check;
1105 
1106 
1107 position_good:
1108 pos = "ok ";
1109 no_pos_check:
1110 /* this is a read and tdl.tppos has been incremented 1 too many */
1111 /* the starting word base is = comp (tdl.tppos+1) for the upper and
1112    tdl.tppos+1 for the lower.  In this way the upper is
1113    always the complement of the lower. the lower half starts at zero
1114    and increments by 1 for each position change.  */
1115 
1116 
1117 dont_initialize_random:
1118 allow_branch_dcw,dcw_count = 0;
1119 
1120 
1121 select_next_dcw:
1122 tdl.tldcw = current_dcw_add->dcw_peek;
1123 dcw_count = dcw_count +1;
1124 current_dcw_add = addrel(current_dcw_add,1); /* bump dcw address */
1125 if dcw_count > 10 then goto say_dcw_loop;
1126 /* should be  a different error---a disaster*/
1127 if tdl.tldcw.typ = "00"b then goto check_stop_dcw;
1128 if tdl.tldcw.typ = "01"b then goto check_proceed_dcw;
1129 if tdl.tldcw.typ = "10"b then goto check_branch_dcw;
1130 /*   must be "11"b non data xfer and proceed  */
1131 goto check_ndt_and_proceed;
1132 
1133 
1134 check_proceed_dcw:
1135 call check_data;
1136 check_ndt_and_proceed:
1137 allow_branch_dcw = 1; /* permit branch now  */
1138 goto select_next_dcw;
1139 
1140 
1141 check_branch_dcw:
1142 if allow_branch_dcw = 0 then goto say_branch_bad;
1143 /* should be a different error--a disaster*/
1144 allow_branch_dcw = 0;
1145 current_dcw_add = addrel(tip,fixed(tdl.tldcw.add));
1146 goto select_next_dcw;
1147 
1148 
1149 check_stop_dcw:
1150 call check_data;
1151 goto error_check_done;
1152 
1153 
1154 check_data:proc;
1155 tdl.tdtcal_reladd = fixed(tdl.tldcw.add)
1156     - fixed(rel(addr(tio.trarea(1))));
1157 tdl.tdtcal_wc = fixed(tdl.tldcw.wc)-fixed(tdl.dcwres.wrd);
1158 /*   only check what was actually read  */
1159 if tdl.tdtyp ^=1 then goto not_random_read;
1160 do dovar2 = 1 to tdl.tdtcal_wc;
1161 tio.twarea(tdl.tdtcal_reladd+dovar2) = dvran;
1162 call compute_random;
1163 end;
1164 
1165 
1166 not_random_read:
1167 do dovar1 = 1 to tdl.tdtcal_wc;
1168 if trarea(dovar1+tdl.tdtcal_reladd) = twarea(dovar1+tdl.tdtcal_reladd) then goto data_good;
1169 if tdl.tchmsk ^= "000000000000000000000000000000000000"b&
1170    tdl.tldcw.typ = "00"b&
1171    dovar1= tdl.tdtcal_wc then do;
1172 if bool(trarea(dovar1+tdl.tdtcal_reladd),tdl.tchmsk,"0010"b)
1173     = bool(twarea(dovar1+tdl.tdtcal_reladd),tdl.tchmsk,"0010"b) then goto data_good;
1174  end;
1175 tdl.tdecnt = tdl.tdecnt+1; /* bump data error count */
1176 data_good:
1177 end;
1178 end check_data;
1179 
1180 
1181 
1182 error_check_done:
1183 /*********************************************************************/
1184 
1185 
1186 
1187 
1188 /*    check to see if any error output is to be done here */
1189 
1190 
1191 
1192 
1193 
1194 if tdl.tntflg ^=0 then goto check_for_options_after_error_check;
1195 if (tdl.status.pwr ^= "0"b|tdl.status.major_status = "0010"b)
1196    ="0"b then goto not_man_intervention;
1197 if tdl.endng ^= 0 then goto not_man_intervention;
1198 /*  dont service manual intervention if in forced term test */
1199 if tdl.status.pwr ^= "0"b then goto in_man_intervention;
1200 if tdl.status.major_status ^= tdl.testat.major_status
1201      then goto in_man_intervention;
1202 
1203 
1204 not_man_intervention:
1205 if tdl.tmiflg ^=0 then goto end_man_intervention;
1206 if tdl.trflg = 0 then goto no_tran_request;  /* "tdd" modifier not used */
1207 /* tdl.trflg is set by the modifier "tdd", and the location
1208    of the peripheral operation on which it was used is saved
1209    in tdl.tsfld(8) and tdl.tscnt(8).  If tdl.trycnt >=
1210    0 then tdl.trflg is set to tdl.trycnt; otherwise, tdl.trflg
1211    is set to the "nn" in "tnn".
1212    tdl.trflg is an immediate modifier and only applies for
1213    one peripheral operation.
1214 */
1215 if tdl.terflg^=0|tdl.tdecnt ^=0 then goto transient_error;
1216 /* no error on this peripheral operation
1217      If no recovery tries have yet been made, tdl.trcnt will be =0.
1218    If tdl.trcnt is non-zero, it will contain the
1219    number of times that retry has been made so far.
1220    This number is added to tdl.tottrn.read, tdl.pastrn.read,
1221    and to cyctrn.read if a read operation, or to the
1222    equivalent .write if not a read operation.
1223    tdl.trcnt is then zeroed and tdl proceeds to the next field.
1224 */
1225 if tdl.topcd.op_type = 3 then do;
1226      tdl.pastrn.read = tdl.pastrn.read + tdl.trcnt;
1227      tdl.cyctrn.read = tdl.cyctrn.read + tdl.trcnt;
1228      tdl.tottrn.read = tdl.tottrn.read + tdl.trcnt;
1229 end;
1230 else do;
1231      tdl.pastrn.write = tdl.pastrn.write + tdl.trcnt;
1232      tdl.cyctrn.write = tdl.cyctrn.write + tdl.trcnt;
1233      tdl.tottrn.write = tdl.tottrn.write + tdl.trcnt;
1234 end;
1235 tdl.trcnt = 0;
1236 goto check_for_options_after_error_check;
1237 
1238 
1239 transient_error:
1240 /* an error has occurred for a peripheral operation
1241    with a "tdd" modifier.
1242    tdl.trycnt contains the number of retries to make.
1243    If it is zero, then none are made, tdl.trflg
1244    is set to zero and the "tdd" is ignored.
1245    Since we can only be in a transient
1246    recovery routine if "tdd" is used and
1247    if tdl.trycnt ^=0, this effectively
1248    means "tdd" is a nop if tdl.trycnt = 0;
1249 */
1250 if tdl.trycnt = 0 then goto no_tran_request;
1251 /* there are tdl.trycnt tries to be made.
1252    Bump tdl.trcnt to account for them
1253    and use it to determine if the last
1254    has been reached.
1255 */
1256 tdl.trcnt = tdl.trcnt + 1;
1257 if tdl.trcnt >= tdl.trflg then goto unrecoverable;
1258 if tdl.traner = 0 then goto enter_transient_recovery;
1259 /* the transient message output is requested */
1260 tdl.tdlret = enter_transient_recovery;
1261 tdl.add_tran = 2;  /* special flag to add transient message */
1262 goto complete_transient_message;
1263 
1264 
1265 enter_transient_recovery:
1266 if tdl.topcd.op_type ^=3 then goto enter_write_recovery;
1267 if tst.linetab(tdl.tsubr+1) ^=0 then goto invalid_tran_line;
1268 tdl.line_number = tdl.tsubr;
1269 goto nxlin;   /* enter the transient routine */
1270 
1271 
1272 enter_write_recovery:
1273 if tst.linetab(tdl.tsubw+1) ^=0 then goto invalid_tran_line;
1274 tdl.line_number = tdl.tsubw;
1275 goto nxlin;  /* enter the transient routine */
1276 
1277 invalid_tran_line:
1278 inv_data = "transient error recovery subroutine is a non_tdl line";
1279 goto say_invalid_instruction;
1280 
1281 
1282 unrecoverable:
1283 if tdl.topcd.op_type = 3 then do;
1284      tdl.pastrn.read = tdl.pastrn.read + tdl.trcnt;
1285      tdl.cyctrn.read = tdl.cyctrn.read + tdl.trcnt;
1286      tdl.tottrn.read = tdl.tottrn.read + tdl.trcnt;
1287 end;
1288 else do;
1289      tdl.pastrn.write = tdl.pastrn.write + tdl.trcnt;
1290      tdl.cyctrn.write = tdl.cyctrn.write + tdl.trcnt;
1291      tdl.tottrn.write = tdl.tottrn.write + tdl.trcnt;
1292 end;
1293 tdl.add_tran = 1; /* special flag for unrecoverable message */
1294 goto complete_transient_message;
1295 
1296 
1297 no_tran_request:
1298 if tdl.terflg = 0&tdl.tdecnt = 0 then goto check_for_options_after_error_check;
1299 tdl.toterr.sta = tdl.toterr.sta + tdl.terflg;
1300 tdl.cycerr.sta = tdl.cycerr.sta + tdl.terflg;
1301 tdl.paserr.sta = tdl.paserr.sta + tdl.terflg;
1302 tdl.toterr.dat = tdl.toterr.dat + tdl.tdecnt;
1303 tdl.cycerr.dat = tdl.cycerr.dat + tdl.tdecnt;
1304 tdl.paserr.dat = tdl.paserr.dat + tdl.tdecnt;
1305 tdl.taeflg = 1; /* set any error flag */
1306 
1307 
1308 complete_transient_message:
1309 if tdl.bypass ^=0 then goto check_for_options_after_error_check;
1310 
1311 
1312 man_intervention_started:
1313 tdl.ttyret = check_for_options_after_error_check;
1314 call error_output(tdp,pos);
1315 if tdl.teepopt ^=0&tdl.eep_line_no ^=0&tdl.tmiflg=0&tdl.endng = 0 then goto start_eep;  /* message not yet issued */
1316 /* dont start eep if in forced term test */
1317 goto main_dispatch_queue_service;
1318 /* goto common code */
1319 
1320 
1321 start_eep:
1322 tdl.eep_in_progress = 1;
1323 tdl.eep_talpha = tdl.talpha;
1324 tdl.eep_tnmbr = tdl.tnmbr;
1325 tdl.eep_tnmwrd = tdl.tnmwrd;
1326 tdl.eep_next_field_number = tdl.next_field_number;
1327 tdl.eep_per_op_number = tdl.per_op_number;
1328 tdl.eep_line_number = tdl.line_number;
1329 tdl.eep_tlscan = tdl.tlscan;
1330 tdl.eep_inst_index = tdl.inst_index;
1331 tdl.eep_tdlret = tdl.tdlret;
1332 tdl.line_number = tdl.eep_line_no;
1333 goto nxlin;
1334 
1335 
1336 end_man_intervention:
1337 tdl.tmiflg = 0;
1338 goto restart;
1339 
1340 
1341 in_man_intervention:
1342 if tdl.tmiflg ^=0 then goto not_first_intervention;
1343 tdl.toterr.sta = tdl.toterr.sta + tdl.terflg;
1344 tdl.cycerr.sta = tdl.cycerr.sta + tdl.terflg;
1345 tdl.paserr.sta = tdl.paserr.sta + tdl.terflg;
1346 tdl.toterr.dat = tdl.toterr.dat + tdl.tdecnt;
1347 tdl.cycerr.dat = tdl.cycerr.dat + tdl.tdecnt;
1348 tdl.paserr.dat = tdl.paserr.dat + tdl.tdecnt;
1349 tdl.taeflg = 1; /* set any error flag */
1350 tdl.tmiflg = 1;
1351 goto man_intervention_started;
1352 
1353 
1354 not_first_intervention:
1355 tdl.tmiflg = tdl.tmiflg +1;
1356 if tdl.tmiflg >= 128 then goto reset_man_intervention;
1357 
1358 
1359 man_intervention_loop:
1360 tdl.tmnem = "res  ";
1361 check = 32;
1362 goto per_op_common;
1363 
1364 
1365 reset_man_intervention:
1366 tdl.tmiflg = 1;
1367 goto man_intervention_started;
1368 
1369 
1370 check_for_options_after_error_check:
1371 if tdl.tmiflg ^=0 then goto man_inter_options;
1372 if tdl.opt = 0 then goto tdl.tdlret;
1373 tdl.optrtn = tdl.tdlret;
1374 goto process_options;
1375 
1376 
1377 man_inter_options:
1378 if tdl.opt = 0 then goto man_intervention_loop;
1379 tdl.optrtn = man_intervention_loop;
1380 goto process_options;
1381 
1382 
1383 setup_random_data:proc;
1384 if fixed(tdl.tdata) ^= 0 then
1385      dvran = tio.tadwd; /* use address as data */
1386 if tdl.tpsflg ^=0 then
1387      dvran = bool(bit(fixed(tdl.tppos+1,18),18),"111111111111111111"b,"1100"b)||bit(fixed(tdl.tppos+1,18),18);
1388 /* the starting word base is = comp (tdl.tppos+1) for the upper and
1389    tdl.tppos+1 for the lower.  In this way the upper is
1390    always the complement of the lower. the lower half starts at zero
1391    and increments by 1 for each position change.  */
1392 not_pos_rand:
1393 do dovar1 = 1 to data_setup_wc;
1394 tio.twarea(data_setup_reladd+dovar1) = dvran;
1395 call compute_random;
1396 end;
1397 
1398 
1399 
1400 end setup_random_data;
1401 
1402 
1403 setup_octal_data:proc;
1404 tdl.tdtyp = 0;
1405 do dovar1 = 1 to data_setup_wc;
1406 tio.twarea(data_setup_reladd+dovar1) = tdl.tdata;
1407 end;
1408 end setup_octal_data;
1409 
1410 
1411 setup_add_to_data:proc;
1412 tdl.tdtyp = 0;
1413 do dovar1 = 1 to data_setup_wc;
1414 tio.twarea(data_setup_reladd+dovar1)
1415 = bit(fixed((fixed(tdl.tdata) + fixed(tio.twarea(data_setup_reladd+dovar1))),36));
1416 end;
1417 end setup_add_to_data;
1418 
1419 
1420 setup_data_from_line:proc;
1421 tdl.tdtyp = 0;
1422 work_ptr = addrel(addr(tst.lines),(fixed(tdl.tdata)*14));
1423 /*
1424 
1425 note:   tdl data lines consist of 9 words of data followed by
1426        5 words of padding to fill out to a 14 word ascii multics line.
1427 
1428 */
1429 do dovar1 = 1 to tdl.tdtcal_wc by 9;
1430 if tst.linetab(fixed(tdl.tdata)+(dovar1-1)/9+1) ^= 2 then goto not_test_data_line;
1431 end;
1432 
1433 
1434 fix_bit = 0;
1435 do dovar1 = 1 to tdl.tdtcal_wc;
1436 tio.twarea(data_setup_reladd+dovar1) = work_ptr->data_move.data(dovar1+fix_bit);
1437 if mod(dovar1,9) = 0 then fix_bit = fix_bit+5;
1438 end;
1439 end setup_data_from_line;
1440 
1441 
1442 not_test_data_line:
1443 inv_data = "dln data is not all from test data line";
1444 goto say_invalid_instruction;
1445 
1446 
1447 setup_drot:proc;
1448 tdl.tdtyp = 0;
1449 work_ptr = addrel(addr(twarea(1)),data_setup_reladd);
1450 substr(work_ptr->bit_look.data(1),1,(data_setup_wc*36))
1451   = substr(work_ptr->bit_look.data(1),7,(data_setup_wc*36-6))||
1452     substr(work_ptr->bit_look.data(1),1,6);
1453 end setup_drot;
1454 
1455 
1456 setup_adrot:proc;
1457 tdl.tdtyp = 0;
1458 work_ptr = addrel(addr(twarea(1)),data_setup_reladd);
1459 substr(work_ptr->bit_look.data(1),1,(data_setup_wc*36))
1460   = substr(work_ptr->bit_look.data(1),10,(data_setup_wc*36-9))||
1461     substr(work_ptr->bit_look.data(1),1,9);
1462 end setup_adrot;
1463 
1464 
1465 setup_packed_hex_data:proc;
1466 tdl.tdtyp = 0;
1467 work_ptr = addrel(addr(tst.lines),(fixed(tdl.tdata)*14));
1468 /*
1469 
1470 note:   tdl data lines consist of 9 words of data followed by
1471        5 words of padding to fill out to a 14 word ascii multics line.
1472 
1473      only the characters 0-9 and a-f are permitted in the data line
1474 
1475      0-f are translated to a 4 bit pattern "0000" to "1111"
1476           corresponding to the order 0-9,a-f
1477 
1478      the resulting 4 bit patterns are then concatenated adjacently
1479           to produce the final pattern
1480 
1481      it requires 9 data line characters to produce 1 word of output data
1482      (6 bit characters---1 1/2 36 bit words )
1483 */
1484 do dovar1 = 1 to ceil((tdl.tdtcal_wc*9)/6) by 9;
1485 if tst.linetab(fixed(tdl.tdata)+(dovar1-1)/9+1) ^= 2 then goto not_test_data_line;
1486 end;
1487 
1488 
1489 fix_bit = 0;
1490 do dovar1 = 1 to tdl.tdtcal_wc*9;
1491 if hex_val(fixed(work_ptr->char6_peek(dovar1+fix_bit))+1) = 20 then goto invalid_hex_line;
1492 if mod(dovar1,54) = 0 then fix_bit = fix_bit+30;
1493 end;
1494 
1495 
1496 fix_bit = 0;
1497 do dovar1 = 1 to tdl.tdtcal_wc;
1498 tio.twarea(data_setup_reladd+dovar1) =
1499      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+1+fix_bit))+1),4),4)||
1500      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+2+fix_bit))+1),4),4)||
1501      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+3+fix_bit))+1),4),4)||
1502      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+4+fix_bit))+1),4),4)||
1503      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+5+fix_bit))+1),4),4)||
1504      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+6+fix_bit))+1),4),4)||
1505      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+7+fix_bit))+1),4),4)||
1506      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+8+fix_bit))+1),4),4)||
1507      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*9+9+fix_bit))+1),4),4);
1508 if mod(dovar1,6) = 0 then fix_bit = fix_bit+30;
1509 end;
1510 end setup_packed_hex_data;
1511 
1512 
1513 setup_unpacked_hex_data:proc;
1514 tdl.tdtyp = 0;
1515 work_ptr = addrel(addr(tst.lines),(fixed(tdl.tdata)*14));
1516 /*
1517 
1518 note:   tdl data lines consist of 9 words of data followed by
1519        5 words of padding to fill out to a 14 word ascii multics line.
1520 
1521      only the characters 0-9 and a-f are permitted in the data line
1522 
1523      0-f are translated to a 4 bit pattern "0000" to "1111"
1524           corresponding to the order 0-9,a-f
1525 
1526      the resulting 4 bit patterns are then concatenated in pairs with a fill bit as
1527           "0"||"xxxx"||"yyyy" to produce a nine bit character and the
1528           resulting 9 bit characters are contatenated adjacently
1529           to produce the final pettern
1530 
1531      it requires 8 data line characters to produce 1 word of output data
1532      (6 bit characters---1 1/3 36 bit words )
1533 */
1534 do dovar1 = 1 to ceil((tdl.tdtcal_wc*8)/6) by 9;
1535 if tst.linetab(fixed(tdl.tdata)+(dovar1-1)/9+1) ^= 2 then goto not_test_data_line;
1536 end;
1537 
1538 
1539 fix_bit = 0;
1540 do dovar1 = 1 to tdl.tdtcal_wc*8;
1541 if hex_val(fixed(work_ptr->char6_peek(dovar1+fix_bit))+1) = 20 then goto invalid_hex_line;
1542 if mod(dovar1,54) = 0 then fix_bit = fix_bit+30;
1543 end;
1544 
1545 
1546 fix_bit = -30;  /* preset for first bump */
1547 do dovar1 = 1 to tdl.tdtcal_wc;
1548 if mod(dovar1,27) = 1 then fix_bit = fix_bit+30;
1549 byte1 =
1550      "0"b||
1551      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+1+fix_bit))+1),4),4)||
1552      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+2+fix_bit))+1),4),4);
1553 if mod(dovar1,27) = 21 then fix_bit = fix_bit+30;
1554 byte2 =
1555      "0"b||
1556      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+3+fix_bit))+1),4),4)||
1557      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+4+fix_bit))+1),4),4);
1558 if mod(dovar1,27) = 14 then fix_bit = fix_bit+30;
1559 byte3 =
1560      "0"b||
1561      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+5+fix_bit))+1),4),4)||
1562      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+6+fix_bit))+1),4),4);
1563 if mod(dovar1,27) = 7 then fix_bit = fix_bit+30;
1564 tio.twarea(data_setup_reladd+dovar1) =
1565   byte1||byte2||byte3||
1566      "0"b||
1567      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+7+fix_bit))+1),4),4)||
1568      bit(fixed(hex_val(fixed(work_ptr->char6_peek((dovar1-1)*8+8+fix_bit))+1),4),4);
1569 end;
1570 end setup_unpacked_hex_data;
1571 
1572 
1573 invalid_hex_line:
1574 inv_data = "invalid hexidecimal character in uhdln or phdln";
1575 goto say_invalid_instruction;
1576 
1577 
1578 compute_random:proc;
1579 dvranw = "0"b||bit(fixed(fixed(dvran)*317,71),71);
1580 dvran=substr(bit(fixed(fixed(substr(dvranw,37,36),36)+fixed(substr(dvranw,1,35),36),36),36),1,36);
1581 end compute_random;
1582 
1583 
1584 
1585 page_initialize:
1586 call init_page;
1587 if tdl.initreq ^=-1 then goto select_next_test_or_seg_or_start_or_end;
1588 tdl.initreq = 0;
1589 
1590 
1591 start_test:
1592 tdl.lst = tdl.nxt;
1593 tdl.loopct(tdl.line_number+1),  /* clear this lines loop counter  */
1594     tdl.tpsflg,  /*  clear positioning flag  */
1595    tdl.do_dual_io,
1596    tdl.second_io_of_dual,
1597    tdl.eep_tally,
1598    tdl.eep_in_progress,
1599    tdl.tmiflg = 0;
1600 tdl.tchmsk = "000000000000000000000000000000000000"b;
1601 tdl.tpadwd = "101010101010101010101010101010101010"b;
1602 goto nxlin;  /*  goto the next line   */
1603 
1604 
1605 init_page:proc;
1606 tdl.tdtyps,tdl.tcwdls = 0;
1607 tdl.tdatas = "000000000000000000000000000000000000"b;
1608 tdl.tpmbs.chan = tdl.tpaddp;
1609 dvran = "001010011100101110110101100011010001"b; /* standard random dvran */
1610 do dovar1 = 1 to 10;
1611 tio.tdcww(dovar1).add = rel(addr(tio.twarea));
1612 tio.tdcwr(dovar1).add = rel(addr(tio.trarea));
1613 tio.tdcww(dovar1).char = "000"b;
1614 tio.tdcwr(dovar1).char ="000"b;
1615 tio.tdcww(dovar1).w_c = "0"b;
1616 tio.tdcwr(dovar1).w_c = "0"b;
1617 tio.tdcww(dovar1).typ ="00"b;
1618 tio.tdcwr(dovar1).typ = "00"b;
1619 tio.tdcww(dovar1).wc = bit(fixed(tst.max,12),12);
1620 tio.tdcwr(dovar1).wc = bit(fixed(tst.max,12),12);
1621 end;
1622 tdl.tdcws.wc = tst.max;
1623 tio.tdcw.char ="000"b;
1624 tio.tdcw.w_c = "0"b;
1625 tio.tdcw.typ = "00"b;
1626 chgmode,
1627    tdl.terflg,
1628    tdl.taeflg,
1629    tdl.tcwdl,
1630    tdl.tpsflg = 0;
1631 do dovar1 = 1 to 101;
1632 tdl.loopct(dovar1) = 0;
1633 end;
1634 do dovar1 = 1 to 10;
1635 tdl.tsfld(dovar1) = -1;
1636 tdl.tscnt(dovar1) = 0;
1637 end;
1638 end init_page;
1639 
1640 
1641 
1642 set_hbs_bit:proc;
1643   fmtflg = 0;
1644   substr(addrel(tip,tdl.tldcw.add)-> bits,34,1)= "1"b;
1645 skip_hbs_set:
1646   end set_hbs_bit;
1647 
1648 
1649 
1650 
1651 end_page:
1652 tdl.test_no_to_jump_to = tst.trm; /* select term test */
1653 tdl.doing_force = 1;
1654 tdl.endng = 1;
1655 tdl.force = 1;
1656 goto force_test;
1657 
1658 
1659 process_options:
1660 call options(tdp,tpp,check);
1661 if tdl.wait ^= 0 then goto wait_loop;
1662 if check ^=0 then goto tdl.optrtn;
1663 goto main_dispatch_queue_service;
1664 
1665 
1666 wait_loop:
1667 if tdl.wait = 0 then goto process_options; /* wait broken by options request */
1668 /* note that the place to return from after .wait is broken is tdl.optrtn */
1669 tdl.clock_dispatch = wait_loop;
1670 tdl.clock_going = 1;  /* set clock going */
1671 call timer_manager_$alarm_wakeup(60000000,"10"b,tdl.clock_event);
1672 /*  time is in micro seconds
1673   60000000 = 1 min  */
1674 tdl.iocnt = tdl.iocnt +1; /* bump test pages i/o count */
1675 call edit_options(tdp,current_options);
1676 pnum = substr(page_no_char,tdl.pageno,1);
1677 call ioa_$rsnnl("^/^/**^a(^ac) ^a waiting",message,mesg_len,pnum,tdl.iccdd,current_options);
1678 call buffer_tty_output(message,tdl.pageno);
1679 goto main_dispatch_queue_service; /* go away untill called */
1680 /* goto common code  */
1681 
1682 
1683 say_invalid_instruction:
1684 chgmode = 0;  /* make sure we dont inadvertently think we have an io  */
1685 lineno = tdl.line_number;
1686 fieldno = tdl.next_field_number - 1;
1687 tdl.rtnopt = process_options;
1688 tdl.optrtn = restart;
1689 pnum = substr(page_no_char,tdl.pageno,1);
1690 call edit_options(tdp,current_options);
1691 call ioa_$rsnnl("^/^/**^a(^ac) invalid tdl instruction, line ^d, field ^d, ^a^a^/^a^/^a enter options:"
1692 ,message,mesg_len,pnum,tdl.iccdd,lineno,fieldno,tdl.talpha,tdl.tnmbr,inv_data,current_options);
1693 
1694 
1695 invalid_common:
1696 inv_data = "";
1697 tdl.optrd = 1;
1698 goto request_and_wait_for_tty_write;
1699 
1700 
1701 /*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
1702 
1703 
1704 
1705               next test sequencing
1706 
1707        Test pages contain two sets of information relating to
1708             test sequencing.  The first of these sets are the
1709             three values for "fst", "end" and "trm".  The second of these
1710             is the contents of the test sequencing table.
1711 
1712        For any given test page segment, the content of the test
1713             sequencing table is, by definition, a sequence of line numbers
1714             with the occurance of a line number in a given position in
1715             the table defining the starting line number for the test
1716             number associated with that position in the table.
1717 
1718        The value of "tst.fst" defines the "virtual test number" of the
1719           first test in any given test page segment.  This test number
1720           is here called "virtual" because, for other than the first
1721           test page segment, there will be a "real" test with that same
1722           number that exists as the last test in the prior test page.
1723           This "virtual" test does not have an entry in the test sequencing
1724           table to define its line number.  The line number of this
1725           "virtual" test is defined as line #0.
1726 
1727        The test number associated with any entry in the test sequencing
1728           table is equal to the ordinal position of the entry in the
1729           table + the value of "tst.fst".  For a value of 5 for "tst.fst"
1730           with 3 entries in the table, the three entries have ordinal
1731           position of 1,2, and 3 and therefore define tests # 6,7 and 8
1732           (there is no ordinal position 0, the first position is position 1).
1733 
1734          Example:
1735 
1736     seg.a                       seg.b                    seg.c
1737         table                       table                    table
1738 fst=0   pos. 1(test 1)       fst=5  pos. 1(test 6)    fst=8  pos. 1(test 9)
1739 end=5   pos. 2(test 2)       end=8  pos. 2(test 7)    end=12 pos. 2(test 10)
1740 trm=6   pos. 3(test 3)       trm=9  pos. 3(test 8)    trm=12 pos. 3(test 11)
1741         pos. 4(test 4)              pos. 4(force term)       pos. 4(test 12
1742         pos  5(test 5)                                              force and
1743         pos. 6(force term)                                          normal
1744                                                                     term)
1745 
1746       In the above, note that "trm" serves as a way to indicate
1747            whether or not the current segment is the last of the test
1748            segments.  If "trm" = "end", then the current segment is the
1749            last segment. If "trm"="end"+1, then there is a following segment.
1750            There are only two legal values for "trm", "trm" = "end" or
1751            "trm" = "end"+1.  "trm" always refers to the term test for
1752            the current segment.  That is, the last test defined in
1753            the test sequencing table is the force term test.
1754 
1755       "end" refers to the last selectable test in the current segment
1756            by normal test sequencing.  In the example, the last test
1757            normally run in seg.a is test 5.  An "nx" in test 5 will not
1758            cause sequencing to pos.6 in seq.a but will cause seq.b to be
1759            called.  Similiarily, a "nx" in test 8 of seg.b will cause
1760            segment seg.c to be called.  In seg.c, test sequencing will
1761            proceed into test 12.
1762 
1763 
1764 
1765 */
1766 select_next_test_or_seg_or_start_or_end:
1767 call test_seq_init;
1768 if tdl.nxt ^= -1 then goto select_test;
1769 tdl.nxt,tdl.lst = 0;  /*  flag initialization done  */
1770 if tdl.initreq ^= 0 then goto say_end_cycle;
1771 tdl.initreq = -1;
1772 /*
1773 
1774 
1775        output page start message
1776 
1777 
1778 */
1779 pnum = substr(page_no_char,tdl.pageno,1);
1780 call ioa_$rsnnl("^/^/**^a(^ac) start ^a ^a ttldat ^a",message,mesg_len,pnum,tdl.iccdd,tst.name,tst.perip,tst.tpdate);
1781 tdl.ttyret = page_initialize;
1782 goto request_and_wait_for_tty_write;
1783 
1784 
1785 say_end_cycle:
1786 tdl.cyccnt = tdl.cyccnt + 1;
1787 if tdl.halt ^=0 then goto do_say_end_cycle;
1788 if tdl.bypass ^=0 then goto page_initialize;
1789 
1790 
1791 do_say_end_cycle:
1792 pnum = substr(page_no_char,tdl.pageno,1);
1793 call ioa_$rsnnl("^/^/**^a(^ac) end cycle ^d: ^d status and ^d data errors"
1794 ,message,mesg_len,pnum,tdl.iccdd,tdl.cyccnt,tdl.cycerr.sta,
1795 tdl.cycerr.dat);
1796 tdl.ttyret = page_initialize;
1797 tdl.cycerr.sta,
1798    tdl.cycerr.dat = 0;
1799 if (tdl.cyctrn.read ^=0)|(tdl.cyctrn.write ^=0) then do;
1800      call ioa_$rsnnl("^a^/transient errors: ^d read and ^d write",
1801      message,mesg_len,(message),tdl.cyctrn.read,tdl.cyctrn.write);
1802      tdl.cyctrn.read = 0;
1803      tdl.cyctrn.write = 0;
1804 end;
1805 goto request_and_wait_for_tty_write;
1806 
1807 
1808 say_end_pass:
1809 pnum = substr(page_no_char,tdl.pageno,1);
1810 call ioa_$rsnnl("^/^/**^a(^ac) end pass ^d: ^d status and ^d data errors"
1811 ,message,mesg_len,pnum,tdl.iccdd,tdl.pascnt,tdl.paserr.sta,
1812 tdl.paserr.dat);
1813 tdl.paserr.sta,
1814    tdl.paserr.dat = 0;
1815 if (tdl.pastrn.read ^=0)|(tdl.pastrn.write ^=0) then do;
1816      call ioa_$rsnnl("^a^/transient errors: ^d read and ^d write",
1817      message,mesg_len,(message),tdl.cyctrn.read,tdl.cyctrn.write);
1818      tdl.pastrn.read = 0;
1819      tdl.pastrn.write = 0;
1820 end;
1821 tdl.ttyret = start_test;
1822 goto request_and_wait_for_tty_write;
1823 
1824 
1825 get_next_segment:
1826 the_char = substr(tst.name,6,1); /* get sequence letter */
1827 check = search(page_no_char,the_char); /* find it in page_no_char  */
1828 check = check+1;
1829 tdl.call_page = substr(tst.name,1,5)||substr(page_no_char,check,1);
1830 call call_from_page;
1831 
1832 new_segment_common:
1833 tdl.nxt = -1;
1834 tdl.initreq = 0;
1835 tdl.line_number = 0; /* initialization test is defined at line 0 */
1836 goto select_next_test_or_seg_or_start_or_end;
1837 
1838 
1839 select_test:
1840 if tdl.doing_force = 1 then goto find_first_in_sequence;
1841 if tdl.opt = 0 then goto sequence_test;
1842 tdl.optrtn = sequence_test;
1843 goto process_options;
1844 
1845 
1846 sequence_test:
1847 call test_seq_init;
1848 if tdl.nxt = 0 then goto dont_loop_on_test_0;
1849 if loop ^=0 then goto loop_test;
1850 dont_loop_on_test_0:
1851 goto find_next_test;
1852 
1853 
1854 find_first_in_sequence:
1855 /* find first occurance of test to jump to in current test sequence
1856 with jump bit off  */
1857 do dovar1 = 1 to ((tst.end-tst.fst)*4+1) by 4;
1858 if tst.testab(dovar1+1) = 1 then goto no_check_jump;  /* dont use jump  */
1859 if tdl.test_no_to_jump_to - tst.fst = tst.testab(dovar1+2) then goto jump_test_exists;
1860 
1861 
1862 no_check_jump:
1863 end;
1864 goto say_jumping_to_test_not_in_current_sequence;
1865 
1866 
1867 /* check to see if new location in test sequence is <= current
1868 sequence location.  end pass condition if yes */
1869 jump_test_exists:
1870 if (dovar1+3)/4 >= tdl.nxt then goto not_back_jump;
1871 passck = 1;
1872 
1873 
1874 /* reset test sequencing to new location */
1875 not_back_jump:
1876 tdl.nxt = (dovar1+3)/4;
1877 goto loop_test;
1878 
1879 
1880 restart:
1881 call test_seq_init;
1882 goto loop_test;
1883 
1884 
1885 skip_test:
1886 call test_seq_init;
1887 did_skip = 1;
1888 goto find_next_test;
1889 
1890 
1891 force_test:
1892 call test_seq_init;
1893 if test_no_to_jump_to >=(tst.fst+1)&test_no_to_jump_to <= tst.end
1894      then goto find_first_in_sequence;
1895 if tdl.endng ^=0 then goto find_first_in_sequence; /* must be .test e */
1896 the_char = "9"; /* index to first segment */
1897 
1898 try_next_segment:
1899 check = search(page_no_char,the_char); /* find it in page_no_char  */
1900 check = check+1;
1901 tdl.call_page = substr(tst.name,1,5)||substr(page_no_char,check,1);
1902 call call_from_page;
1903 if test_no_to_jump_to
1904      ^> tst.end then goto new_segment_common;
1905 /* if above---found segment  */
1906 if tst.trm = tst.end then goto say_jumping_to_test_not_in_current_sequence; /* no such test */
1907 the_char = substr(tst.name,6,1); /* next segment */
1908 goto try_next_segment;
1909 
1910 
1911 find_next_test:
1912 if tdl.nxt+1 > (tst.end-tst.fst) then goto get_next_segment;
1913 tdl.nxt = tdl.nxt + 1;
1914 
1915 
1916 loop_test:
1917 non_exec_count = non_exec_count + 1;
1918 if non_exec_count = (tst.end-tst.fst) then goto say_no_executable_tests_in_sequence;
1919 if tst.testab((tdl.nxt-1)*4+2) = 0 then goto not_sequenced_jump;
1920 tdl.test_no_to_jump_to = tst.testab((tdl.nxt-1)*4+3); /*select test # to jump to*/
1921 goto find_first_in_sequence;
1922 
1923 
1924 not_sequenced_jump:
1925 if tdl.doing_force ^=0 then goto select_test_at_line;
1926 /* for explicit test requests, the dont run unless explicit request bit
1927 is ignored */
1928 if tst.testab((tst.testab((tdl.nxt-1)*4+3)-1)*4+1) ^= 0 then goto find_next_test;
1929 
1930 
1931 select_test_at_line:
1932 if tst.testab((tst.testab((tdl.nxt-1)*4+3)-1)*4+1) >1 then goto find_next_test;
1933 /* stop condition not 2 or 3, test not completely turned off */
1934 tdl.line_number = tst.testab((tst.testab((tdl.nxt-1)*4+3)-1)*4+4); /* line # of test to tdl.line_number  */
1935 if tdl.test_no_to_jump_to = (tst.testab((tdl.nxt-1)*4+3)+tst.fst) then tdl.doing_force = 0;
1936 if tdl.endng ^=0 then goto start_test;
1937 if passck = 0 then goto check_for_inform;
1938 if tdl.pass =0 then goto check_for_inform;
1939 tdl.pascnt = tdl.pascnt + 1;
1940 if tdl.halt ^=0 then goto say_end_pass;
1941 if tdl.bypass = 0 then goto say_end_pass;
1942 
1943 
1944 check_for_inform:
1945 if tdl.inform = 0 then goto start_test;
1946 if did_skip ^=0 then goto start_test;
1947 /*     endts polts name    */
1948 pnum = substr(page_no_char,tdl.pageno,1);
1949 last_test_no = tst.fst; /* preset in case test #0 last */
1950 if tdl.lst = 0 then goto test_zero_last;
1951 last_test_no = tst.testab((tdl.lst-1)*4+3)+tst.fst; /*compute last test #*/
1952 
1953 
1954 test_zero_last:
1955 next_test_no = (tst.testab((tdl.nxt-1)*4+3)+tst.fst); /* compute next test #*/
1956 halt_message = "";
1957 if tdl.halt = 0 then goto no_halt_at_inform_message;
1958 tdl.optrtn = start_test;
1959 tdl.rtnopt = process_options;
1960 tdl.optrd = 1;
1961 halt_message = "^/enter options:";
1962 
1963 no_halt_at_inform_message:
1964 call ioa_$rsnnl("^/^/**^a(^ac) end t^d next t^d "||substr(time (),1,2)||"."||substr(time (),3,3)
1965     ||halt_message,message,mesg_len,pnum,tdl.iccdd,last_test_no,next_test_no);
1966 tdl.ttyret = start_test;
1967 goto request_and_wait_for_tty_write;
1968 
1969 
1970 test_seq_init:proc;
1971 tdl.lst = tdl.nxt;
1972 did_skip,
1973    passck,
1974    non_exec_count,
1975    tdl.eep_in_progress =0;
1976 end test_seq_init;
1977 
1978 
1979 say_invalid_test_sequencing:
1980 tdl.doing_force = 0;
1981 tdl.optrtn = restart;
1982 tdl.rtnopt = process_options;
1983 pnum = substr(page_no_char,tdl.pageno,1);
1984 call edit_options(tdp,current_options);
1985 call ioa_$rsnnl("^/^/**^a(^ac) invalid test sequencing ^/^a^/^a enter options:"
1986 ,message,mesg_len,pnum,tdl.iccdd,inv_data,current_options);
1987 goto invalid_common;
1988 
1989 
1990 say_no_executable_tests_in_sequence:
1991 inv_data = "no executable tests in this sequence";
1992 goto say_invalid_test_sequencing;
1993 
1994 
1995 say_jumping_to_test_not_in_current_sequence:
1996 inv_data ="trying to jump to a test not in current sequence";
1997 goto say_invalid_test_sequencing;
1998 
1999 
2000 /*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
2001 
2002 
2003 
2004              subroutines
2005 
2006 
2007 
2008 */
2009 lcset:
2010 if tio.tdcwr(tdl.tcwdl).char = "111"b|tio.tdcwr(tdl.tcwdl).typ = "10"b
2011            then goto lcset_error;
2012 tdl.tdtcal_reladd = fixed(tio.tdcwr(tdl.tcwdl).add)
2013     - fixed(rel(addr(tio.trarea(1))));
2014 tdl.tdtcal_wc = fixed(tio.tdcwr(tdl.tcwdl).wc);
2015 tdl.tfdcwp = addrel(addr(tio.tdcwr(1)),(tdl.tcwdl-1)); /* assume read */
2016 if tdl.topcd.op_type = 3 then goto nxfld;  /* was a read */
2017 tdl.tfdcwp = addrel(addr(tio.tdcww(1)),(tdl.tcwdl-1)); /* point to write dcw */
2018 goto nxfld;
2019 
2020 lcset_error:
2021 inv_data = "cannot use tdcw or idcw as first dcw";
2022 goto say_invalid_instruction;
2023 
2024 
2025 lset:proc;
2026 data_setup_reladd = tdl.tdtcal_reladd;
2027 data_setup_wc = tdl.tdtcal_wc;
2028 end lset;
2029 
2030 
2031 dtypst:
2032 /*     all data routines are expected to put the TDL numeric
2033        part of the instruction into "octnum".  Since some
2034        routines isolate the numeric part into "fdec1" or "vdec4"
2035        (DLNnn), they are expected to put the number into "octnum"
2036        before going to dtypst.
2037 */
2038 tdl.tdata = bit(fixed(octnum,36));
2039 call chgorl;
2040 call lset;
2041 if tdl.tdtyp <1|tdl.tdtyp >10 then goto bad_data_type;
2042 goto dtypst_data_setup(tdl.tdtyp);
2043 
2044 
2045 dtypst_data_setup(2):
2046 bad_data_type:
2047 call ioa_$rsnnl("^/tdl.tdtyp ^d illegal in dtypst"
2048 ,term_message,mesg_len,tdl.tdtyp);
2049 call set_polts_abort(term_message);
2050 goto main_dispatch_queue_service;
2051 /* go to common code */
2052 
2053 dtypst_data_setup(1):
2054 call setup_random_data;
2055 
2056 
2057 dtypst_data_setup(7):
2058 goto nxfld;
2059 
2060 dtypst_data_setup(3):
2061 call setup_octal_data;
2062 goto nxfld;
2063 
2064 dtypst_data_setup(4):
2065 call setup_add_to_data;
2066 goto nxfld;
2067 
2068 dtypst_data_setup(5):
2069 call setup_data_from_line;
2070 goto nxfld;
2071 
2072 dtypst_data_setup(6):
2073 call setup_drot;
2074 goto nxfld;
2075 
2076 dtypst_data_setup(8):
2077 call setup_packed_hex_data;
2078 goto nxfld;
2079 
2080 dtypst_data_setup(9):
2081 call setup_unpacked_hex_data;
2082 goto nxfld;
2083 
2084 dtypst_data_setup(10):
2085 call setup_adrot;
2086 goto nxfld;
2087 
2088 
2089 chgorl:proc;
2090 if tdl.tcwdl ^=0 then return;
2091 if chgmode <= 0 then goto nxfld;  /* CHG or not prev per-op  */
2092 if tdl.topcd.op_type ^= 0 then goto nxfld;  /* nd */
2093 end chgorl;
2094 
2095 
2096 call_from_page:proc;
2097 callname = tdl.call_page;  /*  page to call   */
2098 call tpinit(callname,tptr,error);
2099 if error = 0 then goto good_init;
2100 if error ^=1 then goto main_dispatch_queue_service;  /*  system error--we are aborting  */
2101 /* error = 1---no such page  */
2102 call ioa_$rsnnl("^/error calling ^a^/no such test page",term_reason,output_length,
2103      callname);
2104 call set_polts_abort(term_reason);
2105 goto main_dispatch_queue_service;
2106 /* go to common code */
2107 
2108 
2109 good_init:
2110 free tst; /* free old test page */
2111 tpp = tptr; /* new pointer */
2112 tdl.page_ptr = tpp;
2113 end call_from_page;
2114