/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.