- /display the sense lights in the prog. flags and halt
- dff' dap exit
- clf 7
- law 1
- sad f1f
- stf 1
- sad f2f
- stf 2
- sad f3f
- stf 3
- sad f4f
- stf 4
- sad f5f
- stf 5
- sad f6f
- stf 6
- cla cli hlt
- exit, jmp 0
- f1f' 0
- f2f' 0
- f3f' 0
- f4f' 0
- f5f' 0
- f6f' 0
- blk
- /do handling subr.
- /do loops may count up or down by any increment
- /if a do loop is satisfied the index, upon exit, contains the same value
- dof'ctaddr,word, 0 /"word" used in format routine
- dap exit
- clo
- xct i exit
- dac doit
- idx exit
- law i 1
- add ctaddr
- dac lmaddr
- lac i ctaddr
- spa
- jmp some
- lac (oct 650500 /sma sza i
- lio = oct 650200 /spa i
- jmp more
- some, lac (oct 650200 /spa i
- lio (oct 650500 /sma sza i
- more, dac check
- dio check2
- lac i doit
- add i ctaddr
- dac i doit
- szo
- oct 140011 /do index .> | 131071|
- ok, sub i lmaddr
- szo
- jmp over
- check,w1, 0 /"w1" used in format routine
- jmp loopagain
- around, lac i doit /restore index for exit
- sub i ctaddr
- dac i doit
- exit, jmp 0
- loopagain, idx ctaddr
- jmp i ctaddr
- over, lac i doit
- add i lmaddr
- check2,w2_0 0 /"w2" used in format routine
- jmp loopagain
- jmp around
- doit,w1m_0 0 /w1m used in format routine
- lmaddr,temp, 0 /temp " " " "
- blk
- /fixed to floating conversion for fortran arith. statement
- /from fortran stmnt a = i-j/k
- /fortran output i-j/k
- / jda xf
- / dac a
- xf'ct, 0 /"ct" used in format routine
- dap exit
- lac i exit
- dac store
- lac xf
- jda float /float the value in the accumulator
- dac i store
- idx store
- dio i store
- idx exit
- exit, jmp 0
- /floating to fixed conversion for fortran arith.
- /from fortran stmnt i = a+b
- /fortran output efm 2
- / a+b
- / jsp ff
- / dac i
- ff' dap exitff
- jsp fdc /store flt. AC
- loc store
- law store
- jda unflt
- oct 140012 /flt. no. too large to convert to fix.pt.
- xct i exitff
- idx exitff
- exitff, jmp 0
- store,ftemp, 0
- 0 /"ftemp" used in format routine
- blk
- /array handling subroutines
- /i1f defines 1 word (integer) arrays
- /i2f defines 2 word (floating) arrays
- /subsc. values begin with 1 instead of 0
- /no recursive subsc.
- clearmem,ptr, 0
- dap r
- dio endchk
- loop, dzm i ptr
- idx ptr
- and (7777
- sas endchk
- jmp loop
- r, jmp 0
- endchk, 0
- blk
- i2f' dap exit
- cla
- jmp setrealflag
- i1f' dap exit
- law 600
- setrealflag, dap realflag /usk for integer, nop for real
- noi 1 + exit . swap /make call to array subr. a usk
- poi 640600 =>| swap
- exit| .ptr
- idx exit
- idx ptr
- ptr| .ptr /now points to num of dim in subscript storage
- lac i ptr
- dap arraynameptr
- ral 5s
- and (37
- dac nod
- cma
- dac count
- 1 => length
- muloop, idx ptr
- xct i ptr
- ACxlength=>length
- isp count
- jmp muloop /fall out pointing to nth dim
- length
- realflag, skp 0
- sal 1s /double the length for real arrays
- AC+nod=>spaceneeded
- arf => listptr /look thru array storage
- lookloop, listptr|
- sma
- jmp look
- in, AC^poi 377777=>listptr
- sad final
- oct 140013 /no room
- jmp lookloop
- look, sub listptr
- sub spaceneeded
- sma
- jmp enough
- listptr|
- jmp in
- enough, listptr+nod
- xct realflag
- ior (400000 /mark real arrays with sign bit a 1
- arraynameptr, dac 0 /set up name register
- listptr| =>oldptr
- lac listptr
- add spaceneeded
- ior (400000
- dac i listptr
- and (377777
- sad oldptr
- jmp past /new array exactly fills old space
- dac ct /this was oldptr =>| (AC) in old version
- lac oldptr
- dac i ct
- past, poi 400000-nod=>count /set up for backwards isp
- 1=>partialprod
- prodloop, isp count
- exit, jmp 0
- idx listptr
- xct i ptr
- ACxpartialprod=>partialprod=>| listptr /store products of dimensions
- law i 1.+ptr=>ptr
- jmp prodloop
- ptr, 0
- nod, 0 /no. of dimensions
- count, 0
- spaceneeded, 0
- listptr, 0
- oldptr, 0
- partialprod,length, 0
- blk
- test, 0
- nos, 0
- csn, 0
- io, 0
- ssc' jda .+1 /this order is executed
- ac, 0
- AC.ret1.ret2
- idx ret2 /set the return addresses
- dio io /save io
- AC-2
- a, AC.b
- b, lac 0
- sas locssc
- jmp a /find entry in subscript area
- idx b
- xct b
- dip operation
- dap sscptr /set op and ptr to subscript values
- dzm csn
- sscptr| . arrayname
- ral 5s
- AC^poi 37 => nos /set no. of subsc.
- arrayname, lac 0
- AC . operation . dimptr
- jda swap /save mode bit in IO sign
- cla
- spi i
- law 600
- dap efmflag /set efmflag according to mode
- lac (oct 332400
- rcl 1s
- dac scale
- loop, idx sscptr
- noi 1 + dimptr . dimptr
- idx csn
- sad nos
- jmp lastssc
- sscptr|
- sad locssc
- jmp recurse
- sscptr, xct 0 /get subscript value (skipped if recursive)
- sub (1
- dimptr, mul 0 /mul by dimension value
- sza /too many subsc. or out of range if not zero (spa?)
- oct 140014
- scl 9s
- scl 8s
- scale, 0 /shift left 1 (mul by 2) if real array
- AC+operation.operation
- jmp loop
- lastssc, sscptr|
- sad locssc
- jmp recurse
- xct sscptr /this instruction skipped if recursive
- sub (1
- lio i dimptr
- spi
- jmp c
- mul i dimptr /do final mul if dimlist is not exhausted
- scl 9s
- scl 8s
- c, xct scale
- AC+operation.operation
- AC^poi 7777=>test /set up operand address
- d, dimptr|
- spa
- jmp e
- noi 1+dimptr.dimptr
- jmp d /step past unused dimensions
- e, (AC^poi 7777)-test
- sma sza i
- oct 140015 /bounds check
- ac
- lio io
- efmflag, skp 0
- efm 2
- operation, 0
- ret1, jmp 0
- ret2, jmp 0
- recurse, oct 140016 /recursive subsc.
- locssc, loc ssc
- blk
- fin.
- e
- xsy imp idv tpo
- idv' 0
- dap exit
- xct i exit
- dac temp
- idx exit
- lac idv
- scr 9s
- scr 8s
- div temp
- jmp exit
- dac temp
- idx exit
- lac temp
- exit, jmp 0
- blk
- imp'ct3, 0
- dap exit
- xct i exit
- dac temp
- idx exit
- lac imp
- mul temp
- scl 9s
- scl 8s
- exit, jmp 0
- blk
- dss typ
- tpo' dap exit
- next, lac i exit
- dac temp
- idx exit
- law i 3
- dac ct3
- loop, cla
- lio temp
- rcl 6s
- dio temp
- sad (13
- exit, jmp 0
- rcr 9s
- rcr 9s
- jsp typ
- isp ct3
- jmp loop
- jmp next
- temp, 0
- blk
- fin.
Raw Paste