TEXT   204
display the sense lights in the prog
Guest on 27th November 2024 06:51:19 AM


  1. /display the sense lights in the prog. flags and halt
  2. dff'    dap exit
  3.         clf 7
  4.         law 1
  5.         sad f1f
  6.         stf 1
  7.         sad f2f
  8.         stf 2
  9.         sad f3f
  10.         stf 3
  11.         sad f4f
  12.         stf 4
  13.         sad f5f
  14.         stf 5
  15.         sad f6f
  16.         stf 6
  17.         cla cli hlt
  18. exit,   jmp 0
  19.  
  20. f1f'    0
  21. f2f'    0
  22. f3f'    0
  23. f4f'    0
  24. f5f'    0
  25. f6f'    0
  26.         blk
  27.  
  28. /do handling subr.
  29. /do loops may count up or down by any increment
  30. /if a do loop is satisfied the index, upon exit, contains the same value
  31.  
  32. dof'ctaddr,word,  0     /"word" used in format routine
  33.         dap exit
  34.         clo
  35.         xct i exit
  36.         dac doit
  37.         idx exit
  38.         law i 1
  39.         add ctaddr
  40.         dac lmaddr
  41.         lac i ctaddr
  42.         spa
  43.         jmp some
  44.         lac (oct 650500 /sma sza i
  45.         lio = oct 650200        /spa i
  46.         jmp more
  47. some,   lac (oct 650200 /spa i
  48.         lio (oct 650500 /sma sza i
  49. more,   dac check
  50.         dio check2
  51.         lac i doit
  52.         add i ctaddr
  53.         dac i doit
  54.         szo
  55.         oct 140011      /do index .> | 131071|
  56. ok,     sub i lmaddr
  57.         szo
  58.         jmp over
  59. check,w1,       0       /"w1" used in format routine
  60.         jmp loopagain
  61. around, lac i doit      /restore index for exit
  62.         sub i ctaddr
  63.         dac i doit
  64. exit,   jmp 0
  65.  
  66. loopagain,      idx ctaddr
  67.         jmp i ctaddr
  68.  
  69. over,   lac i doit
  70.         add i lmaddr
  71. check2,w2_0     0       /"w2" used in format routine
  72.         jmp loopagain
  73.         jmp around
  74. doit,w1m_0      0       /w1m used in format routine
  75. lmaddr,temp,    0       /temp "   "     "      "
  76. blk
  77.  
  78.  
  79.  
  80.  
  81. /fixed to floating conversion for fortran arith. statement
  82. /from fortran stmnt      a = i-j/k
  83. /fortran output i-j/k
  84. /               jda xf
  85. /               dac a
  86. xf'ct,  0       /"ct" used in format routine
  87.         dap exit
  88.         lac i exit
  89.         dac store
  90.         lac xf
  91.         jda float       /float the value in the accumulator
  92.         dac i store
  93.         idx store
  94.         dio i store
  95.         idx exit
  96. exit,   jmp 0
  97.  
  98. /floating to fixed conversion for fortran arith.
  99. /from fortran stmnt     i = a+b
  100. /fortran output efm 2
  101. /               a+b
  102. /               jsp ff
  103. /               dac i
  104.  
  105.  
  106. ff'     dap exitff
  107.         jsp fdc /store flt. AC
  108.         loc store
  109.         law store
  110.         jda unflt
  111.         oct 140012      /flt. no. too large to convert to fix.pt.
  112.         xct i exitff
  113.         idx exitff
  114. exitff, jmp 0
  115. store,ftemp, 0
  116. 0       /"ftemp" used in format routine
  117. blk
  118.  
  119. /array handling subroutines
  120. /i1f defines 1 word (integer) arrays
  121. /i2f defines 2 word (floating) arrays
  122. /subsc. values begin with 1 instead of 0
  123. /no recursive subsc.
  124.  
  125. clearmem,ptr,   0
  126.         dap r
  127.         dio endchk
  128. loop,   dzm i ptr
  129.         idx ptr
  130.         and (7777
  131.         sas endchk
  132.         jmp loop
  133. r,      jmp 0
  134. endchk, 0
  135.         blk
  136.  
  137. i2f'    dap exit
  138.         cla
  139.         jmp setrealflag
  140.  
  141. i1f'    dap exit
  142.         law 600
  143. setrealflag,    dap realflag    /usk for integer, nop for real
  144.         noi 1 + exit . swap     /make call to array subr. a usk
  145.         poi 640600 =>|  swap
  146.         exit| .ptr
  147.         idx exit
  148.         idx ptr
  149.         ptr| .ptr       /now points to num of dim in subscript storage
  150.  
  151.         lac i ptr
  152.         dap arraynameptr
  153.         ral 5s
  154.         and (37
  155.         dac nod
  156.         cma
  157.         dac count
  158.         1 => length
  159.  
  160. muloop, idx ptr
  161.         xct i ptr
  162.         ACxlength=>length
  163.         isp count
  164.         jmp muloop      /fall out pointing to nth dim
  165.  
  166.         length
  167. realflag,       skp 0
  168.         sal 1s  /double the length for real arrays
  169.         AC+nod=>spaceneeded
  170.         arf => listptr  /look thru array storage
  171.  
  172. lookloop,       listptr|
  173.         sma
  174.         jmp look
  175. in,     AC^poi 377777=>listptr
  176.         sad final
  177.         oct 140013      /no room
  178.         jmp lookloop
  179.  
  180. look,   sub listptr
  181.         sub spaceneeded
  182.         sma
  183.         jmp enough
  184.         listptr|
  185.         jmp in
  186.  
  187. enough, listptr+nod
  188.         xct realflag
  189.         ior (400000     /mark real arrays with sign bit a 1
  190. arraynameptr,   dac 0   /set up name register
  191.         listptr| =>oldptr
  192.         lac listptr
  193.         add spaceneeded
  194.         ior (400000
  195.         dac i listptr
  196.         and (377777
  197.         sad oldptr
  198.         jmp past        /new array exactly fills old space
  199.         dac ct  /this was    oldptr =>| (AC)   in old version
  200.         lac oldptr
  201.         dac i ct
  202.  
  203. past,   poi 400000-nod=>count   /set up for backwards isp
  204.         1=>partialprod
  205. prodloop,       isp count
  206. exit,   jmp 0
  207.         idx listptr
  208.         xct i ptr
  209.         ACxpartialprod=>partialprod=>| listptr  /store products of dimensions
  210.         law i 1.+ptr=>ptr
  211.         jmp prodloop
  212.  
  213. ptr,    0
  214. nod,    0       /no. of dimensions
  215. count,  0
  216. spaceneeded,    0
  217. listptr,        0
  218. oldptr, 0
  219. partialprod,length,     0
  220.  
  221. blk
  222.  
  223. test,   0
  224. nos,    0
  225. csn,    0
  226. io,     0
  227. ssc'    jda .+1 /this order is executed
  228. ac,     0
  229.         AC.ret1.ret2
  230.         idx ret2        /set the return addresses
  231.         dio io  /save io
  232.         AC-2
  233. a,      AC.b
  234. b,      lac 0
  235.         sas locssc
  236.         jmp a   /find entry in subscript area
  237.         idx b
  238.         xct b
  239.         dip operation
  240.         dap sscptr      /set op and ptr to subscript values
  241.         dzm csn
  242.         sscptr|  . arrayname
  243.         ral 5s
  244.         AC^poi 37 => nos        /set no. of subsc.
  245. arrayname,      lac 0
  246.         AC . operation . dimptr
  247.         jda swap        /save mode bit in IO sign
  248.         cla
  249.         spi i
  250.         law 600
  251.         dap efmflag     /set efmflag according to mode
  252.         lac (oct 332400
  253.         rcl 1s
  254.         dac scale
  255. loop,   idx sscptr
  256.         noi 1 + dimptr . dimptr
  257.         idx csn
  258.         sad nos
  259.         jmp lastssc
  260.         sscptr|
  261.         sad locssc
  262.         jmp recurse
  263. sscptr, xct 0   /get subscript value (skipped if recursive)
  264.         sub (1
  265. dimptr, mul 0   /mul by dimension value
  266.         sza     /too many subsc. or out of range if not zero (spa?)
  267.         oct 140014
  268.         scl 9s
  269.         scl 8s
  270. scale,  0       /shift left 1 (mul by 2) if real array
  271.         AC+operation.operation
  272.         jmp loop
  273. lastssc,        sscptr|
  274.         sad locssc
  275.         jmp recurse
  276.         xct sscptr      /this instruction skipped if recursive
  277.         sub (1
  278.         lio i dimptr
  279.         spi
  280.         jmp c
  281.         mul i dimptr    /do final mul if dimlist is not exhausted
  282.         scl 9s
  283.         scl 8s
  284. c,      xct scale
  285.         AC+operation.operation
  286.         AC^poi 7777=>test       /set up operand address
  287. d,      dimptr|
  288.         spa
  289.         jmp e
  290.         noi 1+dimptr.dimptr
  291.         jmp d   /step past unused dimensions
  292. e,      (AC^poi 7777)-test
  293.         sma sza i
  294.         oct 140015      /bounds check
  295.         ac
  296.         lio io
  297. efmflag,        skp 0
  298.         efm 2
  299. operation,      0
  300. ret1,   jmp 0
  301. ret2,   jmp 0
  302.  
  303. recurse,        oct 140016      /recursive subsc.
  304.  
  305. locssc, loc ssc
  306.         blk
  307. fin.
  308.                
  309. e                                
  310. xsy imp idv tpo
  311.  
  312. idv'    0
  313.         dap exit
  314.         xct i exit
  315.         dac temp
  316.         idx exit
  317.         lac idv
  318.         scr 9s
  319.         scr 8s
  320.         div temp
  321.         jmp exit
  322.         dac temp
  323.         idx exit
  324.         lac temp
  325. exit,   jmp 0
  326.         blk
  327.  
  328. imp'ct3,        0
  329.         dap exit
  330.         xct i exit
  331.         dac temp
  332.         idx exit
  333.         lac imp
  334.         mul temp
  335.         scl 9s
  336.         scl 8s
  337. exit,   jmp 0
  338.         blk
  339.  
  340. dss typ
  341. tpo'    dap exit
  342. next,   lac i exit
  343.         dac temp
  344.         idx exit
  345.         law i 3
  346.         dac ct3
  347. loop,   cla
  348.         lio temp
  349.         rcl 6s
  350.         dio temp
  351.         sad (13
  352. exit,   jmp 0
  353.         rcr 9s
  354.         rcr 9s
  355.         jsp typ
  356.         isp ct3
  357.         jmp loop
  358.         jmp next
  359. temp,   0
  360.         blk
  361. fin.

Raw Paste

Login or Register to edit or fork this paste. It's free.