                 fcdddt 2 nov 65
	/drum ddt, m wolfberg
	/Tom Eggers
	/for possible assembly
3500/

low=.-3000+2521-22
tst=.-2
est=.-1
sl=102
nbp=4
l=0
r=1


define senses n
szs nx10
termin

define initialize a,b
law b
dap a
termin

define index a,b,c
idx a
sas b
jmp c
termin

define swap
swp
termin

define load a,b
move (b),a
termin

define setup a,b
law i b
dac a
termin

define count a,b
isp a
jmp b
termin

define move a,b
lio a
dio b
termin
                
                                
define clear a,b
init . 2,a
dzm b
dzm .
index .-1,.-3,.-3
termin

define	dispatch low,upp
[upp-uc 44]x1000 low-uc 44
terminate

define	letter a,b
disp a+uc-44,b
terminate


define		feed a
		law i a
	jda fee
	terminate

define	bprint		/good for up to nbp=10
	dumy=1
	repeat nbp-1,	flexo B+	7200+dumy	dumy=dumy+1
	terminate


aa,	text /A   /
	text /I   /
	text /M   /
	text /M+1 /
	text /M+2 /
	text /B   /
	bprint			/B+1, etc.
                
                                
/beginning of program

in,	lat		/test word initialization
	jmp .+2
	lac (10002
	sza i
	hlt+cla-opr
	dip dfd		/drum field ddt
	rar 6s
	dip dfp		/drum field prog
	dip dpf
	dip dfq-7747+pa
	jsp cbp
	lac dfd
	dip dfe-7747+pa
	law pa
	dap .+4
	law 7746
	dap .+3
	idx .+2
	lac .
	dac .
	idx .-2
	sas (lac pa+7777-7747+1
	jmp .-5
	jmp lis

plc,	cks
	lsm
	lem
	ril 6s
	dio sbi
	law clf 1-opr
	szf 1
	law stf 1-opr
	dap fl1	/save flag 1
	lac r0
	dac ac
	lac r1
	dac pc
	lac r2
	dac io
	lac pa+7777-7747
	dac 7777
                
                                
	lac c4
	dac tas
	dzm tsf
	law 7777
	and r1
	sad (xe2+2
	jmp xe
	sad (xe2+3
	jmp xes
	sza i
	jmp cl
	sub one
	dac t2
	dap tas
	jsp fet
	sas (bpt
	jmp .-3
	law xe4
	sad t2
	jmp bg1
	lac r1
	dap xe4+1
	idx r1
	dap xe4+2
bg1,	lac tas
	sub c4
	sas bk1
	jmp bpr
	isp cn2
	jmp bpr
org,	jmp .+1		/or bpr
	lac bk1+nbp
	dac xe4
	jmp p12
                
                                
cl,	clc		/call
	dac bk0
	jmp .+2
xes,	jsp lcc
xe,	jsp bpo		/xec
	jmp lse


bp,bpr,	law 7777		/break point
	and tas
	dac t
	sas bk1
	jmp 1bp
	isp cn3
	jmp 1bp
	law bk1+nbp
	dap p4
	jmp mp2
1bp,	jsp bpo
	law bk1
	dap 2bp
2bp,	lac .		/check for assigned breakpoint
	sad t
	jmp 3bp
	idx 2bp
	sas mpc
	jmp 2bp
	law i 1
	add xe3+1
	dap pc

ii,	law 7777		/illegal instruction
	and pc
	sad (xe2
	jmp ii2
	add one
	sad (xe4+1
	lac xe3+1
	sub one
ii1,	dzm lwt
	dap lwt
	jda pad
	jmp .+3
ii2,	law 7427		/illegal execute
	jda tys
	lac (741010	/>>
	jda tys
	jmp cl

3bp,	dac bk0
	law i 1
	add xe3+1
	jda pad
	law 55
	dac lcf
	jda tys
	law ac
	dzm mod
	jmp ta5
                
                                 
bg0,	jda chk		/G
	ior cj
xe0,	spi		/X
	jmp err
	dac xe1
	law i 7777
	dac cn1
	dac cn3
	law mp4
	dap mp1
	dzm tsf
	lac (jmp xe2
	jmp p1

pr0,	spi		/P
	law 0		/used by ppk+1
	cma
	add c4
	dac cn1
	dac cn3
	lac bk0
	sad (-0
	jmp err
	add c4
	dac tas
	dzm tsf
	law mp1+1
	spi
	law mp4
	dap mp1
	law bk1
	dap p2
p2,	lac .		/check if proceed thru breakpoint
	sad bk0
	jmp p3
	idx p2
	sas mpc
	jmp p2
	dzm tsf
	jsp fet
p1,	dac xe3
	law xe3
	jmp p3+2
p3,	law nbp
	add p2
	dap p4
	jsp lcc
	jsp bpi
                
                                
mp1,	jmp mp4		/or mp1+1 - multiple proceeds check
	clc
	sad bk1
	jmp mp4
mpc,	lac bk1+nbp		/used as constant
	and (lap-cla+760000
	sad (lap-cla+opr
	jmp mp2
	and (760000
	sad (jsp
	jmp mp2
	sad (cal
	jmp mp2
	sas (xct
	jmp mp3
mp2,	lac c4		/lap,p,jsp i, cal,jda,xct,xct i
	dac cn1
	law bpr
	jmp mp5
mp3,	lac c4		/any others
	dac cn3
mp4,	law org+1
mp5,	dap org
	dzm sym

p4,	lac .		/common point
	dac xe3
	and (lap-cla+760000
	sas (lap-cla+opr		/check for lap
	jmp p5
	xor xe3
	dap xe3
	law 200
	and xe3
	sza i
	jmp p11+1
	xor xe3
	dap xe3
	jmp p11
p5,	and (760000
	sas (xct
	jmp p8
	idx sym
	sad c10
	jmp p7-2
	lac xe3
	jmp p6+1
                
                                 
p6,	jsp fet		/chase xct and indirect chains
	dap tas
	and ci
	sza i
	jmp p7
	law 7777
	and dep
	sub mb
	sma
	jmp p12		/illegal instruction
	idx sym
	sas c10
	jmp p6
	law 7447		/illegal proceed, entered from p5+5
	jmp ii2+1
p7,	jsp fet
	sad (bpt		/bpt special
	jmp p12
	jmp p4+1

p8,	law i 7777		/check for jsp,jda,cal
	and xe3
	sad (jsp
	jmp p10
	sad (jsp i
	jmp p10
	sad (jda
	jmp p9
	sas (cal
	jmp p12
	add c01		/(010100
	dac xe3
p9,	law 7777		/deposit ac
	and xe3
	sub mb
	sma
	jmp p12		/illegal instruction
	lac xe3
	dap tas
	dzm tsf
	lac ac
	jda dep
	idx xe3
	add (430000
p10,	sub c2
	dip xe3
p11,	dzm ac		/pc . ac
	lio pc
	law 7777
	and xe3+1
	spi
	ior c4
	ior ac
	dac ac
                
                                
p12,	lac ac
	dac r0
	lac io
	dac r2
	clo
	lac pc
	ral 1s
	spa
	eem		/restore extend  mode
	rar 1s
	add c4		/restore overflow
fl1,	opr		/restore flag 1
	cks		/wait for tyo complete
	ril 2s
	spi i
	jmp .-3
	lac (bpt
	dac 7777
	lac (jmp plc
	dac 3
	lio dfd
	dia
	law 7751
	add dfp
	lio sbi
	cbs
	spi
	esm
	cli+swp-opr
	jmp 7747
                
                                 bpi,	lio (-0		/break points insert
	jmp .+2
bpo,	cli		/break points take out
	dio dff
	dap bp6
	lac (dap bp4
	dac bp2+1
	law bp5
	dap dpx
	spi i
	idx dpx
bp1,	law bk1
	dap bp3
bp2,	add (nbp
	dap bp4		/gets changed
bp3,	lac .		/used by cbp
	spa
	jmp bp5+1
	dap tas
bp4,	lac .
	dac dep
	cla
	jmp dp0
bp5,	dac i bp4
	idx bp3
	sas mpc
	jmp bp2
	cla
	sad dff
bp6,	jmp .
	law (bpt
bp6+2,	dap bp4		/used as a constant
	dzm dff
	idx dpx
	lac .
	dac bp2+1
	jmp bp1


cbp,	dap cbx		/clear all breakpoints
	law bk1
	dap bp3
	clc
	dac i bp3
	idx bp3
	sas mpc
	jmp .-4
cbx,	jmp .
                
                                 
fet,	lio (-0		/fetch
	dio dff
	jmp dep+2

dep,	.		/deposit
	dzm dff
	dap dpx
	lac tas
	sma
	jmp dpx-1
dep+6,	lac tsf
	sza
	jmp dp2
dp0,	lio dff
	spi i
	lac dfp
	dip t1
dp1,	law 7777
	and tas
	jda chk
	dap t1
	lio t1
	dia
	law 1
	lio dff
	spi
	add dfp
	swp
	law dep
	dcc		/single word swap for breakpoint
	hlt
	lac dep
dpx,	jmp .


chk,	0		/check against F
	dap chx
	law 7777
	and chk
	sub mb
	sma
	jmp ta0
	add mb
chx,	jmp .

fck,	0		/field check
	dap fcx
	lac fck
	spq
	jmp err
	sub (27
	sma
	jmp err
	add (27
	rar 6s
fcx,	jmp .
                
                                
dp2,	lio dff		/fetch, deposit internal registers
	law 7777
	and tas
	sub (ac
	spa
	jmp ta0
	sub c3
	sma
	jmp dp4
dp3,	lac i tas
	spi i
	lac dep
	dac i tas
	jmp i dpx
dp4,	sub (2
	sma
	jmp dp6
	spi
	jmp dp3
	add one
	sma
	jmp dp5
	lac dep		/M+1
	jda chk
	jmp dp3
dp5,	lac dep		/M+2
	jda chk
	sub ll
	spa
	jmp ta0
	jmp dp3
dp6,	sub (nbp
	sma
	jmp ta0
	spi		/B thru B+nbp-1
	jmp dp9
	lac dep
	sad (-0
	jmp dp3
	jda chk
	dac chk
	law bk1
	dap dp7
dp7,	lac .		/check whether already assigned
	sad chk
	jmp dp8
	idx dp7
	sas mpc
	jmp dp7
	jmp dp3
dp8,	clc
	dac i dp7
	jmp dp7+3
                
                                
dp9,	lac i tas
	sma
	jmp i dpx
	law 56
	jda tys
	clc
	dac lwt
	jmp pn2

dr2,	dac tas		/assign drum fields
	law 7777
	and fa
	jda fck
	dip dfd
	lac tas
	jda fck
	sad dfd
	jmp err
	jmp in+7

pv,	dap pvx		/punch, verify swap routines
	clc
	dac dff
	lac pvf
	sza i
	jmp pv1
	spa
	jmp pv2		/from pwd
	law 7777
	and fa
	sub lo
	spa
	jmp pv1
	dap .+5
	sub wc
	add one
	szm
	jmp pv1
hi,	lac .		/used by searches
pvx,	jmp .
pv1,	lac fa
	dac pvf
	dap lo
	jsp zd
	lac 0
	jmp pvx
pv2,	lac dep
	jmp pvx
                
                                
zd,	dap zdx		/zero drum used for searches also
	law 1
	add wrd
	sub lo
	sub est
	sma
	cla
	add est
	dap esp
	dap wc
	lac dff
	sza
	jmp zd2
	dap .+1
	dzm
	idx .-1
	sas esp
	jmp .-3

zd1,	lac lo
	add dfp
	swp+cli-opr
	dia
	lio wc
zda,	dcc
	hlt
zdx,	jmp .
zd3,	law i 1
	add lo
	add wc
	sub wrd
	sza i
	jmp zrt
	lac wc
	adm lo
	law 1
	add wrd
	sub lo
	sub wc
	sma
	cla
	adm wc
	lio dff
	spi i
	jmp zd1

zd2,	lio lo
	dia
	lac wc
	add dfp
	swp+cli-opr
	jmp zda
                
                                
sav,	jda fck		/save
	dac t1
	lac dfp
	dac t
	jmp su1
uns,	jda fck		/unsave
	dac t
	lac dfp
	dac t1
su1,	clc lia-opr	/lio (-0
	jsp zro+1
	dio dff
	lac t
	dac dfp
	jsp zd
su2,	lac t1
	dac dfp
	law su3
	dap zdx
	jmp zd1
su3,	lac t
	dac dfp
	law su2
	dap zdx
	jmp zd3

                
                                
ws,	spi		/W,N,E
	jmp err
	dzm tsf
	dap ws2
	lac ll
	sub ul
	szm
	jmp err
	jsp lcc
	clc
	dac dff
	lac wrd
	dac chi
	lac ll
	dac lo
	lac ul
	dac wrd
	jsp zd

ws0,	lac wc
	dap hi
	cla
	dap ws4+1

ws4,	dzm sym
	lac .
	dac t2
ws2,	jmp .		/ea1 or ws1

ea1,	and (770000
	lio sym
	sad (jda
	sni i
	jmp . 2
	jmp . 4
	and ci
	sza
	jmp ea2
	law 7777
	and t2
                
                                
ws1,	xor chi
can,	and msk		/used as and
wea,	sza		/sza or sza i
	jmp ws3

	law 7777
	and ws4 1
	add lo
	dap loc
	dzm lcf
	jda pad
	law 2136
	jda tys
	lac i ws4+1
	jda lwt
	jsp lcc

ws3,	idx ws4+1
	sas hi
	jmp ws4
	jmp zd3

ea2,	idx sym
	sad c10
	jmp ws3
	law 7777
	and t2
	sub mb
	sma
	jmp ws3
	add mb
	dac tas
	sub lo
	spa
	jmp dep+6
	dap .+5
	sub wc
	add one
	szm
	jmp dep+6
	lac .
	jmp ws4+2
                
                                
ver,	jsp soi		/verify
	jsp lcc

vf1,	lac t
	dap fa
	lac fa
	sub chk		/lo
	sub (dio
	spa
	jmp vf2
	add chk		/lo
	sub wrd
	szm
	jmp vf2
	jsp pv
	dac chi
	lac i la
	sad chi
	jmp vf2

vf3,	lac fa
	dap loc
	dzm lcf
	jda pad
	law 2136
	jda tys
	lac chi
	jda lwt
	jsp lct
	lac i la
	jda lwt
	jsp lcc

vf2,	idx fa
	idx la
	sas rb1
	jmp vf1+2
	jsp rbk
	jmp vf1

start
                
                                                                                                                                                                     
