                                      
/first drum part

/define - redefine old macro

eoc/
def,	jdp spu
	jsp as
	szf i 5
	jmp .-3		/flush redundant separators
	jsp mps
	jmp nxs
	lio i snw
	ril 3
	spi
	jmp mco-2
	cal 12		/ild
	jmp mco

	lac fre
	dac i snw
mco,	law i 1
	dac tc
	dzm mv4
	law 1
	add svp
	dac scm
	lac ch
	sas (36
	sad (77
	jmp mag
	law dtd 1
	jmp exm

/define new macro

nxs,	idx msa
	lio sy2
	dio i msa
	idx msa
	lac fre
	dac i msa
	cla
	sni
	dap nsm
	idx msa
	sub svp
	spa
	jmp mco
	jmp sce
                
                                
/scan macro for pseudo ops

crd,	lac sqz
	jdp sav
	idx mv4
	law nor 1
	dac ddo
mag,	jdp spu
	dac tsp
	jsp as
	szf i 5
	jmp nfr
	lac sy2
	xct nsm
	jsp mps
	jmp nfm
	sad (lac pdf 2	/define
	jmp dfc
	sad (lac pdf 5	/terminate
	isp tc
	jmp nfr
	lac tsp
	dac chp
	law i 1
	add scm
	dac svp
	jdp win
	stf 6
	lac ch
	jmp ign 1

win,	0
	law 17
	jdp put
	jdp put
	jdp put
	jdp put
	lac pub
	dap fre
	clf 2
	jmp i win

dfc,	law i 1
	adm tc
	jmp rz

cmb,	lac sqz
	jdp sav
	idx mv4
	jmp rz
                
                                
/replace dummy arguments by glitch 14

nfm,	lac svp
	dac mv5
	dzm mv6
	idx mv6
	idx mv5
	sad scm
	jmp nfr
	lac i mv5
	sas sqz
	jmp nfm 3
	lac tsp
	dac chp
	law 14
	jdp put
	lac mv4
	sub mv6
	jdp put
	law 74
	xct cas
	jdp put
	lac ch
	sas (74
	jdp put
nfr,	law 40
	sas ch
	jmp . 3
	law i 1
	adm chp
	lac chp
	dac tsp
	jmp rz

/set put origin

spu,	0
	xct fre
	sub (las
	dac chp
	sal 1
	adm chp
	jmp i spu

ter,	cal 15		/tmt
	jmp rz
                
                                
/macro brackets

obm,	xct cas
	skp 600
	jmp rz
	law i mex
	add i fup
	lia
	law obm
	jda fuu
	sni i
	jmp rz
	jmp kbm

cbm,	xct cas
	skp 600
	jmp rz
	law mex
	sad i fup
	jmp ilf
	jsp fub
	law mex
	sas i fup
	jmp rz
kbm,	law i 2
	adm chp
	jdp scp
	jsp gch
	dac fee
	jdp ucp
	xct gut
	dac ch
	law 74
	sas fee
	jmp ibm
	law 72
	sad ch
	jmp grr
ibm,	idx chp
	lac ch
	jmp gut 2
                
                                
/repeat

rpt,	law cmf 1
	dap cmf
	law rep
	jmp opc

rpe,	law ilt
	dap cmf
	szf 4
	jmp ire
res,	lac num
	dac i fus
	law mex
	dac i fup
	jdp spu
	dac tc
	law rdp 1
exm,	dac ddo
	law gut
as,	stf 2
	dap fuq
	jmp rz

ire,	cla
	dap lof
	jmp res 1

crr,	law 77
	sas ch
	jmp rz
	law mex
	sas i fup
	jmp rz
	law 15
	jdp put
	lac tc
	jdp scp
	law nor 1
	dac ddo
	law gch
	dap gut
	lac tc
	jdp scp
	lac i fus
	sza
	cma 16
	dac i fus
	spa
	jmp wil
	clf 2
g15,	jdp ucp
	idx sac
	isp i fus
	jmp rz
	jdp ucp
	jdp ucp
	jsp fub
	jmp rz
                
                                
/macro argument collection

cme,	jdp cms
	lac chp
	jdp sav
	jmp rz

cmc,	jdp cms
	lac svp
	dac smp
	lac scm
	jdp sav
	lac i fus
	jdp scp
	law nor 1
	dac ddo
	law gch
	dap gut
	stf 6
	jsp fub
wil,	law rz
	jda win

cms,	0
	law mex
	sas i fup
	jmp rz
	law i 1
	adm chp
	law 16
	jdp put
	jmp i cms
                
                                
/macro processor push down

sav,	0
	dac i svp
	law i 1
	adm svp
	sub msa
	sma
	jmp i sav
pce,	cal 14
	jmp gb

usv,	0
	idx svp
	lac i svp
	dac svp
	dac smp
	idx smp
	jmp i usv

scp,	0
	lio chg
	dio i sac
	dac chg
	lac gut
	sad (jsp nch
	dip i sac
	idx sac
	sas (las
	jmp i scp
	jmp pce

ucp,	0
	law i 1
	adm sac
	lio i sac
	dio chg
	law gch
	spi
	law nch
	dap gut
	spi i
	jmp i ucp
gc0,	law las-1
	dap gc6
	dap gc9
	cla
	dap gc2-1
	lac fre
	dap gc8
                
                                
/garbage collect

gc1,	law fre
	dap gc2
	dap gc3
	law i
gc2,	add
	lia
	sub gc9
	sma
	dio i gc2
	lai
	sub gc6
	spq
	jmp gc4
	lai
	sub i gc3
	sma
	jmp gc4
	lac gc2
	dap gc3
gc4,	law 3
	adm gc2
	sub msa
	sub (add
	spa
	jmp gc2-1
	idx gc6
	dap gc9
	dap gc5 1
	sub fre
	sma
	jmp i ucp
gc3,	lac
	dap gc5
	sub gc5 1
	sub (law-dac
	dap gc2-1
	sza i
	jmp gc6
gc5,	lac
	dac
	idx .-1
	idx gc5
	sub gc8
	spa
	jmp gc5
gc6,	law
	dap .+2
	law 77
	and .
	sad (17
	jmp gc1
	idx gc6
	sub fre
	sma
	jmp gc1
	jmp gc6
gc8,	lac
gc9,	law
                
                                
/macro processor glitches

g14,	lac gcx
	dap 1g4
	xct gut
	cma
	add i smp
	dap 14g
	sub smp
	spq
	jmp 1g4-1
	law 600
	dap cas
14g,	lac
	jdp scp
	szf 2
	jmp rz
	law ob1
	dac fuu
	jsp fuu 2
	xct gut
1g4,	jmp

g17,	jdp usv
	jdp ucp
	jmp gut

g16,	law i dtb-fum-1
	dac ch
	jdp ucp
	szf 2
	jmp gch 1
	law ob1
	dac fuj
	sas i fup
	jmp fuq 2
	jmp ob1 1
                
                                
/operators

o,	ior num
	jmp fur 1

a,	and num
	jmp fur 1

umi,	clc
x,	xor num
	jmp fur 1

d,	mul (1
	div num
	cla
	jmp fur 1

r,	mul (1
	div num
	cli
	swp
	jmp fur 1

m,	mul num
	rcr 1
	dio num
	add num
	jmp fur 1

sb,	szf i 2
	xct cas
	jmp ad
	law s
	szf i 6
	jmp qz
	law umi
	jmp opc

ad,	law p
	szf 6
	jmp rz
	jmp qz

ovb,	law 600
	dap obr
	jmp gut

p,	add num
	jmp fur 1

s,	sub num
	jmp fur 1
                
                                
/case shifts and center dot (null operator)

upc,	cla
	dap cas
ade,	szf 2
	jmp fuq
	jmp gut

lwc,	law 600
	jmp upc 1

/printx

pip,	xct gut
	dac sy2
	xct gut
	sad sy2
	jmp rz
	lia>>05<<stf 6
	xct tox
	jmp pip 2
                
                                
/flexo

flx,	xct gut
	rar 6s
	dac num
	xct gut
	ral 6s
	adm num
	xct gut
	adm num
	jmp gut-2

/character

chr,	xct gut
	sad (51
	lac tbl 2
	sad (43
	lac tbl 1
	sad (44
	lac tbl
	sma
	jmp ilf
	dac . 2
	xct gut
	0
	dac num
	jmp gut-2

/text

tex,	xct gut
	dac sy2
	xct gut
	sad sy2
	jmp gut-2
	rar 6s
	adm num
	xct gut
	sad sy2
	jmp gut-2
	ral 6s
	adm num
	xct gut
	sad sy2
	jmp gut-2
	adm num
	xct gut
	dac dcn
	sad sy2
	jmp gut-2
	lac num
	jdp tbr
	idx loc
	dzm num
	lac dcn
	jmp tex 5
                
                                
/radix

rad,	law raw
	jda fuj
dec,	law 12
	jmp oct 1

raw,	lac num
	szf 4
	law 10
	dac bas
	clf 6
	jsp fub
	jmp tab

oct,	law 10
	dac bas
	jmp rz


/parameter assignment (=)

eql,	szf i 5
	jmp ilf
	clf 5
	lac sqz
	dac num
	law eqr
	jmp opc

eqr,	szf 4
	jmp eq1 2
	dac sqz
	jsp see
	jmp eq1
	law i 1
	adm sea
	law i 1
	adm sct
eq1,	lac num
	jda shv
	jsp fub
	lac ch
	jmp gus-1

/value - on line octal print

val,	law vap
	jmp opc

vap,	lac num
	jda opt
	jmp ry

dcl,	jmp dlc
                
                                
/save constant

opn,	szf 2
	jmp fuq
	szf i 6
	jmp ilf
	law prn
	xct cas
	law obk
opc,	jda fuu
	jmp cln

prn,	lac i orp
	xct pas
	sma
	jmp pok
	law 2
	adm orp
	sas (cvb 20
	jmp prn
	cal 1		/nca
pok,	xct pas
	szf i 4
	jmp pts
	jmp prc

pts,	lac num
	dac i lol
	lia>>05<<clf 6
	szf 5
	xct pas
	jmp min
	jmp prb
prc,	law i 1
	adm lol
	dac pui
	idx pui
prb,	idx cct
prt,	lac lop 1
	add i orp
	sub pui
	dac num
	jsp fub
	law ilf
	jmp obk 3

min,	lac lol
	dac pui
	idx pui
	sad lop
	jmp prc
	lai
	sas i pui
	jmp min 2
	jmp prt
overlap xyz-.,first drum overlap
                
                                
ep2,	fld p2o
	ep2-eoc
	lio ep2
	dia
	lio ep2 1
	law eoc
	dcc
	hlt
	jmp ffg
word jmp ep2 2
                
                                /symbol pack

/numeric sort

eoc/
nuu,	lac (377777
	dac pui
	dac opt
	lac lop
	dap nu1
nu1,	lio .
	idx nu1
	sni i
	jmp nu2
nu3,	idx nu1
	sas lop 3
	jmp nu1
	lio opt
	dio ckm
	lac pui
	dac bst
	xor (400000
	jmp fnd 1

nu2,	swp
	xct nu1
	swp
	xor (400000
	dac ch
	clo
	sub bst
	sza i
	jmp nu5
	spa
	szo
	szo
	jmp nu3
	lac ch
	sub pui
	sza i
	jmp nu7
	sma
	szo
	szo
	jmp nu3
nu4,	lac ch
	dac pui
	dio opt
	jmp nu3

nu5,	lai
	sub ckm
	spq
	jmp nu3

nu7,	lai
	sub opt
	sma
	jmp nu3
	jmp nu4
                
                                
/alpha sort

all,	lac lop
	dap al1
	lac (377777
	dac pui
al1,	lac .
	and (177777
	sza
	sub bst
	szm
	jmp al2
al3,	idx al1
	idx al1
	sas lop 2
	jmp al1
	lac pui
	lia
	dac bst
	sas (377777
	jmp fnd 2
	jmp dun

al2,	add bst
	sub pui
	sma
	jmp al3
	adm pui
	idx al1
	lio i al1
	dio opt
	jmp al3 1


/set-up punch/print

sup,	0
	dap su2
	lio grr 2		/(xct tox
	szs 20
	jmp su1
	law 47
	xct xaq
	jmp du1
	lio (jda ppp
su1,	dio tym
	law m8
	jda txx
su2,	law .
	jda txx
	jmp i sup

/symbol pack variables

bst,	400000		/best symbol/value so far
                
                                
/alpha print/punch setup

alp,	law m6
	jdp sup
	dzm bst
	law all
	jmp nac

/numeric print/punch setup

nup,	law m7
	jdp sup
	law nuu

/symbol punch/print common

nac,	dap fnd
fno,	law 77
	jdp typ
fnd,	jmp .
	dac opt
	lai>>05<<stf 2
	szs i 10
	sad (377777
	jmp dun
	law ist
	dap fn1
	lai
fn1,	sad .
	jmp fn2
	idx fn1
	idx fn1
	sas (sad ise
	jmp fn1-1
	clf 2
	jmp fn3
fn2,	idx fn1
	lac i fn1
	sad opt
	jmp fnd
	dac ch
fn3,	lai
	jdp cvt
	lac (flexo =
	szs i 20
	szs 30
	law 36
	jdp typ
	jsp opt 1
	szf i 2
	jmp fno
	law 3621
	jdp typ
	lac ch
	jda opt
	jmp fno
                
                                
/parity punch

ppp,	0
	dap ppx
	law 2325
	rcr 277
	ral 7s
	and .-2
	dap . 1
	ril
	rar 7s
	rcl 7s
	xct pax
	lac ppp
ppx,	jmp .

/restore initial symbol table

rst,	lac lop
	dap . 1
	dzm .
	idx .-1
	sub (dzm-lio
	sas lop 3
	jmp .-4
	dzm sy2
	lac (add
	sub szp
	dac sct
	clc>>05<<lia
	dio cvb
	idx .-1
	sas (dio cvb 20
	jmp .-3
	law pet
	dac msa
	law las
	dap fre
	law 0
	dap inp
	law 100
	dap nsm
rs1,	lac ist
	dac sqz
	jsp see
	skp i 
	hlt
	idx rs1
	lac i rs1
	jda shv
	idx rs1
	sas (lac ise
	jmp rs1
	law cm0
	jmp du2
                
                                
/constants, variables printer

kop,	law koa
	dap koj
	jdp ko0
	spa
vop,	law voa
	dap koj
	jdp ko0
	sma
	jmp du1+1

koa,	law m1
	jda txx
	law m2
	skp i		/change to xct pas when figure out
			/how to get inclusive constants areas
	law m3
	jda txx
	law m5
	jda txx
	law koj 1
	jmp kop 1

voa,	law m4
	jda txx
	law m5
	jda txx
	law koj 1
	jmp vop 1

ko0,	0
	law cvb
	dap ko1
ko1,	lac .
	sas (-0
	xct i ko0
	jmp ko3
koj,	jmp . 1
	and (7777
	jda opt
	idx ko1
	lac i ko1
	sza i
	jmp ko4
	add opt
	sub (1
	jdp ts
	jda opt
ko4,	law 77
	jdp typ
	skp i
ko3,	idx ko1
	idx ko1
	sas (lac cvb 20
	jmp ko1
	idx ko0
	jmp i ko0
                
                                
/text printer

txx,	0
	dap txy
	law i 3
	dac opt
	lio i txx
tx1,	cla
	rcl 6s
	sad (40
txy,	jmp .
	swp
	xct tym
	swp
	isp opt
	jmp tx1
	idx txx
	jmp txx 2

m1,	357774
	637246
	text .nstants area,_.
m2,	text . reserved

_.
m3,	text . inclusive

_.
m4,	357774
	257261
	text .riables area

_.
m5,	text .from	t.
	467734
	400000

m6,	text .alpha_.

m7,	text .numeric_.

m8,	text .
/symbols _.

m9,	text .start
_.
                
                                
/initial symbol table

define this a
	a"	a
termin

ist,	this 1s
	this 2s
	this 3s
	this 4s
	this 5s
	this 6s
	this 7s
	this 8s
	this 9s
	this i
	this and
	this ior
	this xor
	this xct
	this jdp
	this cal
	this jda
	this lac
	this lio
	this dac
	this dap
	this dip
	this dio
	this dzm
	this adm
	this add
	this sub
	this idx
	this isp
	this sad
	this sas
	this mul
	this div
	this jmp
	this jsp
	this skp
	this szf
	this szs
	this sza
	this spa
	this sma
	this szm
	this szo
	this spi
	this sni
	this spq
	this clo
	this sft
	this ral
	this ril
	this rcl
	this sal
                
                                
	this sil
	this scl
	this rar
	this rir
	this rcr
	this sar
	this sir
	this scr
	this law
	this iot
	this tyi
	this ckn
	this rrb
	this cks
	this dsc
	this asc
	this isb
	this cac
	this lsm
	this esm
	this cbs
	this dia
	this dba
	this dcc
	this dra
	this lem
	this eem
	this rbt
	this bpt
	this arq
	this dsm
	this wat
	this lei
	this lea
	this rer
	this nmn
	this nmf
	this ioh
	this rpa
	this rpb
	this tyo
	this ppa
	this ppb
	this dpy
	this opr
	this nop
	this clf
	this stf
	this lia
	this lai
	this swp
	this cla
	this lap
	this hlt
	this cma
	this clc
	this lat
	this cli
ise,	377777	777777
                
                                
/done with symbol pack

dun,	lac tym
	sas (jda ppp	/check for punching
	jmp du1+1
	law m9
	jda txx
	law i 13
	jda fee
	lio .-2
	xct pax
	law i 300
	jda fee
	law i 47
	arq
	skp i
du1,	xct tox
	lio grr 2	/(xct tox
	dio tym
	law cm1
du2,	jdp drm
	eoc
overlap cvt-.,symbol table overlap

cvt/	0
	and (177777
	mul (1
	div . 1
	50
	dio . 3
	mul (1
	div .-3
	0
	jdp cv1
	jdp cv1
	lac .-3
	jdp cv1
	jmp i cvt

cv1,	0
	swp
	sni
	jmp i cv1
	swp
	add (7
	dac pui
	sar 7
	cma
	add pui
	sar 7
	add (cvo
	dap . 1
	lac .
	add pui
	swp
	xct tym
	jmp i cv1

cvo,	10	-10	37	6	-22
                
                                
ep3,	fld p3o
	ep3-eoc
	fld knn
	pet-knn
	lio ep3
	dia
	lio ep3 1
	law eoc
	dcc
	hlt
	lio ep3 2
	dia
	lio ep3 3
	law knn
	dcc
	hlt
	jmp ffg
                
                                
/storage

knn/	constants


pit,
	334773	2176	jmp str	/start
	252500	134773	jmp coo	/constants
	344724	74204	jmp var	/variables
	263577	2551	jmp flx	/flexo
	252033	130305	jmp chr	/character
	336772	36	jmp tex	/text
	255217	60635	jmp dim	/dimension
	317146	716	jmp oct	/octal
	254745	75143	jmp dec	/decimal
	330306	1432	jmp rad	/radix
pdf,	254750	75217	jmp def	/define
	336764	111320	jmp ter	/terminate
	330562	57626	jmp rpt	/repeat
	351104	16	jmp wrd	/word
	344716	2347	jmp val	/value
	323363	115323	jmp pip	/printx
	350437	114170	jmp tso	/whenever
	0	0
fre,	law las

pet,	pet 100/
buf,	buf 104/
cvb,	cvb 20/
fsp,	fsp 14/
fdp,	fdp 14/
npb,	npb 20/
sgl,	sgl 14/
las,

overlap las,beginning of free storage

p2o=pet
p3o=p2o+xyz-eoc
p4o=p3o+xyz-eoc
p5o=p4o+eob-eoc

word jmp ep3 4
                
                                
/non-ts patcher

eoc/	clc>>05<<lia
	iot 3		/tyo without wait
	cks
	ril 2s
	spi		/is tyo status bit still on
	jmp tss		/yes, must be in ts or typewriter not working
	lio (jdp i ioi
	dio pax
	dio pbx
	idx pbx
	dac tox
	idx tox
	dac rax
	idx rax
	dac dcx
	idx dcx
	lio (dio dr1
	dio dix
	cla
	dap tsh
	law 1
	dap tin 2
	lio (jdp arr
	dio xaq
	lio (p5o
	dia
	lio (fld ep5-br7
	lac (70000 br7
	dcc
	hlt
	cbs
	rrb
tss,	law i 1		/set-up symbol table constants
	add lop
	dac lop 1
	add szp
	add szp
	dap lop 2
	idx lop 2
	dap lop 3
	cks
	ril 2s
	spi i
	jmp .-3		/wait for tyo completion
	law rrs		/go to restore initial symbols
	jmp sov 1	/and command routine
                
                                
/go back to et

mll,	lio ml1
	dio 4000
	idx mll
	idx mll 1
	sas (dio 4000 ml2-ml1
	jmp mll
	lsm
	lem
	clc 20
	tyo
	lac (dcc
	dac 0
	jmp 4000

ml1,	cli>>05<<cla
	dia
	lio (614000	/et field + 4000 words
	xct tsh
	skp i
	jmp 0		/ts, start et at 2
	dcc
	hlt
	law 4000 ml3-ml1
	dap 2515		/end of et non-ts patcher
	jmp 2453		/beginning of et non-ts patcher

ml3,	law 15		/re-edit test word substitute
	jmp 6411		/just after the lat in et
ml2,			/end of get et routine

consta

eob,
	fld p4o
	eob-eoc
	lio eob
	dia
	lio eob 1
	law eoc
	dcc
	hlt
	jmp ffg

word jmp eob 2
                
                                
/sequence break routines
/cor 7


/buffer lengths_.

9lr=200		/reader buffer length
9lo=40		/type-out buffer length
9lp=2000		/punch buffer length


0/
br7,	cks
	ril 5s
	spi
	jmp 90m
	rir 4s
	spi		/reader
	jmp 90r
	ril 1s
	spi		/type-out
	jmp 90o
91d,	ril 2s
	spi		/punch
	jmp 90p

90d,	jmp i (brr
                
                                
/reader

90r,	rrb
91r,	0		/iot 1, dio ., or last char
	lac 92r		/input pointer
	spa
	jmp 92n		/right-hand character
93n,	ril 9s		/left-hand character
	dio i 92r
	add (400000	/step input pointer
	sad (92d+9lr	/end of buffer
	lac (92d
	dac 92r
	add (1
	sub 93r
	sza		/next to last character?
	sub (9lr
	lio .+2
	sza i
	dio 91r		/yes, clobber read instruction
	jmp br7

92n,	lac i 92r
	rcl 9s
	lac 92r
	jmp 93n
                
                                
/read alpha requests from program

95r,	0
	dac tac
	lac 91r
	sad 94n		/reading?
	jmp 99r		/yes
	lac 92r		/no, how many characters in buffer?
	sub 93r
	ral 1s
	spa
	add (9lr+9lr
	sub (20		/begin reading 20 characters early
	spa		/i.e. before the buffer is empty
	jmp 91n
99r,	law i 7777	/initialize counter
	dac 90t
	lac 93r		/output pointer
	sad 92r		/buffer empty?
	jmp 90n		/yes, step counter
	lio i 93r	/no, get character
	add (400000	/step output pointer
	sad (92d+9lr
	lac (92d
	dac 93r
	spa
	rir 9s		/get proper half of word
	rcr 8s
	cli
	rcl 8s
	lac tac
	jmp i 95r

90n,	isp 90t		/no character for too long?
	jmp 99r+2
91n,	lac 94n		/yes, start reader
	dac 91r
94n,	iot 1
	jmp 99r

90t,	0
92r,	92d
93r,	92d
                
                                
/type-out

90o,	lac 91o
	sza		/trying to type out?
	jmp 91d		/no
	lac 93o
	add (400000	/step output pointer
	sad (92d+9lr+9lo	/end of buffer?
	lac (92d+9lr	/if so, reset to beginning
	dac 93o
	lio i 93o
	sma		/which half word?
	ril 9s
	sas 92o		/buffer empty?
	iot 3		/no, tyo
	sad 92o
	idx 91o		/yes, set type-out indicator to "no"
	jmp br7

/type-out request from program

95o,	0
	dac tac
	dio 99o
	lac 92o
	spa
	jmp 97o
98o,	ril 9s
	dio i 92o
	add (400000
	sad (92d+9lr+9lo
	lac (92d 9lr
	sad 93o		/buffer full?
	jmp .-1		/yes, wait for completion
	dac 92o
	lio 99o
	lac 91o
	sza i		/typing?
	jmp . 3
	iot 3		/no, start typewriter
	dzm 91o
	lac tac
	jmp i 95o

97o,	lac i 92o
	rcl 9s
	lac 92o
	jmp 98o

91o,	-0
92o,	92d+9lr
93o,	92d+9lr
99o,	0
                
                                
/punch

90p,	lac 91p
	sza		/punching?
	jmp 90d		/no
	law 7777
	and i (1
	sad (99p		/program waiting for restart?
	jmp 93q		/yes.
94q,	lac 93p
	add (400000	/step output pointer
	sad (92d+9lr+9lo+9lp
	lac (92d+9lr+9lo
	dac 93p
	lio i 93p
	sma		/which half word?
	ril 9s
	sas 92p		/buffer empty?
	iot 5		/no, punch
	sad 92p
	idx 91p		/yes, set indicator
	jmp br7
93q,	lac 92p
	sub 93p
	ral 1
	spq
	add (9lp 9lp
	sub (126.	/restart 2 seconds before empty buffer
	spa
	idx i (1		/index return
	jmp 94q
                
                                
/punch alpha. request from program

95p,	0
	dac tac
	dio 91q
	lac 92p		/input pointer
	spa
	jmp 90q
92q,	ril 9s
	dio i 92p
	add (400000	/step input pointer
	sad (92d+9lr+9lo+9lp
	lac (92d+9lr+9lo
	sad 93p		/full?
99p,	jmp .		/yes, wait for nearly empty buffer
	dac 92p
	lio 91q
	lac 91p
	sza i		/punching?
	jmp 96p-1
	iot 5		/no, start punch
	dzm 91p
	lac tac
96p,	jmp i 95p

90q,	lac i 92p
	rcl 9s
	lac 92p
	jmp 92q

91q,	0
91p,	-0
92p,	92d+9lr+9lo
93p,	92d+9lr+9lo
                
                                
/punch binary request from program

94p,	0
	dac dr2
	law 2
	rcr 6s
	rcr 6s
	jdp 95p
	rcl 6s
	rcl 6s
	lac dr2
	jmp i 94p

/program service dispatch

ioo,	jmp 95p
	jmp 94p
	jmp 95o
	jmp 95r
	jmp 91m

/drum break

90m,	lac (77777
	and i (1
	sas (npj 70000
	hlt
	lio i (dr1	/pick up dia word from core0
	dia
	lio dr2
	lac tac
	dcc
	hlt
	idx i (1
	jmp br7

91m,	0		/dcc request
	dac tac
	dio dr2
	law i 50.
	add i (dr1	/address advance
	lia
	dba
npj,	jmp .
	idx 91m		/dcc skips
	jmp i 91m

tac,	0		/temporary ac for program service
dr2,	0		/dcc io word
                
                                
/buffer area

constants

92d=70000+.

overlap [92d 9lr 9lo 9lp],core 7 use
overlap [92d-70000-br7 p5o],drum space

ep5,	fld p5o
	ep5-br7
	fld pet
	lio ep5
	dia
	lio ep5 1
	law br7
	dcc
	hlt
	lac .-2
	dac 2
	cli>>05<<cla
	dia
	lio ep5 2
	jmp 2

start ep5 3
                
                                                                                                                          

