               job  INDEXING & STORE STARS                                 3100D
               ctl  6611
     *
     * Stuff in the preamble -- not in one-field-per-card format
     *
               org  333
     *
     * Set up for one-field-per-card format and begin loading
     *
  333start     sw   8,12
  340reload    sw   1
  344          r    1
     *
     * Look for next program -- A in column 80
     *
  348detail    r
  349tptest    bce  *&5,80,a
  357          b    cont
  361          cs   reload,80
  368          dcw  #1
     *
     tapes1    equ  1268   blank indicates the tape loader
     taperd    equ  1288   tape read routine?
     tapes2    equ  1398   GM indicates the tape loader
     *
     * Stuff that is in one-field-per-card format
     *
     xxx       equ  5777&x1        Generate XXX address
     *
               org  377
  377          bce  389,1257,1
  385          b    taperd           ,,
  389init      nop  0                ,,
  393          mcw  tptest&11,init&3 ,,
  400begin     cs   332            START TEST
  404          cs
  405          bce  titlpr,titlsw,1  BR TO TITLE PRINT ROUTINE IF 1 IN S52
  413          org  titlex
  413          cs   80             CLEAR READ AREA
  417bnx       b    detail         BRANCH TO PROGRAM CHAINING ROUTINE
  421cont      sw   1,21           LOAD PRINT AREA
  428          sw   62,78            ,,
  435          lca  80,299           ,,
  442          lca  68,278           ,,
  449          lca  50,250           ,,
  456          nop
  457          lca  7,chg1&6
  464          lca  7,chg2&6
  471          lca  33,99
  478          sw   99,240
  485          bin  around,
               org  500
  500back      bce  back2,4067,X  Instr is replaced before exec
  508          b    bnx
     scope     equ  *&1
  512chg1         X XXX,XXX       Instr is replaced before exec
  519          sar  263
  523chg2         X XXX,XXX       Instr is replaced before exec
  530          sbr  266
  534          bss  scope,B       B on for scoping
  539          mcw  chg1,260
  546          c    268,248
  553          bu   errpr2
  558          bin  bump,
               org  600
  600back2     sw   10
  604          mcw  12,chg3&6
  611chg3      lca  blank1,XXX    B addr is replaced before exec
  618          lca  7,207
  625          bin  chg1,
               org  679
  679around    cs   0
  683          sbr  corsiz         Save core size
     *                             Test high-order two bits of thou
  687          bwz  m6,corsiz,B    11 .. 12000 -- 15999
  695          bm   m5,corsiz      10 .. 8000 -- 11999
  703          bwz  m4,corsiz,S    01 .. 4000- -- 7999
     *                             High-order two bits are zero
     *                             Test low-order two bits of thou
  711          bwz  m3,corsiz-2,B  11 .. 3000 -- 3999
  719          bwz  m2,corsiz-2,Z  ???
  727          mcw  b1&7,back&7
  734          b    back
  738m2        mcw  b2&7,back&7
  745          b    back
  749m3        mcw  b3&7,back&7
  756          b    back
  760m4        mcw  b4&7,back&7
  767          b    back
  771m5        mcw  b5&7,back&7
  778          b    back
  782m6        mcw  b6&7,back&7
  789          b    back
  795corsiz    dsa  XXX
  796b1        bce  back2,63,1
  804b2        bce  back2,64,1
  812b3        bce  back2,65,4
  820b4        bce  back2,66,8
  828b5        bce  back2,67,2
  836b6        bce  back2,68,6
               org  900
  900errpr2    lca  error,285      BEGIN ERROR PRINT ROUTINE
  907          bss  errhlt,E       E ON TO ERROR STOP
  912          w    bump           ERROR PRINT
  916errhlt    h    bump           ERROR STOP
  920bump      a    bump,count     Bump counter
  927          bce  zero,count-1,9  Ninety times?
  935clear     cs   332            CLEAR
  939          cs                    ,,
  940          b    cont
  944zero      s    count
  948corr      bss  corrpr,C       C ON TO CORRECT PRINT ROUTINE
  953          b    last           BRANCH TO SENSE D
  957corrpr    w                   CORRECT PRINT ROUTINE
  958last      bss  cont,D         D ON TO REPEAT
  963          b    detail         BRANCH TO READ NEXT RECORD
  970count     dcw  @000?@
  971blank1    dcw  #1
               org  1100
 1109          dcw  #10
               org  hdrs-10
 1114error     dcw  @ERROR@
 1119          dcw  #5
 1139          dcw  @INDEXED INSTRUC.    @
 1159          dcw  @INDEX REGISTERS     @
 1179          dcw  @RESULTS SHOULD BE   @
 1199          dcw  @RESULTS ARE PROC. ON@
     *
     * Title print routine.  Notice that in the original format,
     * the title and ID are in CC 49-77 of the last card -- the one
     * that transfers control to the program.
     *
     titlsw    equ  1252   1 to use title print routine
     hdrs      equ  1120   All programs put headers in 1120-1199
     titlex    equ  413    All routines must return here after title
     *
               org  1200
 1200titlpr    w                 Print (space).
 1201          sw   49           Set WM for Title and Block No.
 1205          lca  77,277       Load Title and Block No. in Print Area.
 1212          w                 Print Title and Block No.
 1213          cs   277          Clear Print Area
 1217          w                 Print (space).
 1218          cw   hdrs&20,hdrs&40  Clear Word Marks in second
 1225          cw   hdrs&60      line stored information.
 1229          lca  hdrs&79,280  Load second line.
 1236          w                 Print second line.
 1237          cs   280          Clear Print Area.
 1241          w    titlex       Print (space) and branch to main program.
 1245          dcw  #1
               end  start
