               JOB
               CTL  6611
     x1        equ  89
               ORG  1
               ORG  333
  333start     LCA  k000,x1
  340          SW   1500
  344cs        CS   3999
  348          SBR  cs&3
  352          BW   cs,1500
  360          H    print  start to print, start reset to punch
  364          SW   flag   flag set means punch
  368          B    gblkp
     *
     * Print records
     *
  372print     CC   1
  374          SW   201
     *
     * Get a block to print
     *
  378gblkw     RT   1,1501
  386          BER  tperr 
  391          C    1560,bbbbb
  398          BE   588
  403recw      C    1560&X1,lllll
  410          BE   gblkp
  415          BCE  cc1,1501&X1,1
  423          BCE  ccL,1501&X1,0
  431line      MCW  1633&X1,332
  438          W
  439          A    k01,count1
  446          BCE  blkw,count1-1,1  Done with block?
  454          A    k134,x1          No
  461          B    recw             Get next record from block
  465blkw      MCW  k00,count1       Reset to first record in block
  472          MCW  k000,x1
  479          B    gblkw
  483cc1       CC   1
  485          B    line
  489ccL       CC   L
  491          B    line
     *
     * Tape error handler
     *
  495tperr     SBR  tperx&3
  499          MCW  k00,count2
  506retry     BSP  1
  511          RT   1,1501
  519          BER  *&5
  524tperx     B    0
  528          A    k01,count2
  535          BCE  *&5,count2-1,1  Ten errors?
  543          B    retry           No
  547          H    1,1
  554          B    retry
     *
     * Search for a block to punch
     *
  558gblkp     RT   1,1501
  566          BER  tperr
  571          C    1560,bbbbb
  578          BE   ptest
  583          BU   gblkp
  588ptest     BW   blkp,flag
  596          H    blkp      start to punch, start reset to quit
  600          B    done
     *
     * Read a block to punch
     *
  604blkp      MCW  k000,x1
  611          MCW  k00,count1
  618          SW   101
  622          RT   1,1501
  630          BER  tperr
  635          BEF  last
     *
     * Test whether to punch the next record
     *
  640recp      C    1560&X1,lllll
  647          BE   last
  652          MCW  1580&X1,180
  659          P
  660          SS   4
  662          A    k01,count1
  669          BCE  blkpb,count1-1,2  Done with block?
  677          A    k081,x1           No
  684          B    recp              Get next record from block
  688blkpb     B    blkp
  692last      CS   180
  696          P
  697done      RWD  1
  702fin       H    999,999
  709          B    fin
  717lllll     DCW  @LLLLL@
  722bbbbb     DCW  @BBBBB@
  723flag      dc   #1
  726k000      DSA  0                            DCW  '000'
  728k01       DCW  01
  730count1    DCW  #2
  733k134      DSA  134                          DCW  '134'
  735k00       DCW  00
  737count2    DCW  #2
  740k081      DCW  081
               END  start
