executive routine  6 june 1971

psf=iot 0077	psn=iot 1077	sps=iot 3077
bef=iot 0177	ben=iot 1177	sbe=iot 3177
bff=iot 0277	bfn=iot 1277	sbf=iot 3277
rsf=iot 4177	rsn=iot 4077	srs=iot 4277
usf=iot 5777	usn=iot 5677	srw=iot 2677
spn=iot 1477	scn=iot 1577	lar=iot 0677
rpn=iot 0477	rcn=iot 0577	sti=iot 3377
lbe=iot 1377	rbe=iot 3777	sbr=iot 2577
rsb=iot 2077	siw=iot 3577
lqn=iot 4377	soq=iot 4477	sei=iot 2777
dia=iot 60	dcc=iot 62
rpa=iot i 1	rrb=iot 30	ppa=iot i 5
tyo=iot i 3	tyi=iot 4

rpp=770000
rcp=770002	rqp=770003
rfv=770006	rfa=770007
lpp=770010	cqt=770011
scp=770012	sqp=770013
ubn=770020	ubs=770021
ubf=770022
rin=770030	rfn=770031
ioc=770032	lcr=770037

sfa=770045

ncb.=12	/size of typewriter buffer
ewv.=5	/restart level

npb.=140	/punch buffer size
pwm.=30	/restart level

nrb.=200	/size of reader buffer
rwm.=40	/reader restart level
nuf.=20	/number of user fields
nqu.=44	/number of queues, typewriters, and enters

/process words

di1=6	/W register
prn=7	/process ring
prq=11	/process queue
prs=12	/scheduling word
pbl.=11.	/length of process block

cms=6630	/origin of computation blocks

/computation words

pss=11	/scheduling word
aw1=pss+1	/assignment register
bp1=13	/location of breakpoint
bp2=bp1+1	/proceed count
bp3=bp2+1	/instruction under breakpoint
ilr=bp3+1	/illegal instruction return
imr=ilr+1	/illegal memory reference return
sup=imr+1	/superior sphere
spe=sup+1	/fault entry to superior
be1=spe+1	/break enable
clw=be1+1	/chain of procs waiting to enter
con=clw+1	/pointer back to console
/con+1 not used
prh=con+2	/process hoard
/prh+1 not used

define die
	jmp .
terminate

0/	105

40/
sut-1,	law 5000
sut,	lia
	lar
	scn
	ben
	bff
	psf
	spn
	ben
	bff
	add (xct
	sas (5001
	jmp sut
	ioc
	law 7400
	ivk 121	/initialize microtape address
	lxr (1
	dzm i 0
	SXXA
	sas (.-1
	jmp .-3
	jmp 131
	constants

74/
	340000+qqt-prq
unt=ivk .	jmp 20
dat=ivk .	jmp 21
mot=ivk .	jmp 77

100,	jmp tot	/0 - interrupt
	jmp dsp	/1 - iot
	jsp trp	/2 - illegal
	jsp trp	/3 - lock fault
	jmp .	/4 - function tardy
	jsp trp	/5 - function busy
	jmp str	/6 - function started
	jsp trp	/7 - hlt
	jmp adf	/10 - extend snag
	jmp bp	/11 - bpt
	jmp xe0	/12 - esi
	jmp ivw	/13 - ill ivk
	jmp pre	/14 - preempt
	jmp rbn	/15 - rnd rbn
	jmp fr1	/16 - frk
	jmp qt1	/17 - qit
	jmp atm	/20 - meta
	jmp ivt	/21 - enter
	jmp ivt	/22 - ivk
	jmp adx	/23 - index snag
	jmp adf+2	/24 - last snag
125,	/two words of space
127/pmt,	76
130,	law 50	/hack
131,	ioc
	ivk 120
	lac (70000 exi
	dac 141
	lac (add
	dac 144
	ubn
140,	repeat 6,0
	jmp 147
147,	cli	/system has expired
	lar
	szs 70
	jmp .-1
153,	lio (save
	dia
	lio (240000 i-save
	law i i-save-1
	dcc
	hlt
	jmp save

163/
dd2,	repeat nuf,0
dd3,	repeat nuf,0
dd4,	repeat nuf,0
dd5,	repeat nuf,0
dd6,	repeat nuf,0

/constants for administrative routine

303,
cc,	repeat 4,0	/negative if core doesn't work
cc 3/	-0	/core 3 is down
		/nonzero if unswappable
bc,	repeat 4,1000	/core use flags
uc,	repeat 4,0	/absolute core words
		/comp+core, 0 if empty
fdf,	repeat 4,0	/free drum fields

rds,	skp i	/skip if reader initialization needed
	ubs
frp,	0	/free process pool, chained through 0 words
cpp,	cpp-prq	cpp-prq	/process chain
	0	0	/unused

/queues, enters, typewriters

332,ntb,
qqt,	-1	.-prq-1	/queue for microtapes
	.-prq	.-prq-1	/queue for adm rt
	exc	mte	/microtape entry
	arc	101	/adm rt (mtas)
	arc	100	/adm rt (ivks)
tyt.=.-4-prq	/top level typewriters
repeat 5,lac .-prq	.-prq
/2nd level twrs
repeat 5,.-prq	[[.-11.-qqt]]x4000+.-prq
nqux2+qqt/

atl,	law 103+4
	add t
trp,	sub (103	/program trap
	and (17

/cause enter to superior sphere, reason in AC
spr,	dac t
	lxr prc
	rar 6s
	dip i prn+1
spc,	lac (040000
	dip i prn
	dzm t6
	lxr cmp
	lio i spe
	spi
	jmp wcl	/no superior
	lio i sup
	jmp ntu

wcl,	law clw-prq
	add cmp
	jmp wta

ill,	lxr cmp	/recoverable illegal instruction
	lio i ilr
	TIA>P
	jmp 102	/return not set
ill+4,	lxr prc
	ral 3s
	rcr 3s
	lio i 1
	rcl 3s
	rar 3s
	rir 3s
	dio i di1
	dac i 1
	ubn

b,	/typewriter, reader, and punch buffers
b ncbx5 npb/
repeat ifm .-b nrb,b nrb/
erb.=b+nrb

dsp,	lxr cmp	/iot trap
	lio i con
	sil 5s	/not suppressed
	sni
	jmp ill
	lxr prc
	sad (2
	jmp wa	/wat
	sad (5
	jmp to	/tyo
	sad (6
	jmp ti	/tyi
	sad (16
	jmp ar	/arq
	sas (14
	jmp ill

	dra	/dra
	law 145
	A+IA
	and (7777
	dac i 2
	lxr cmp
	xct 130
	dac i 25
	ubs

/function started trap

str,	rfn
	law 77
	A^IA
	sas (1
	sad (2
	add (13	/drum
	TAX
	law 7777
	and i iow-14
	sza
	jmp 105	/process already hung
	rpp
	dio i iow-14
hng,	lxr prc	/hang this process
	lac (020000
	jmp hag

iow,	0	/drum (1)
	0	/drum (2)
	0	/ttyin (16)
	0	/ttyout (17)
	mtp	/unit monitor (20)
	0	/data control (21)
	0	/crock (22)
	0	/kludge (23)
	0	/lossage (24)

/bpt trap

bp,	rfa
	lxr cmp
	lac i bp1
	and (177777
	A~IP
	jmp tr4
	lac i bp1
	TAAI>P
	jmp b2
	isp i bp2
	jmp b3
tr4,	dio i bp1
	law 4
	jmp spr

b2,	A+I>P
	jmp tr4
	lac (-200000
	adm i bp1
b3,	rfa
	lac i bp3	/multiple proceed
	lxr (-070000
	X+IX
	dac i 0	/replace instruction
b4,	lxr prc
	law 4000	/set ESI
	ior i 4
	dac i 4
	ubn

/ESI trap

xe0,	law i 4000
	adm i 4
xe1,	lxr cmp
	lac i bp1
	TAAIM|
	jmp tr2	/disabled
	spa
	jmp xe3
	sfa	/replace bpt
	jmp xe2	/not in core
	add (-070000
	TAX
	law i-bpt
	lio i 0
	dac i 0
	lxr cmp
	dio i bp3
	lac i bp1
	lia
xe3,	ril 1s
	A>>05<<I<M
	ubn	/multiple proceed
	ior (600000	/superproceed
	dac i bp1
	isp i bp2
	jmp b4
tr2,	law 2
	jmp spr

xe2,	lac (30000
	lxr prc
	dip i prn
	lai
	jmp adc

                                
ATM=	RFA	?META PROCESSOR
	LXR [+.<....
	X+IX
	law 770
	and i 0
	rar 3s
	and i 0
	dac t	/meta number
	sub (mtz-mtb
	sma
	jmp mt9
	add (mtz
	dap mtc
	lxr prc
	lac i 0
	lio i 2
mtc,	xct .
	dio i 2
rta,	dac i 0
	ubs

mtb,	dac i di1	/mta 000 - AC to W
	dio i di1	/mta 001 - IO to W
	lac i di1	/mta 002 - W to AC
	lio i di1	/mta 003 - W to IO
	jmp atl	/mta 004
	jmp atl	/mta 005
	jmp atl	/mta 006
	jmp atl	/mta 007
	jmp lpm	/mta 100 - enter low priority mode
	jmp m11	/mta 101
	jmp ill	/mta 102
	jmp ill	/mta 103
	jmp rde	/mta 104 - read drum
	jmp rde	/mta 105 - read drum
mtz,

ar,	dzm t	/arq
	siw i
	idx t

/cause enter to adm rt, transmitted word in t

mt9,	law 3x2
	jmp ntr

/enter low priority mode
lpm,	lac mtc	/(100000
	ior i prq
	dip i prq
	lac (10000
	dip i prn
	jmp pre

rde,	lac i 2	/read drum (mta 104, mta 105)
	lio pmt
	jmp dr0

m11,	law arc	/restart procs waiting to enter
	sas cmp
	jmp ill
	lac i 0
	jda rct
	ubs

/quit

qt1,	lac i prn
	lxr i prn+1
	dap i prn
	X.AX
	dap i prn+1
	jsp crock
	lxr cmp
	lio i prh
	spi
	idx i prh	/decrease debt
	dio t
	spi	/return it to hoard
	lxr (frp-prh	/or pool
	lio i prh
	aam
	dio prc
	lac prc
	dac i prh
qt2-1,	lxr (cpp-prq	/check process chain
qt2,	law 7777
	and i prq
	sad (cpp-prq
	jmp wa0
	dac rms
	TAX
	law i 7777	/find sphere for which process is needed
	and i prn
	ral 7s
	sad (2
	jmp qt5	/wants to fork
	lxr i 5	/wants to enter
	lio i sup
	TAXP
	lio i ntb
	law 7777
	A^IA|
qt5,	lac i 5
	lio t
	spi i	/AC = sphere
	sad cmp
	jmp .+3	/found a deserving one
	lxr rms
	jmp qt2

	jsp rms+1
	jmp sched

/fork

fr1,	lxr cmp
	lio i prh
	TII.<
	jmp fr2	/hoard is not empty
	lio frp	/hoard empty, check pool
	TIIP|
	jmp fr6	/lose
	law i 1
	adm i prh	/increase debt
	lxr (frp-prh
fr2,	aam	/unlink
	lac i prh
	dac i prh
	dio acp	/new process block
	jsp crock
	lxr prc
	lio i prn
	lac acp	/new proc
	dac i prn
	X.AX
	dac i prn+1
	dio i prn
	X.IX
	dio i prn+1
	TAX
	lio i 5
	lac i di1
	lxr acp
	dio i 5
	dac i di1
	lxr prc
	lac i prs
	lio i prq
	lxr acp
	dac i prs
	dio i prq
	TXI
	lac prc
	dio prc
	jda acp	/put old process back on queue
	lio prc
	ubf

fr6,	law 7776	/back up PC
	lxr prc
	add i 1
	dap i 1
	law 2
	jmp fr8

/interrupts

tot,	sei i
	jmp exi
/function bus interrupt
	rin
	cla
	rcl 6s
	sas (1
	sad (2
	add (13	/drum
	TAX
	lio i iow-14
	dzm i iow-14
	TIAP|
	jmp .	/no suspended process
	jda acp
	lac (10000
	dip i prn
	ubn

/service io

srv,	dap sr1
srr,	skp	/skip if reader running
	jmp sr0
	srw i
	jmp srz
	rrb
rip,	lac b
	ral 8s
	rcr 8s
	aam
	dac rip
	rpa-i
	idx rip
	sad (lac erb
	lac (lac b
	dac rip
	sub rop
	sas (erb-b-rwm
	sad (-rwm
	rsn
	TAP|
	dap srr	/full, shut off reader
	dap rrs	/buffer not empty
srz,	srs
	jmp sr0
	TAP|
	jmp .+3
	dap srr
	dap rdn
	rsf
	law rdt
sr0-1,	jda rct

sr0,	rpn
	sni i
	jmp sr5
sr6,	rcn
	sni
	jmp sr4
	ril 4s
	TIX
	sps
	jmp sr2
	sti
	jmp sr3
	jsp if0+1
	psf
sr2,	tyi
	jsp itf
	TXI	/restart both processes
	ril 1s
	dio t3
	law tyt
	A+IA
	jda rct
	lio t3
	jmp sr7

sr3,	jsp ite
	tyo
	sbf i
	jmp sr6
	TXI	/reactivate for tyo
	ril 1s
sr7,	law tyt+1
	A+IA
	jmp sr0-1

sr5,	lxr (1
	jsp ite
	ppa
	sbf i
	jmp sr6
	law pnt
	jmp sr0-1

sr4,	spn	/restore these
	scn
sr1,	jmp .

clt=.-prq	.-prq	/clock
pnt=.-prq	.-prq	/punch
rdt=.-prq	.-prq	/reader
cbl=.-2-prq	/call buttons
	repeat 5,.-prq

sbm=.-prq	.-prq	/wat chain

/index and test if buffer empty

ite,	dap ie7
	law 377
	aam
	and i bop
	lia
	idx i bop
	sad i bor+1
	lac i bor
	dac i bop
	sad i bew
	bff
	sad i bip
	ben
ie7,	jmp .

/index and test if buffer full

itf,	dap if7
	aam
	lac i bip
	rcr 8s
	ral 8s
	aam
	dac i bip
	bef
	idx i bip
	sad i bor+1
	lac i bor
	dac i bip
	sad i bop
	bfn
	idx i bew
	sad i bor+1
	lac i bor
	dac i bew
if7,	jmp .

/clear typewriter buffer

if0,	psn
if0+1,	dap if3
	bff
	lac i bip
	dac i bop
	law i 0
	xct i ra2
	dac i zsc	/clear waiting character flag
if3,	jmp .


/buffer pointer table

bop=.-1	z=0
	b+z	z=z+npb	/1 (punch)
	b+z	z=z+ncb	/2
	b+z	z=z+ncb	/3
	b+z	z=z+ncb	/4
	b+z	z=z+ncb	/5
	b+z	z=z+ncb	/6

ra2=.-2	skp	/2 (selectric switch)
	skp	/3
	skp i	/4
	skp i	/5
	skp i	/6

zc1=.-2	0	/2 (flexo case)
	0	/3

zc2=.-2	0	/2 (selectric case)
	0	/3

zsc=.-2	-0	/2 (waiting char and switch)
	-0	/3

bip=.-1	z=0
	b+z	z=z+npb	/1 (punch)
	b+z	z=z+ncb	/2
	b+z	z=z+ncb	/3
	b+z	z=z+ncb	/4
	b+z	z=z+ncb	/5
	b+z	z=z+ncb	/6

bew=.-1	z=0
	b+z+npb-pwm+1	z=z+npb	/1 (punch)
	b+z+ncb-ewv+1	z=z+ncb	/2
	b+z+ncb-ewv+1	z=z+ncb	/3
	b+z+ncb-ewv+1	z=z+ncb	/4
	b+z+ncb-ewv+1	z=z+ncb	/5
	b+z+ncb-ewv+1	z=z+ncb	/6

bor=.-1	z=0
	b+z	z=z+npb	/1 (punch)
	b+z	z=z+ncb	/2
	b+z	z=z+ncb	/3
	b+z	z=z+ncb	/4
	b+z	z=z+ncb	/5
	b+z	z=z+ncb	/6
	b+z

rct,	0	/reactivate all processes hung on device
	dap rc1
	lxr rct
	law 7777
	and i prq
	A~XP|
rc1,	jmp .
	jda rms
	jmp rct+2

rms,	0	/remove process from soft wait
	dap acx	/returns with process in XR
	lxr rms
	lac i prq
	ral 3s
	lio i prq
	X.A<M
	jmp acx	/not in IO wait
	TAX
	law 7777
	and i prq
	sas rms
	jmp .-4
	dac acp
	law 7777
	A^IA
	dap i prq
	ril 4s
	X.I<M
	jmp acp+2
	sad (cpp-prq	/was in proc chain
	dio cpp+1	/was last in proc chain
	lxr acp
	law i 7777
	and i prn
	TAP|
	lac (040000	/enter superior
	dip i prn
	jmp acp+2

acp,	0	/activate process
	dap acx	/returns with process in XR
acp+2,	lxr acp
	law 0
	sad i prn+1
	jmp aci
	dap nup	/forbid infinite quantum
	lac (700000
	and i prq
	dip i prq
	ral 3s	/1 if low priority
	lio (6
	A^IP
	jmp acx	/suppressed
	add (apq
	dap act
	X.AI
	jda rpc
	TIX
act,	law
	A~XP|
	sqp	/cause preempt trap
	lxr acp
acx,	jmp .

aci,	lac frp	/process deleted while in wait
	dac i 0
	TXXA
	dac frp	/quit processor used at wa0
	jmp acx

/executive interrupts

exi,	jsp srv
	rsb	/read switches and buttons
	lxr tsb
	X~IP|
	jmp cck	/no change
	CXX
	dio tsb
	X^IA
	sar 7s
	dac t0	/call buttons that have been pressed
	lac pmt
	A^II
	law btc+2
	jda bdu

/call buttons

bs1,	law cbl+2
	dac t6
	lac t0
	rar 6s
ub0,	and (-7777
	sza i
	jmp cck
	dac t4
	lxr t6
	X.A>P
	lac i prq
	A~XP|
	jmp ubx
	jda rms
	lac (10000
	dip i prn
ubx,	idx t6
	lac t4
	ral 1s
	jmp ub0

cck,	soq
	jmp bs0
	law 600
	dap ckr
	lxr (clt
ck1,	law 7777
	and i prq
	sad (clt
	jmp ck2
	TAX
	dap ckr
	isp i 0
	jmp ck1
	TXA
	jda rms
	jmp ck1
ck2,	law 60	/used as constant
	xct srr
	law 0
	cli>>05<<cmi
ckr,	skp i 600	/skip if clock running
	lia
	lqn
bs0,	rbt	/check buttons
	law btc
	jda bdu
	rbt 400
	law btc+1
	jda bdu
	lxr cmp
	rbe
	dio i be1
	lac sbm+prq	/check sbm chain
sb1,	sad (sbm
	jmp rm1
	dac rms
	TAX
	law 7777
	and i prq
	dac t0
	lxr i 5
	lio i be1
	lbe
	lio i aw1
	lar
	spn
	scn
	sbr i
	jsp rms+1
	lac t0
	jmp sb1

/check buttons
bdu,	0
	dap bdx
	lxr bdu
	lai
	sad i btn-btc
bdx,	jmp .
	dio i btn-btc	/buttons changed
	lxr cmp	/hack
	lac i 25
	and i aw1
	sza
	isp i 27
	jmp .+4
	lxr prc
	lac (i
	dip i prn
	lac bdu
	jda rct
	jmp bdx

btt,	law i 3
	A+XI<
	jmp cll
	lac i btn	/button ivk
	lxr prc
	sas i 0
	jmp rta
	law btc+3
	A+IA
	jmp wta

btc=.-prq	.-prq	/processes hung on buttons
	.-prq
csb=.-prq	arl
btn,	0	/button words
	0
	0	/console switches

ivi,	lac i itt-10
	dap .+3
	lxr prc
	lac i 0
	jmp .
itt,	clk
	rdr
	pch

clk,	TA<
	ubs
	cli>>05<<cmi
	xct ckr
	lqn
	dap ckr	/turn on clock
	law clt
	jmp wta


cll,	law i 10
	A+X<
	jmp ivi
	law cbl-1	/call button ivk
	A+XAX|
wtt,	TAX	/hang process, device in AC
	law 7777
	and i prq
	A~XP
	jmp 105	/function busy
wta,	TAX	/hang process, device pointer in AC
	lac prc
	lio i prq
	dap i prq
	TAX
	lai>>05<<clf 7
	dap i prq
	lac (040000
hag,	adm i prq	/hang this process, reason in AC
	lxr cmp
h1,	law 7777	/see if any active procs in this sphere
	and i prn
	TAAX
	sad cmp
	jmp dec-1
	lac i prq
	and (660000
	sza
	jmp h1
	jmp dce	/yes

dec-1,	lio i 0	/no active procs
dec,	law 0	/deactivate all cores
	rcl 3s
	sub (4
	TAX<
	jmp .+5	/core 6 or 7
	law 5	/or so
	adm i bc+4
	spa
	dzm i bc+4	/avoid overflow
	sni i
	jmp dec
dce,	szf 5
	jmp ntk

hgn,pre,	dzm alarm1
rbn,	jsp crock
	sma
	jmp update
	law 4000
	dac ctr
	lac alarm1
	spa
	ubn
/put proc back on queue
	lxr prc
	lac i prq
	and (660000
	lio cp
	X.AP|	/skip if proc can't run
	jda rpc

wa0,	law cpp-prq	/check process chain
	lio frp
	sas cpp
	TIP|
	jmp sched
	cli>>05<<cmi
	dio t
	jmp qt2-1

/scheduler
sched,	lxr (apq-1
	SXX
	lac i prq
	TAAIP|
	jmp .-3
	dio prc
	lpp
	X.IX
	dio cp
	lac i prq
	and (-010000
	sad i prq
	jmp si6
	dac i prq	/proc was demoted for address snag
	lac i prs
	sar 1s
	dac i prs
	lac prc
	dac who
si6,	lac i prs	/debug patch
	spa
	jmp .
	law 7777
	and i prq
	X.IX
	dac i prq	/unchain
	TAXP|
	jmp si9
	lac i prs
	TIX
	mul (140000	/increase for longer quanta
	scl 2s
	sub i prs

	lio (20	/minimum quantum
	AMI.<
	lia
/I=quantum
si8,	CIA
	dac alarm1	/goes off when quantum ends
	TIA
	rcr 5s
	rir 7s
	sni
	lio (100	/because 0 would lose
	law i 3700
	and i 4
	A>>05<<IA
	dac i 4
	law 7
si7,	dio ctr
	lia
	sqp
	lac 0	/check hardware
	sza i
	idx cs1
	dac 0
si5,	lxr prc	/entry from enters
	lac i 5
	lxr cmp
	A~XP|
	jmp rm3
	dac cmp	/new sphere
	rbe
	TXXP	/"kludge" - JCS
	dio i be1
rm1,	lxr cmp
	lio i be1
	lbe
	lio i 0
	lcr
	lio i aw1
	lar
	spn
	scn
	cla>>05<<clf 7
	sfa
	jmp adc	/bring in core 0

/run process in prc

rm3,	lxr prc
	lio i prn
	cla>>05<<clf 7
	dip i prn
	rcl 6s
	TAXP|
	ubn
	xct i rm9-1

/restart superior enter

	law i 7777
	and i prn+1
       	ral 6s
	dac t
	jmp spc

rm9,	ubs
	jmp ill
	jmp xe1	/core rename has been loaded
	lxr prc

si9,	TIX
	lio (4000
nup,	skp 600	/skip if can give infinite quantum
		/cleared by acp, set by update
	jmp si8
	dzm alarm1
	law 10
	jmp si7

/put process in AC on scheduling chain
/at level in IO

rpc,	0
	dap rpx
	lxr rpc
	lac i prs
	dac rpt
	TIX
rp1,	law 7777
	and i prq
	TXI
	TAXP|
	jmp .+5
	lac i prs
	sub rpt
	spq
	jmp rp1
	X.IX
	lac rpc
	dap i prq
	X.AX
	swp
	dap i prq
rpx,	jmp .
rpt,	0

/record passage of time
t2,crock-1,	0
crock,	dap crx
	rqp
	lai
	sad (10
	jmp crx
	lxr prc
	law 3700
	and i 4
	lio ctr
	dac ctr
	rcr 6s
	swp
	AMIAI
	adm i prs
	spa	/
	jmp .	/
	lxr i 5
	lai
	adm i pss
	spa	/
	jmp .	/
	lai
	adm alarm1
	lai
rb2,	adm alarm2
crx,	jmp .
ctr,	4000	/quantum counter, last time it was looked at

update,	law cms
	dac t
	dzm t4
w1,	TAX
	lac i pss
	TAAM|
	jmp w5	/sphere doesn't exist
	mul (200000	/fudgeable constant
	dac i pss
	dac t1
	dzm t2
	dzm t3
	lio (40	/increase to give infinite quantum sooner
w2,	law 7777
	and i prn
	TAAX
	sad t
	jmp w3
	lac i prs
	AMI.<
	idx t4
	lac i prs
	adm t3
	lac i prs
	sub t1
	CAA.>
	adm t2
	jmp w2

w3,	lac t2
	cli
	div t3
	law i 7777
	add (377777
	spa
	jmp .
	dac t1
w4,	law 7777
	and i prn
	sad t
	jmp w5
	TAX
	lac i prs
	mul t1
	dac i prs
	jmp w4

w5,	law 30
	adm t
	sas (7400
	jmp w1
	law 1
	sas t4
	ZAP
	law 600	/ok to give infinite quantum
	dap nup
	TAP
	dzm alarm1	/do it
	law i 800.	/fudgeable constant
	jmp rb2

apq=.-prq
	0	/chain of active processes
	0	/low priority processes
	0	/hung process
cp,	apq+2	/apq of currently running process
alarm1,	0	/goes positive when time to reschedule
alarm2,	-800.	/goes positive when time to update

cmq,	0
cmp,	exc	/current sphere
prc,	cs1	/current process
who,	arl	/process for which last swap was done

tsb,	0	/switches and buttons
t0,	0
t1,	0
t3,	0
t4,	0
t6,	0
t7,	0
t8,	0

cs1,	525252	/hung process
	420000+.+2
	dac i .
	dac cs1+2
	520052
	exc
t,	0
cs1+prn,	mtp
	exc
cs1+prq,	0
cs1+prs,	0

/memory protection violation
/attempted core in IO,t4

ila,	lxr cmp
	lac i imr
	sma
	jmp ill+4
	law 6
	jmp spr	/would be nice to pass the attempted core

adf,	cli	/extend snag
	jmp adf+7
adf+2,	lio i 3	/last snag
	lac i 1
	TAAX
	A+X<M
	jmp ady
adf+7,	lac (77777
	jmp ady+3

adx,	lio i 3	/xsum snag
	lac i 1
	TAAX
	A+X>P
	cla
ady,	and (70000
	A+II
	law 7777
ady+3,	dio t
	rfa
	lxr (-070000
	X+IX
	and i 0
	add t
adc,	lio cmp
	dio cmq
adc+2,	ral 6s
	and (7
	lia	/attempted core in AC, IO
	dac t4
	sub (6
	sma
	jmp ila	/core can't exist
	lac cmq
	A+IX
	lac i 1
	sza i
	jmp ila	/core doesn't exist
	lac prc
	sad who
	jmp adb
	sni
	dzm cmp	/came from rm3-1
	TAX
	lac i prs
	adm i prs
	lac (010000
	adm i prq
	jmp pre

/bring program field t4 of computation cmq into core, preserving
/core 0 of running computation
/return with XR, CR set up for cmq

adb,	lxr cmp
	lio i 0
	cla
	rcl 3s
	dac t2	/this sphere's core 0
	ZAIX
br1,	xor t2
	TAP
	sas i cc
	jmp br0
	lac i bc
	AMI.>
	jmp br0
	X.AI
	dac t0	/least recently used core
br0,	SXXA
	sas (4
	jmp br1

/bring program field into core
/computation in cmq, absolute core (already selected for priority) in t0
/pseudo core in t4, must exist and be on the drum (translation = 6)

	idx bc
	idx bc+1
	idx bc+2
	idx bc+3
	lxr t0
	dzm i bc
	lac i uc
	sza
	jmp br2
	lac wf	/no previous inhabitant
	dac i fdf	/adm rt will dismiss this field
	dzm wf
	jmp br3

br2,	dac t1	/primary field word
ct1,	dac t2	/current field word
	and (7770
	dac t3	/computation block
	TAAX
	lio i 0
	xor t2
	TAX
	xct i r1
	CXX
	law 6
	rcr 3s
	xct i r2
	lxr t3
	dio i 0	/clear translation of previous inhabitant
	lxr t2
	law 3777
	and i 1	/get next attachment
	ior (4000
	sas t1
	jmp ct1
	TAX
	law 3777
	and i 1
	ior wf
	dac i 1	/mark last inhabitant on drum

br3,	lac t4
	add cmq
	dac t1	/assignment word
br4,	dac t2
	TAAX
	and (7770
	dac t3
	law i 3777
	and i 1
	sza i
	jmp br5	/just an attachment
	dac rf	/the real field
	xor i 1
	ior (400000	/4000 for new drum
      	dac i 1
	TXA
	lxr t0
	dac i uc
br5,	lxr t3
	lio i 0
	law 7
	and t2
	TAX
	xct i r1
	lac t0
	rcr 3s
	CXX
	xct i r2
	lxr t3
	dio i 0	/fix up translation
	sas (600000
	jmp .	/was already in core
	lxr t2
	law 3777
	and i 1
	ior (4000
	sas t1
	jmp br4
	lac t0
	rcr 3s
	lcr
	lac wf
	ral 1s
	dac wf
	dra
	lac .
	lai
	add (30
	dap wf
	dap cf
	lio wf
	dia
cf,	law .
	lio rf
	ril 1s
	dcc
	jmp de9	/keep trying
	lac rf
	dac wf
	lxr cmq
	lio i 0
	lcr
	jmp rm3

rf,	0	/last read field
wf,	0	/last write field

/drum error recovery

de9,	law 7777
	and wf	/clear write field
	lia
	jmp cf-1

/tables to rotate translation word

r1,	ril 3s	ril 6s	ril 9s
	rir 6s	rir 3s
r2,	nop

ivw,	rfa	/ivk trap without PRL
	lxr (-70000
	X+IX
	law 77
	and i 0
	lia
	lxr cmp
	law 7777
	and i con
	TAXP|
	jmp ill
	law i nuf
	A+I<
	jmp ill
	jmp ivt+2

ivt,	rfa	/ivk trap with user PRL
	lxr (-070000
ivt+2,	dio t7
	X+IXI
	dio t2	/address of capability
	lac i 0
	dac t8	/capability word
	TAIP|
	jmp ill	/does not exist
	rcl 6s
	rir 6s
	sar 2s
	sad (17
	jmp etr	/enter
	lxr prc
	sad (16
	jmp twi	/twr ivk
	sar 1s
	dio acp	/low 12 bits of capability
	lxr i 0
	X.AX
	cli
	rcr 3s
	xct i .+1
	jmp drm	/0 - drum field
	jmp ssp	/1 - entered process
	jmp ifs	/2 - sphere
	jmp pgq	/3 - programmed queue
	jmp ill	/4 - directory
	jmp ill	/5 - file
	jmp ill	/6?

drm,	lxr prc	/drum ivk
	lac i 2	/drum sector
	ral 6s
	lio acp	/drum field
	rcr 6s
	lio t8
	ril 5s	/write permit

/A = drum field and sector
/IO(0) = write permit
/XR = prc
/user AC = count
/user W = core address
/user AC(13) . write
/F5 = 0

dr0,	and (777740
	dac t	/drum field and sector
	lac i 0
	rar 5s
	TA>P
	stf 5	/write
	cmi
	spi>>05<<szf 5
	ubs	/write permit error
	law 7740
	and i 0
	lia	/count
	lac i di1
	sfa
	jmp adc	/not in core
	dac t1
	lxr cmp
	jda ach	/check validity
	jmp ill	/wraps around or violates PRL
	szf 6
	jmp fs0	/doing read/write sphere

/t = drum field and sector
/t0 = count
/t1 = core address
/F5 . write

dr1,	szf 5
	jmp dc2
	lac t	/put in dcc format
	dip t0
	law 0
	dip t

dc2,	dra
	xct .+2
	lai
	sub t
	and (7777
	sub (7652
	and (-77
	sza
	jmp dc3
	lio t
	dia
	lio t0
	lac t1
	dcc
	ubs
	jmp skk

dc3,	jsp srv
	jmp dc2

/check for wraparound, PRL violation
/A = core address
/I = count
/X = sphere (saved)
/skip if ok

ach,	0
	dap ahx
	dio t0	/count
	law 7777
	and ach
	A.IAP
	sub (i
	A+I.<
	jmp ahx	/wraps around
	lac (077700
	lio i con
	ril 2s
	spi
	and ach
	sza	/skip if PRL violation
	idx ahx
ahx,	jmp

ssp,	rar 1s	/entered process ivk
	sma
	jmp mrw	/read-write memory
	and (7
	lxr cmp
	lio i con
	ril 1s
	TAX
	xct i .+1
	jmp sp0	/11 - read state
	jmp sp1	/31 - set state
	jmp sp2	/51 - continue
	jmp sp3	/71 - return
	jmp sp4	/111 - cause illegal inst.
	jmp sp5	/131 - return and skip
	jmp sp6	/151 - read process number
	jmp ill	/171

sp1,	stf 6
sp0,	stf 2	/read/write process state
sp0+1,	lio (3
	lxr prc
	lac i 2
/transmit info with user's core
/A = user core address
/I = count
/acp = core 7 address
/F6 . write
/F4 . read/write process state
/F2 . read A I W

sp0+4,	sfa
	jmp adc
	lxr cmp
	jda ach
	jmp ill
	law 1
	sub t0
	lia	/1-count
	lac (070000
	ior acp
	TAX
	eem
s01,	aam
	lac ach
	szf i 6
	lac i 0
	aam
	dac ach
	dac i 0
	idx ach
	SII<=
	jmp s02
	SXX
	szf i 2	/to skip over PC
	sni>>05<<szf 4	/to skip over core rename
	SXX
	sni>>05<<szf i 2
	jmp s01
       	SXX	/to get W
	SXX
	jmp s01

s02,	lem
	szf i 4
	ubs
	lxr t	/doing read/write process state
	lio i con
	ril 2s
	lxr acp
	lac i 4
	and (-013700
	spi
	ior (010000
	dac i 4	/replace PRL
	lac i 1
	and (-xct	/clear PRV
	dac i 1
	jmp skk
sp5,	lxr acp
	law 1
	add i 1
	spi i
	dap i 1
sp3,	lac (10000
	jmp sp4+1
sp2,	ZAP
sp4,	lac (20000
	spi
	jmp wcl	/C-list is locked
	lxr t2
	dzm i 0	/delete capability
	jda crock-1
	lxr prc
	lio i prs
	lxr acp
	lac crock-1
	sza
	dip i prn
	TAP
	dip i prn+1
	dio i prs
	jsp acp+1
	ubs

sp6,	cli
	lac acp
	TAX
	SII
	law 7777
	and i prn+1
	sza i
	ubs	/abandoned
	sas i 5
	jmp .-7
	lxr prc
	dac i 2	/computation
	dio i 0	/process number
	jmp skk

ifs,	lxr prc	/sphere ivk
	lio i 2
	rar 1s
	sma
	jmp rrr	/read-write
	and (77
	TAX
	law 60
	A^XP
	jmp mt8	/let George do it
	law i 10
	X+A<M
	jmp ill
	lac cmp
	dac cmq
	lac acp
	dac t
	xct i .+1
	jmp dsb	/12 - suppress processing
	jmp enb	/32 - permit processing
	jmp coa	/52 - attach
	jmp rat	/72 - reverse attach
	jmp rdp	/112 - read process state
	jmp wrp	/132 - write process state
	jmp rbs	/152 - read bpt state
	jmp wbs	/172 - write bpt state

rat,	dac cmq	/reverse attach
	lac cmp
	dac acp
coa,	A.IAX	/attach
	ral 6s
	and (7
	dac t3	/attaching field
	sub (6
	X.A<M
	ubs
	and (7
	dac t4	/attached field
	sub (6
	A.IX
	law arc
	sas cmp
	lac i con
	ral 2s
	swp
	spi	/check for attaching PRL field
	sas (-6
	sma
	ubs
	lio i 0
	lxr t4
	xct i r1
	dio t2	/translation from attachee
	lac acp
	adm t4
	TAX
	sad i 1	/see if attachee exists
	ubs	/no
	law 3777
	and cmq
	add t3
	dac t0
	TAX
	sad i 4001
	jmp co8	/attacher is nonexistent
	law 3777
	and i 4001
	sas i 4001
	ubs	/attacher is real core
	lia	/remove previous attachment
	TAX
	law 3777
	and i 4001	/follow attachment ring around
	sas t0
	jmp .-4
	xor i 4001
	A>>05<<IA
	dac i 4001
co8,	lxr cmq
	lac t2
	lio i 0
	lxr t3
	xct i r1
	rcr 3s
	CXX
	xct i r2
	lxr cmq
	dio i 0	/insert new translation
	lxr t4	/put attacher in ring
	lio i 1
	law i 3777
	A^IA
	A~II
	ior t0
	dac i 1
	lxr t0
	dio i 4001
	jmp skk

/stop processing in a computation, remove soft waits

dsb,	TAX
	lac i con
	ior (400000
	dac i con
dsd,	law 7777
	and i prn
	TAAX
	sad t
	jmp dse
	jda rms	/remove each process from iot wait
	lac (400000
	ior i prq
	dac i prq
	jmp dsd

dse,	lxr (apq	/remove processes from run queue
	jsp dsf
	lxr (apq+1
	jsp dsf
	lac cmp
	sad t
	jmp hgn	/suppressed self
	ubs

dsf,	dap dsx
dsf+1,	law 7777
	and i prq
	TXI
	TAXP|
dsx,	jmp .
	lac i prq
	spa
	TIX
	dap i prq
	jmp dsf+1

enb,	add (clw-prq
	jda rct	/restart procs waiting to enter
	lxr t
	lac i con
	and (377777
	sad i con
	ubs	/was already enabled
	dac i con	/turn off stop bit
usl,	law 7777	/check each process
	and i prn
	sad t
	ubs
	TAX
	lac (-400000
	adm i prq
	TXA
	jda acp
	jmp usl

wrp,	stf 6
rdp,	cmi>>05<<stf 4	/read/write process state
	TAX
rdp+2,	law 7777
	and i prn
	sad acp	/look for selected process
	ubs	/does not exist
	TAAX
	SIIP
	jmp rdp+2
	dac acp
	lac i prq
	sma
	ubs	/not stopped
	and (060000
	sza>>05<<szf 6
	ubs	/process is in a wait
	szf i 6
	jmp .+3
	dip i prn
	dip i prn+1
	lxr prc
	lac i di1	/core address
	lio (6
	jmp sp0+4

wbs,	stf 6
rbs,	law bp1	/read/write breakpoint status
	adm acp
	jmp sp0+1

mrw,	lxr acp
	law 0
	sad i prn+1
	ubs	/logged out
	lac i 5
	dac acp
	lxr prc
	lio i 2
rrr,	clc>>05<<swp>>05<<stf 6
	jmp dr0

fs0,	lac t
	lio t0
	lxr acp
	jda ach	/check sphere address
	ubs
	lac t
	ral 6s
	and (7
	dac t2	/sphere field
	A+XX
	sub (6
	sma
	jmp ill	/illegal field
	law 3777
	A^XX
fs3,	lxr i 4001
	TXXIP|
	ubs	/referenced field not assigned
	A^XX
	X~IP|
	jmp fs3	/trace attachment ring
	X~IA
	sad (400000	/4000 for new drum
	jmp fsc	/in core
	ral 1s
	dip t	/on the drum
	jmp dr1	/do the transfer there

/t = sphere addr
/t0 = count
/t1 = core addr
/t2 = sphere field
/F5 . write

fsc,	lac t1
	ral 6s
	and (7	/own core field
	lxr acp
	lio i 0
	lxr t2	/referenced core field
	xct i r1
	swp	/A(0-2) = translated core
	lxr cmp
	lxr i 0
	X.IX
	xct i r1	/own translated core
	szf 5
	swp

      	rir 3s
	rcr 3s
	lcr	/read core 0, write core 1
	lio t1
	law 7777
	A^II
	and t
	szf 5
	swp
	lxr t0
	A+XA
	sub (1
	dap fsr	/last address
	lai
	ior (010000
	CXX
	SXX	/1-count
	eem
fsr,	lio i .
	X.AX
	dio i 0
	X.AX
	SAA
	SXX>
	jmp fsr
	lem
	jmp skk

pgq,	rfv	/queue ivk
	ril 6s
	sni
	SAI
	law i 2
	A+II.<
	jmp mt8
	lac acp
	TAAX
	TIP|
	jmp rlq	/release queue
	lac i prq	/enter queue
	spa
	jmp eq8
	lio prc
	lac i prq+1
	dio i prq+1
	X.IX
	dio i prq
	X.AX
	dap i prq
	jmp hng
eq8,	SAA<
	TXXA
	dac i prq
	ubs

rlq,	lio (-1	/release queue
	lxr i prq
	TXX>
	jmp rq3
	A~XP
	jmp rq4
rq2,	TAX
	dio i prq
	ubs
rq3,	I+XI<
	SII	/avoid underflow
	jmp rq2
rq4,	lia
	lac (10000
	dip i prn
	law 7777
	and i prq
	X.IX
	dac i prq
	X~AP|
	dac i prq+1	/queue now empty
	lai
	jda acp
	ubs

/send ivk to adm rt for action
mt8,	law 77
	and t7
	rfv
	rir 6s
	A>>05<<IA
	dac t
       	law 4x2
	jmp ntr

                
etr,	lio t8	/enter
	law 77
	A^IAX
	rfv
	rir 6s
	A>>05<<IA
	dac t
	law 7700
	lio t8
	A^IAP|
	jmp btt
	ril 5s
	spi
	jmp mt8	/master entry
	rar 5s

/enter, objectx2 in AC
/transmitted word in t (goes to IO)

ntr,	dac t6
	TAX
	lio i ntb
ntu,	law 7777
	A^IAXP|
	jmp ill	/entry was deleted
	dac cmq	/computation being entered
	lac i con
	TAAI<M
	A+IAI>P
	jmp ntt	/suppressed or C-list locked
	A+I<M	/check for core 0 C-list
	jmp ntp
	lio i 0
	lcr
	law 0
	sfa
	jmp adc+2	/bring it into core
	lxr (-070000
	law 100
ntq,	dac t4	/look for slot for entered process capability
	law 0
	SXX
	SAA
	sad t4
	jmp ntt	/full
	lio i 0
	X.IP
	jmp .-6
	dap ntv
	dio t2	/address
	lxr cmq	/look for a process
	lio i prh
	TII.<
	jmp .+7	/hoard is not empty
	lio frp	/hoard empty, check pool
	sni
	jmp ntz	/too bad
	law i 1
	adm i prh	/increase debt

      	lxr (frp-prh
	aam	/unlink from hoard or pool
	lac i prh
	dac i prh
	dio acp	/new process
	lxr cmq
	lac i con
	rar 3s
	and (010000
	lxr cmp
	lio i spe
	lxr t6
	TXXP
	lio i ntb+1
	lxr acp
	dio i 1	/PC
	dac i 4	/PRL
	lac t
	dac i 2	/transmitted word
ntv,	law	/capability index
	dac i 0
	dzm i 3
	dzm i prq
/dzm i di1?
	lac cmq
	dac i prn
	dac i 5
 X.AX
	lio i prn+1
	dac i prn+1
	TIX
	dap i prn
	X.AX
	dac i prn+1
	jsp crock
	lxr prc	/fix priority
	law 3700
	and i 4
	lio i prs
	lxr acp
	dio i prs
	dap i 4
	lac prc
	TXI
	sad who
	dio who
	ior (150000
	lxr t2
	dac i 0
	stf 5
	jmp hng	/hang entering process
ntk,	law apq
	dac cp	/enteree is not low priority
	lio acp
	dio prc
	lpp
	jmp si5

ntp,	law 7777
	and i con

       	TAXP|	/check for core 7 C-list
	jmp .
	law 20
	jmp ntq

ntt,	law clw-prq
	add cmq
	jmp wta

ntz,	lac t6	/can't get a process

/hang process until it gets another
/reason in AC

fr8,	rar 7s
	lxr prc
	dip i prn
	law cpp-prq
	dap i prq
	TXA
	lxr cpp+1
	dac cpp+1
	dap i prq
	lxr prc
	lac (060000
	jmp hag

rdr,	xct rds
	jmp rd2
	law rdt	/initialize reader
	jda rct	/restart any stray process
	lac rip
	dac rop
	law i 3
	dac r00
	law 600
	dap rds
	dap srr	/turn on reader
	dap rdn	/turn off end of tape
	dap rrs	/buffer empty
	lio ck2	/turn on extra interrupts
	xct ckr
	lqn
	rsf
	rpa-i
rd2,	law rdt
rrs,	skp 600	/skip if buffer empty
	jmp rop
rdn,	skp i 600	/skip if end of tape
	jmp wtt
	law 0
	dap rds
	ubs

rb1,	sma
	jmp rd2
	lio prb
	ral 2s
	rcl 6s
	dio prb
	isp r00
	jmp rd2
	law i 3
	dac r00
	jmp skk-1

rop,	lac b
	dac t
	lio (skp 600
	idx rop
	sad (lac erb
	lac (lac b
	dac rop
	sub rip
	sza i
	dio rrs	/buffer empty
	sas (erb-b-rwm
	sad (-rwm
	jmp rbo	/buffer nearly empty, turn on reader
rab,	lio t8
	ril 5s
	lac t
	TI>P
	jmp rb1
	rcl 8s	/alpha
skk-1,	dio i 0	/process still in XR
skk,	lxr prc
	law 1
	add i 1
	dap i 1
	ubs

rbo,	dio srr
	lio (1
	xct ckr
	lqn
	jmp rab

r00,	0	/rpb count
prb,	0	/rpb word

pch,	spn
	lia
	law pnt
	sbf i
	jmp wtt
	lxr (1
	jsp itf
	ubs

wa,	lac i 4	/wat
	and (164000	/ESI?
	sas (040000
	jmp ill	/probably Shockey
	law sbm
	jmp wta

/typewriter ivks

twi,	sir 6s
	ril 1s
	dio t6
	law 3400
	and i 0
	rar 8s
	TIX
	rfv
	ril 6s
	sni
	SAI
	law 10
	AMIAI>
	jmp mt8	/variant .> 10
	sad (1
	jmp ill	/variant = 7 (clear input buffer?)
	lpf
	iam
tws,	lac i qqt
	TAAI>P
	jmp twd	/disabled
	A+I>P
	jmp tww	/at top of tree
	law i 7777
	and i qqt+1
	ral 7s
	TAXP|
	die
	jmp tws

to,	stf 6	/tyo trap
ti,	scn	/tyi trap
	ril 5s
	law 20
	A+IX
	stf 4
	jmp tws

twd,	law qqt-prq
	A+XA
	szf 4
	jmp twl
	lio t8	/enable/disable
	ril 5s
	spi i
	jmp ill	/enable/disable not allowed
	jda rct	/restart
	idx rct
	jsp rct+1
	lxr t6
	lac i qqt
	and (377777
	szf i 6
	ior (400000
	dac i qqt
	ubs

        tww,	szf i 4
	jmp twd
	law i 6
	A+XAI
	rar 1s	/console no.
	rir 4s
	lar
	scn
	dac t3
	szf 6
	jmp too
	TAX
	xct i ra2
	jmp zcw
ti6,	sps
	sbe i
	jmp wtl
	jsp ite
	xct i ra2
	jmp zti
rei,	lxr prc	/return with IO
	szf i 5
	dio i 2	/to IO
	szf 5
	dio i 0	/to AC
rel,	lxr cmp
	lio i aw1
	lar
	spn	/?
	scn
	ubs

too,	lxr prc
	lio i 2
	szf 5
	lio i 0
	dio t
to3,	lxr t3
	sps
	jsp if0	/first char
	sbf i
	jmp wtl
	xct i ra2
	jmp zto
	lio t
zo2,	jsp itf
	jmp rel

wtl,	lxr cmp
	lio i aw1
	lar
	spn	/?
	scn
	lac t3
	ral 1s
	add (tyt
twl,	szf 6
	SAA
	jmp wtt

zti,	law 77	/selectric tyi
	A^IA
	lio (100
	sad (66
	ZIP
	sad (65
	jmp zic
	lio i zc2
	jmp zlk
zic,	dio i zc2
	jmp ti6

zto,	law 77	/selectric tyo
	and t
	lio (100
	sad (72
	ZIP
	sad (74
	dio i zc1
	lio i zc1

zlk,	dac t0
	dio t1
	A>>05<<IA
	dac t2
	lxr (ktb-kte-1
zll,	SXXIAP|
	jmp zlf
	lio i kte
	szf i 6
	ril 9s
	law 0
	rcl 7s
	sad t2
	ZIP
	sad t0
	TII.<
	jmp zll
	lac i kte
zlf,	lxr t3
	szf i 6
	ral 9s
	rar 2s
	TI.>
	ior t1
	lio (77
	A^II
	and (100
	szf i 6
	jmp zi2
	sad i zc2
	jmp zo2
	dac i zc2
	lio (66
	sza
	lio (65
	jsp itf
	jmp to3
zi2,	sad i zc1
	jmp rei
	dac i zc1
	dio i zsc
	lio (74
	sza i
	lio (72
	jmp rei

zcw,	lio i zsc	/check if char waiting
	TIIP>
	jmp ti6
	law i 0
	dac i zsc
	jmp rei

define z a,b,c
ax4000 bx4 cx2002 1001
termin

/table part 1 - upper and lower case the same
ktb,	z 61,17,1	/a
	z 62,14,1	/b
	z 63,15,1	/c
	z 64,12,1	/d
	z 65,13,1	/e
	z 66,10,1	/f
	z 67,11,1	/g
	z 70,3,1	/h
	z 71,2,1	/i
	z 41,37,1	/j
	z 42,34,1	/k
	z 43,35,1	/l
	z 44,32,1	/m
	z 45,33,1	/n
	z 46,30,1	/o
	z 47,31,1	/p
	z 50,23,1	/q
	z 51,22,1	/r
	z 22,54,1	/s
	z 23,55,1	/t
	z 24,52,1	/u
	z 25,53,1	/v
	z 26,50,1	/w
	z 27,51,1	/x
	z 30,43,1	/y
	z 31,42,1	/z

	z 57,20,1	/(
	z 55,56,1	/)
	z 0,7,1	/space
	z 36,6,1	/tab
	z 77,4,1	/c.r.
	z 34,47,1	/black
	z 35,44,1	/red
	z 75,24,1	/backspace
	z 75,5,1	/index . backspace
	z 60,5,1	/60 . index

/table part 2 - upper and lower case separate

	z 20,76
	z 1,77
	z 2,74
	z 3, 75
	z 4,72
	z 5,73
	z 6,70
	z 7,71
	z 10,63
	z 11,62

	z 174,165	/upper case shift
	z 72,66	/lower case shift

	z 101,175	/uc numbers
	z 102,172
	z 103,174
	z 104,176
	z 105,163
	z 106,157
	z 107,173
	z 110,170
	z 111,171
	z 120,116

	z 21,162	/ /
	z 121,160	/ ?
	z 33,40	/ ,
	z 133,60	/ =
	z 40,100	/ _
	z 140,136	/ .
	z 54,36	/ -
	z 154,16	/ +
	z 56,140	/ .
	z 156,177	/ |
	z 73,0	/ .
	z 173,57	/ =
kte,

/microtape unit monitor

mus,	szf i 6	/end of tailspin
	jmp mtg	/already stopped
msp,	lac (-010000	/stop tape
	adm i mtt+7
	law tec
	szf i 1
	law i tec
	adm i mtt+5	/fudge block number
	mot 500	/stop
	spi
	jmp un6

mtg,	unt 100	/unit wait
	unt	/read unit number
	rir 9s
	law 30	/or 170 for 20 units
	A^IX
	ril 9s
	lac (100000
	lok
	mot	/motion select
	ior i mtt+7	/turn on ready bit
	mot 100	/skip ready
	and (7777
	A.I<M	/skip if block or end mark
	jmp un5
	lac (-200000
	mot 300	/skip EOT
	jmp un4	/block mark
	A>>05<<IM|	/in end zone
	jmp un5	/already know about it
	AMIA	/turn on end
	ior (070000	/clear lastrev, need, moving
	CAA<M
	ior (040000	/turn on lastrev if not fwd
	lia
un5,	dio i mtt+7
	law 10	/check whether to end block wait
	A^IP|
	jmp mtg	/not waiting
	ril 6s
	lpf
	iam
	szf i 6
	jmp un6	/not moving
	szf 2
	jmp mtg	/in end zone, coming out
	ril 7s
	spi
	jmp msp	/want to stop
	lac i mtt+4
	sub i mtt+5
	szf i 1
	cma
	TA.<	/number of blocks to go
	jmp mtf
un6,	law i 30	/terminate block wait
	and i mtt+7	/clear wait, stop flags
	dac i mtt+7
	rar 6s
	TAI<M
	jmp mus	/in tailspin, stop tape
	frk
	mtl
	jmp mtg

mtf,	szf 5	/check whether to search
	sas dtf
	jmp mtg	/busy, or don't need to search
	idx dtf
	ivk 174	/enter queue
	frk
	mtg
	TXXI
	ril 9s
	dat	/data select
	dat 400	/search
	dat 300	/read status
	spi i
	jmp mth	/block delay or end mark
	dat 200	/read block number
	law 1777
	A^II
	dio i mtt+5	/new block
	lac (-020000
	lok
	and i mtt+7
	dac i mtt+7	/clear need
mth,	ivk 274	/release data control
	law i 1
	adm dtf
	qit

un4,	A^II>P	/block mark, clear end bit
	cma
	ral 2s	/+1 or -1, depending on direction
	adm i mtt+5
	jmp un5

tbc.=4	/tape beginning coast distance
tec.=1	/tape ending coast distance

/microtape entry
/index in AC, 10xunit number in XR

mte,	lxr (30	/or 170 for 20 units
	ril 3s
	X^IX	/unit no. x10
	iam
	lok
	lio i mtt+7
	rir 6s
	spi i	/busy flag
	jmp .+5
	dap .+2	/unit is busy
	law 111
	ivk .
	qit

	dap i mtt+6	/set up entered process
	law 40	/mark it busy
	dap i mtt+7
	law mtt
	A+XI
	law 11
	xct i mtt+6	/get state of calling process
mtd,	lio i mtt+0	/see whether to translate
	ril 2s
	law 1777
	and i mtt+1
	spi
	jmp mbt
	ior (777000	/translate block number
	ral 9s
	sar 8s
	spa
	cma
mbt,	rir 1s
	spi
	law i 5000	/rewind, set desired block negative
	dac i mtt+3
	rir 1s
	law 10
	rcl 2s
	dap i mtt+7	/set up control flags, clear attempt count
	lac (-200000
	A^XX	/to indicate data is not in buffer

mtl,	law 100	/decide what to do next
	lok
	adm i mtt+7	/count attempts
	ral 6s
	TAAI>P
	jmp mt0+1	/too many
	lpf	/load tape flags
	iam
	szf i 3
	jmp mt0	/tape not ready
	and (000125
	sad (000124
	jmp mdo	/rewind complete
	law 341
	A^IA
	sad (301
	jmp mdo	/rewind complete
	lac i mtt+3
	sub i mtt+5	/actual block
	szf i 6
	jmp ms1	/tape not moving
	lia	/bum?
	szf 1
	cmi
	law tbc+tec+2
	A+II.>
	jmp ms9	/a long way to go, wait
	AMI.<
	jmp mh1	/very close
mh2,	law 2xtbc+tec+3	/went past, or can't get control
	TII=	/skip if can stop in time
	AMI>	/must go past and turn around
	jmp mst	/far enough past, stop
	law i tbc+1	/wait
ms9,	szf 1
	cma
	add i mtt+3	/get waiting block number
	dac i mtt+4
	law 10
mda-1,	adm i mtt+7	/block wait flag
mda,	TXX<M
	qit
	jmp mth	/release data control

mh1,	TXX>P	/try to get data control
	jmp m12-1	/already have it
	cla
	sas dtf
	jmp mh2	/busy
	idx dtf
	ivk 174
	TXXI
	ril 9s
	dat	/data select
	jmp m12
mst,	law 30	/turn on stop flag
	jmp mda-1

ms1,	szf 2	/tape stopped
	jmp ms4	/in end zone
	CAI<
	cma
	sub (2xtbc+tec+1
	szm
	jmp srt	/quite far away
	add (tbc+tec	/fairly close
	szm
	jmp mr3
	cmi	/too close, go away
srt,	law tbc	/start tape, direction in IO
	spi i
	cma
	adm i mtt+5	/fudge block number
srt+4,	X.IA
	ril 9s
	mot	/motion select
	spa
	mot 600	/forward
	TAI<M
	mot 700	/reverse
	mot 400	/go
	lac i mtt+7	/turn on moving, need
	ior (430000
	spi i
	and (370000	/and direction bit
msu-1,	dip i mtt+7
msu,	ulk
	jmp mtl

ms4,	lio (1102	/start from end zone
	szf 4
	lio (-1
	dio i mtt+5	/set up block number
	jmp srt+4
mr3,	lac i mtt+7	/stopped a reasonable distance away
	rcl 1s
	rar 1s
	dac i mtt+7	/put in direction bit
	idx dtf	/get data control
	ivk 174	/wait as long as necessary
	TXXI
	ril 9s
	dat
	lac (030000
	lok
	ior i mtt+7
	dac i mtt+7	/turn on moving, need
	mot	/motion select
	spa
	mot 600	/forward
	sma
	mot 700	/reverse
	mot 400	/go
m12-1,	ulk
m12,	law 7400
	mta
	lac (400000
	A>>05<<XXA	/to indicate that this unit has data control
	A+X>P
	jmp m15	/stuff is in buffer, too
	lac (200000
	A>>05<<XX
	law i 37
	and i mtt+0
	sas i mtt+0
	jmp mt2	/not on 40 word boundary
	lio i mtt+7
	rir 2s
	A.I<M
	jmp m15	/read
	law 401
	xct i mtt+6	/move stuff into buffer
	jmp mt2
m15,	lio i mtt+7	/ready to try the transfer
	rir 2s
	lac i mtt+3
	spi
	dat 600	/write
	spi i
	dat 500	/read
	dat 300	/get status
	lac (140000
	A^IP
	jmp mtl	/block delay or end of tape
	lac i mtt+3
	dac i mtt+5	/store correct block number
	lac (-020000
	lok
	and i mtt+7
	dac i mtt+7	/clear need bit
	ulk
	spi
	jmp m16	/wrong block number
	ril 1s
	dio tpb
	rar 2s
	spa
	jmp .+6	/was a write
	lio i mtt+0	/read
	law 421
	xct i mtt+6	/move stuff out of buffer
	jmp mt2	/bad core address
	lio tpb
	spi
	jmp mdn	/transfer was ok
	cla	/error
	ril 1s
	SAA
	TII.<
	jmp .-3
	jmp mt0+3

mt2,	law 2	/error 2 - bad core address
	jmp mt0+3
mt0,	ZAP	/error 0 - tape not ready
mt0+1,	law 1	/error 1 - can't find block
	ulk
mt0+3,	dac i mtt+0	/error code
	clf 6
	jmp mdf

m16,	dat 200	/read block number
	law 1777
	A^IA
	dac i mtt+5
	jmp mtl

mdn,	law 400	/block transfer complete
	adm i mtt+0
	lio (770000
	idx i mtt+1
	A^IP|
	jmp mdo
	lac (-010000
	adm i mtt+1
	A^IP
	jmp mtd
mdo,	ulk	/operation complete
	stf 6	/to step PC
mdf,	lio i mtt+7
	law tbc+4-tec	/set up tailspin
	spi i
	cma
	add i mtt+3
	dac i mtt+4
	law mtt
	A+XI
	law 31
	xct i mtt+6	/write out new AC and IO
	law 10
	lok
	dap i mtt+7
	law 71
	szf 6
	law 131
	xct i mtt+6	/return
	jmp mda	/release data control if have it, then qit

/microtape unit tables

mtt,	repeat 4,[repeat 6,0
	ivk
	0]

tpb,	0	/status

dtf,	0	/number of processes trying to use data control
		/= queue population +1

constants
end,
bpb=cms-[[cms-end]>pbl]xpbl	/beginning of process blocks

repeat if2,[decimal	printo [cms-end]>pbl-5	octal
printx . process blocks or .	printo [cms-end]
printx . words
.]

cms-5xpbl/	0
cms-4xpbl/	cms-5xpbl	/hoard for adm. rt.
cms-3xpbl/	0	/hoard for tapes
cms-2xpbl/
arl,	0	/login/logout process
	103
	0
	0
	011000
	arc
	0
	arc
	arc
	040000 csb
	0

mtp,	0	/microtape unit monitor
	mtg
	0
	0
	411000
	exc
	0
	exc	/proc. ring
	cs1
	020000	/hung
	0

cms,
arc,	0	/computation for adm. rt.
	arc+1-4000+400000	/+4000 for new drum
	arc-4000
	0
	0
	0
	0
	arl	/proc. ring
	arl
	0
	4000
	repeat 3,0
	-0
	-0
	arc
	102
	0
	.-prq
	100000	/not stopped, PRL
	0
	cms-4xpbl	/hoard
	0

exc,	767666
	exc-4000+400000	/+4000 for new drum
	0
	0
	0
	0
	0
	cs1	/proc. ring
	mtp
	0
	4000
	repeat 3,0
	-0
	-0
	arc
	102
	0
	.-prq
	100000
	0
	cms-3xpbl	/hoard
	0

save,	law 4444
	lio (200
	lar
	lea
	iam
	lem
p5_,	law i 2
	dac .pp6
	idx p4
	aam
	lac p4
	TAI=|
	jmp p8
	rcl 3s
	add (sa
	dap q1
	cla
	rcl 4s
	add (sa
	dap q0
	cla
	rcl 4s
	add (bt
	dap q2
	cla
	rcl 4s
	add (bt
	dap q3
	ril 3s
	TIX
	lac i d1
	dac .p7
	lxr i d0
q0_,	lio
	lai
	adm .r0
	iot 14
q1_,	lac
	adm .rr1
	iot 114
q2_,	lac
	adm .rr2
	iot 214
q3_,	lac
	adm .r3
	iot 314
	SXX.>
	jmp q0+1
	isp pp6
	jmp .+2
	jmp p5
	law (0
	dap q1
	dap q2
	dap q3
	cli
	lxr p7
	jmp q0+1

p4_,	m-1

p8_,	TIM
	jmp ysy
	dzm m2
	law m1-1
	dac p4
	jmp p5

/                                define n s,a,t,b,m
[[[ax20 s 4]x20 t 3]x20 b]x10 m
terminate

m_,
n 6,4,5,10,0
n 6,4,5,10
n 7,4,6,10
n 10,4,7,10
n 10,4,7,4
n 7,4,6,4
n 6,4,5,4
n 5,4,5,6,4
n 5,2,6,7,3
n 4,1,7,10
n 4,4,7,4
n 5,4,1,4
n 6,4,5,4
n 6,4,5,4,1
n 6,4,5,4,2
n 5,4,4,4,3
n 5,4,4,4,4
n 0,0,0,0,5
n 6,4,5,10
n 6,4,5,10
n 7,5,5,10
n 10,6,5,10
n 10,6,5,3
n 7,5,5,3
n  6,4,5,3
n 5,2,5,3
n 4,1,5,4
n 4,1,5,4
n 5,2,4,4
n 6,1,5,4
n 5,2,4,4,1
n 5,2,4,4,2
n 4,1,5,4,3
n 4,1,5,0,4
n 0,0,0,0,5
m1_,
n 5,0,4,4
n 5,4,4,4
n 6,4,5,4
n 4,4,7,4
n 5,4,4,4
n 6,4,5,4,4
n 7,4,6,4,3
n 6,4,5,4
n 4,4,7,4
n 5,4,4,4
n 6,1,5,4,4
n 7,0,6,4,3
n 6,7,4,5
n 5,7,2,2
n 4,1,3,6
n 5,3,3,1
n 0,4,4,4
n 6,4,5,4,1
n 6,4,5,10
n 6,4,5,10
n 7,5,5,10
n 10,6,6,10,4
n 10,6,7,10,3
n 10,6,10,3
n 7,5,10,3
n 6,4,5,3,1
n 7,2,3,3,2
n 5,5,0,3,3
n 4,1,1,4
n 4,1,5,4
n 5,2,5,4
n 6,4,5,4
n 5,2,4,4,1
n 5,2,4,4,2
n 4,1,5,4,3
n 4,1,5,0,4
n 0,0,0,0,5
m2_,	-0

bt_,
7050	7744	10726	11346
12466	13171	13717	15271
16120	sa_,	17710	21654
22713	24013	25154	27636
31163	32563	34240	37620
43530	45626	52330
d0_,
-7046	-10054	-4754	-2265
-5312	0
d1_,	-1003	0	-526
-252	0	-12625
consta
repeat ifp .-7400,printx /lose/
variab

nfd1=106
ncd1=107
frd2=110
sd1=113
sd2=142

7400/

sav,	lem
	iam
	ZAIXP
	SXXI
	sas i cc
	jmp .-2
	dzm i bc	 /found a good core
	law arc
	dac i uc
	lac (667600
	rcr 3s
	TXXI
	rcr 3s
	dac arc	/core rename
	lbe	/I=0
	dia
	lia
	lcr
	eem
	lio (210000	/adm. rt. on field 21, loc. 3400
	law 4400
	dcc
	hlt
	lxr (-100
	dzm i 100
	SXXP
	jmp .-2
	lac (740002
	dac i 74	/give it console switches
	lac (340000+qqt+2-prq
	dac i 77	/give adm rt a queue
	lxr (-5	/give it twrs
	lac (740502
	dac i 62+5
	add (101
	SXXP
	jmp .-3
	nam
	lac (70000 dd2
	dac .ptr
lp2,	lac i ptr
	and (710000
	sas (010000
	jmp lpl	/not a read/write drum field
	law 177
	and i ptr
	dap sv3
	TAAIX
	ior (050000
	dac i ptr
       	law i 26
	sni i
	A+I.<
	jmp lpl	/illegal field
	iam
	lio i sd1
	spi
	jmp sv1
	lac (add 1
	dac i sd1
	law sd1
	A+XA
	lxr (frd1
	sad i 0
	jmp sv2
	lxr (frd2
	sad i 0
	jmp sv2
	TAX
	law i 1
	A+XX
	lac i 0
	spa
	jmp .-4
sv2,	dio i 0
sv3,	law	/field no.
	sub (sd2-sd1
	TA<M
	law frd2-frd1
	TAX
	idx i nfd1
sv0,	nam
	jmp lpl+1

sv1,	idx i sd1	/shared field
	jmp sv0

lpl,	dzm i ptr
	idx ptr
	sas (070000 dd6+nuf
	jmp lp2

	iam
	ZX	/find a waste field
	lac i frd1
	TAP|
	lxr (frd2-frd1	/drum 1 full
	lac i frd1
	sza i
	hlt	/can't
	aam
	lio i frd1
	dio i frd1
	sub (sd1
	rar 7s
	dac wf
	idx i ncd1
	lem
	law bpb
	dac t
      	lio frp
	aam
	dio t
	dac frp
	law pbl
	adm t
	sas (cms-5xpbl	/leave last five out
	jmp .-7
	ZX	/clear all pss words
	law i 0
	dac i cms+pss
	law 30
	A+XAX
	sas (7400-cms
	jmp .-5
	lio (cs1
	lpp
	lio (7
	scp
	sqp
	cqt
	jmp sut-1

constants
repeat ifm 7741-.,printx .saver too big.77..
variables

7741/	lat>>05<<cli
	TAP
	jmp ysy
	dia	/new system
	lio (240000
	law i 7777
	dcc
	hlt
	jmp sav
ysy,	lio (dd2+120	/saver
	dia
	lac (70000 dd2+120
	lio (247660
	dcc
	hlt
	jmp sav

consta
start 7741