               job  Infrastructure for one-card tests.
               ctl  6611
     *
     * First card of a test block:
     *
     * 1-7   Widths of up to six instructions
     * 8-72  Code to be loaded starting at 401, followed by a title.
     *       The word mark at 401 is set automatically.  One is not
     *       needed at the end if it is a branch instruction with a
     *       blank D modifier.
     * 73-77 Test block ID
     * 78-80 Sequence number plus 12-zone in 80
     *
     * Detail cards:
     *
     *  1-20 A or D field.  This is printed in 201-220.
     * 21-40 B field.  This is printed in 222-241.
     * 41-60 Correct result.  This is printed in 264-283.
     * 61-72 Comment.  This is printed in 302-313 (if your printer
     *       has 132 columns).
     * 73-77 Test block ID.  This is printed in 292-296.
     * 78-80 Sequence number.  This is printed in 298-300.
     *
     RA        equ  20   Reader area A field
     RB        equ  40   Reader area B field
     RCORR     equ  60   Reader area correct result field
     RCOMM     equ  72   Reader area comment
     RID       equ  77   Reader area ID
     RSEQ      equ  80   Reader area sequence field
     *
     PA        equ  220  Printer area A field
     PB        equ  241  Printer area B field
     PRES      equ  262  Printer area result field
     PCORR     equ  283  Printer area correct result field
     PSTAT     equ  290  Printer area test status field
     PID       equ  296  Printer area ID
     PSEQ      equ  300  Printer area sequence field
     PCOMM     equ  313  Printer area comment
     *
     * Header processing:
     * 7-72 is put into 401-465 and 201-265.  Word marks are set as
     * indicated in 1-6.  The test block ID in 73-77 is put into
     * 292-296.  If 190 is not blank the header is printed, with
     * word marks.
     *
     * Detail processing:
     * Word marks are set in 1, 21, 41, 61, 73 and 78.  The detail
     * fields are loaded into the print area.  The B field is also
     * loaded into 243-262, which is the result field.  Control
     * branches to 401.  At the end of processing, control should
     * branch to
     * FAILED (669) if the test failed,
     * FAILNS (674) if the test failed and no scoping (SS B) test
     *   should be done,
     * WORKED (636) if the test worked,
     * WORKNS (641) if the test worked and no scoping (SS B) test
     *   should be done,
     * COMPAR (699) if the infrastructure is to compare the result
     *   field (243-262) to the correct result field (264-283) and
     *   branch to FAILED or WORKED depending upon whether the
     *   result is unequal or equal,
     * TEST (706) if the loaded code has done a compare and the
     *   unequal indicator is to be tested as for COMPAR,
     * COMPNS (715) as for COMPAR, but no scoping (SS B) test should
     *   be done,
     * TESTNS (722) as for TEST, but no scoping (SS B) test should
     *   be done.
     *
     * Halts (indicated by contents of A-addr and B-addr):
     * 001 -- BWZ cannot reliably detect a 12 zone.
     * 002 -- Compare appears not to work.
     * 003 -- Add appears not to work.
     * 086 -- Tape error if test read from tape.
     * 099 -- Test failed.
     *
     * Sense switches:
     * B -- Tight loop around test, for scoping
     * C -- Print correct results
     * D -- Repeat entire test with same detail -- useful for erratic
     *      errors
     * E -- Halt if error
     * F -- Not used by the infrastructure
     * G -- Not used by the infrastructure
     *
     * Start with some self tests.
     * Verify that BWZ can detect a 12 zone:
     *
     start     bwz  v2,*,B        Good if branch
     v1        nop  001           001 = BCE failed
               h
               b    start
     v2        bwz  v1,start&7,K  Bad if branch -- start&7 has 12 zone
     *
     * Verify that Compare can detect unequal fields.  This is only
     * needed to verify that Add works correctly.
     *
               c    v2&7,start&7
               bu   c2            Good if unequal branch
     c1        nop  002           002 = compare / branch unequal fail
               h
               b    start
     c2        c    v2&7,v2&7
               bu   c1            Bad if unequal branch
               b    addtst        Skip code load area
     *
     * Test code is loaded here.
     *
               org  401
     code1     equ  *&1
     code      ds   65
               ds   1             In case last is B needing blank D
     *
     * Verify that add works well enough to set the word marks.
     *
     addtst    lca  @200@,203
               a    *-6,203
               c    203,@201@     Is 200 & 1 equal to 201?
               bu   s1            Fail if unequal
               b    detail        Start the test sequences
     s1        nop  003
               h
               b    start
     *
     * Read a record from card or tape.  Tape input is indicated
     * by a GM in 81.  Se put a WM under it so long records will
     * not clobber us.  A  in column 80 is a header.  Otherwise
     * branch to 401 to execute the test.
     *
     detail    sw   81            In case of GM there
     readit    bce  tapein,81,"   Tape load puts GM in 81
               cs   80            Start fresh
               cs   332
               cs
               r    gotit
     taperr    bsp  1
               nop  86            Halt 86 for tape error
               h
     tapein    rt   1,1
               ber  taperr
     *
     * Got a record.
     *
     gotit     bwz  header,80,B   Header?
     *
     * Detail record
     *
               sw   ra-19,rb-19
               sw   rcorr-19,rcomm-11
               sw   rid-4,rseq-2
               lca  ra,pa         A field
               lca  rb,pb         B field
               lca  rcorr,pcorr   Correct result field
               mcw  rid,pid       ID field
               lca  rseq,pseq     Sequence number field
               mcw  rcomm,pcomm   Comment
     scope     lca  rb,pres       Actual result field starts as B
               b    code1         Run the test
     *
     * Return here for success
     *
     worked    bss  scope,b      Tight loop for scoping
     * Return here for success but no scoping test
     workns    bss  prntok,c     Print correct result
               b    testd
     prntok    mcw  @OK@,pstat-4
     prntit    w
               cs
               cs
     testd     bss  scope,d      Loose loop -- test & print
               b    readit       Go do another test
     *
     * Return here for failure
     *
     failed    bss  scope,b      Tight loop for scoping
     * Return here for failure but no scoping test
     failns    bss  errhlt,e     Error halt?
               mcw  @ERROR@,pstat-1
               b    prntit
     errhlt    nop  99           Halt 99 for test failure
               h
               b    testd
     *
     * Return here to compare B to Correct and announce
     * error if unequal.
     *
     compar    c    pres,pcorr
     test      bu   failed
               b    worked
     *
     * Return here to compare B to Correct and announce
     * error if unequal, without scoping test
     *
     compns    c    pres,pcorr
     testns    bu   failns
               b    workns
     *
     * Record is a header.
     *
     header    bce  prnthd,1,*    Print headers with * in 1
               sw   8             Word marks under first instruction
               chain7               and widths
               lca  72,code-200   Code (7-72) to print area
               lca  72,code       Code (7-72) to execute area
               mcw  @01@,swaddr#2  Refresh changed instructions
               mcw  @01@,add&3
     swloop    bce  donesw,add&3,8  Already set seven word marks
     add       a    1-0,swaddr    Add length to  SW  address
               mcw  swaddr,sw1&3  Plug offset into
               mcw  swaddr,sw2&3    SW  instructions
     sw1       sw   200-0
     sw2       sw   400-0
               a    *-6,add&3     Bump width counter
               b    swloop        Go set another word mark?
     *
     * Done setting word marks.  Finish the header.
     *
     donesw    bce  detail,190,   No header if 190 is blank
               sw   rid-4,rseq-2
               mcw  rid,pid       Test ID to print area
               mcw  rseq,pseq     Sequence number to print area
               w
               wm
               cs
               cs
               mcw  @--A/D Field---------@,pa
               mcw  @--B Field-----------@,pb
               mcw  @--Actual result-----@,pres
               mcw  @--Correct result----@,pcorr
               mcw  @Status@,290
               mcw  @-ID--@,pid
               mcw  @SEQ@,pseq
               w
               cs
               cs
               b    detail         Read a Detail record
     *
     * Print headers with * in 1
     *
     prnthd    bce  detail,190,   No header if 190 is blank
               sw   rid-4,rseq-2
               mcw  rid,pid       Test ID to print area
               mcw  rseq,pseq     Sequence number to print area
               sw   1
               mcw  rcomm,272
               w    readit
               end  start
