tape to tape line

/macros

define	lookup A
	add (A
	dac tem
	lac i tem
	terminate
define	fill POB, EOB, CHR
	lac CHR
	dac i POB
	idx POB
	sas EOB
	jmp .-4
	terminate

define	switch A,B,C,D,E,F,G
	szs 10
	jmp A
	szs 20
	jmp B
	szs 30
	jmp C
	szs 40
	jmp D
	szs 50
	jmp E
	szs 60
	jmp F
	jmp G
	terminate

/program variables

cas,	0
tab,	0
xxx,	0
yyy,	0
tem,	0
bnk,	0
nbw,	200
lob,	54
fbl,	0
io,	0
ia,	0
fa,	0
cnt,	0
piw,	0
pib,	0
eib,	0
poc,	0
pow,	0
pob,	0
eob,	0
ccr,	0
eof,	171717
t1,	0
t2,	0
t3,	0
t4,	0
etb,	a6

/concise to 1401 table
tbl,	020020
001020
002020
003020
004020
005020
006020
007020
010020
011020
020020
015015
020020
015015
020020
020020
012020
021020
022022
023023
024024
025025
026026
027027
030030
031031
020020
033013
020020
020020
036036
020020
073020
041041
042042
043043
044044
045045
046046
047047
050050
051051
020020
020020
040060
074020
020020
034020
020020
061061
062062
063063
064064
065065
066066
067067
070070
071071
072072
073073
074074
020020
020020
077077

/subroutines

/read paper tape packed alphanumeric
red,	0
	dap wri-1
	dio yyy
	lac nbw
	dac . 11
	law . 11
	dap . 5
	lac fbl
	dap . 4
	cal 42
	0
	0
	0
	0
	lac .-4
	sad (3
	jmp fin
	sad (10
	cal 11
	law red 12
	jda sta
	lio yyy
	lac red
	jmp

/write mag tape
wri,	0
	dap sta-1
	dio yyy
	lac pob
	dac pow
	lac i pow
	sas ccr
	jmp . 7
	idx pow
	sad eob
	jmp wr1 17
	lac i pow
	sad (202020
	jmp .-5
	szs i 30
	jmp wr1
	szs i 40
	jmp wr1
	lac eob
	sub (3
	dap pow
	lio cnt
	ril 3s
	cla
	rcl 3s
	sza
	jmp . 4
	lac (002112
	dap i pow
	jmp . 3
	ior (002100
	dap i pow
	idx pow
	cla
	rcl 3s
	sza
	jmp . 2
	lac (12
	ral 3s
	rcl 3s
	dac t1
	and (7
	sza
	jmp . 4
	lac t1
	ior (12
	jmp . 2
	lac t1
	ral 3s
	rcl 3s
	dac t1
	and (7
	sza
	jmp . 4
	lac t1
	ior (12
	jmp . 2
	lac t1
	dac i pow
	idx pow
	cla
	rcl 3s
	sza
	jmp . 3
	lac (1212
	jmp . 3
	ral 6s
	ior (12
	ral 6s
	dac i pow
wr1,	law . 14
	dap . 10
	lac ia
	dap . 7
	lac fa
	dap . 6
	lio io
	cal 61
	0
	0
	0
	0
	law .-4
	jda sta
	idx cnt
	lio yyy
	lac wri
	jmp

/status error test

sta,	0
	dap err-1
	lac i sta
	spa
	jmp .-2
	sza
	jmp err
	jmp
err,	cal 11
/get character in low order ac
fet,	0
	dap dep-1
	idx piw
	sas eib
	jmp . 5
	jda blk
	jda red
	jda set
	jmp fet 2
	lac i piw
	sza i
	jmp fet 2
	and (000077
	jmp

/deposit character in output buffer
/assumed in low order ac
dep,	0
	dap msk-1
	lac dep
	rcr 6s
	idx poc
	sas (4
	jmp . 14
	dzm poc
	idx pow
	sas eob
	jmp .-6
	jda wri
	jda obt
	jda clr
	lac pow
	add (4
	dac pow
	jmp dep 4
	add (msk
	dac msk
	lac i msk
	dac msk
	cma
	and i pow
	dac i pow
	lac poc
	sad (3
	jmp . 5
	sad (2
	jmp . 2
	rcl 6s
	rcl 6s
	rcl 6s
	and msk
	ior i pow
	dac i pow
	jmp
msk,	0
	770000
	007700
	000077


clr,	0
	dap blk-1
	dio yyy
	lio pob
	dio t2
	fill pob, eob, (202020
	lio t2
	dio pob
	lac ccr
	dac i pow
	idx poc
	lio yyy
	lac clr
	jmp

blk,	0
	dap set-1
	dio yyy
	lio pib
	dio t3
	fill pib, eib, (000000
	lio t3
	dio pib
	lio yyy
	lac blk
	jmp


set,	0
	dap obt-1
	lac pib
	sub (1
	dac piw
	lac set
	jmp

obt,	0
	dap fin-1
	lac pob
	dac pow
	dzm poc
	lac obt
	jmp

/finish
fin,	lac (jmp don
	dac red 1
	lac pib
	dac piw
	jmp r7 1
don,	lac (dap wri-1
	dac red 1
	jda wri
	lio cnt
	ril 3s
	cla
	rcl 3s
	sal 3s
	rcl 3s
	sal 3s
	rcl 3s
	dac t1
	cla
	rcl 3s
	sal 3s
	rcl 3s
	sal 6s
	ior (000013
	dac t2
do1,	cal 52
	0
	. 3
	t1
	2
	cal 11

start

       
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     line part 2

st,	lap 
	and (70000
	dac bnk
	dip wr1 1 1 
 	d ip  w r1  12
	dip wr1 13
	dip  red 13
	d ip red 14
	dip do 1 2
	dip  do1 3
	d ip stt 10 
	dip st t  1 1 
 	 d i p   s a t   2 
 	 a d d   ( b e g 
 	 d a c   .   3 
 	 c a l   3 3 
 	 0 
 	 0 
 	 l a c   t o p 
 	 d a c   t o 
 	 l a c   b n k 
 	 a d d   ( s t t 
 	 d a c   .   3 
 	cal 34
	 0
	0
	ca l 1 1
to, 	0
b eg, 	szs  i 30
	jm p . 17
 	lac ( 33
	dac lob
	lac (nop
	dac blk-4 
	lac ( jmp r7 1 
	dac r 71
	lac  (dzm cas
 	dac a1 3
	la c (jmp b1
 	d ac f1 3
	 dac dep 1 3
	lac ( t b 3
	dac e tb
	jmp  . 16
	la c  ( 54
	dac lob
	lac (idx poc
	dac blk-4
	lac (jmp a4
	dac r71
	lac (nop
	dac a1 3
	lac (jda wri
	dac f1 3
	dac dep 13
	lac (a6
	dac etb
	lat
	rcr 9s
	rcr 3s
	and (000077
	dac t1
	sza i
	jmp . 6
	sub (54
	sma
	jmp . 3
	lac t1
	dac lob
	rcl 9s
	rcl 3s
	and (007777
	dac t1
	sza i
	jmp . 16
	lac to
	add t1
	add lob
	sub (7776
	sma i
	jmp . 6
	lac (7776
	sub to
	sub lob
	dac nbw
	jmp . 3
	lac t1
	dac nbw
	lac to
	dac pib
	dac fbl
	dac piw
	add nbw
	dac eib
	dac pob
	dac ia
	dac pow
	add lob
	dac eob
	dac fa
	dzm cnt
	dzm poc
	dzm cas
	lac (202020
	dac ccr
	jda blk
	jda clr
	jda set
	lio (011202
	dio io
	switch r1,r2,r7,r4,r3,r7,r7
r1,	lio (011202	/eof
	dio io
	lac (eof
	dap ia
	add (1
	dap fa
	jda wri
	lac eib
	dap ia
	lac eob
	dap fa
	cal 11
r2,	lio (010102	/rewind
	dio io
	jda wri
	lac cnt
	sub (1
	dac cnt
	cal 11
r3,	lac (122020	/double space
	dac ccr
	jmp r7
r4,	lac (jmp r4 3	/output to new page
	dac a5-1
	jmp a4 1
	lac (jmp r7 1
	dac a5-1
	cal 11
r7,	jda red
	jda fet
	lookup tbl
	rcr 9s
	rcr 9s
	lac cas
	sza i
	jmp . 2
	rcl 9s
	rcl 9s
	and (000077
	sad . 13
	jmp a5
	sad . 12
	jmp a1
	sad . 11
	jmp a2
	sad . 10
	jmp a3
	sad . 7
r71,	jmp a4
	jmp a6
	36
	77
	72
	74
	15
a1,	jda wri
	jda obt
	jda clr
	dzm cas
	jmp r7 1
a2,	lac cas
	sza i
	jmp r7 1
	dzm cas
	lac (53
	jmp a6
a3,	lac cas
	sza
	jmp r7 1
	lio (1
	dio cas
	lac (53
	jmp a6
a4,	jda wri
	jda obt
	jda clr
	lac (012020
	dac i pow
	jda wri
	jda obt
	jda clr
	jmp r7 1
a5,	lac (tb
	dac tab
	lac pow
	sub pob
	mul (3
	rcl 8s
	rcl 9s
	add poc
	add (2
	dac t4
	lac t4
	sub i tab
	sma
	jmp f1
	jmp f2
f1,	idx tab
	sas etb
	jmp a5 12
	jda wri
	jda obt
	jda clr
	idx pow
	idx pow
	jmp r7 1
f2,	lac i tab
	sub (1
	scr 9s
	scr 8s
	div (3
	nop
	add pob
	dap pow
	dio poc
	jmp r7 1
tb,	000007
	000050
	000070
	000110
	000130
	000170
a6,	jda dep
	jmp r7 1
b1,	jda wri
	jda obt
	jda clr
	jda fet
	lookup tbl
	sas (077077
	jmp b1 3
	dzm cas
	jmp r7 1
stt,	lio (010102
	dio io
	jda wri
	lac cnt
	sub (1
	dac cnt
	cal 54
	0
	. 3
	t1
	3
	cla
	lio t1
	ril 9s
	rcl 3s
	ril 3s
	rcl 3s
	lio t2
	ril 3s
	rcl 3s
	ril 3s
	rcl 3s
	ril 3s
	rcl 3s
	dac . 6
	lio (011002
sat,	cal 61
	0
	. 3
	1
	0
	law .-4
	jda sta
	cal 11

constants
top,	.
start st