       rem 704 fortran self loading record 1 to cs.
       ful
       lxa 0,1
       cpy 2,1
       txi 1,1,1
       cpy 25,1
       htr 3
       tze 0
       com
       acl 2
       com
       tra 23
       rtt
       iod
       htr 0
       txi 13,1,-1
       cad 0,1
       cal 15
       sta 22
       ars 18
       sta 13
       cal 15
       cpy 15
       cpy 2
       rtb 1
       lxd 23,1
       cpy 3
       ltm
       bst 145
       end
       rem fortran ii card-to-tape
       org 72
 begin rcd 1
       lxd add01,1
       lxd add02,2
 add23 cpy l9row            copy 92
       txl add03,
       tra 2,4              eof tr
 add03 stq data1            store 9l
       sxd add01,1
       sxd add02,2
       lxd add04,1
       cpy r9row            copy 9r
       stq data2            store 9r
       tsx sub1,2           exit entry1 sub1
 add01 txl add05            return1
       als 1                return2
 add02 txl add06            exit to entry2 sub1
add05  cpy data3
       stq data1
       cpy data4            copy right
       stq data2
       tsx sub1,2
 add04 txl add07,0,8        return1
       als 3                return2
       txl add08
 add07 cal l9row
       slw data1
       cal r9row
       slw data2
 add14 txl add09,1,1
 add15 cpy l9row
       txl add10
 add12 htr begin            eof
       txl add11            eor
 add10 cal l9row
       ana data1
       tnz add12
       cal l9row
       ors data1
       cpy r9row
       cal r9row
       ana data2
       tnz add12
       cal r9row
       ors data2
       tnx add13,1,1
       tsx sub1,2
       txl add14             return1
       txl add08             return2
 add09 cal data3
       ora data1
       slw data3
       cpy data5
       ana data5
       slw data1
       cal data4
       ora data2
       slw data4
       cpy data6
       ana data6
       slw data2
 add13 tsx sub1,2
       txl add15             return1
       als 4                 return2
       txl add08
 add11 cal data1
       slw l9row
       cal data3
       com
       ana data5
       ans data1
       cal data2
       slw r9row
       cal data4
       com
       ana data6
       ans data2
       tsx sub1,2
       txl add16              return1
       slw data0              return2
       als 2
       acl data0
       als 1
       txl add08
 add16 cal data3
       swt 6
       tra add34
add32  txl add31
add33  wtd 5
       tra add29
add34  wtd 2
add29  ora data5
       ora l9row
       com
       slw data1
       cal data4
       ora data6
       ora r9row
       com
       slw data2
       tsx sub1,2
       txl add17                 return1
       slw data0                 return2
       als 1
       acl data0
       als 4
       txl add08
 add17 lxd add01,1
       lxd add02,2
       tra 3,4
 sub1  sxd add18,1
       sln 1
       cal 1,4
       add cons1
       ldq data1
 add22 sta add06
       sta add08
       txh add19,1,1
       stq data0                index=1
       cal data0
       tze add20
 add19 lxa cons1,1              
 add21 pxd 12                   clean acc
       lgl 1                    1st in acc
       als 5                    100000
       lgl 1                    1000001
       als 5                    100000100000
       lgl 1                    1000001000001
       als 5
       lgl 1
       als 5
       lgl 1
       als 5
       lgl 1
       tra 2,2                  1000001000001000001000001000001
 add08 acl 0,1                  address computed at add22 in address
 add06 slw 0,1                  entry2 address prev.
       tix add21,1,1
       lxd add18,1
 add20 slt 1
       tra 1,2                  off
       ldq data2                sense light on
       cal 1,4
       adm add21
 add18 txl add22,0,**           ir1 stored in decrement
 cons1 htr 6
 data0 htr
 data1 htr                      9l row
 data2 htr                      9r row
 data3 htr
 data4 htr
 data5 htr
 data6 htr
 l9row htr
 r9row htr
start  rew 2
       sln 0
 add27 rcd 1
       tsx add23,4
       htr recor
       txl add24                 return3
       sln 2                     return4
       lxd add25,4
 add26 cpy block,4
       tix add26,4,1
 add25 txl add27,0,12
 add24 slt 2
       tra add28                 off
       swt 6
       tra add30
       wef 5
       rew 5
 add28 rtb 1
       cpy recor
       tra add28
       tra 4                     eof
       rew 1
       rtb 1
       rtb 1
       tsx 4,4
 recor htr
block  bes 11
add31  rew 5
       cls add32
       sto add32
       cal data3
       tra add33
add30  wef 2
       rew 2
       tra add28
       end
       rem
       rem ************* fortran ii section six ************************F6r00010
       rem fortran 2   record 0003  -  cit to sap conversion.           f6r00011
       rem                                                              f6r00012
       rem cit to sap conversion                                        f6r00020
 zero  equ 113     
 one   equ 114
 sw1   equ 127
 sw2   equ 128
       org 136                                                          f6r00030
 start cla one
       cas sw2
       tra add01         sw2 equal zero, assume switch two up,
       tra lib1          sw2 equal one, assume switch two down,
       swt 2             equal two. test switch two
       tra add01
 lib1  rew 4             sw two down.
       wef 2
       lxd add02,2       set read error counter.
 add02 txi add03,0,5
 add05 bst 4
 add03 rtb 4             read tape 4
       lxa data1,1
 add04 cpy reco3,1       cpy into rec-1, rec-2,---
       txi add04,1,1
       tra add01         end of file on tape 4.
       ars 255
       ars 0255
       rtt
       tix add05,2,1     if error.
       sxd add06,1       save count of no. of words read in.
       lxa add07,1       set xr1=0
 in207 sxd add08,1       save xr1.
       cal recor,1       store sl in data2
       slw data2         store op in data3
       cal reco3,1
       slw data3
       cal reco2,1       store sa in data4
       slw data4
       cal reco1,1       store ra in data5
       slw data5
       ldq data6
       stq e1005         store blanks in e1006,1007,1010,1005
       stq e1006
       stq e1007
       stq e1010
       cal data2         test symbolic location.
       tze add09         if zero, go to add09.
       lrs 30            not zero. see if sl(1) equal zero.
       tze add10         sl(1) equal zero, go to add10.
       sub data7         sl(1) not equal zero. see if equal 15.
       tnz add11         sl(1) not equal 15, go to add11
       cal data6         sl(1) equal 15. put blanks in ac and
       tra add12         go to add12
 add11 add data7         resotre sl(1) in ac.
       sub lib3
       tze lib2          if sl(1)=$, go to lib2
       add lib3
       sub lib5
       tze lib6          if sl(1)=(, go to lib6
       add lib5
       sub data7
       tpl me1           go to me1 if sl(1) greater then 15 (i.e.,alpha-
       add data7
       rql 1             sl(1) less then 15, not zero, assemble symbol.
       tsx sub1,1        and go to sub1 (tiv type entry).
       tra add12
 me1   cal data2
       tra add12
 add10 lgl 13           ifn. assemble symbol and go to sub2.
       tsx sub2,1
 add09 lgl 36           symbolic loc equal zero. put blanks in acc.
 add12 slw e1003        store acc. in e1003.
 in245 ldq data3        select op in mq.
       cls data8
       lgl 18
       stq e0777        store decrement in e0777.
       ldq data6        load mq with blanks
       lgl 6
       als 6
       sto e1004        store in e1004.
       cas data9        is op equal oct.
       tra add13        op less then oct
       tra add14        op equal oct. go to add14.
       cas dat10        op greater then oct. see if op=bcd.
       tra add13
       tra add15        op equal bcd. go to add15.
 add13 ldq data4        op not bcd or oct.
       pxd              select sa in mq.
       lgl 6
       tnz in301        sa(1) not equal zero. go to in301.
       lgl 12           sa(1) equal zero. test for internal
       tnz in310        formula number type. if yes, go to in310.
       ldq data6        sa(1),sa(2),sa(3) equal zero. load mq with
       cla data5        test for now-zero tag or relative address.
       tnz in446        not equal zero. go to in446
       cla e0777        ra equal zero. test for non-zero decrement.
       tnz in320        not zero, go to in320
       cal dt713        zero, or a blank to rt-hand end of e1004.
       ors e1004
       tra in367
 in301 cas data8        test if sa(1)=16.
       tra in313        greater then 16(true symbol). go to in313.
       tsx 4,4          equal is error.
       tsx sub1,1       less then 16 (tiv entry type). go to sub1.
       lrs 30           return from sub1.
       rql 1
       tra in313
 in310 tsx sub2,1       internal formula no. type.
       pxd 
       lgl 6
 in313 ors e1004
       stq e1000
       cal dt713 
       ors e1000
       ldq e1000
 in320 cal in313
       tsx in403,1
       cla data5       select relative address.
       ars 18
       tze in335       ra equal zero, go to in335
       ldq data6       ra not equal zero, load mq with blanks and
       tsx in422,1     go to in422
       cla data5       set acc. equal ra.
       tpl in333       if ra positive, go to in333.
       cal dt714       if ra negative, select octal 40 (minus)
       tra in334       and go to in334.
 in333 cal data8       select octal 20 (plus)
 in334 tsx in416,1 
 in335 cal data5       set acc. equal ra. ana octal 77777
       ana data1
       tnz in344       if not zero, go to in344.
       cla e0777       zero. test if e0777 equal zero.
       tze in363       if zero, go to in363.
       ldq dt711       not zero, load mq with 0 in 1st charac, rest
       tra in352       and go to in 352
 in344 ldq dt710
       cas dt722
       tra in351
       tra in351
       ldq data6
 in351 tsx in422,1
 in352 cla dt712
       tsx in416,1
       cla e0777
       tze in363
       ars 18
       ldq data6
       tsx in422,1
       cla dt712
       tsx in416,1
 in363 pxd 6
       ldq data6
       lgl 36,2
 in366 ors *
 in367 wtd 2
       lxa in363,1
 in371 cpy e1011,1
       tix in371,1,1
       iod
       lxd add08,1
       txi add06,1,4
 add06 txl in207,1,*
       lxd add02,2
 add08 txi add03,0,*
 in401 txl in412,2,30  if shift less then or equal 30, go to select
       cal in417       shift greater then 30. prepare to modify addres
 in403 add dt723       compute address for storing word.
       sta in417
       sta in366
       sta in410
       pxd             clear acc.
 in410 slw *           store zero in word.
       pdx 0,2         set xr2 equal to zero
 in412 lgl 6           select character
       cas dt713       is character blank.
       tra in416       no.
       tra 1,1         yes, return to program
 in416 als 30,2        no, shift character
 in417 ors *
       pxd
       txi in401,2,6   adjust xr2 shift and go to in401.
 in422 stq e1002
       sxd dt772,1
 in424 lrs 35
       pdx 0,1
       slw e1001
 in427 dvp dt721
       als 0,1
       ors e1001
       stq e1000
       cla e1000
       tze in437
       clm 0
       txi in427,1,-6
 in437 cal e1001
       ldq e1002
       lgl 1
 in442 ldq e1002
       lrs 6,1
       lxd dt772,1
       tra 1,1
 in446 ars 18
       tze in320
       tsx in422,1
       cla data5
       tpl in455
       cal dt714
       tra in457
 in455 pxd
       lgl 6
 in457 ors e1004
       cal in313
       tsx in403,1
       tra in335
 add15 ldq data4
       cal data8
       tqp in470
       add data8
       lrs 0
 in470 ors e1004
       als 3
       lgl 3
       als 3
       lgl 3
       als 3
       lgl 3
       als 3
       lgl 3
       als 3
       lgl 3
       als 3
       lgl 3
       slw e1005
       als 3
       lgl 3
       als 3
       lgl 3
       als 3
       lgl 3
       als 3
       lgl 3
       als 3
       lgl 3
       als 3
       lgl 3
       slw e1006
       tra in367
 add14 cla data4
       sub dt717
       tnz in532
       cal dat10
       slw e1004
       tra add15
 in532 cal dt723
       ors e1004
       cal data4
       slw e1005
       cal data6
       slw e1006
       tra in367
 sub1  sxd dt703,1     save xr1 for return
       pax 0,4         store character in xr4
       sub data7       is character *.
       tnz in550       no, go to in 550.
       cal dt716       yes, select *.
       ldq data6       load mq with blanks.
       tra in313       go to in 313.
 lib2  tra rpch1
       tra add12
 lib3  bcd 100000$
 lib4  bcd 1$
 lib5  bcd 100000(
 lib6  cal data2
       tra add12  
 in550 cal dt770,4     select appropriate numeric or alphabetic
       als 6           character.
       ora dt771       followed by left parenthesis
       als 24          and shift into proper position.
       slw e1000
       lxa in565,3
       rql 12
       pxd 0
       lgl 3           tag bits into acc. address
       tnz in565       tag bits equal zero. no, go to in565
 in562 tnx in575,1,1   yes. if finished with word, go to in 575
       lgl 5           not finished with word. test address bits 
       tze in562       address bits zero.
 in565 pax 4,4         address bits not zero.
       cal dt770,4     select character.
       tnx in576,1,1
       als 22,2        shift into proper position .
       ors e1000
       pxd
       lgl 5
       txi in565,2,6   adjust shift.
 in575 cal dt713
 in576 ldq data6
       lgl 22,2
       ora e1000
       lxd dt703,1
       tra 1,1
 sub2  sto e1000
       lgl 8
       pxd 0
       lrs 29
       dvp dt721
       tnz in612 
       cal dt713       if subsidiary no. is zero, select a blank
 in612 slw e1002
       lgl 36
       sxd dt772,1
       pax 0,1
       cal in756,1     select alphabetic character.
       als 6
       ora e1002
       ldq data6
       lgl 24
       slw e1002
       cla e1000
       tra in424
 add07 htr 0
 add01 wef 2
       rew 4
       rew 2
       rtb 1
       tra 4
 dt703 htr 0
 dat10 oct 604623636000
 data9 oct 602223246000
 data6 oct 606060606060
 dt707 oct 336060606060
 dt710 oct 636060606060
 dt711 oct 006060606060
 dt712 oct 73
 dt713 oct 60
 dt714 oct 40
 data8 oct 20
 dt716 oct 54
 dt717 oct 777777777777
 data7 oct 17
 dt721 oct 12
 dt722 oct 5
 dt723 oct 1
 data1 oct 77777
 dt725 oct 71
       oct 70
       oct 67
       oct 66
       oct 65
       oct 64
       oct 63
       oct 62
 dt735 oct 51
       oct 50
       oct 47
       oct 46
       oct 45
       oct 44
       oct 43
       oct 42
       oct 41
       oct 31
       oct 30
       oct 27
       oct 26
       oct 25
       oct 24
       oct 23
       oct 22
 in756 oct 21
       oct 11
       oct 10
       oct 7
       oct 6
       oct 5
       oct 4
       oct 3
       oct 2
       oct 1
 dt770 oct 0
 dt771 oct 34
 dt772 htr 0
 data2 htr 0
 data3 htr 0
 data4 htr 0
 data5 htr 0
 e0777 htr 0
 e1000 htr 0
 e1001 htr 0
 e1002 htr 0
 e1003 htr 0
 e1004 htr 0
 e1005 htr 0
 e1006 htr 0
 e1007 htr 0
 e1010 htr 0
 e1011 htr 0
       htr 0
       htr 0
       htr 0
 e1015 htr 0
 rec   bes 100
 rpch1 lls 6                                                            f6r03961
       sub lib3                                                         f6r03962
       tze lib2a                                                        f6r03963
       cal lib4         single dollar sign                              f6r03964
       tra add12                                                        f6r03965
 lib2a cal dol2         double dollar sign.                             f6r03966
       tra add12                                                        f6r03967
 dol2  bcd 1$$                                                          f6r03968
 reco1 syn rec-4                                                        f6r03979
 reco2 syn rec-3                                                        f6r03980
 reco3 syn rec-2                                                        f6r03990
 recor syn rec-1                                                        f6r04000
       end                                                              f6r04001
       rem
       rem ************* fortran ii section six ************************F6s00010
       rem fortran 2   record 005  -  on-line print.                    f6s00011
       rem                                                              f6s00012
       rem modifications to tph1 to print with                          f6s00020
       rem sense switch changes                                         f6s00030
 zero  equ 113                                                                  
 one   equ 114
 sw1   equ 127
 sw2   equ 128
 sw3   equ 129
 sw4   equ 130
       org 136                                                          f6s00040
       rew 2
       lxd files,1
       cla one
       cas sw2          test sense switch two.
       tra lib1         up
       tra asker        down
       swt 2
 lib1  tnx cards,1,1    up, any files to do. go return to loader if not
 asker cla one          switch 2 down (or up but files to do)
       cas sw3          test sense switch three.
       tra files        up, go to return to loader
       tra lib2         down
       swt 3
 files txi cards,,3     up, go return to loader
 lib2  sxd count,1      switch three down.
       wpr              to print file of tape two.
       spr 1
 count txi print
 parts lxd count,1
       tix asker,1,1
 cards rtb              return to loader
       tra 4
 me8   htr 5
 print rtt
       nop
 me9   lxd me8,4
 i113  lxd i117,2       set record length equal 20
       sln 1            turn on sense light 1
       rtd 2            select tape two in bcd mode
 i116  cpy d65,2        and copy record.
 i117  txl i132,,20
       tra parts        end of file.
 i121  txi i122,2,1
 i122  pxd 0,2
       rtt              test tape check.
       txl i134,0,0     error.
 i125  add i131         print this record.
       std i130
       tsx i143,4
 i130  htr d41+1
 i131  txl me9,0,d65
 i132  tix i116,2,1     next word but no
       txl i122,0,0     more then 20.
 i134  tix i136,4,1     test for another try.
       tsx 4,4
 i136  bst 2            try again.
       txl i113,0,0
 i143  cla 1,4          substitute coding.
       std i302
       ars 18
       add i302
       sta i161
       sta i211
       sub 1,4
       sxd i302,4
       pax 0,4
       sxd i155,4
 i155  txh 0,0,*
       wpr             select printer
       cla i301        find last non-blank group.
       lxd i224,4
 i161  cas *,4
       txi i165,4,-1
 i163  txi i161,4,1
       txi i165,4,-1
 i165  sxd i230,4      store end test.
       sxd i242,4
       sxd i172,4
       sxd i271,4
       lxd i155,4
 i172  tnx i176,4
       txl i175,4,12
       spr 8           first cycle.
 i175  lxd i155,4      initialize group count.
 i176  lxa i203,2      initialize left setup.
       lxd i245,1
       cla one
       cas sw4
       tra i201
       tra lib5
       swt 4
 i201  txl i203,0,*
 lib5  nop
 i203  pxd
 i204  slw d41,1      clear card image.
       slw d21,1
       tix i204,1,1
 i207  cal i303       initialize column indicator.
 i210  slw 0
 i211  ldq *,4        obtain group.
       sxd i201,4     store group count.
       lxa i215,4     set character count.
 i214  pxd 
 i215  lgl 6
       pax 0,1
       cal 0          position column indicator.
       ars 6,4
       tix i245,1,16  test for digit.
       txh i250,1,15  test for y-z one
       ors d36,3      store digit.
 i224  tix i214,4,1   count characters.
 i225  ars 1          shift and test column.
       lxd i201,4     restore group count.
       txi i230,4,-1  count groups.
 i230  txl i232,4     test for last non-blank group.
       tnz i210       test for end of row.
 i232  cal d23,2      form true 8,4
       ors d26,2      and 3 rows and
       ors d33,2      move 8,4 and 8,3
       slw d24,2      rows.
       cal d22,2
       ors d26,2
       ors d32,2
       slw d23,2
 i242  txl i265,4     test for end.
       txh i265,2,15  test for right half.
       txi i207,2,15  initialize right half.
 i245  tix i253,1,16  test for 16/ch/32
       txh i256,1,15  test for x-zone
       ors d36,3      store digit.
 i250  ors d40,2      store y-zone.
       tix i214,4,1   count characters.
 i252  txl i225       obtain next group.
 i253  tix i261,1,16  test for 32/ch/48.
       txh i224,1,15  test for blank.
       ors d36,3      store digit.
 i256  ors d37,2      store x-zone.
       tix i214,4,1   count characters.
 i260  txl i225       obtain next group.
 i261  ors d36,2      store 0-zone.
       ors d36,3      store digit.
       tix i214,4,1   count characters.
       txl i225
 i265  lxd i300,1     copy loop.
 i266  cpy d41,1      card image copies.
       cpy d21,1
       tix i266,1,1   count copies.
 i271  txh i276,4     test for second cycle.
       lxd i252,1     no, reload index registers
       lxd i260,2     and return.
       lxd i302,4
       tra 2,4
 i276  wpr            select printer again.
       spr 9          second cycle.
 i300  txl i176,0,12  convert rest of line
 i301  bcd 1
 i302  htr 1
 i303  mze
       bes 40
 d21   htr 0
 d22   htr 0
 d23   htr 0
 d24   htr 0
 d25   htr 0
 d26   htr 0
 d27   htr 0
 d30   htr 0
 d31   htr 0
 d32   htr 0
 d33   htr 0
 d34   htr 0
 d35   htr 0
 d36   htr 0
 d37   htr 0
 d40   htr 0
 d41   htr 0
 d65   bes 20
       end
       rem ************* fortran ii section six ************************F6T00010
       rem fortran 2   record 007  -  tape 3,7 to 2,6.                  f6t00011
       rem                                                              f6t00012
       rem dump tape2 onto tape6 and tape3 onto                         f6t00020
       rem tape7 if batch compiling
 zero  equ 113                                                                  
 one   equ 114
 sw1   equ 127
 sw2   equ 128
       org 136                                                          f6t00030
       rew 2              rewind tapes two and three.
       rew 3
       lxd zero,1
       swt 6              test sense switch 6 to see if batch compiling.
       tra fini           up. do not dump tapes but go to fini.
 a11   rtt
       nop
 a6    lxd seven,4        set read error counter.
 a2    lxd zero,2
       rtd 2              read a record of tape two.
 a1    cpy rec-1,2
       txi a1,2,1
       tra eof            eof
       ars 255
       ars 253
       rtt
       tra error          error
       txi next2,2,-1
 next2 sxd a4,2           save word count of record to use when writing.
       lxd zero,2                  onto tape6
 a3    cpy rec-1,2
       txi a4,2,1
 a4    txl a3,2,*
       iod
       tra a11           go read next record from tape two.
 seven     0,0,5
 error bst 2             read error procedure.
       tix a2,4,1
       tsx 4,4
 er    htr er
 eof   wef 6             at end of file one tape two. write end of file.
       txi a5,1,1   
       rem               on tape six.
 a5    txh test2,1,1     two files done. yes, go test switch two.
       rtd 2             no
       tra a6
 tape7 cla one           test sense switch one.
       cas sw1
       tra eof3+1
       tra a7
       swt 1
       tra eof3+1
 a7    lxd seven,4       down. set read error counter.
 a12   lxd zero,2                 onto tape7
       rtb 3             read a record from tape three
 a8    cpy rec-1,2
       txi a8,2,1
       tra eof3          eof of file.
       ars 255
       ars 255
       rtt
       tra err3          error.
       txi next1,2,-1
 next1 sxd a10,2         save word count of record.
       lxd zero,2
       wtb 7             write the record onto tape seven.
 a9    cpy rec-1,2
       txi a10,2,1
 a10   txl a9,2,*        test end of record.
       iod
       rtt
       nop
       tra a7            go read next record.
 err3  bst 3
       tix a12,4,1       read error procedure.
       tsx 4,4
 err4  htr err4
 eof3  wef 7             at eof on 3, write eof on 7.
       rtb 1
       rtb 1
       rtb 1
 fini  rew 2             rewinds tapes 2,3, and 4 and
       rew 3             returns to loader,
       rew 4
       rtb 1
       tra 4
 test2 cla one           after 2nd file from 2 to 6,
       cas sw2           test sense switch 2.
       tra tape7
       tra wt3
       swt 2
       tra tape7         up. go test switch 1.
 wt3   lxd a5,1          down. reset index register 1 to 1.
       cla wt3-1         change a5 transfer address to tape7.
       sta a5
       tra a6
       bss 40
 rec   bes 500
       end
       rem Successful compilation record                                F1SC0010
       rem control is returned to this record at the completion of a 
       rem single problem compilation, or at the end of batch
       rem compilation.  tape 1 is rewound and a load button
       rem sequence is executed at the card reader.
       rem an installation may change this record to suit its onw
       rem operating needs.
       rem
       rem master record card = f0090000.
       org 24
start  ltm
       rew 1
       rcd 209             card reader load button sequence.
       cpy 0
       tra seccpy
       htr 32767           card reader empty, halt.
seccpy cpy 1
       tra 0
       end 24
       rem source program error record.  this record tests sl3 and sl6  F1SPE010
       rem to determine if a card reader load button sequence is to be  f1spe020
       rem executed, or if the next program is to be compiled.  sl3-on  f1spe030
       rem if tape 5 cannot be read or eof on tape 5 before end card    f1spe040
       rem is found.  ss6-on if in batch compile mode.                  f1spe050
       rem			f1spe060
       rem master record card = f0100000.			f1spe070
       org 24			f1spe080
       ltm 			f1spe090
       slt 1               sl1-on if program to be retried.			f1spe100
       tra ss6tst			f1spe110
       tra skipcm          skip to common record			f1spe120
ss6tst swt 6               ss6-on if in batch mode.			f1spe130
       tra readcd          single compilation. read card reader seeq.			f1spe140
       slt 3               on if end card error found by batch monitor			f1spe150
       tra skipbm          skip to batch monitor record			f1spe160
       rew 6			f1spe170
readcd rew 4			f1spe180
       rew 3			f1spe190
       rew 2			f1spe200
       rew 1			f1spe210
       rcd 209             card reader load button sequence.			f1spe220
       cpy 0			f1spe230
       tra seccpy			f1spe240
       htr 32767           card read emtpy.			f1spe250
seccpy cpy 1			f1spe260
       tra 0			f1spe270
skipcm rtb 1               skip over file 1 mark to batch monitor			f1spe280
       rtb 1               skip over batch monitor record			f1spe290
skipbm rtb 1               and/or skip machine error record			f1spe300
       tra 4               to 1-cs to read next record			f1spe310
       end 24			f1spe320
       rem  monitor program for batch compilation                       f1bm0010
       rem master record card f0120000
       org 24
start  swt 6                         test sw6, up = single problem,
       tra add93+1         skip over machine error record and go to sec1
       sln 0                         turn off lights
add01  lxa l(5),4          counter for 5 tries to read tape 5.
       cal blanks
       slw buffer-1
       slw buffer-2
       rtt                           turn off indicator
       nop
add015 rtd 5
       lxa l(14),3                   assume 14 words per record
add02  cpy buffer,1
       tra add03
       tra add90                     eof
       tra add04                     eor
add03  tix add02,1,1
add04  ars 255
       ars 255
       rtt                           test tape indicator
       tra add80                     on, prepare to read again
       wtd 2                         off, write this record on tape 2
add05  cpy buffer,2
       tix add05,2,1
       iod
       rtt
       nop
add70  txh add71,0         routine to restore printer carriage and print
       tsx print,c         first statement of current source program
       pze restr,0,buffer
       wpr
       wpr
       wpr
       wpr
       wpr
       wpr
       cls add70           change txh to txl
       sto add80
add71  sln 1               sl1-on if at least 1 source statment on tp 2
       pxd 0,0                       exits
       ldq buffer-14                 test for comment card
       lgl 6
       sub l(c)
       tze add01                     yes, go read next tape record
       lgl 24                        discard formula number
       pxd 0,0
       lgl 6
       tze add06                     test for continuation card
       sub blank
       tnz add01                     yes, go read next tape record
add06  lxa l(12),1                   this record is of first card of
       lxa l(7),2                    fortran statement. prepare to test
       cla buffer                    for end(..,..,..,..,..) card
       sto buffer-2                  position endmark
       ldq buffer-13
       tsx sub1,4
       sub l(e)                      test first char for e
       tnz add01
       tsx sub1,4        
       sub l(n)                      test second char for n
       tnz add01
       tsx sub1,4
       sub l(d)                      test third char for d
       tnz add01
       tsx sub1,4
       sub l(()                      test fourth char for (
       tnz add01
       tsx sub1,4
       tsx sub1,4
       sub comma                     test sixth char for ,
       tnz add01
       tsx sub1,4
       tsx sub1,4
       sub comma                     test eighth char for ,
       tnz add01
       tsx sub1,4
       tsx sub1,4
       sub comma                     test tenth char for ,
       tnz add01
add93  wef 2                         this is end card, terminate file
       rtb 1               skip over machine error record.
       tra 4                         go to 1-cs for section one
add80  bst 5                         tape error
       tix add015,4,1
       tsx print,4
           tp5err,0,tp5end
sproer sln 3               sl3-on if tape cannot be read or end card
bstrtn bst 1               trouble.
       bst 1               backspace system tape to source program error
       bst 1               record.
       tra 4               call in 1 - cs.
add90  slt 1                         is there a problem to be compiled
       tra add91                     finished, rewind all types
       tsx print,4
           endcd,0,cdtend
       rew 5
       tra sproer
add91  bst 1
       rew 6
       rew 5
       tsx print,c
           rema,0,enda
       tsx print,c
       htr restr,0,restr+1
       tqo *+1
       tra bstrtn   
sub1   pxd 0,0                       subroutine to bring next non blank
       tix add50,2,1                 char of buffer region to ac.
       lxa l(6),2
       ldq buffer,1
       txi add50,1,-1
add50  lgl 6
       cas blank
       tra add51
       tra sub1
add51  cas endmk
       tra 1,4
       tra add01
       tra 1,4
restr  bcd 11
buffer bes 14
       oct 77777777777
endmk  oct 77
l(3)       3
l(5)       5
l(6)       6
l(7)       7
l(12)      12
l(14)      14
l(c)   bcd 100000c
blanks bcd 1
blank  bcd 100000
l(e)   bcd 100000e
l(n)   bcd 100000n
l(d)   bcd 100000d
l(()   bcd 100000(
comma  bcd 100000,
tp5err bcd 90     tape 5 containing source subprogram read 5 times
       bcd 9 unsuccessfully. tape 5 now positioned at record which
       bcd 3 cannot be  read.
tp5end bss 0
endcd  bcd 90     end card missing or mispunched for last subprogr
       bcd 3am being compiled.
cdtend bss 0
rema   bcd 71
       bcd 6 the last problem has been processed.
enda   bss 0
       rem print control subroutine.
 a     equ 1
 b     equ 2
 c     equ 4
print  bss 0
 ran   cla 1,4
       ars 18
       sto rnb
       sxd rnc,4
 rn40  cla rna
       add rnd
       cas rnb
       nop
       tra rn50
       als 18
       add rna
       sto ran10
       tsx wot,c
 ran10 htr
       cla ran10
       ars 18
       sub rne
       sta rn20
       sub rne
       sta rn30
       sta rna
       cla blnks
 rn20  sto
 rn30  sto
       tra rn40
 rn50  cla rnb
       als 18
       add rna
       sto rn60
       tsx wot,c
 rn60  htr
       lxd rnc,c
 rna   htr
 rnb   htr
 rnc   htr
 rnd   htr 20
 rne   htr 1
       rem
       rem print subroutine.
 wot   sxd x1,1
       sxd x2,2
       cla 1,4          print routine
       sta t5           x
       std x4           x
       ars 18           x
       add x4           x
       sta pr2          x
       sta ci9          x
       sub 1,4          b-a+1 in ac
       tze 2,4
       tmi 2,4
 l11   pax 11,4
       sxd pr6,4
       cal wp           initialize switch 
       sto wp           x
 pr6   txh t4
 t4    wpr
 z2    txl s3
 oz2   txl
 sp4   spr 4
       txl rpr+2
 s3    cls wp           set switch for masking
       sto wp           character from type wheel 1
 t5    cal *            obtain first character
       ars 30           x
       tze sp4          double space if zero
       cas yzone        test for space suppress
       txl bk           no
       txl rpr+1        suppress space
 bk    cas bnk          test for blank
       txl digf         no
       txl rpr+2        blank
 digf  spr 10           set channel skip
       ana mk           mask out zone
 mk    pax 15,1         obtain spr combination
       txi n2,1,1       x
 n2    tnx n3,1,8       x
       spr 8            x
 n3    tnx n4,1,4       x
       spr 4            x
 n4    tnx n5,1,2       x
       spr 2            x
 n5    tnx rpr,1,1      x
       spr 1            x
 rpr   wpr
       spr 5            suppress space
       cla blanks       find last non-blank group
       lxd ci4,4        x
 pr2   cas 0,4          x
       txi pr1,4,-1     x
       txi pr2,4,1      x
       txi pr1,4,-1     x
 pr1   sxd ci6,4        store end test
       sxd ci8,4        x
       sxd pr8,4        x
       sxd wp4,4        x
       lxd pr6,4        x
 pr8   tnx pr5,4
       txl pr3,4,12
       spr 8            first cycle
 pr3   lxd pr6,4        initialize group count
 pr5   lxa pr7,2        initialize left setup
       lxd yz1,1        clear card image
 pr7   pxd              x
 pr4   slw lt,1         x
       slw rt,1         x
       tix pr4,1,1      x
 cir   cal col1         initialize column indicator
 ci2   slw col          x
 ci9   ldq 0,4          obtain group
       sxd oz2,4        store group count
       lxa o6,4         set character count
 ci1   pxd
 o6    lgl 6
       pax 0,1
       cal col          position column indicator
       ars 6,4          x
       tix yz1,1,16     test for digit
       tix yz1,1,15     test for y-zone
 ci5   ors d,3          store digit
 ci4   tix ci1,4,1      count characters
 ci3   ars 1            shift and test column
       lxd oz2,4        restore group count
       txi ci6,4,-1     count groups
 ci6   txl ci7,4        test for last non-blank group
       tnz ci2          test for end of row
 ci7   cal 8.3,2        form true 8.4
       ors d-8,2        and 3 rows and
       ors d-3,2        move 8.4 and 8.3
       slw 8.2,2        rows
       cal 8.4,2        form true 8.4
       ors d-8,2        x
       ors d-4,2        x
       slw 8.3,2        x
 ci8   txl wp,4         test for end
       txh wp,2,15      test for right half
       txi cir,2,16     initialize right half
 yz1   tix xz1,1,16     test for 16/ch/32
       txh xz2,1,15     test for x-zone
       ors d,3          store digit
 yz2   ors y,2          store y-zone
       tix ci1,4,1      count characters
 x1    txl ci3          obtain next group
 xz1   tix oz1,1,16     test for 32/ch/48
       txh ci4,1,15     test for blank
       ors d,3          store digit
 xz2   ors x,2          store x-zone
       tix ci1,4,1      count characters
 x2    txl ci3          obtain next group
 oz1   ors z,2          store 0-zone
       ors d,3          store digit
       tix ci1,4,1      count characters
       txl ci3
 wp    txh wp9          inverted to txl if program carriage control
       txl wp7          no program
 wp9   lxd wp2,1        mask out first col. of card image
       cal mk2          x
 ans   ans lt,1         x
       tix ans,1,1      x
 wp7   lxd z2,1         copy loop
 cran  cpy lt-12,1
       cpy rt-12,1      x
       txi t2,1,-1
 t2    txh cran,1,-12
       cal wp           reset switch for second cycle
       sto wp           x
 wp4   txh wp5,4    
       lxd x1,1         no, reload index registers and return
       lxd x2,2         x
 wt2   lxd x4,4         x
 l2    tra 2,4          x
 rpr2  wpr
       txl pr2-2
 wp5   wpr 
       spr 9            second cycle
 wp2   txl pr5,0,12     convert rest of line
 blnks bcd 1
 x4    htr
 yzone oct 20
 bnk   oct 60
 mk2   oct 37777777777
 col1  mze
 col   bss 1
 rt    bes 16
 8.5   bss 1
 8.4   bss 1
 8.3   bss 1
 8.2   bss 1
 d     bes 9
 z     bss 1
 x     bss 1
 y     bss 1
 lt    syn y+1
 8.4l  syn lt-14
 8.4r  syn rt-14
       bss 27
       end 24
       rem machine error record. this record halts to permit operator   F1ME0010
       rem intervention. if the same source program is to be re-tried,
       rem operator should press start.  if next source program is to be
       rem compiled, the operator must manually turn sl1-on, and press
       rem start.
       org 24
       htr nextin
nextin slt 1
       tra 4
       bst 1
       bst 1
       tra 4
       end 24
       rem
       rem applied programming, ibm , l. may and a. s. noble jr.
       rem 704 fortran ii / sectonr one.                   29 oct 58
       rem 
       rem section 1= reads in and classifies statements. for arithmetic4f10000
       rem formulas, compiles the object (output) instructions. for  
       rem nonarithmetic statements including input-output, does a
       rem partial compilation, and records the remaining information
       rem in tables.
       rem           the five major divisions of section 1 are=
       rem common, states a, b, c, and d. common remains in lower memory
       rem throught section1. state a reads in and classifies all
       rem statements, and treats nonarithmetic statements. states b,
       rem c, and d treat arithmetic formulas.
       rem 
       rem section 1 / common =
       rem 704 fortran master record card / common = f0140000.
       org 0                                                            4F100121
       pze orgcom,,1tocs                                                4f100122
       pze orga-1                                                       4f100123
       rem                                                              4f10013
       rem part 1 / working storage, buffers, and table parameters=
       rem                           eifno and sense swithc simulators.
       rem                           tape table buffers.
       rem                           tape table parameters - intet.
       rem                           drum table parameters.
       rem                           forsub count and buffer.
       rem                           cib buffer and parameters.
       rem                           remaining working storage.
       rem part 2 / constants used by section one.
       rem part 3 / subroutines used by section one=
       rem name                      function
       rem c0150,2                   scan, and convert numerics.
       rem c0160,2                   scan characters.
       rem c0180,2                   convert numerics.
       rem c0190x,4                  initialize c0190 to 1st word of f.
       rem c0390,4                   insert character.
       rem c0190,4                   obtain next non-blank char in ac.
       rem c1t00,4                   compiled instruction table entries.
       rem dim.sr,4                  dimension table search.
       rem drtabs(,4)                drum table entries.
       rem getifn,4                  get interal formula number.
       rem jif(gif),4                jumps (gets) ifn in sl and tl.
       rem mtr000                    monitor states from drum.
       rem ra000,4                   computer relative address.
       rem rdrx,4                    read drum into bufr.
       rem sr6dc1,1                  convert 6 bcd digits to 1 binary.
       rem ss000,4                   scan and process subscripts.
       rem subx00,4                  add blanks to subroutine names.
       rem testfx,1                  test for fixed or floating point.
       rem test..,4                  test character in ac.
       rem tet00,1                   tape table entries.
       rem 
       rem diag                      diagnostic callers.
       rem 
       rem the following conventions are used in this listing=
       rem 
       rem ** in the addres, tag, or decrement of an instruction
       rem indicates that this field will be modified by the program.
       rem * in col/36 indicates the instruction is a transfer out of
       rem this logical block or subroutine.
       rem c in col/34 indicates the instruction was corrected.
       rem p in col/32 indicates the instruction was inserted (patch).
       rem 
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem common/1-working storage, buffers, and table parameters=
orgcom org 24
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem eifno and sense switch simulators.
eifno  pze **,,**                    external,,interal formula number.
endi1  pze 2                         simulator for sense switch 1.
endi2  pze 2                         simulator for sense switch 2.
endi3  pze 2                         simulator for sense switch 3.
endi4  pze 2                         simulator for sense switch 4.
endi5  pze 2                         simulator for sense switch 5.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem buffers used by tet00 for the tape tables.
teifno bss 10                        external,,internal formula numbers.
tdo    bss 10                        do statements.
tifgo  bss 10                        if and go to statements.
trad   bss 10                        if and go to transfer addresses.
fortag bss 10                        indexes to tau and sigma tables.
forvar bss 10                        right - non-sub. fx. pt. variables.
forval bss 10                        left  - non-sub. fx. pt. variables.
fret   bss 10                        frequency statements.
equit  bss 10                        equivalence statements.
closub bss 10                        names of subroutines.
format bss 10                        format statements.
subdef bss 10                        subroutine definition statements.
common bss 10                        upper memory storage statements.
holarg bss 10                        hollerith arguments for subroutine.
nonexc bss 10                        non-executed statements.
tstops bss 10                        stop statements.
callfn bss 10                        1st / last ifn for call statements.
fmtefn bss 10                        table of format external formnos.
       rem  end of tape table buffers.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem intet/ table parameters used by tet00, where
       rem                           o = origin of table buffer,
       rem                           b = buffer capacity,
       rem                           a = address of table entry,
       rem                           e = entry length in words,
       rem                           c = count of blocks put on tape,
       rem                           p = portion of buffer that is full,
       rem 
intet  pze teifno,,10                00) 0,,b.
       pze eifno,,1                      a,,e.
       pze **,,**                        c,,p.
       rem
       pze tdo,,10                   01) 0,,b.
       pze 1c,,5                         a,,e.
       pze **,,**                        c,,p.
       rem
       pze tifgo,,10                 02) 0,,b.
       pze 1c,,2                         a,,e.
       pze **,,**                        c,,p.
       rem
       pze trad,,10                  03) 0,,b.
       pze 1g,,1                         a,,e.
       pze **,,**                        c,,p.
       rem
       pze fortag,,10                04) 0,,b.
       pze g,,1                          a,,e.
       pze **,,**                        c,,p.
       rem
       pze forvar,,10                05) 0,,b.
       pze g,,2                          a,,e.
       pze **,,**                        c,,p.
       rem
       pze forval,,10                06) 0,,b.
       pze g,,2                          a,,e.
       pze **,,**                        c,,p.
       rem
       pze fret,,10                  07) 0,,b.
       pze 1g,,1                         a,,e.
       pze **,,**                        c,,p.
       rem
       pze equit,,10                 08) 0,,b.
       pze 1c,,2                         a,,e.
       pze **,,**                        c,,p.
       rem
       pze closub,,10                09) 0,,b.
       pze g,,1                          a,,e.
       pze **,,**                        c,,p.
       rem
       pze format,,10                10) 0,,b.
       pze g,,2                          a,,e.
       pze **,,**                        c,,p.
       rem
       pze subdef,,10                11) 0,,b.
       pze 1g,,1                         a,,e.
sbdfcn pze **,,**                        c,,p.
       rem
       pze common,,10                12) 0,,b.
       pze 1g,,1                         a,,e.
       pze **,,**                        c,,p.
       rem
       pze holarg,,10                13) 0,,b.
       pze 1g,,1                         a,,e.
       pze **,,**                        c,,p.
       rem
       pze nonexc,,10                14) 0,,b.
       pze eifno,,1                      a,,e.
       pze **,,**                        c,,p.
       rem
       pze tstops,,10                15) 0,,b.
       pze eifno,,1                      a,,e.
       pze **,,**                        c,,p.
       rem
       pze callfn,,10                16) 0,,b.
       pze callnm,,1                     a,,e.
       pze **,,**                        c,,p.
       rem
       pze fmtefn,,10                17) 0,,b.
       pze set,,1                        a,,e.
       pze **,,**                        c,,p.
       rem
       bss 3                         expansion space intet.
       rem  end of tape table parameters.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem ....ix/ table parameters used by drtabs, where
       rem                           arg1 = 1st location of argument,
       rem                           l    = length of argument in words,
       rem                           tda  = loc. of next drum entry,
       rem                           n    = no. of entries on drum,
       rem                           ***  = txl for entry sum table,
       rem                           ***  = txh for block sum tab(flcn),
       rem                           fda  = loc. of 1st drum entry,
       rem                           k    = buffer capacity in entries,
       rem                           dbl  = k*(l+1) for entry sum table,
       rem                           dbl  = k*l+1   for block sum table,
       rem                           j    = drum capacity in entries,
       rem                           i    = 5 - drum number.
       rem
       pze g+1,,1                    fixcon) arg1+l,,l
       pze fixcon,,**                        tda,,n
txlop  txl fixcon,,50*1                  *** fda,,k*l
       pze 50*2,,100                         dbl,,j
fxcnix txi alt,,5-2                      txi atl,,i
       rem
       pze g+1,,1                    flocon) arg1+l,,l
       pze flocon,,**                        tda,,n
txhop  txl flocon,,50*1                  *** fda,,k*l
       pze 50*1+1,,450                       dbl,,j
flcnix txi alt,,5-2                      txi atl,,i
       rem
       pze e+3+2,,2                  tau1  ) arg1+l,,l
       pze tau1,,**                          tda,,n
       txl tau1,,25*2                    *** fda,,k*l
       pze 25*3,,100                         dbl,,j
tau1ix txi alt,,5-4                      txi atl,,i
       rem
       pze e+3+4,,4                  tau2  ) arg1+l,,l
       pze tau2,,**                          tda,,n
       txl tau2,,12*4                    *** fda,,k*l
       pze 12*5,,90                          dbl,,j
tau2ix txi alt,,5-4                      txi atl,,i
       rem
       pze e+3+6,,6                  tau3  ) arg1+l,,l
       pze tau3,,**                          tda,,n
       txl tau3,,8*6                     *** fda,,k*l
       pze 8*7,,75                           dbl,,j
tau3ix txi alt,,5-4                      txi atl,,i
       rem
       pze e+11+1,,1                 sigma1) arg1+l,,l
       pze sigma1+2,,1                       tda,,n
       txl sigma1,,30,*                  *** fda,,k*l
       pze 30*2,,30                          dbl,,j
sig1ix txi alt,,5-2                      txi atl,,i
       rem
       pze 1c+2,,2                   dim1  ) arg1+l,,l
       pze dim1,,**                          tda,,n
orgdm1 txl dim1,,0                       *** fda,,k*l
       pze 0,,100                            dbl,,j
dim1ix txi dimalt,,5-3                   txi atl,,i
       rem
       pze 1c+2,,2                   dim2  ) arg1+l,,l
       pze dim2,,**                          tda,,n
orgdm2 txl dim2,,0                       *** fda,,k*l
       pze 0,,100                            dbl,,j
dim2ix txi dimalt,,5-3                   txi atl,,i
       rem
       pze 1c+3,,3                   dim3  ) arg1+l,,l
       pze dim3,,**                          tda,,n
orgdm3 txl dim3,,0                       *** fda,,k*l
       pze 0,,100                            dbl,,j
dim3ix txi dimalt,,5-3                   txi atl,,i
       rem  end of drum table parameters.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem count and buffer for table of function names and degrees.
bk     bss 1                        forsub counter.
forsub bss 100                      names and degrees of functions.
       rem  end of function count and buffer.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem parameters and buffer for compiled instruction table.
bs     pze ,,100                     cib capacity (4 * 25).
ec     pze ,,**                      entry count = no. words in cib.
bbox   pze ,,**                      2s complement of the entry count.
cib    bss 100                       compiled instruction buffer.
       rem  end of cit parameters and buffer.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem all of the above buffers and parameters are used by 1 prime.
       org 576                                                          4f102625
erase  bss 5                         common working storage.            4f10263
1c     bss 5                         common working storage.
1g     bss 1                         common working storage.
2g     bss 1                         common working storage for state a.
3g     bss 1
1h     bss 1
2h     bss 1
3lbar  bss 1                         storage used by arithmetic.
areras bss 1                         storage used by arithmetic.
argcnt mze 4,,1                      argument counter used by c30, c20.
argctr bss 1                         storage used by arithmetic.
callnm pze **,,**         
chsave bss 1                         working storage used by roycnv.
dimsav bss 1                         working storage used by ss000.
e      bss 14                        working storage used by ss000.
epsm3  bss 3
 eps   bss 1                         epsilon - variable used by ra000.
e1c    bss 1                         common working storage.
 efn   bss 1                         external formula number (f-1).
f      bss 111                       assembled statement region.
firstc bss 1                         used by ss000,testfx,c3000.
fsname bss 1                         name of function.
ft     bss 12                        source program input buffer.
g      bss 2
 gtag  bss 1                         variable used by iot, ra.
holcnt bcd 1h(0000                   working storage used by c3300.
i      bss 1       
left   bss 3                         storage used by arithmetic.
length pze **,,**
nbar   bss 1                         storage used by arithmetic.
 n2    bss 1      
opnwrd bss 1                         eraseable used by state d.
phi(i) pze **,,**
 rat   pze 8,,**                     variable used by iot.
residu bss 1                         remainder of f-region word.(c0190)
 set   pon  **
 sl    bss 1
symbol bss 1                         working storage used by ss000.
 tl    pze 31*8,,**
tline  pze **                        variable used by iot.
       rem  end of common working storage, buffers, and parameters.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem common/2-constants used by section one=
       rem 
ten    oct 12                         (1010) - ctest-11
endmk  oct 77                         111111 - ctest-10
open   oct 74                         (      - ctest-9
comma  oct 73                         ,      - ctest-8
clos   oct 34                         )      - ctest-7
equal  oct 13                         =      - ctest-6
11z    oct 40                         -      - ctest-5
slash  oct 61                         /      - ctest-4
point  oct 33                         .      - ctest-3
l22    oct 20                         +      - ctest-2
star   oct 54                         *      - ctest-1
ctest  bss 0                          address used for indexing above.
       rem
l(0)   bcd 1000000                    0
l(1)   bcd 1000001                    1
l(2)   bcd 1000002                    2
l(3)   bcd 1000003                    3
l(4)   bcd 1000004                    4
l(5)   bcd 1000005                    5
l(6)   bcd 1000006                    6
l(7)   bcd 1000007                    7
l(8)   bcd 1000008                    8
l(9)   bcd 1000009                    9
minus  oct 14                         -
l(c)   bcd 100000c                    c
l(f)   bcd 100000f                    f
l(h)   bcd 100000h                    h
char2  oct 32                         constant used by cd000.
l(o)   bcd 100000o                    o (alphabetic)
char3  oct 52                         constant used by cd000.
specop oct 53                         00000$
blank  oct 60                         0000000000060
l(s)   bcd 100000s                    s
l(t)   bcd 100000t                    t
l(x)   bcd 100000x                    x
l(z)   bcd 100000z                    z
pm     oct 72                         record mark (illegal) -cd000
bit29  oct 100
 a81   dec 81                         constant used by iot.
l(96)  oct 140                        used by c0500.
l(112) oct 160                        used by c0400.
mask3  oct 777                                          -arithmetic.
1e9    oct 1000                       address=8
l(a()  bcd 10000a(                    internal flo-pt variable prefix.
l(H()  bcd 10000h(                    
l(I()  bcd 10000i(                    internal fix-pt variable prefix.
sapsym oct 6212
ifsym  oct 6712
caller oct 7112
mask2  oct 77777                      2**15-1           -arithmetic.
2e17   oct 400000                     tag=4
2e18   oct 1000000                    decrement=1
decr1  pze 1,,1                       constant used by drtabs.
abtag2 oct 1000002                    constant used by c3200.
 d2    pze ,,2                        constant used by iot.
abtag3 oct 2000004                    constant used by c3200.
d3cn   pze ,,3                        constant used by iot.
betad2 oct 3077775                    3*2**18+(-3)      -arithmetic.
 d6    pze ,,6                        constatn used by iot.
fsind  pze ,,16
dec17  pze ,,17
dec18  pze ,,18
pz     oct 32000000                   plus zero -cd000.
mask5  oct 37777600                                     -arithmetic.
fnind  pze ,,32
dec35  pze ,,35
mz     oct 52000000                   minus zero -cd000.
ngtbit oct 000200000000 
 bta   pze ,,144                      constant used by iot.
bda    pze 0,0,192                    constant used by iot.
5blans bcd 10                         006060606060
e(     bcd 1100000                                      -arithmetic.
i(     bcd 1200000                                      -arithmetic.
a(     bcd 1300000                                      -arithmetic.
p(     bcd 1400000                                      -arithmetic.
o(     bcd 1600000                                      -arithmetic.
x(     bcd 1700000                                      -arithmetic.
betad1 oct 77775077775                (-3(*2**18+(-3)   -arithmetic.
1bar   oct 77777000000                (2**15-1)*2**18DECREMENT mask.
 15p   dec 1585                       constant used by iot.
proctr oct 176060606060   
adplus oct 200000000000               addition sign -arithmetic.
flovar bcd 1a(0000                    a( internal floating pt.
fxfx   bcd 1exp(1
flfx   bcd 1exp(2
flfl   bcd 1exp(3
fixvar bcd 1i(0000                    i( internal fixed pt. variable.
minus0 mze 0 
decmi2 mze ,,2
adspop oct 530000000000               $00000
dolsgn oct 536000000000               constant used by c32000
adstar oct -140000000000              multiplucation sign -arithmetic.
strstr oct -145400000000              exponentiation sign -arithmetic.
blanks bcd 1                          606060606060
mask1  oct -377777700000              -(2**20-U.***15     -arithmetic.
mask4  oct -377777777737                                  -arithmetic
all1   oct -377777777777              end of statment word.
       rem
l(add) bcd 1add000                    symbolic operation code.
l(als) bcd 1als000                    symbolic operation code.
l(ana) bcd 1ana000                    symbolic operation code.
l(ars) bcd 1ars000                    symbolic operation code.
l(bss) bcd 1bss000                    symbolic operation code.
l(cal) bcd 1cal000
l(chs) bcd 1chs000                    symbolic operation code.
l(cla) bcd 1cla000                    symbolic operation code.
l(clm) bcd 1clm000                    symbolic operation code.
l(cls) bcd 1cls000                    symbolic operation code.
l(cpy) bcd 1cpy000
l(dct) bcd 1dct000                    symbolic operation code.
l(ded) bcd 1ded000
l(dvp) bcd 1dvp000                    symbolic operation code.
l(fad) bcd 1fad000                    symbolic operation code.
l(fdp) bcd 1fdp000                    symbolic operation code.
l(fmp) bcd 1fmp000                    symbolic operation code.
l(fsb) bcd 1fsb000                    symbolic operation code.
l(hpr) bcd 1hpr000                    symbolic operation code.
l(lda) bcd 1lda000
l(ldq) bcd 1ldq000                    symbolic operation code.
l(lls) bcd 1lls000                    symbolic operation code.
l(lrs) bcd 1lrs000                    symbolic operation code.
l(lxd) bcd 1lxd000                    symbolic operation code.
l(mpy) bcd 1mpy000                    symbolic operation code.
l(mse) bcd 1mse000                    symbolic operation code.
l(ora) bcd 1ora000                    symbolic operation code.
l(pse) bcd 1pse000                    symbolic operation code.
l(pxd) bcd 1pxd000                    symbolic operation code.
l(opr) bcd 1opr000                    symbolic operation code.
l(qxd) bcd 1qxd000                    symbolic operation code.
l(sta) bcd 1sta000                    symbolic operation code.
l(sto) bcd 1sto000                    symbolic operation code.
l(stq) bcd 1stq000                    symbolic operation code.
l(sub) bcd 1sub000                    symbolic operation code.
l(sxd) bcd 1sxd000                    symbolic operation code.
l(tix) bcd 1tix000
l(tov) bcd 1tov000                    symbolic operation code.
l(tqo) bcd 1tqo000                    symbolic operation code.
l(tra) bcd 1tra000                    symbolic operation code.
l(tsx) bcd 1tsx000                    symbolic operation code.
l(ufa) bcd 1ufa000                    symbolic operation code.
       rem  end of common constants used by section one.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem common/3-subroutines used by section one*
       rem 
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem c0150,2/ calls=c0190,diag,c0180,c0160. caller=c0100.
       rem c0150 inspects 1st nb char starting in mq. if numeric, sets i
       rem = 0, and converts successive numerics to binary. if non-
       rem numeric, sets i = -o, and packs into 1g successive characters
       rem until a ,()= or endmk is met, and left in the ac.
c0150  sxd c015x,2                    save the c(xr2).
       tsx c0190,4                  * test 1st non-blank character
       cas l(9)                       for numeric or non-numeric.
c015x  txi c0151,0,**                 if non-numeric, transfer.
       nop                            if numeric, then
       tsx c0180,2                  * go convert to binary.
       sto 2g                         save next non-nueric character.
       cla l(0)                       prepare to set i to +0.
 fwa   txi c0152,0,**                 go set i for numeric.
c0151  tsx c0160,2                  * assemble non-numerics in 1g.
       sto 1g                         save punctuation mark, and
       cls l(0)                       prepare to set i to -0.
c0152  sto i                          set i = +0, or -0.
       cla 2g                         pickup next character,
       lxd c015x,2                    restore the c(xr2), and
       tra 1,2                      * return to caller.
       rem  end of program c0150.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem c0160,2/ calls=c0190,diag. callers=c0100,c0200,c1000,c1200,
       rem c1500,c3000,c3100,c0150.
       rem c0160 assembles left-adjusted in 1g, the char in the ac and
       rem successive nb chars starting in the mq, until a ,()= or endmk
       rem is met and left in the ac. also marks end of word with a 
       rem blank, if less then 6 characters.
c0160  sxd c016x,2                  save the c(xr2), and
       lxa l(0),2                   set xr2 to control shifting.
       stz 1g                       clear working storage.
c0161  lxa ctestx,4                 test
c0162  cas ctest,4                  character
c016x  txi c0163,0,**               in the ac
       txi c0165,0                  against
c0163  tix c0162,4,1                all punctuations.
       txl c0164,2,30               if symbol exceeds 6 characters,
       tsx diag,4                 * go to the diagnostic.
c0164  als 30,2                     build left-adjusted
       ors 1g                       symbol in working storage.
       tsx c0190,4                * get next nb character in the ac.
       txi c0161,2,6                update shift count, and continue.
c0165  txh c0167,2,0                if punctuation is 1st character.
c0166  tsx diag,4                 * or illegal, go to the diagnostic.
c0167  txl c0166,4,5                if legal punctuation, then
       sto 1h                       save, and
       cla blank                    add a blank
       als 30,2                     to symbols that are less
       ors 1g                       then 6 characters in length.
       cla 1h                       pickup punctuation mark,
       lxd c016x,2                  restore the c(xr2), and
       tra 1,2                    * return to caller.
       rem  end of program c0160.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem c0180,2/ calls=c0190,diag. callers=c0100,c0200,c0300,c0400,
       rem c1000,c1100,c1200,c1400,c1500,c0150.
       rem c0180 converts successive numerics starting in the mq to
       rem binary, places result in 1g, and leaves 1st non-numeric in
       rem the ac. 1st numeric is assumed to be already in the ac.
c0180x tsx c0190,4                * obtain 1st numeric in the ac.       4f105165
c0180  sto 1g                       place 1st numeric in 1g.            4f10517
       tsx c0190,4                * examine next non-blank character,
       cas l(9)                     and if non-numeric, then
       tra 1,2                    * return to caller.
       nop                          if numeric, then
       sto 2g                       save digit in 2g.
       cla 1g                       multiply
       als 2                        c(1g)
       add 1g                       by 
       als 1                        10,
       add 2g                       and add current digit.
 dcf   txi c0180,0,-f               repeat process for next character.
       rem  end of program c0180.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem c0190x,4/ callers=cd000,cb000,cc000,c0300,c3300.
       rem c0190x initializes c0190 to obtain 1st word of formual in f.
c0190x cla dcf                      set formula word
       std fwa                      address = -(f-region address),
       sxd chctr,0                  set character count = 0,
       tra 1,4                    * return to main routine.
       rem  end of program c0190x.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem c0390,4/ callers=c0300,c3300.
       rem c0390 inserts the character in the ac into the 1st position
       rem to the left of that defined by fwa and xr1
c0390  cla endmk                     prepare to change
       lxd fwa,2                     the proper character
       lxd chctr,1                   in the f-region.
       tnx c0393,1,1                 adjust mask
c0392  lgl 6                         to position
       tix c0392,1,1                 character
c0393  com                           invert mask, and
       ans -1,2                      erase proper character.
       lgl 36                        adjust character, and
       ors -1,2                      insert in erased position.
       rem c0390 continues by using c0190.
       rem
       rem c0190,4/ callers=cd000,cb000,cc000,c0100,c200,c00300,c0400,
       rem c0900,c1000,c1100,c1200,c1400,c1500,c1600,c3000,c3100,c3200,
       rem c3300,c3400,c0150,c0160,c0190,ss000,roycnv,rsc,lpr.
       rem c0190 obtains in ac the next non-blank character of formula.
c0190  sxd c0194,1                   save the c(xr1), and
       lxd chctr,1                   set xr1 = character count.
       ldq residu                    pick up any remaining characters.
c0191  tix c0193,1,1                 if none,
       lxd fwa,1                     pick up next formula
       ldq 0,1                       word from f-region,
       txi c0192,1,-1                and increase
c0192  sxd fwa,1                     formula word address by 1.
       lxa l(6),1                    reset xr1 for 6 new characters.
c0193  pxd ,0                        examine
       lgl 6                         next character
       cas blank                     and compare with a blank.
c0194  txi c0195,0,**                if blank,
chctr  txi c0191,0,**                go examine next character.
c0195  sxd chctr,1                   if not blank, reset char count,
       stq residu                    save any remaining characters, 
       lxd c0194,1                   restore the c(xr1), and 
       tra 1,4                     * return to main routine.
       rem  end of program c0190.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem cit00,4/ callers=c0200,c0400,c0900,c1000,c1100,c1300,c1600,
       rem c3200,rdc,wbt,rbt,wrd,brw,eft,lpr,cma,emk,input(output),
       rem etmsw(ltmsw),lib,vra(vrd).
       rem c1t00 make entries in the compiled instruction table. when
       rem the buffer is full it is written as a record onto tape 3.
cit00  sxd citxr2,2                  save the c(xr2).
       sxd citxr1,1                  save the c(xr1).
       stq citmqr                    save the c(mqr).
       lxd bbox,2                    set xr2 = 2s compl of no-wrds-entd.
       cla bs                        compare block size
       sub ec                        with entry count.
       tnz cit04                     if block is not full,go make entry.
       wrs cittap                    prepare to write block on cit tape.
       pax ,1                        set xr1 = 0, and
cit01  cpy cib,1                     copy successive
       txi cit02,1,-1                words of block
cit02  txi cit03,2,1                 and continue
cit03  txh cit01,2,1                 until xr2 = 0.
       iod                           when done,
cit04  lxa l(4),1                    set xr1 = entry size.
cit05  txi cit05+1,4,-1              set xr4 = -(addr of next entry wrd)
       cla 0,4                       and pick up address of next entry
       sta cit06                     to set next address.
cit06  cla **                        move entry
       sto cib,3                     into cib buffer,
       txi cit07,2,-1                and count 1 for each word entered.
cit07  tix cit05,1,1                 when doen,
       sxd bbox,2                    save the c(xr2), and
dmsr99 pxd dmsr05+1,2                compute the
       com                           real number
       add 2e18                      of words entered
dmsr98 pdx dmsr05,2                  in cib buffer, and
       sxd ec,2                      save in ec.
       ldq citmqr                    restore the c(mqr),
       lxd citxr1,1                  restore the c(xr1),
       lxd citxr2,2                  restore the c(xr2), and
       tra 1,4                     * exit to main routine (5th wrd cs).
       rem  end of program cit00.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem dim.sr,4/ calls=diag. callers=c1200,ss000,cma.
       rem dim.sr searchs the dimension tables. entrance is to dim1sr,
       rem dim2sr, or dim3sr according to the dimension.
       rem dim1sr= entry point for 1 dimension table.
dim1sr sxd dmsr00,4                  save the c(xr4) for return,
       lxd dim1ix-3,4                set xr4 = number of entries in dim1
       cla orgdm1                    and pick up 1st address of dim1 to
dmsr00 txi dmsr01,0,**               go set drum address.
       rem dim2sr = entry point for 2 dimension table.
dim2sr sxd dmsr00,4                  save the c(xr) fro return.
       lxd dim2ix-3,4                set xr4 = number of entries in dim2
       cla orgdm2                    and pick up 1st address of dim2 to
dmsr01 sta drmadr                    set drum address.
       cla dmsr99                    set loop address to
       sta dmsr15                    dmsr05+1 for dim1 and dim2.
       cal dmcn12                    (stz d3)
dmsr11 txi dmsr02,0,**               go set op fro dim1 and dim2.
       rem dim3sr= entry point for 3 dimension table.
dim3sr sxd dmsr00,4                  save the c(xr4) fro return,
       lxd dim3ix-3,4                set xr4 = number of entries in dim3
       cla orgdm3                    and pick up 1st address of dim3 to
       sta drmadr                    set drum address.
       cla dmsr98                    set loop address to
       sta dmsr15                    dmsr05 for dim3.
       cal dmcn3                     (cpy d3)
dmsr02 slw dmsr05                    set op codes according
       slw dmsr07                    to dimension.
       txl dmsr08,4,0                if table is empty, go out.
       sxd dmsr11,4                  save entry count in case of error.
dmsr14 lxa l(5),4                    set error counter for 5 attempts.
dmsr13 sxd dmsr12,4                  save error counter, and
       lxd dmsr11,4                  reset entry count.
       rdr 3                         select drum.
       cla e+2                       get name of variable.
       lda drmadr                    load current drum address, and
dmsr04 cpy drsym                     copy drum symbol.
       tlq dmsr06                    compare with name of variable, and
       cpy d12                       if not less, copy n1 and n2.
dmsr05 pze d3                        (dim1 and dim2 = stz , dim3 = cpy).
       cpy drcksm                    copy checksum.
       cas drsym                     compare drum symbol with anem of v.
       tsx diag,4                  * go to dignostic - machine error.
dmsr12 txi dmsr09,0,**               if not equal, then
       cpy drsym                     continue
       tlq dmsr06                    process
       cpy d12                       until
dmsr15 tix **,4,1                    table
       txi dmsr08,0                  is exhausted.
dmsr06 cpy d12                       pass over entry
dmsr07 pze d3                        (dim1 and dim2 = stz, dim3 = cpy)
       cpy drcksm                    and checksum, and
       tix dmsr04,4,1                repeat loop.
dmsr08 lxd dmsr00,4                  restore the c(xr4), and
       tra 1,4                     * take not found exit.
dmsr09 cal drsym                     compute a
       acl d12                       new
       acl d3                        logical checksum
       com                           for entry. and
       acl drcksm                    compare with
       com                           drum checksum.
       tze dmsr10                    if not equal, then
       lxd dmsr12,4                  repeat attempt,
       tix dmsr13,4,1                unless process
       tsx diag,4                  * failed 5 times in reading drum.
dmsr10 lxd dmsr00,4                  restore the c(xr4), and
       tra 2,4                     * take found exit to main rotuine.
       rem
dmcn12 stz d3                        constant used by dim.sr.
dmcn3  cpy d3                        constant used by dim.sr.
ent    bcd 1ntr000                   variable used by io and fl.
nze    bcd 1pze000                   variable used by fl.
       rem end of program dim.sr.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem drtabs(,4)/ calls rdrx,diag. callers=c1200,ss000,roycnv,cma,
       rem vra(vrd).
       rem drtabs is called by tsx ....ix,4 -where .... is the name of
       rem the drum table referred to. drtabs makes entries in the drum
       rem tables, and also searches the drum tables for infomation.
       rem dimalt= entry point for dimension tables.
dimalt cal txlop                     pick up switch control,
       txi drtabs,0                  and go set switch for dim tables.
       rem alt= entry point for all other drum tables.
alt    cal txhop                     pick up switch control,
drtabs stp dimsw                     set switch.
       cla 0,4                       get caller (tsx ....ix,4) in ac.
       sxd xr1,1                     save the c(xr1),
       sxd xr2,2                     save the c(xr2),
       sxd xr4,4                     save the c(xr4), and
       stq mq                        save the c(mqr).
       add l(1)                      prepare to move parameterrs
       sta move                      into working storage.
       sub l(4)                      prepare to update
       sta update                    permanent parameter.
       lxa l(5),1                    move 5 words
move   cal **,1                      (....ix+1)
       slw temp,1                    of parameters
       tix move,1,1                  into working storage.
       cls nar                       initialize
       sta try                       all
       add l(1)                      general
       sta esum1                     instructions=
       sta esum2                     x
       ars 17                        x
       adm biad                      x
       sta jump1                     x
       sta jump2                     x
       cal fda                       x
       std compr                     x
       stp jump1                     x
       stp sw                        x
       stp rx4                       x
       cla lbuf                      x
       sta bufl                      x
       cla tda                       x
       lxd tda,2                     x
       sxd buff+1,2                  x
dimsw  txl buff,0                    if dim table, skip search.
       txl xerr01+1,2,0              skip if table is empty.
       lxd nar,1
       sxd nc,2
       sxd add01,2
add02  tnx compr,1,1                 computes (n*l).
add01  txi add02,2,**                (n)
buffm1 lxd fda,2 
buff   lxd dbl,1                     l(j)
       tix buff+3,1,**               (n) test for table overflow.
xerr01 txi which,0                   go find out which table overflowed.
       lxd di,1 
       wdr 5,1  
sw     txl eblk,0                    enter sum=txl, block sum=txh.
       txl add04,2,0                 skip if table is empty.
       txi add03,2,1               
add03  tnx add05,2,50                skip if block is not yet full.
add04  stz dump                      start new block checksum.
       cla tda                       change checksum address.
       sta fda              
       add l(1)                      set entry addr = checksum add +1.
       sta tda
add05  cal dump
       acl g                         add new flocon to
       slw dump                      checksum for this block.
       lda fda
       cpy dump                      write block checksum on drum.
       wdr 5,1
       lda tda
       cpy g                         write new flocon on drum.
xr2    txi nowin,0,**                go update flocon parameter.
eblk   pxd ,0                        for all tables except flocon=
       lxd nar,2                     (l)
       lda tda                       next drum entry address.
       tnx esum2,2,1                 if l = 1,
esum1  cad **,2                      (arg1+l-1) write new
       tix esum1,2,1                 entry on drum.
esum2  cad **                        (arg1+l-1)
       slw dump                      compute and
       cpy dump                      write checksum for new entry.
nowin  cal nar                       update permanent
       ars 18                        parameters for entry
       add decr1                     just add to table.
rx4    txl rx4+2,0,**                if table was flocon,
       sub l(1)                      readjust.
       adm tda                       n=n+1,tda=tda+(l+1) or (l).
update sto **                        (....ix-3)
       lxd tda,2                     l(n)
xr4    txi out,0,**                  get tag and exit.
nxblk  lxd nc,4
       lxd fda,2                     l(k*l),k=k.
new    lxd nar,1                     l(l)
try    cla **,1                      (arg1+l)
bufl   cas **,2                      (bufr or ctabl)
nc     txi nc+2,0,**                 not found.
       txi yea,2,-1                  k*l = k*l-1.
       tnx buffm1,4,1                n = n-1 or item not in table.
       sxd nc+4,1           
       tix new,2,**                  k = k-1.
       sxd nc,4                      save current value of n,
       cal dbl                       and get new block.
       adm fda
       sta fda
       lxd ntl,2                      
compr  tix compr+2,2,**              (k*l)
       sxd fda,2                     k*l = (n*l)mod k*l if n*l is
       sxd ntl,2                     less than k*l, otherwise k*l = k*l,
       tsx rdrx,4                  * go read next block into buffer.
ntl    txi nxblk,0,**                (n*l,n*l-k*l,N*L-2*k*l,...(n*l)mod
yea    tix try,1,1                   k*l). test next word of arg. l=l-1.
       lxd tda,2                     (n)
       sxd yea+3,4   
       tix out,2,**                  compute tag.
       lxa l(0),2
out    pxd ,2                        exit with tag in the ac.
       ars 18                        (tag = number of entries
       lxd xr2,2                     which preceed the entry
       lxd xr4,4                     which equals the argument.
       lxd xr1,1                     restore the c(xr1,xr2,xr4),
       ldq mq                        restore the c(mqr), and
       tra 1,4                     * return to main routine.
which  lxd xr4,4                     get alpha bar, and
       cla 0,4                       and pick up alpha (tsx ...nix,4).
       ana mask2                     blank all but ...nix.
       sub conx                      (...nix) - (addr of fixcnix-5).
       lxa l(9),4                    set xr4 for 9 tables.
comput sub l(5)                      compute which
       tze whichx                    table overflowed.
       tix comput,4,1                if table is not found.
       tsx diag,4                  * got to diagnostic.
whichx pxd ,4                        otherwise,
       com                           convert 2s complement
       add 2e18                      of number,
       pdx ,4                        place in xr4, and
       txi diag,0                  * go to diagnostic.
       rem
conx   pze fxcnix-5                  constant used by drtabs.
bufr   bes 50                        drum table buffer.
mq     bss 1                         working storage used by drtabs.
nar    bss 1                         working storage used by drtabs.
tda    bss 1                         working storage used by drtabs.
fda    bss 1                         working storage used by drtabs.
dbl    bss 1                         working storage used by drtabs.
di     bss 1                         working storage used by drtabs.
temp   bss 0                         indexing addres for above -drtabs.
dump   bss 1                         working storage used by drtabs.
       rem end of program drtabs.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem getifn,4/ callers=c0100,c0200,c1000,c1100,c1600,c3200.
       rem getifn places the internal formula number in ac and in 1c.
getifn lxd eifno,1                   place the internal formula
       pxd ,1                        number in xr1, in the decrement
       sto 1c                        of the ac, and in 1c. then
       tra 1,4                     * return to caller.
       rem  end of program getifn.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem jif(gif),4/ callers=rdc,eft,lpr,spc,cma,emk,input(output),
       rem vra(vrd),c3200.
       rem jif = entry point used by rdc,lpr,spc,cma,emk,vra(vrd),c3200.
jif    cal eifno                     increase the
       add d1                        internal formula number
       std eifno                     by 1.
       rem gif = entry point used by eft,input(output).
gif    cal eifno                     pickup ifn,
       ana 1bar                      clear sl, and
l(sl)  slw sl                        place ifn in the decrements
l(tl)  std tl                        of sl and tl.
       tra 1,4                     * exit to caller.
       rem  end of program jif(gif).
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem mtr000/ monitor routine for calling states from drum.
       rem statea= entry point for state a.
statea lxa l(4),4                    set c(xr4) = 4, then
       txi mtr1,0                    go get parameters.
       rem stateb= entry point for state b.
stateb lxa l(2),4                    set c(xr4) = 2, then
       txi mtr1,0                    go get parameters.
       rem statec= entry point for state c.
statec lxa l(1),4                    set c(xr4) = 1, then
mtrcsl txi mtr1,0,**                 go get parameters.
       rem stated= entry point for state d.
stated lxa l(3),4                    set c(xr4) = 3, then
mtr1   cla zeta+4,4                  obtain the number of words in the
       std mtrcsl                    current state, and save.
       ars 18                        add the number of words in the
       add mtr3                      current state to the memory origin
       sta mtr2                      to set address of copy loop.
       lxa drmerc,1                  set for five attempts.
mtr15  rdr 5,4                       read select current logical drum.
       lxd mtrcsl,2                  length of current state to xr2.
       lda zeta+4,4                  then copy
       pxd ,0                        current state
       cad drcksm                    from drum
       com                           into memory
mtr2   cad **,2                      while computing
       tix mtr2,2,1                  logical checksum.
       com                           if this equals drum checksum,
mtr3   tze memorg                  * then enter current state.
       tix mtr15,1,1                 checksum failed, try up to 5 times.
mtrerr txi diag,4,-mtrerr          * go to diagnostic after 5 failures.
       rem
zeta   pze del(a),,endadr-orga
       pze del(d),,endadr-orgd
       pze del(b),,endadr-orgb
       pze del(c),,endadr-orgc
       rem  end of program mtr000.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem rad00,4/ callers=lpr,arith.
       rem rad00 computes relative address.
rad00  sxd raxr4,4                   save the c(xr4) for return.
       stz eps                       clear epsilon (working storage).
       cla dimsav                    examine the
 ed2   pax e+4,4                     dimension count, and
       txl ed1,4,2                   if 3 dimension,
       add l(1)                      increase it 1.
ed1    adm ed2                       then set
       sta ed3                       ed3 address to
 ed3   cla **,4                      examine successive
       ldq d1                        subscript
       tze ed4                       variables, and
       stq ep5                       accordingly set
       ldq l(0)                      epsilon and
 ed4   stq eps,4                     epsilon sub i
       tix ed3,4,1                   to 1 or to 0. when done,
       cla d1                        if 1 dimension, pickup decrement1,
       lxa dimsav,4                  and go subtract addend 1. 
       txl 1d1,4,1                   if 2 or 3 dimension, then
       ldq e+11                      pickup addends 1 and 2,
       stz e+11                      clear e+11, and
       slq e+11                      restore addend 1 to e+11.
       lgl 18                        adjust and place
       stq n2                        addend 2 in n2.
       ldq e+6                       and, if 2 dimension
       cla eps-1                     pickup epsilon sub 1,
       txl 2d1,4,2                   and go subtract addend 2.
       sub e+12                      if 3 dimension, set gtag
       sto gtag                      to epsilon sub 1 - addend 3.
       ldq e+8                       pickup dimesnions 1 and 2.
       stz e+8                       clear e+8, and
       slq e+8                       restore dimension 1 to e+8.
       lgl 18                        adjust, and multiply
       mpy gtag                      dimension 2 times gtag.
       als 17                        then add
       add eps-2                     epsilon sub 2
       ldq e+8                       to the product, and
2d1    sub h2                        subtract addend 2.
       sto gtag                      multiply 
       mpy gtag                      the result
       als 17                        times
       add eps,4                     dimension 1, and add in epsilon
       add eps                       sub i and epsilon.
 1d1   sub e+11                      subtract addend 1,
       sto gtag                      and place the result
       cal e                         in the decrement of gtag,
       ars 24                        with 1-tautag
       sta gtag                      in the address.
       lxd raxr4,4                   restore the c(xr4), and
       tra 1,4                     * exit to caller.
       rem  end of program rad00.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem rdrx,4 calls=diag. caller=drtabs.
       rem rdrx reads a block fo drum entries into 50 word bufr.
rdrx   lxa drmerc,1                  set for 5 attempts to read drum.
rep    lxd di,2                      set xr2 * (5-drum number).
       txh bias-2,2,0                if not greater then zero.
       tsx diag,4                  * go to diagnostic.
       rdr 5,2                       select current drum.
       lxd fda,2                     set xr2 = no. of words to copy.
bias   pxd etsum,0                   clear the ac.
       lda fda                       drum origin of current block.
jump1  txl **                        (etsum-2*l) txl=entry,txh=block.
       cad dump                      read
       com                           flocon block
lbuf   cad bufr,2                    and compute
       tix lbuf,2,1                  logical checksum.
xr1    txi prove,0,**                go test checksum.
       cpy bufr,2                    copy loop
       tnx err,2,1                   for all 
       cpy bufr,2                    copy loop
       tnx err,2,1                   tables
       cpy bufr,2                    except
       tnx err,2,1                   flocon*
       cpy bufr,2                    X 
       tnx err,2,1                   x
       cpy bufr,2                    X 
       tnx err,2,1                   x
       cpy bufr,2                    X 
       tnx err,2,1                   x
       cpy bufr,2                    X 
       nop                           x
etsum  cad dump                      sum checksums.
jump2  tix **,2,1                    (etsum-2*l) test end of block.
rdrxcr lxd fda,2                     compute
       com                           new
       acl bufr,2                    logical
       tix rdrxcr+2,2,1              checksum, and
prove  com                           if checksums compare
       tze 1,4                     * return to main routine.
err    tix rep,1,1                   otherwise, repeat up to 5 times.
       tsx diag,4                  * failed 5 times in reading drum.
       rem  end of program rdrx.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem sr6dc1,1/ calls=diag. callers=ca000,ss000.
       rem sr6dc1 converts up to 6 bcd digits to their binary equiv.
sr6dc1 sxd sr6xr2,2                  save the c(xr2), and
       lxa l(6),2                    set to count 6 characters.
       stz sr6wrk                    initialize output cell to 0.
sr6dc2 pxd ,0                        obtain next character
       lgl 6                         in ac and
       cas ablank                    test for blank.
sr6xr2 txi sr6dc3,0,**               if not blank,
endwrd tix sr6dc4,0,-1               (decr= end of problem indicator)
sr6dc3 cas l(9)                      test for numeric.
       tsx diag,4                  * if non-numeric - go to diagnostic.
nop    nop                           if numeric,
       sto sr6wrk+1                  save digit, and
       cla sr6wrk                    multiply previous partial
       als 2                         result by 10, 
       add sr6wrk                    and add in 
       als 1                         current digit, saving
       add sr6wrk+1                  new partial result.
       sto sr6wrk                    then adjust count, and
sr6dc4 tix sr6dc2,2,1                when 6 chars have been treated,
       cla sr6wrk                    leave output in ac,
       lxd sr6xr2,2                  restore the c(xr2), and
tra    tra 1,1                     * exit to main routine.
       rem  end of program sr6dc1.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
       rem ss000,4/ calls=c0190,diag,sr6dc1,dim,sr,drtabs,tet00,testfx.
       rem callers=arith,lpr,c0200.
       rem ss000 scans subscript combinations and makes table entries.
ss000  sxd sxr2,2                    save c(xr2),
       sxd sxr1,1                    save c(xr1),
       sxd sxr4,4                    save c(xr4), and
       stz dimctr                    set dimctr = 0.
       lxa l(6),4                    initialize
       sxd sbs2,4                    for each subscript member.
       cal txhop                     pick up txh op, and
       stp sbc6                      set op
       stp sbc8                      switches.
       cal txlop                     pick up txl op, and
       stp sbc4                      set op switch.
ss001  lxa l(5),3                    set for 6 characters of multiplier.
       stz symbol                    clear working storage.
       tsx c0190,4                 * get first non blank char in the ac.
       cas l(9)                      compare it with 9.
       txi ss0045,0                  return to explicit coding.
       nop                           if numeric,
       sto firstc                    save right-adjusted digit, and
ss0012 als 36,2                      left-adjust digit to
       ors symbol                    build symbol.
       txi ss0013,2,6                update shift decrement, and
ss0013 txi ss0014,1,-1               update count of chars collected.
ss0014 tsx c0190,4                 * get next nb character in the ac.
       lxa ctestx,4                  set xr4 = no. of punctuation marks.
ss0015 cas ctest,4                   test this character againtt
       txi ss0016,0                  all punctuation.
       tra subtr,4                   if equality is found, transfer.
ss0016 tix ss0015,6,1                if not found to be punctuation,
       cas l(9)                      test for numeric
       txi ss0017,0                  and if
ctestx nop ctest-endmk               found to be numeric
       txh ss0012,1,0                continue building symbol. but if
       txi stop49,0                  seventh char, go to diagnostic.
ss0017 tsx testfx+1,1              * go test for fixed point variable.
       tsx diag,4                  * not fixed point --go to diagnostic.
       lgl 30                        restore fixed point variable
       slw residu                    to resudu, and
       lxd chctr,4                   reset character counter
       txi ss0018,4,1                to begin processing
ss0018 sxd chctr,4                   subscript multiplier.
 sbx   cls sbc6                      test for
       tmi sbx1                      previous multiplier.
       tsx diag,4                  * double multiplier for subscript.
 sbx1  sto sbc6                      reset multiplier switch.
       cla firstc                    test
       sub l(10)                     multiplier
       tmi sbx2                      for constant.
       tsx diag,4                  * subs-multipler not a constant.
 sbx2  cla symbol                    adjust multiplier
       ars 42,2                      to low order position.
       lxd sbs2,4                    get storing tag,
       slw e+9,4                     and store multiplier.
       stz e+15,4                    set addend = 0.
ss003  lxa l(6),3                    set for 6 chars of variable/addend.
       stz symbol                    clear working storage.
ss004  tsx c0190,4                 * go get next nb character in the ac.
ss0045 lxa ctestx,4                  compare character
ss005  cas ctest,4                   to all
       txi ss006,0                   punctuation.
       tra subtr,4                   if equality is found, transfer.
ss006  tix ss005,4,1                 if not found to be punctuation,
       txl ss008,1,5                 if 1st character of variable or
       sto firstc                    addend, save for later test.
ss008  als 36,2                      position each character. but
ss009  txl stop49,1,0              * on 7th character, go to stop.
       ors symbol                    build symbol.
       txi ss007,2,6                 update effective address of shift.
ss007  txi ss004,1,-1                updat for another char collected.
stop49 tsx diag,4                  * go to diagnostic on 7th character.
       rem substr/ control transfers for subscript scan=
       txi isc,0                     enk (illegal in list subscript).
 isc   tsx diag,4                  * (   (illegal in list subscript).
       txi sbc,0                     ,
       txi sbr,0                     )
       txi isc,0                     =   (illegal in list subscript).
sbs2   txi sbm,0,**                  - ,,subscript element counter,
       txi isc,0                     /   (illegal in list subscript).
sxr1   txi isc,0,**                  .   (illegal in list subscript).
sxr2   txi sbp,0,**                  +
sxr4   txi sbx,0,**                  *
subtr  bss 0                         indexing address for above list.
 sbm   ssm                           minus addend.
 sbp   clm                           plus addend.
       lxd sbs2,4                    get storing tag, and
       sto e+15,4                    store sign of addend.
       cls sbc8                      test switch
       tmi sbp1                      for previous addend.
       tsx diag,4                  * double addend for subscript,
 sbp1  sto sbc8                      reset addend switch.
       tsx testfx,1                * go to test for fixed point.
       tsx diag,4                  * not fixed point --go to diagnostic.
       lxd sbs2,4                    get storing tag, and
       cls sbc6                      test switch
       tpl sbp2                      for previous multiplier.
       cla l(1)                      if none,
       sto e+9,4                     set multiplier
       txi sbp4,0                    to 1, and continue.
 sbc1  cls sbc6                      reset multiplier
sbp2   sto sbc6                      op switch.
sbp4   cal symbol                    if variable subscript.
       txh sbp41,2,36                add a blank
       cal blank                     if less
       als 36,2                      than 6
       ora symbol                    characters, and
 spb41 slw e+10,4                    place in e-region.
       tsx testfx,1                * go to test for fixed point.
       tsx diag,4                  * not fixed point --go to diagnostic.
       cla sbc8                      if there is an addend,
       tmi ss003                     go collect, otherwise
       txi sbc7,0                    go update storing tag.
sbr    cls sbc4                      set switch
       sto sbc4                      for closing parenthesis.
sbc    cal dimctr                    update
       add l(1)                      dimension counter
       sta dimctr                    by 1.
       lxd sbs2,4                    get storing tag.
sbc6   txh sbc1,0                    switch-if no multiplier, and
sbc8   txh sbc2,0                    switch-if no addend, then
       cla l(1)                      set
       sto e+9,4                     multiplier = 1.
       stz e+15,4                    set addend = 0.
       cla firstc                    test for
       sub l(10)                     constant or variable.
       tpl sbp4                      if constant, then
       stz e+10,4                    set variable = 0.
sbc9   cal symbol                    adjust
       ars 42,2                      constant
       ors e+15,4                    to low order position.
sbc7   tnx sbc3,4,2                  update storing tag
       sxd sbs2,4                    by -2, and save.
sbc4   txl ss001,0                   switch-repeat for next sub-comb.
       txi sa000,0                   go make table entries and get tag.
 sbc2  cls sbc8                      reset addend
       sto sbc8                      op switch.
       cls l(10)                     test
       add firstc                    addend
       tmi sbc9                      for constant.
       tsx diag,4                  * subscript addend not a constant.
sbc3   cls sbc4                      after scanning 3 subscripts.
       tmi sa000                     go make table entries and get tag.
       tsx diag,4                  * go to diag - no ) after 3rd subs.
       rem csa000= entry point used by c0200 (go to routine).
csa000 sxd sxr4,4                    save c(xr4) for return to c0200.
sa000  cla dimctr                    save
       sto dimsav                    the contents of dimctr
       als 33                        position and
       sto e                         store i tag.
       cla e+11                      move subscript addends
       sto e+12                      into position
       cla e+9                       for following
       sto e+11                      program.
       cla l(2)                      examine dimctr
       txi 1d0000,0                  whether dimesnion of
       txi 2d0000,0                  variable is 1, 2, or 3.
3d0000 lxa l(6),4                    prepare to pick up 3 coefficients.
3d0001 ldq e+9,4                     convert them from bcd to binary
       tsx sr6dc1,1                * in e+3,5,7, and
       sto e+9,4                     store back in e+3,5,7,
       tix 3d0001,4,2                when done, prepare
       lxa l(3),4                    to pick up 3 addends.
3d0002 cla e+14,4                    convert addens (bcd to binary)= 
       slw g                         strip off
       ldq g                         sign.
       tsx sr6dc1,1                * convert addends in e+11,12,13,
       ldq e+14,4                    put sign in s-bit of mq, and
       tqp 3d0040                    if plus--skip next, 
       ora 2e17                      if minus--or sign into bit 18,
3d0040 sto e+14,4                    and store back into e+11,12,13,
       tix 3d0002,4,1                when done,
       tsx dim3sr,4                * go search dim3 table,
       tsx diag,4                  * --error...not on drum,
3d0060 cla e+3                       reformatize e-string =
       als 18                        pack together coefficients 1 and 2
       add e+5                       and store them
       sto e+3                       in e+3.
       cla e+4                       move subscript 1
       sto e+5                       to e+5.
       cla e+7                       and move
       als 18                        coefficient 3
       sto e+4                       into e+4.
       cla e+8                       move subscript 3 into e+7,
       sto e+7                       next subscript 2 in e+6.
       cla d12                       move dimesions 1 and 2
       sto e+8                       into e+8.
       cal e+11                      pack together
       als 18                        addends 1 and 2
       ora e+12                      and
       slw e+11                      store them in e+11.
       cal e+13                      move 
       als 18                        addend 3
       slw e+12                      into e+12.
       tsx tau3ix,4                * go search tau3 table.
       als 24                        position tau3 tag, and
       ors e                         place tau3 tag in tag word.
       cal e+7                       combine
       ora e+6                       subscripts 3,2, and 1,
3d0340 ora e+5                       and if they are all zero,
3d0350 tze notag                     --don,t enter fortag.
ftg000 cla eifno                     enter fortag=
       ana mask1                     bring up alpha (intformno)
       slw g                         and store in g.
       cal e                         bring up tautag for i,
       ars 24                        adjust, and
       ors g                         place in g with alpha.  then
       tsx tet00,1                 * enter into fortag table
       pze 4                         (tet table 4).
       txi saexit,0                  go to exit.
2d0000 lxa l(4),4                    then pickup and
2d0001 ldq e+7,4                     convert coefficients
       tsx sr6dc1,1                * (bcd to binary),
       sto e+7,4                     and store back in e+3 and e+5,
       tix 2d0001,4,2                when done,
       lxa l(2),4                    prepare to 
2d0002 cla e+13,4                    pickup the two addends.
       slw g                         strip off
       ldq g                         their signs,
       tsx sr6dc1,1                * convert them from bcd to binary,
       ldq e+13,4                    put sign in s-bit of mq, and
       tqp 2d0040                    if plus--skip next,
       ora 2e17                      if minus--or sign into bit 18,
2d0040 sto e+11,4                    and store back in e+11 and e+12.
       tix 2d0002,4,1                when done,
       tsx dim2sr,4                * go search dim2 table.
       tsx diag,4                  * --error...not on drum.
2d0060 cla e+3                       reformatize e-string =
       als 18                        pack together
       add e+5                       coefficents 1 and 2,
       sto e+3                       and store them in e+3,
       cla e+6                       move subscript 2 into e+5
       sto e+5                       (next to subscript 1 in e+4),
       cla d12                       obtain
       ana mask1                     dimension 1, and move it
       sto e+6                       into e+6.
       cal e+11                      pack together
       als 18                        addends 1 and 2,
       ora e+12                      and store them
       slw e+11                      in e+11.
       tsx tau2ix,4                * go seatch tau2 table.
       als 24                        position tau2 tag, and
       ors e                         place tau2 tag in tag word.
       cal e+4                       combine subscripts 1 and 2, and
       txi 3d0340,0                  go to fortag section.
1d0000 ldq e+3                       pickup and convert coefficients
       tsx sr6dc1,1                * (bcd to binary), and
       als 18                        then adjust them,
       sto e+3                       and store them back in e+3.
       cla e+11                      pickup addend,
       slw g                         strip off sign,
       ldq g                         convert addend
       tsx sr6dc1,1                * (bcd to binary), and then
       ldq e+11                      put sign in s-bit of mq, 
       tqp 1d0001                    if plus--skip next,
       ora 2e17                      if minus--or sign into bit 18.
1d0001 als 18                        then adjust and store
       slw e+11                      back into e+11.
       tsx tau1ix,4                * go search tau1 table.
       als 24                        position tau1 tag, and
       ors e                         place tau1 tag in tag word.
       cal e+4                       take subscript, and
       txi 3d0350,0                  go to fortag section.
notag  cal fnind                     position sigma1 tag, and
       ors e                         place sigma1 tag in tage word.
saexit lxd srx1,1                    restore the c(xr1)
       lxd srx2,2                    restore the c(xr2)
	lxd srx4,4	restore the c(xr4)
	tra 1,4	* exit to main routine.
       rem  end of program ss000.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
	rem subx00,4/ callers=c3000,c3300.
	rem subx00 adds blanks to the names of subroutines.
subx00	lxa l(6),3	prepare to count chars and shifts.
	ldq 1g	pickup subroutine name.
subx01	pxd ,0	clear the ac, and
	lgl 6	search for a blank
	sub blank	character in this name.
	tze subx03	if not blank, then
	txi subx02,1,6	update shift count, and
subx02	tix subx01,2,1	continue until 6 chars are counted.
	tra 1,4	* return to caller after 6th char.
subx03	ldq blanks	if less then 6 characterrs in name,
	lgl 36,1	shift enough blanks into the ac,
	ors 1g	and fill out name with blanks.
	tra 1,4	* return to caller.
       rem  end of program subx00.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
	rem testfx,1/ callers=ss000,c3000,iffix.
	rem testfx test for fixed or floating point variables.
testfx	cal firstc	compare first character
	cas l(h)	with h.
	cas l(o)	if greater then h, compare with o.
	tra 1,1	* if not greater then h, less then o,
	tra 1,1	* then take floating point exit.
	tra 2,1	* otherwise, take fixed point exit.
       rem  end of program testfx.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
	rem test..,4/ calls=diag. callers=c0100,c0200,c0300,c0400,c1000,
	rem c1100,c1200,c1400,c1500,c1600,c3000,c3100,c3200,c3400,lpr.
	rem test.. tests the character in the ac(30-35).
	rem test character in the ac for comma or endmark.
testa0	cas comma
	tra testa1
	tra 1,4	* return to caller.
testa1	sub endmk
	tze 1,4	* return to caller.
	tsx diag,4	* error -- go to diagnostic.
	rem test character in the ac for comma or closed parenthesis.
testb0	cas comma
	tra testb1
	tra 1,4	* return to caller.
testb1	sub clos
	tze 1,4	* return to caller.
	tsx diag,4	* error -- go to diagnostic.
	rem test character in the ac for open parenthesis or endmark.
testc0	cas open
	tra testc1
	tra 1,4	* return to caller.
testc1	sub endmk
	tze 1,4	* return to caller.
	tsx diag,4	* error -- go to diagnostic.
	rem test character in the ac for endmark.
testd0	cas endmk
err77p	tsx diag,4	* machine error, go to diagnostic.
	tra 1,4	* return to caller.
	tsx diag,4	* error -- go to diagnostic.
	rem test character in the ac for open parenthesis.
teste0	cas open
	tra teste1
	tra 1,4	* return to caller.
teste1	tsx diag,4	* error -- go to diagnostic.
	rem test character in the ac for closed parenthesis.
testf0	cas clos
	tra testf1
	tra 1,4	* return to caller.
testf1	tsx diag,4	* error -- go to diagnostic.
	rem test character in the ac for comma.
testg0	cas comma
	tra testg1
	tra 1,4	* return to caller.
testg1	tsx diag,4	* error -- go to diagnostic.
	rem test character in the ac for non-numeric.
testh0	cas l(9)
	tra 1,4	* return to caller.
	nop
	tsx diag,4	* error -- go to diagnostic.
	rem test character in the ac for numeric.
testi0	cas l(9)
	tsx diag,4	* error -- go to diagnostic.
	tra 1,4	* return to caller.
	tra 1,4	* return to caller.
       rem  end of program test...
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
	rem tet00,1/ callers=ca000,cc000,c0100,c0200,c0300,c1300,c1400,
	rem c1500,c3000,c3100,ss000,for,spc,cma,emk,lib,vra(vrd).
	rem tet00 makes entries in the tape tables. when a buffer is
	rem full it is written as a record onto tape 4.
tet00	sxd tetxr2,2	save the c(xr2),
	sxd tetxr4,4	save the c(xr4), and
	stq tetmqr	save the c(mqr).
	cla 1,1	compute table number
	als 1	times 3
	add 1,1	and
	com	place the 2s complement
	add L(1)	of this
	pax 0,2	in xr2
	cla intet,2	obtain the current
	ars 18	b (buffer capacity),
	sto tetwrk	and save it. then
	cla intet+2,2	get p (portion of buffer full),
	ars 18	and
	sub tetwrk	compare to b.
	tnz tet03	if buffer is full,
	std intet+2,2	set p = 0, and
tet01	wrs tabtap	prepare to write block on tabtap.
	lxa tetwrk,4	set xr4 = block size (b).
	cla tetwrk	add block size to 
	add intet,2	orgin of current block (o).
	sta tet02	and set address of copy loop (o+b).
	cpy 1,1	copy table num for identification.
tet02	cpy **,4	write block onto
	tix tet02,4,1	table tape, and
	iod	when done,
	cla intet+2,2	increase c (block count)
	add l(1)	by 1 for
	sta intet+2,2	block just written on table tape.
tet03	cla intet+2,2	add p (portion of buffer full)
	ars 18	to o (origin of current table
	add intet,2	buffer) to set
	sta tet05	address of entry loop (p+o).
	cla intet+1,2	obtain current a (entry address),
	sta tet04	and set address of entry loop.
	pdx ,4	set xr4 = e (entry length in wrds).
	add intet+2,2	increase p by e to account
	std intet+2,2	for following entry.
	lxd l(0),2	set xr2 = 0. then
tet04	cla **,2	move the current entry
tet05	sto **,2	into the current table buffer, and
	txi tet06,2,-1	when
tet06	tix tet04,4,1	done,
	ldq tetmqr	restore original c(mqr),
	lxd tetxr2,2	restore original c(xr2),
	lxd tetxr4,4	restore original c(xr4), and
	tra 2,1	* exit to main routine.
       rem  end of program tet00.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
	rem diagnostic callers=cd000,cb000,cc000,ca100,c0200,c0300,c090,
	rem c1000,c1200,c3000,c3100,c3200,c3400,c0150,c0160,c0180,test..,
	rem sr6dc1,drtabs,rdrx,dim.sr,ss000,roycnv,rdc,rsc,lpr,eqs,rpr,
	rem cma,emk,beg(typ),vra(vrd).
	rem (ca000 also calls the diagnostic after all statements have
	rem been processes. if there have been no previous calls to 
	rem the diagnostic during section one, then 1prime is called.)
diag	txi 4,0	* go get the diagnostic.
       rem  end of program diag.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
	rem routine to compile flow tracing instructions.
fltr00	sxd fltr05,4          save calling tag.		4f114571
	cla eifno             get last internal and external formula nos.	4f114572
	sta ent               place last efn in dec of ntr instruction.		4f114573
	ars 18			4f114574
	sta nze               place last ifn in dec of pze		4f114575
	lxd argctr,4			4f114576
	txl fltr01,4,0        is this an fn function, no skip.		4f114577
	stz 1c+2			4f114578
	cls 2e18              set address to -1		4f114579
	tra fltr03			4f11457a
fltr01	cla sbdfcn            is this a main program or subprogram.		4f11457b
	tnz fltr02            skip on subprogram		4f11457c
	stz 1c+2              set address to 0		4f11457d
	stz 1c+3			4f11457e
	tra fltr04			4f11457f
fltr02	cla dolsgn            set address to $+2		4f11457g
	sto 1c+2			4f11457h
	cla d2			4f11457i
fltr03	sto 1c+3              set relative address word of cit.		4f11457j
fltr04	tsx cit00,4				4f11457k
	pze l(0)              compile      ntr  *+2,0,efn		4f11457l
	pze ent			4f11457m
	pze 15p			4f11457n
	pze d2			4f11457o
	tsx cit00,4			4f11457p
	pze l(0)              compile    pze  alpha,0,ifn		4f11457q
	pze nze               where alpha is 0 for main program, $+2 for		4f11457r
	pze 1c+2              subprogram, or -1 for fn function in either		4f11457s
	pze 1c+3              main or subprogram.		4f11457t
	lxd fltr05,4			4f11457u
fltr05	txi cit00,4           go compile    lxd M(,4  or  7(type=,4		4f11457v
	rem			4f11457w
	rem			4f11458
       rem  end of the common part of section one.
	rem
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
	rem section 1 / initialization = 
	rem 704 fortran master record card / initizlization = f0150000.
	org 0			4f114641
	pze forsub,,1tocs			4f114642
	pze dmwr98			4f114643
	org forsub			4f11465
	rem initialization occupies forsub buffer and is written over
	rem by forsub entries if there are any fortran functions in the
	rem program.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       rem 
	rem part i / clear drums 1,2,3,4, and rewind tapes 2,3,4 =
cldr00	lxa cldr07,1	clear drums 1,2,3,4 to +0.
cldr01	wrs 197,1	x
	lxd cldr07,2	x
cldr03	cpy cldr08	x
	tix cldr03,2,1	x
	tix cldr01,1,1	x
	rew 146	rewind working tapes 2,3,4.
	rew 147	x
	rew 148	x
       rem  end of initialization / part 1.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem part 2 / write states a,b,c,d on drums1,3,4,2=
dmwr01	lxa l(3),4	prepare to write state d on drum 2.
	tra dmwr11	x
dmwr03	lxa l(1),4	prepare to write state c on drum 4.
	tra dmwr11	x
dmwr06	lxa l(2),4	prepare to write state b on drum 3.
	tra dmwr11	x
dmwr09	lxa l(4),4	prepare to write state a on drum 1.
	cla dmwr98	this is final state to be written,
	sta dmwr40	change address to get out of loop.
dmwr11	cla zeta+4,4	get length of current state.
	pdx ,2	length of current state.
	sxd check,2	save length.
	ars 18	length + origin to prepare for ck
	add mtr3	sum and copy loops.
	sta dmwr20	x
	sta dmwr26	x
	pxd ,0	clear ac and compute ck sum.
dmwr20	acl **,2	x
	tix dmwr20,2,1	x
	slw drcksm	x
	lxa drmerc,1	set for five attempts.	
dmwr23	wdr 5,4	prepare to write drum.
	lxd check,2	x
	lda zeta+4,4	x
	cpy drcksm	write ck sum on drum.
dmwr26	cpy **,2	write state on drum.
	tix dmwr26,2,1	x
	rdr 5,4	prepare to read state back.
	lxd check,2	x
	lda zeta+4,4	x
	pxd ,0	clear ac and read back ck sum and
	cad garbge	state.
	com	x
dmwr32	cad garbge	recompute ck sum.
	tix dmwr32,2,1	x
	com	x
dmwr40	tze 1tocs	* ck sum agree, go get next state.
	tix dmwr23,1,1	ck sum failed, try up to 5 times.
	cla dmwr89	set monitor to return to this
	sto statea	program instead of to state a.
	txl dmwr80,4,3	test for state a in progress.
	tsx diag,4	* state a cannot be written on drum1.
dmwr80	txl dmwr82,4,2	test for state d in progress.
	rtb 1	space over state c record.
	rtb 1	space over state b record.
	rtb 1	space over state a record.
	tsx diag,4	* state d cannot be written on drum2.
dmwr82	txl dmwr84,4,1	test for set b in progress.
	rtb 1	space over state a record.
	tsx diag,4	* state b cannot be written on drum3.
dmwr84	rtb 1	space over state b record.
	rtb 1	space over state a record.
	tsx diag,4	* state c cannot be written on drum4.
dmwr88	lxa l(0),4	set ir4 to 0 to cause diagnostic to
	tra diag	* print end line and stop
dmwr99	tsx ca100,4	* go to subroutine to load ft region.
	tra ca010	* go begin state a of section one.
       rem  end of initialization / part 2.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem part3 / variables and constants used by initialization=
garbge	bss 1	eraseable storage.
check	pze ,,**	saving cell for length of state.
cldr07	pze 4,,2048	constant for clearing drums.
cldr08	pze 0	constant for clearing drums.
dmwr89	tra dmwr88	constant for error routine.
dmwr90	pze dmwr99	constant for address modification.
       rem  end of initialization / part 3.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem
	rem section 1 / statea =
	rem 704 fortran master record card / state a = f0190000.
	org 0			4f115571
	pze orga,,dmwr09			4f115572
	pze enda-1			4f115573
	rem					4f11558
	rem name	function
	rem part 1 / assemble and classify all statements=
	rem ca000	assemble statement.
	rem cd000	scan for hollerith and illegal chs.
	rem cb000	classify=arithmetic/non-arithmetic.
	rem cc000	classify=which non-arithmetic.
	rem part 2 / process control and specification statements.
	rem c0100	do.
	rem c0200	go to.
	rem c0300	if.
	rem c0400	if (sense switch.
	rem c0500	if (sense light.
	rem c0600	if divide check.
	rem c0700	if ac overflow.
	rem c0800	if mq overflow.
	rem c0900	pause.
	rem c1000	assign.
	rem c1100	sense light.
	rem c1200	dimension.
	rem c1300	stop.
	rem c1400	frequency.
	rem c1500	equivalence.
	rem c1600	continue.
	rem c3000(c3500)	subroutine / function.
	rem c3100	common.
	rem c3200	return.
	rem c3300	call.
	rem c3400	end.
	rem part 3 / process input-output statements=
	rem rdc	read card
	rem rit	read input tape.
	rem rdp	print.
	rem wot	write output tape.
	rem pdc	punch.
	rem wbt	write tape.
	rem rbt	read tape.
	rem wrd	write drum.
	rem rdd	read drum.
	rem eft 	end file.
	rem rwn	rewind.
	rem bsp	backspace.
	rem for	format.
	rem rsc	reset and scan.
	rem listr	control for list scan.
	rem lpr	left parentheses in list scan.
	rem eos	equal sign in list scan.
	rem spctr	control for specification scan.
	rem spc	subscript specifications.
	rem rpr	right parenthesis in list scan.
	rem cma	comma in list scan.
	rem emk	endmark in list scan.
	rem part 4 / subroutines used by state a=
	rem beg(typ),4	begin scan and type test.
	rem begtr	control for beginning scan.
	rem brw,4	binary read or write compiler.
	rem bss,2	compiles= ifn bss 0.
	rem ca100,4	read source program tape.
	rem cc500,4	scan dictionary.
	rem etm(ltm)sw,4	if sw=nop, compiles etm(ltm). sl=0.
	rem iffix,1	sets up forvar or forval entry.
	rem in(out)put,2	compiles cal *, and xit (lev).
	rem lib,1	makes closub entry, compiles cit.
	rem vra(vrd),4	makes forvar, fixcon, cit entries.
	rem part 5 / constants and variables used by state a.
	rem dic	dictionary.
	rem t	transfer table.
	rem
	rem the following conventions are used in this listing=
	rem
	rem ** in address, tag, or decrement of an instruction
	rem indicates that this field will be modified by the program.
	rem * in col/36 indicates the instruction is a transfer out of
	rem this logical block or subroutine.
	rem c in col/34 indicates the instruction was corrected.
	rem p in col/32 indicates the instruction was inserted (patch).
	rem
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem statea/1-assemble and classify all statements=
orga	org 1824
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem ca000/ calls=ca100,sr6dc1,tet00,diag.
	rem ca000 assembles statement in the f-region and assigns an ifn.
ca010	lxd endwrd,4	if the final statement has been
	txl diag,4,0	* processed, the go call diagnostic.
	lxd eifno,1	keep interal formula number
	txi ca013,1,1	(decr part of eifno)
ca013	sxd eifno,1	up to date by adding 1.
	cal ft	 obtain hollerith coded 5-digit
	ars 6	external formula no in acc.
	slw f-1	and retain in f-01.
	lxd dcf,1	initialize index a to compl of f.
ca018	lxa l(11),2	set up loop for 11 cycles.
ca019	ldq ft+12,2	move word from region ft
	stq 0,1	to region f.
	tix ca020,1,1	keep f-region address up-to-date.
ca020	tix ca019,2,1	test end of loop.
	tsx ca100,4	* go read next non-blank card.
	cal ft	test rightmost character of
	ana l(63)	first word for continuation mark,
	tze ca021	if zero or blank,
	sub ablank	discontinue reading,
	tnz ca018	otherwise continue.
ca021	cla blanks	begin scanning region f backwards
ca022	cas -1,1	to find first non blank word.
	tra ca023	not blank.
	txi ca022,1,1	blank, so continue scan.
ca023	ldq 36ones	place binary ones in first word
	stq 0,1	following rightmost nonblank word.
	cal f-1	pick up external formula number and
	cas 5blans	compare with /0     /.
	tra ca015	not compare.
	tra cd000	* take extformno, if any and
ca015	lrs 35	go to conversion subroutine and
	tsx sr6dc1,1	* return here with result in acc.
	sta eifno	store result in address of eifno.
	tsx tet00,1	* go to program tet to enter eifno
	pze 0	into table teifno (table o).
	rem end of program ca000.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem cd000/ calls=c0190x,c0190,diag.
	rem cd000 scans for hollerith and illegal characters.
cd000	tsx c0190x,4	* set scan to pick up 1st character.
cd001	tsx c900,1	* if not endmark or illegal character
	cas comma	scan
	txi cd002,0	for
	txi cd003,0	hollerith
cd002	sub open	specification
	tnz cd001	which
cd003	tsx cd900,1	* can be=
	sub l(10)	, n h
	tpl cd001	or = ( n h.
cd004	tsx cd900,1	* if not endmark or illegal character
	cas l(9)	continue scan.
	txi cd005,0	n
	txi cd004,0	is
	txi cd004,0	a
cd005	cas l(h)	fixed
	txi cd001+1,0	point
	txi cd700,0	integer.
	txi cd001+1,0	x
cd700	tsx c0194	* go get next nonblank character,
	cas endmk	and if endmark,
	txi cd701,0	then skip
	txi cc000,0	* to non-arithmetic classification.
cd701	tsx cd600,1	* since hollerith has been found,
	txi cd700,0	then $ is legal in format test.
cd900	tsx c0190,4	* obtain next nonblank character,
	cas endmk	and if not
	txi cd800,0	endmark, then skip
	txi cb000,0	* exit to arith/non-arith scan.
cd800	cas specop	check for $
	txi cd601,0	which, unless holerith, is an
	tsx diag,4	* error -- go to diagnostic.
cd600	cas pm	check for record mark
	tra 1,1	which is an
	tsx diag,4	* error -- go to diagnostic.
cd601	cas char3	check for minus zero
	tra 1,1	which is an
	tsx diag,4	* error -- go to diagnostic.
	cas char2	check for plus zero
	tra 1,1	which is an
	tsx diag,4	* error -- go to diagnostic.
	cas minus	check for minus sign
	tra 1,1	which is an 
	tsx diag,4	* error -- go to diagnostic.
	sub ten	check for ten
	tnz 1,1	which is an
	tsx diag,4	* error -- go to diagnostic.
	rem  end of program cd000.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem cb000/ calls=c0190x,c0190,diag.
	rem cb000 classifies statement as arithmetic or non-arithmetic.
cb000	lxa l(1),1	set xr to count parentheses.
	tsx c0190x,4	* reset chctr and fwa to begin scan.
cb001	tsx c0190,4	* examine next non-blank character.
	cas aequal	if an equal sign,
	txi cb005,0	then
	txi cb200,0	go test paren-count.
cb005	cas alpar	if a left parenthesis,
	txi cb006,0	then
	txi cb001,1,1	update paren-count by 1.
cb006	cas arpar	if a right parenthesis,
	txi cb007,0	then
	txi cb500,0	go test paren-count.
cb007	sub endmk	if not endmark, then
	tnz cb001	go examine next character.
	txi cc000,0	* otherwise, go to dic look-up.
cb200	tix cc000,1,1	* if equal was not within parens,
cb201	tsx c0190,4	* then examine next character.
	cas alpar	if left parenthesis,
	txi cb205,0	then
	txi arith,0	* this is an arithmetic formula.
cb205	cas acomma	if a comma,
	txi cb206,0	then
	txi cc000,0	* go to non-arithmetic dic look-up.
cb206	sub endmk	if not endmark, then
	tnz cb201	go examine next character.
	txi arith,0	* this is an arithmetic formula.
cb500	tix cb001,1,1	 if paren-count does not balance,
	tsx diag,4	* error-go to diagnostic routine.
	rem  end of program cb000.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem cc000/ calls=cc500,c0190x,diag,c0190,tet00.
	rem cc000 classifies statement as to which non-arithmetic.
cc000	stz 2g	set dictionary word tag, and
	lxa l(0),3	character count and entry count.
cc001	tsx c0190x,4	* reset chctr and fwa to begin scan.
	tsx cc500,4	* examine next dictionary character.
	cas endmk	test for consecutive endmarks.
	tra err77p	* machine error, go to diagnostic.
	tsx diag,4	* error = not found in dictionary.
	txi cc004,4	go begin comarision.
cc002	tsx cc500,4	* examine next dictionary character.
	cas endmk	test for end of dic entry.
	txi err77p,0	* machine error, go to diagnostic.
	txi cc007,0	if end of entry, look no further.
cc004	sto 1c	otherwise, save character
	stq 1c+1	and remainder of dictioanry word.
	tsx c0190,4	* go get next formula character,
	ldq 1c+1	and restore dictionary word.
	sub 1c	if charcaters are equal,
	tze cc002	then go compare next character.
cc005	tsx cc500,4	* otherwise, examine next dic char.
	sub endmk	continue until an endmark is
	tnz cc005	found, then
	txi cc001,1,-1	count entry, and begin again.
cc007	cla t,1	if the current statement is
	tpl t,1	of the non-excutable type,
	sxd 1c+2,1	then
	tsx tet00,1	* go enter eifno in the 
	pze 14	nonexc table.
	lxd 1c+2,1	and then
cc008	tra t,1	* take indicated transfer.
	rem  end of program cc000.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem statea/2-process control and specification statements=
	rem
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem c0100/ calls=getifn,c0190,test..,c0180,c0160,c0150,tet00.
	rem c0100 processes do statements.
c0100	tsx getifn,4	* get internal formula number in 1c.
	tsx c0190,4	* obtain 1st non-blank character
	tsx testi0,4	* which should be numeric.
	tsx c0180,2	* obtain in 1g the bin equiv of beta.
	sto 2g	save the 1st char of subscript.
	cla 1g	take converted result for beta
	sta 1c	and store in addr of 1c.
	cla 2g	1c is now compete except for tag.
	tsx c0160,2	* obtain in 1g the subscript.
	cla 1g	store subscript
	cto 1c+1	 in 1c+1.
	tsx c0150,2	* obtian in 1g the proper n1.
	cla 1g	store n1
	sto 1c+2	in 1c+2.
	cal i	obtain i in logical acc and
	ars 18	store in pos 18 of 1c
	ors 1c	0 if numeric, or 1 if non-numeric.
	tsx c0150,2	* obtain in 1g the proper n2.
	tsx testa0,4	* test the ac for comma or endmark.
	tnz c0113	if endmark, then
	rql 31	create one in mq for n3
	stq residu	and place in residu.
c0113	cla 1g	store n2
	sto 1c+3	in 1c+3.
	cal i	obtain i in log acc and
	ars 19	store in pos 19 of 1c
	ors 1c	0 if numeric, or 1 if non-numeric.
	tsx c0150,2	* obtain in 1g the proper n3.
	tsx testd0,4	* the ac should contian an endmark.
	cla 1g	store n3
	sto 1c+4	in 1c+4.
	cal i	obtain i in log acc and
	ars 20	store in pos 20 of 1c
	ors 1c	0 if numeric, or 1 if non-numeric.
	tsx tet00,1	* go to tet program to enter
	pze 1	1c,1c+1,..1c+4 in tdo table 1.
	txi ca010,0	* exti to process next statement.
	rem  end of program c0100.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem c0200/ calls=getifn,diag,test..,c0190,c0180,tet00,c0160,
	rem cit00,ss000(csa000).
	rem c0200 processes go to statements.
c0200	tsx getifn,4	* get internal formula number in 1c
	sto 1c+2	and in 1c+2.
	tsx c0190,4	* obtain in acc next nb character
	cas l(9)	and compare it with 9.
	txi c0205,0	if non-numeric, go compare with (.
	nop	if numeric, then
	tsx c0180,2	* obtain in 1g the binary equv beta.
	tsx testd0,4	* the ac should contain an endmark.
	cla 1g	store beta in 1c+1 to construct
	sto 1c+1	the 2nd word of tifgo table entry.
	txi c0202,0	go  to enter 1c,1c+1 into tifgo.
c0205	cas alpar	test character for alphabetic.
	txi c0210,0	if not alphabetic, then
	txi c0212,0	this is type= go to ( ), i.
c0210	tsx c0160,2	* type= go to n,(),so obtain in 1g n
	tsx testg0,4	* which should be followed by comma.
	cla 1g	save the symbol n in 1c+3
	sto 1c+3	for compiled instruction.
	tsx c0190,4	* obtain in acc next nb character,
	tsx teste0,4	* which should be a lparan.
	cla l(1)	prepare to set address part of 1c
	tra c0213	to 1 to indicate class of transfer.
c0212	cla l(2)	prepare to set addr of 1c to 2.
c0213	sta 1c	store 1 or 2 in addr of 1c.
	lxd ctran,2	obtain 250-(no. trad entries), and
	pxd ,2	place in the decrement of the ac
	sto 1c+1	and store in 1c+1.
c0215	tsx c0190,4	* obtain in acc next nb char.
	tsx c0180,2	* obtain in 1g the bin equ of beta.
	sto 2g	save char in acc.
	tsx tet00,1	* go to enter 1g
	pze 3	into trad table (table 3).
	lxd ctrad,2	reduce counter
	tix c0216,2,1	ctrad
c0216	sxd ctrad,2	by 1.
	cla 2g	restore char to acc.
	tsx testb0,4	* test for comma or rparen.
	tnz c0215	if right parenthesis, then
	cla ctrad	obtain in addr of acc 250-no. of
	ars 18	entries in trad table,and store
	sta 1c+1	in addr of 1c+1.
	cla 1c	obtain 1c in acc
	lbt	and test low order bit.
	tra c0220	this is a type go to (),i formula.
	tsx c0190,4	* obtain next nb char and
	tsx testd0,4	* test for endmk.
	tsx cit00,4	* go make the following cit entry=
	pze 1c+2	word 1--decr= intformnn (location)
	pze l(tra)	word 2--tra00p (op and decr)
	pze 1c+3	word 3--variable n (address)
	pze l(0)	word 4--00000 (rel addr and tag).
	tra c0202	go to enter 1c,1c+1 into tifgo.
c0220	tsx c0190,4	* examine next nb character,
	tsx testg0,4	* which should be a comma.
	tsx c0190,4	* obtain in acc next nb char, and
	tsx c0160,2	* obtain in 1g the fxf-pt. variable.
	tsx testd0,4	* which should be followed by endmk.
	cla l(1)	prepare proper form of subscript
	sto e+3	combination as
	sto dimctr	input to subscript analysis=
	cla 1g	e+3 = 1st coefficient.
	sto e+4	e+4 = 1st subscript variable,
	stz e+9	e+9 = addend of subscript,
	tsx csa000,4	* dimctr = dimension of variable.
	cla e	output from csa is found in
	ars 24	e = i--tautag (general tag) 1-11.
	sto 2g	adjust and save for comp. instr.
	tsx cit00,4	* go make the following cit entry=
	pze 1c+2	word 1--decr-intformno(location)
	pze l(tra)	word 2--tra000(op and decr)
	pze l(0)	word 3--000000(address)
	pze 2g	word 4--addr = tautag for i
	rem c0200= entry point used by c0400,c1000.
c0202	tsx tet00,1	* go to tet to enter 1c and 1c+1
	pze 2	into tifgo table (table 2).
 ctrad	txi ca010,0,250	* exit to process next statement.
	rem  end of program c0200.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem c0300/ calls=-c0190x,c0190,c0390,test..,diag,c0180,tet00,
	rem stateb.
	rem c0300 processes if statements.
c0300	lxd eifno,4	place the current internal formula
	pxd ,4	number in the decrement of 1c
	ssm	with sign set to minus
	sto 1c	for future tifgo entry.
	tsx c0190x,4	* set chctr and fwa to begin scan.
	tsx c0190,4	* obtain in ac the 1st nb char (i).
	ldq l(x)	replacw the character i
	tsx c0390,4	* with the character x.
	ldq l(10)	repalce the character f
	tsx c0390,4	* with the character 001010.
	tsx teste0,4	* if not lparen -- then error.
	ldq aequal	replace the character lparan
	tsx c0390,4	* with the character equal.
	lxa l(1),2	set xr2 for counting parentheses.
	tra *+2
c0302	tsx c0190,4	* make sure that next nb character
	cas endmk	is not an endmark.
	tra err77p	* machine error, go to diagnostic.
	tsx diag,4	* program error, go to diagnostic.
	cas alpar	if it is a lparen,
	txi c0303,0	then add 1 to paren count, and
	txi c0302,2,1	go examine next character.
c0303	sub arpar	if it is a rparen,
	tnz c0302	the test paren count, and if it
	tix c0302,2,1	can not be reduced,mate is found.
	ldq endmk	so replace the character rparen
	tsx c0390,4	* with the character endmk.
	tsx c0180,2	* binary equivalent of beta 1.
	tsx testg0,4	* this should be followed by a comma.
	cla 1g	move beta1
	sta 1c	to address of 1c.
	tsx c0190,4	* and proceed to form
	tsx c0180,2	* the binary equivalent of beta 2.
	tsx testg0,4	* this should be follwed by a comma.
	cla 1g	move beta2
	als 18	to decr part
	sto 1c+1	of 1c+1.
	tsx c0190,4	* and proceed to form
	tsx c0180,2	* the binary equivalent of beta 3.
	tsx testd0,4	* this should be followed by endmark.
	cla 1g	move beta3
	sta 1c+1	to address of 1c+1.
	txi arith,0	* exit to arith for final processing.
	rem  end of program c0300.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem c0400/ calls=c0190,c0180,test..,cit00,c0200.
	rem c0400 processes if (sense switch statements.
c0400	cla l(112)	for sense switch
	sto 1h	set 1h to 112, and prepare to
	cla l(pse)	set 2h to pse.
	rem c0401= entry point used by c0500.
c0401	sto 2h	set 2h for sense switch or light.
	tsx c0190,4	* proceed to form the binary
	tsx c0180,2	* equivalent of sw or sl number.
	tsx testf0,4	* this should be followed by rparen.
	cla l(3)	store 3
	sto 1c	in address of 1c.
	cla 1g 	add the proper increment to the
	add 1h	number of sense switch or light,
	als 18	and adjust to the decrement.
	rem c0402= entry point used by c0600.
c0402	sto 1c+3	set 1c+3 for cit entry.
	lxd eifno,4	place the current internal formula
	pxd ,4	number in the decrement of
	std 1c	 1c for future tifgo entry, and
	sto 1c+2	1c+2 for future cit entry.
	tsx c0190,4	* proceed to form the binary
	tsx c0180,2	* equivalent of beta 1,
	tsx testg0,4	* which should be followed by comma.
	cla 1g	bring up,
	als 18	adjust and
	sto 1c+1	store beta1 in decr of 1c+1.
	tsx c0190,4	* proceed to form the binary
	tsx c0180,2	* equivalent of beta 2,
	tsx testd0,4	* which should be followed by endmk.
	cla 1g	bring up and
	sta 1c+1	store beta2 in addr of 1c+1.
	tsx cit00,4	* go make the following cit entry=
	pze 1c+2	word1--decr = intformno (location)
	pze 2h	word2--pse,mse,dct,tov,or tqo.
	pze l(0)	word3--000000 (address)
	pze 1c+3	word4--decr=ss or sl no., or 000000
	txi c0202,0	* make tifgo entry, and return to ca.
	rem  end of program c0400.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem c0500/ uses=c0400.
	rem c0500 processes if (sense light statments.
c0500	cla l(96)	store 96 in
	sto 1h	1h and
	cla l(mse)	obtain (mse000) in acc.
	tra c0401	* and continue by using program c04.
	rem  end of program c0500.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem c0600/ uses=c0400.
	rem c0600 processes if divide check statements.
c0600	cla l(dct)	store (dct000)
	sto 2h	in 2h
	cla l(4)	and pick up 4 to set 1c.
	rem c0601= entry point used by c0700.
c0601	sto 1c	set 1c for future tifgo entry.
	pxd ,0	clear the ac,
	tra c0402	* and continue by using program c04.
	rem  end of program c0600.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem
	rem c0700/ uses c0600.
	rem c0700 processes if ac overflow statements.
c0700	cla l(tov)	pickup tov000 to set 2h.
	rem c0701= entry point used by c0800.
c0701	sto 2h	set 2h for future cit entry.
	cla l(5)	pickup 5 to set 1c, and
	tra c0601	* continue by using program c06.
	rem  end of program c0700.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c0800/ uses=c0700.
	rem c0800 processes if mq overflow statements.
c0800	cla l(tqo)	pickup tqo000 to set 2h,
	tra c0701	* and continue by using program c07.
	rem  end of program c0800.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c0900/ calls=c0190,cit00,diag. caller=c1300.
	rem c0900 processes pause statements.
c0900	lxd c090x,2	set xr2 for exit to ca000.
	rem c0901= entry point used by c1300.
c0901	stz 1g	clear 1g.
c0902	tsx c0190,4	* test next non-blank character
	cas endmk	for end of statement mark.
	tra err77p	* machine error, go to diagnostic.
c090x	txi c0903,0,-ca010+1	if not end of statement, then
	add 1g	add 1g to digit,
	als 3	multiply by 8.
	sto 1g	and store back in 1g.
	txi c0902,0	continue until end of statement.
c0903	cla 1g	then place octal alpha
	als 15	in the decrement
	sto 1c	of 1c for future cit entry.
	lxd eifno,4	place the current internal formula
	pxd ,4	number in the decrement
	sto 1c+1	of 1c+1,with zeros elsewhere.
	tsx cit00,4	* go make the following cit entry=
	pze 1c+1	word1--decr = intformno (location)
	pze l(hpr)	word2--hpr000 (op and decr)
	pze l(0)	word3--000000 (address)
	pze 1c	word4--decr = alpha, rest zeros.
	tra 1,2	* exit to ca000, or to c1300.
	rem  end of program c0900.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c1000/ uses=c0200. calls=getifn,c0190,c0180,diag,c0190,test..
	rem cit00.
	rem c1000 processes assign statements.
c1000	tsx getifn,4	* get internal formula number in 1c
	sto 1c+2	 and 1c+2,with zeros elsewhere.
	cla l(6)	store 6 in
	sta 1c	address of 1c.
	tsx c0180x,2	* go form binary equiv of alpha.
	sub l(t)	if next character is not t, then	4f12093
	tze *+2	this is an 
	tsx diag,4	* error - go to the diagnostic.
	tsx c0190,4	* examine next non-blank character
	sub l(0)	and if it is not 0, then
	tnz *-3	error, go to diagnostic.
	cla 1g	put bin equiv of alpha
	sto 1c+1	in address of 1c+1.
	tsx c0190,4	* proceed to assemble in 1g
	tsx c0160,2	* the symbol n.
	tsx testd0,4	* the next nb char should be endmk.
	tsx cit00,4	* go make the following cit entry=
	pze 1c+2	word1--decr = intformno (location)
	pze l(cla)	word2--cla000 (op and decr)
	pze l(0)	word3--000000 (address)
	pze l(0)	word4--000000 (reladdr and tag).
	tsx cit00,4	* store second compiled instruction=
	pze l(0)	word1--000000  (all zeros)
	pze l(sto)	word2--sto000 (op and decr)
	pze 1g	word3--symbol n (address)
	pze l(0)	word4--000000 (rel addr and tag).
	tra c0202	* continue by using program c02.
	rem  end of program c1000.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c1100/ calls=c0190,c0180,test..,getifn,cit00.
	rem c1100 processes sense light statments.
c1100	tsx c0180x,2	* go form binary equiv of sl number.
	tsx testd0,4	* the next nb character shd be endmk.	4f12122
	cla 1g	store sense light number
	add l(96)	plus 96
	als 18	in decr
	sto 1g	of 1g.
	tsx getifn,4	* get internal formula number in 1c.
	tsx cit00,4	* go make the following cit entry.
	pze 1c	word1--decr = intformno (location)
	pze l(pse)	word2--pse000 (op and decrement)
	pze l(0)	word3--000000 (address part)
	pze 1g	word4--decr = 96+alpha,rest zeros.
	txi ca010,0	* exit to process next statement.
	rem  end of program c1100.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c1200/ calls=c0190,c0160,test..,dim.sr,diag,c0180,drtabs.
	rem c1200 processes dimension statements.
c1200	tsx c0190,4	* proceed to assemble in 1g
	tsx c0160,2	* the variable symbol.
	tsx teste0,4	* next nb character should be lparen.
	cla 1g	put variable symbol
	sto 1c	in 1c.
	sto e+2	also in e+2. then
	tsx dim1sr,4	* go search dim1 table.
	tra c1280	then if not
	tra c1299	found,
c1280	tsx dim2sr,4	* go search dim2 table.
	tra c1281	then if not
	tra c1299	found,
c1281	tsx dim3sr,4	* go search dim3 table.
	tra c1282	do not contuinue if
c1299	tsx diag,4	* variable previously appeared.
c1282	tsx c0180x,2	* go form binary equiv of d1.
	sub clos	if not 1 dimension,
	tze c1210	then
	cla 1g	put d1
	als 18	in decr
	sto 1c+1	of 1c+1.
	tsx c0180x,2	* go form binary equiv of d2.
	sub clos	if not 2 dimension,	4f12163
	tze c1220	then
	cla 1g	put d2
	sta 1c+1	in address of 1c+1.
	tsx c0180x,2	* go form binary equiv of d3.	4f12168
	sub clos	if more than 3 dimensions,
	tze *+2	this is an
	tsx diag,4	* error - go to the diagnostic.
	cla 1g	if 3 dimension, put d3
	sto 1c+2 	in 1c+2, and
	tsx dim3ix,4	* go make dim3 entry.
	txi c1201,0	go to test for end of statement.
c1210	cla 1g	if 1 dimension, put d1
	sto 1c+1	in 1c+1, and
	tsx dim1ix,4	* go make dim1 entry. then
	txi c1201,0	go to test for end of statement.
c1220	cla 1g	if 2 dimensions, put d2 in
	sta 1c+1	address part of 1c+1. and
	tsx dim2ix,4	* go make dim2 entry. then
c1201	tsx c0190,4	* obtain nb char following rparen.
	tsx testa0,4	* test for comma or endmark.
	tnz c1200	if character is endmakr, then
	txi ca010,0	* exit to process next statment.
	rem  end of program c1200.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c1300/ calls=c0901,tet00,cit00.
	rem c1300 processes stop statements.
c1300	tsx tet00,1	* go make eifno entry
	pze 15	in tstop table.
	tsx c0901,2	* use c0900 to begin processing.
	tsx cit00,4	* go make following cit entry=
	pze l(0)	word1--all zeros
	pze l(tra)	word2--tra000 (op+decr)
	pze 1c+1	word3--decr = intformno (symbol)
	pze l(0)	word4--zeros (rel addr and tag)
	txi ca010,0	* exit to process next statement.
	rem  end of program c1300.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c1400/ calls=c0190,c0180,test..,tet00.
	rem c1400 process frequency statements.
c1400	tsx c0180x,2	* go form binary equiv of efn.
	tsx teste0,4	* character should be a lparen.	4f12208
	cls 1g	change sign of symbol
	sto 1g	to minus.
	tsx tet00,1	* go to program tet to enter
	pze 7
c1401	tsx c0180x,2	* go form binary equiv of m(1).
	STO 1C	Save char in acc.	4f12215
	tsx tet00,1	* go to program tet to enter m(1)
	pze 7	into table fret (table7), and
	cla 1c	restore char in acc, and
	tsx testb0,4	* test for , or ).
	tnz c1401	if right parenthesis, then
	tsx c0190,4	* obtain in acc next nbchar, and
	tsx testa0,4	* test for comma or endmark.
	tnz c1400	if endmake, this statement is done.
	txi ca010,0	* exit to process next statement.
	rem  end of program c1400.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c1500/ calls=c0190,test..,c0160,c0180,tet00.
	rem c1500 processes equivalence statements.
c1500	tsx c0190,4	* obtain next nbchar in acc.
	tsx teste0,4	* character should be a lparan.
c1501	cla l(1)	initialize 1c
	sto 1c+1	to 1.
	tsx c0190,4	* obtain next nbchar in acc and
	tsx c0160,2	* obtain in 1g the symbol v.
	ldq 1g	move v
	stq 1c	into 1c.	
	cas alpar	examine character left in the ac,
	txi c1503,0	and if
	txi c1502,0	character is a left parenthesis,
	tix c1503,0	then
c1502	tsx c0180x,2	* go form binary equiv of n.
	tsx testf0,4	* 1st non-numeric should be a rparen.	4f12244
	cla 1g	put bin equiv of n
	sto 1c+1	in 1c+1.
	tsx c0190,4	* obtain next nbchar in ac, and
c1503	tsx testb0,4	* test for comma or rparen.
	tze c1504	if comma, then
	tsx tet00,1	* go to program tet to enter symbol
	pze 8	and n in equit (table 8), and
	txi c1501,0	return to continue processing x.
c1504	cls 1c+1	make sign of n minus since
	sto 1c+1	this is last item.
	tsx tet00,1	* go to program tet to enter symbol
	pze 8	and n in equit (table 8), and
	tsx c0190,4	* obtain next nbchar in acc, and
	tsx testa0,4	* test for comma or endmark.
	tnz c1500	if endmark, then
	txi ca010,0	* exit to process next statement.
	rem  end of program c1500.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c1600/ calls=c0190,test..,gif,bss.
	rem c1600 processes continue statements.
c1600	tsx c0190,4	* obtain next nbchar in acc.
	tsx testd0,4	* character should be an endmark.
	tsx gif,4	* get internal formula number, and
	tsx bss,2	* go compile= ifn bss 0.
	txi ca010,0	* exit to process next statement.
	rem  end of program c1500.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c3000/ calls=diag,c0190,c0160,test..,subx00,tet00,testfx.
	rem c3000 processes subroutine and function statements.
c3500	cal txhop
	stp c3003
c3000	lxd eifno,4	examine internal formula no., and
	txl *+2,4,1	if not the 1st statement, then
	tsx diag,4	* error - go to diagnostic.
	cla argcnt	set argcnt to indicate to later
	ssp	return that there was a preceeding
	sto argcnt	subroutine or function statement.
	tsx c0190,4	* if 1st character of name is
	tsx testh0,4	* numeric, then go to the diagnostic.
	tsx c0160,2	* assemble name in 1g.
	tsx testc0,4	* next char shd be lparen or endmark.
c3003	txl *+3,0
	cla 1g
	sto fsname
	tsx subx00,4	* fill out name with blanks.
	tsx tet00,1	* go enter name
	pze 11	in subdef table.
	lxd eifno,4	place
	pxd ,4	internal formula number
	sto g	in g.
	txi c3003,0	go test for end of statement.
c3001	add endmk	if not endmark, restoere character
	tsx testh0,4	* which should be non-numeric
	sto firstc	1st character of argument.
	tsx c0160,2	* assemble argument in 1g.
	tsx tstb0,4	* next char shd be comma or rparan.
	cla 1g	 move argument
	sto g+1	into g+1.
	tsx testfx,1	* go test for fixed or floating pt.
	txi c3004,0	if floating pt., skip forval entry.
	tsx tet00,1	* if fixed point, go make entry
	pze 6	in forval table.
c3004	tsx tet00,1	* in both cases, make entries in
	pze 11	subdef table.
	cla argcnt	update
	add d1	argument count
	sto argcnt	by 1. and
c3002	tsx c0190,4	* examine next non-blank character.
	sub endmk	if not endmark, then
	tnz c3001	go process next argument.
	txi ca010,0	* otherwise, exit to ca000.
	rem  end of program c3000.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c3100/ calls=c0190,diag,test..,c0160,tet00.
	rem c3100 processes common statements.
c3100	tsx c0190,4	* get first non-blank char of symbol
	tsx testh0,4	* which should be non-numeric.
	tsx c0160,2	* assemble symbol in 1g, and test
	tsx testa0,4	* next character for comma or endmk.
	pax ,4	save result of test in xr4, and
	tsx tet00,1	* go enter this symbol
	pze 12	in common table.
	cla sbdfcn	any entries in subdef	4f123291
	tze c3101	indicate this is not a 	4f123292
	cla 2e18	main program. since this	4f123293
	sto g	is a common	4f123294
	cal 1g	statement which	4f123296
	slw g+1	appears in a subprogram	4f123297
	ars 30	enter any	4f123298
	tsx testfx+1,1	* fixed point	4f123299
	tra c3101	variables	4f12330
	tsx tet00,1	* in	4f123301
	pze 6	forval table.	4f123302
c3101	txh c3100,4,0	if character was comma, repeat.	4f123303
	txi ca010,0	* if endmk, exit to ca000.	4f12331
	rem  end of program c3100.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c3200/ calls=c0190,test..,getifn,diag,cit00,jif(gif).
	rem c3200 processes return statements.
c3200	tsx c0190,4	* examine next non-blank character,
	tsx testd0,4	* which should be an endmark.
	tsx getifn,4	* get internal formula number in 1c.
	tsx jif,4	* set sl to alpha+1.
	cla argcnt	test argcnt for preceeding
	tpl *+2	subroutine - if none, then
	tsx diag,4	* error - go to the diagnostic.
	cla fsname
	tze *+7
	tsx cit00,4	* go make the following cit entry=
	pze 1c	word1--0(ifn)000
	pze l(cla)	word2--cla000
	pze fsname	word3--name of function
	pze l(0)	word4--000000
	stz 1c	clear 1c.
	tsx cit00,4	* go make the following cit entry=
	pze 1c	word1--0(ifn)000
	pze l(lxd)	word2--lxd000
	pze dolsgn	word3--$
	pze l(1)	word4--000001
	tsx cit00,4	* go make the following cit entry=
	pze L(0)	word1--000000
	pze l(lxd)	word2--lxd000
	pze dolsgn	word3--$
	pze abtag2	word4--001002
	tsx cit00,4	* go make the following cit entry=
	pze L(0)	word1--000000
	pze l(qxd)	word2--qxd000
	pze dolsgn	word3--$
	pze abtag3	word4--002000
	tsx cit00,4	* go make the following cit entry=
	pze sl	word1--0(ifn+1)000
	pze l(qpr)	word2--qpr000
	pze l(0)	word3--000000
	pze argcnt	word4--0(n+1)004
	tsx cit00,4	* go make the following cit entry=
	pze l(0)	word1--000000
	pze l(tra)	word2--tra000
	pze sl	word3--0(ifn+1)000
	pze l(0)	word4--000000
	txi ca010,0	* exit to process next statement.
	rem  end of program c3200.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c3300/ calls=c0390,c0190x,c0190,test..,arith,subx00.
	rem c3300 processes call statements.
c3300	tsx c0190,4	* if 1st character of name is
	tsx testh0,4	* numeric, then go to the diagnostic.
	tsx c0160,2	* collect the rest of the name, which
	tsx testc0,4	* shd be followed by lparen or endmk.
	tze c3301	if lparen, then change call to a
	tsx c0190x,4	* pseudo-arithmetic formula (z10=).
	tsx c0190,4	* pickup the character c,
	ldq l(z)	and
	tsx c0390,4	* replace c with z.
	ldq l(10)	and
	tsx c0390,4	* replace a with ten.
	ldq equal	and
	tsx c0390,4	* replace first l with =.
	ldq blank	and
	tsx c0390,4	* replace second l with blank.
	cla eifno	put 1st ifn of this cal in callnm
	ars 18	for later table entry fo
	sta callnm	first / last numbers of calls.
	txi arith,0	* then exit to arith to process.
c3301	tsx subx00,4	* if there are no arguments, then
	cla 1g	after completing name with blanks,
	sto g	move it into g, and
	tsx tet00,1	* go enter name
	pze 9	into closub table.
	tsx getifn,4	* put internal formula number in 1c.
	tsx cit00,4	* go make the following cit entry=
	pze lc	word1--0(ifn)000
	pze l(sxd)	word2--sxd000
	pze x(	word3--700000
	pze l(4)	word4--000004
	tsx cit00,4	* go make the following cit entry=
	pze l(0)	word1--000000
	pze l(tsx)	word2--tsx000
	pze 1g	word3--(name)
	pze l(4)	word4--000004
	tsx fltr00,4	* go make flow tracing instructions.
	pze l(0)	word1--000000
	pze l(lxd)	word2--lxd000
	pze x(	word3--700000
	pze l(4)	word4--000004
	txi ca010,0	* exit to process next statement.
	rem  end of program c3300.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem c3400/ calls=c0190,diag,test...
	rem c3400 processes end statements.
c3400	lxa l(5),2	prepare to set 5 ss simulators.
c3405	tsx c0190,4	* pickup constant,
	cas l(2)	which should be 0,1, or 2.
	tsx diag,4	* otherwise, go to the diagnostic.
	txi c3410,0	simulator is preset to 2.
	sto endi1+5,2	if 0 or 1, set proper simulator.
c3410	tsx c0190,4	* skip next non-blank character, and
	tix c3405,2,1	repeat process for 5 constants.
	tsx c0190,4	* examine next non-blank character,
	tsx testd0,4	* which should be an endmk.
	txi ca010,0	* exit to process next statement.
	rem  end of program c3400.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem statea/3-process input-output statements=
	rem
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	rem rdc/ calls=input,beg,diag,etmsw,lib,cit,jif.
	rem rdc processes read statements.
rdc	cla a81	set the address field of
	sta ent	ent (ntr000) to 81.
	tsx input,2	* go compile cal *, and xit (lev).
	cla csh	pickup (csh) to
	rem tsc= entry point used by rit.
tsc	sto tsa	set tsa.
	cal rtn	move (rtn)
	slw end	into end.
	cla dbc	pickup (dbc) to
	rem ttc= entry point used by rdp.
ttc	sto tta	set tta.
	tsx beg,4	* convert constant formula number.
	tsx diag,4	* attempt to use variable format no.
	tnz 4,4	go to the diagnostic, if there was
	tsx diag,4	* no format number given.
	sta st	move binary format number into set.
	cal ntr	move ntr000
	slw op	into op.
	cal txlop	set op-switches.
	stp etmsw	etmsw and ltmsw,
	stp ltmsw	to no transfer case.
	tsx etmsw,4	* go compile etm.
	tsx lib,4	* make closub entry, and compile=
	pze l(0)	word1--000000
	pze cal	word2--cal000
	pze tta	word3--(dbc) or (bdc)
	pze l(0)	word4--000000
	tsx cit,4	* go make the following cit entry=
	pze l(0)	word1--000000
	pze slw	word2--slw000
	pze l(0)	word3--000000
	pze d1	word4--001000
	tsx lib,4	* make closub entry, and compile=
	pze l(0)	word1--000000
	pze cal	word2--cal000
	pze tsa	word3--(csh) or (tsh)
	pze l(0)	word4--000000
	tsx cit,4	* go make the following cit entry=
	pze tl	word1--0(ifn)0(248)
	pze ent	word2--ntr0(81, or unit, or 00)
	pze set	word3--800(format number)
	pze l(0)	word4--000000
	tsx jif,4	* go jump ifn, and set sl and tl.
	rem bxt = exit switch to rsc or last, used by wbt,rbt,wrd.
bxt	txi rsc,0	* exit to scan list, if there is one.
	rem  end of program rdc.
       rem * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
	rem 
	
page 78

