drum supervisor for lisp 7-25-64

np=10
wpp=100
top=7777

drm,	0
	dap dsx
	dio dsd
	lac i dsx
	dap dsa
	dip dsb
dsa,	lac .
	and (177777
	sub (top
	spa
	jmp dsz
	add (i
	dac dse
	and (1-wpp
	xxx=0
	repeat np
sad pa1+xxx	jmp dp1+xxx+xxx	xxx=xxx+1
	law i pb1-pa1
	add dv4
	dap dva
	lac i dv4
	sma
	jmp dsh
dva,	lio .		/write out old field
	dia
	cla
	dip i dv4
	lac i dv4
	lio (wpp
	dcc
	opr 400

dsh,	law i wpp-1
	and dse
	dac i dva
	and (7777
	swp
	dia
	law i 7777
	and dse
	add (wpp
	swp
	lac i dv4
	dcc		/get new field
	opr 400
	lac dv4
	jmp dtn
                
                                 
dp1,	xxx=pb1+1
	law pb1
	repeat np-1
jmp dp	law xxx	xxx=xxx+1

dp,	sad dv1
	jmp dtk
	xxx=1
	repeat np-2
sad dv1+xxx	jmp dtk-1-xxx-xxx	xxx=xxx+1

dtn,	xxx=np-1
	repeat np-1
lio dv1+xxx-1	dio dv1+xxx	xxx=xxx-1
	dac dv1

dtk,	law i 7777
	and dsb
	ral 5s
	sas (400012	/dac i shifted
	sad (400015	/dio i
	dip i dv1

dtm,	law wpp-1
	and dse
	add i dv1
dsu,	dac dsc
	idx dsx
	lac drm
	lio dsd
dsb,	dsc
dsx,	jmp .
	jmp .

dsz,	lac i dsa	/for addr in core
	jmp dsu
                
                                 
dsc,	0	/addr through which to indirect
dsd,	0	/temporary for io
dse,	0	/true drum addr of data

/preference pushdown
dv1,	xxx=pb1+np-1
	repeat np,xxx	xxx=xxx-1
	dv4=.-1

/page addr registers
pa1,	repeat np,0

/buffer addr registers
pb1,	xxx=0
	repeat np,db1+xxx	xxx=xxx+wpp

/buffer space
db1,	repeat np,.+wpp/

start