JOB  WRITE TEST TAPE ROUTINE                                5300E
               CTL  6611
     begld     equ  1365              in program 5310
     gmwm      equ  1398              in program 5310          
               ORG  1500
     *
     * Come here after clearing core
     *
 1500begin     RWD  1
 1505          R    1                 load program 5310
     *
     * Come back here after loading program 5310,
     * the last card of which has B in column 1
     *
 1509begwr     MCW  kbegld,4          set up to enter tape loader
 1516          LCA  mygmwm,gmwm
 1523write     WTW  1,1               write tape record
 1531          BER  taperr
 1536          BEF  tapeof
 1541aftwr     BIN  rddat,
 1546rddat     CS   81                clear read area
 1550          BIN  testlc,
 1555read      SW   1
 1559          R                      read detail card
 1560          LCA  gmwm,81
 1567          BCE  prog,80,A         first card of a program?
 1575          BIN  write,            go write a detail card
               ORG  1589
 1589prog      MCW  kldcds,aftwr&3
 1596          B    write             go write the program header
 1600ldcds     R    1                 load from cards
 1604enter     LCA  gmwm,1250         enter here from set wm card
 1611          MCW  kb,81             ensure no gmwm in 81
 1618          MCW  krddat,aftwr&3
 1625          BIN  write,            go write the program
 1630taperr    BSP  1
 1635          SKP  1
 1640          BIN  write,
 1645tapeof    H
 1646          B    tapeof
 1650finish    WTM  1
 1655          RWD  1
 1660done      H
 1661kb        BIN  done,
               ORG  1700
 1700mygmwm    DCW  @"@
 1703kbegld    DSA  begld
 1706kldcds    DSA  ldcds
 1709krddat    DSA  rddat
 1711km100     DCW  @I0@
 1713k1399     DCW  @T9@
     *
     * Start here.  Clear core from 1399 down to 100
     *
 1714start     MCW  k1399,clear&2     store next clear address
 1721clear     CS   1399              clear a bank
 1725          A    km100,k1399       subtract 100 from clear address
 1732          BCE  clrfin,clear&1,0  done?
 1740          B    start             no, clear some more
 1744clrfin    SW   1,8
 1751          B    begin
 1755testlc    BSS  nolc,G            don't test for LC if G is on
 1760          BLC  finish
 1765nolc      B    read
 1818          DCW  #1
               END  start