job  Chain loader                                           chain
               ctl  6611
     *
     * If run from cards, just load the next program.
     *
     * Otherwise, load the program selected by parameters in
     * 181-186.  Clear from 100-180 and 200 to the address in
     * 187-189.  If 189 is blank, use 3999 for the top address
     * to clear
     *
     * Stops:
     * 86 in A-star and B-star on read errors.
     * 99 in A-star and B-star on end of file.
     *
     * Fields in header records
     *
     ishead    equ  80  A = for header
     headtp    equ  79  T = Test, C = Chain, H = Print, E = EOF
     headid    equ  76
     *
     * Reserved memory to control the chain loader and each program.
     * The low-order digit of the address of TARGID must be six.
     *
     targeq    equ  181  / for 'run target if unequal,'
     *                 S for 'run target if equal,'
     *                 T for 'run if target ID less than test ID,'
     *                 U for 'run if target ID greater than test ID,'
     *                 B...G for 'run if the specified sense switch
     *                       is on.'
     *                 blank for unconditional
     targnc    equ  182  Last digit of target address 3-6
     targid    equ  186  Target ID
     topadr    equ  189  Top address to clear, max 3999
     *
               org  201
     *
     * Load the program.  Clear core, except for parameter area, first.
     *
               org  201
     load      sw   300             Done when this is cleared
               lca  top4k,clear&3   Default top address to clear
               bce  clearl,topadr,  Use default if parameter block blank
               mcw  topadr,clear&4
     clearl    cw   clear&1
     clear     cs   0-0            Clear a hundred
               sw   clear&1
               a    @I0@,clear&2   Subtract a hundred
               bw   clearl,300     More to do?
               cs   1,299          Clear me and run the header
     top4k     dsa  3999
               ltorg*
     *
     * Start here
     *
     start     bce  tape,81,"  Tape load deposits GM in 81
               sw   1
               r    1
     tape      lca  gm,81        Don't clobber the loader
               cw   gm           So the header can read other programs
     *
     * Skip to a header
     *
     skip1     rtw  1,1          Read a record
               ber  skiper       OOPS, it's an error
               bef  skipef       End of file
               bce  header,ishead,a  It's a header
               b    skip1        Go get another one
     *
     * Error while hunting for a header record
     *
     skiper    bsp  1            Backspace
     skipq     nop  86
               h
               b    skip1        Try again
     *
     * End of file while hunting for a header record
     *
     skipef    rwd  1            Rewind
               nop  99
               h
               b    skip1        Try again
     *
     * Header record.
     *
     header    bce  skip2,headtp,C   Skip chain loaders
               bce  skipef,headtp,E  End of file record
               bce  load,targnc,     Target address digit is blank
               mn   targnc,headc&3   Set up compare
               mn   targnc,headc&6
               sw   targeq,targid-3
               mcw  targeq,headb&4  Set up branch status
     headc     c    headid,targid   Test for target
     headb     bin  load,*       Branch to header if compare succeeds
     skip2     rtw  1,1          Skip program record
               ber  skip2e       OOPS, it's an error
               bef  skipef       End of file
               b    skip1        Hunt for header
     skip2e    bsp  1            Backspace
               nop  86
               h
               bin  skip2,
     *
     gm        dcw  @"@
     *
               end  start