TAPE DUPLICATOR
/macro definitions
define	feed N
	law i N
	cli
	ppa
	add (1
	spa
	jmp .-3
	terminate

define	type3
	repeat 3,ril 6s	tyo
	terminate

define	typet M,N
	law M
	dap . 1
	lio ...
	type3
	idx R 2
	sas (lio N
	jmp R 2
	terminate

define	swap
	rcl 9s
	rcl 9s
	terminate

define	pargn
	dio . 5
	lac . 4
	add (rar
	dac . 2
	law 25
	...
	rir 7s
	rcr 1s
	ril 8s
	terminate

define	parck
	dio . 5
	lac . 4
	add (rar
	dac . 2
	law 125
	...
	sma
	terminate

/SETUP SEQUENCE
dimension b1(3510)
ts=3500
100/
mst,	hlt
	szs 10
	jmp ver	/verify
	szs 20
	jmp dup	/duplicate
	szs 70
	jmp em3
	jmp em2
m2,	text )SS1 on >>04<< Verify.
SS2 on >>04<< Duplicate.
SS3 on >>04<< Check parity on all but blank lines.
SS4 on >>04<< Tape is a master.
SS2 ^ SS4 ^ SS6 on >>04<< Ignore lines with hole 7 punched.)
em2,	typet m2, em2
	lio (77
	tyo
	jmp em3
m3,	text )Select either SS1 or SS2.  Push CONT to restart.)
em3,	typet m3, em3
	lio (77
	tyo
	jmp mst
dup,	szs i 40	/master tape?
	jmp not
	feed 100
	jsp tpr	/title punch
not,	feed 100
	724001	/get first line
	clf 7
	stf 4
	szs i 40
	jmp . 3	/save checkblock from last master
	dzm c.rc	/clear char count
	dzm .css	/clear check sum count
	law pn 3
	dap rdy 3
	law rst
	dap rp
	730000	/wait for reader
stl,	swap
	sza
	jmp . 3	/line not zero
	730001
	jmp stl	/skip tape leader
	dac .rbf
	lio rbf
	law b1-1
	dap sto
	law i ts	/table size
	dac .t1
	stf 3
	jmp ntr	/enter read routine

/READY TO PUNCH OR READ?
rdy,	cks
	ril 4s	/check punch
	spi
	jsp ...	/to pn or pn+3
	szf i 3
	jmp rdy
	cks
	ril 1s	/r-buff full?
	spi
	jmp rd
	jmp rdy

/PUNCH SEQUENCE
pn,	dap rp
	lio p.bf
	720005
	szf i 4
	jmp ett
stp,	law b1-1
	dap get
	law i ts-10	/table size -10
	dac .t2
	clf 4
ett,	szf i 6	/end of the tape?
	jmp net
	isp .t4
	jmp get-1
	jmp pcs	/punch ck sum
net,	szf i 3
	jmp . 4
	idx .eot
	sad (3
	jmp end
	idx get
get,	lio ...
	dio pbf
	isp t2
rp,	jmp ...	/rst or rdy
	jmp rrs
rst,	law pn
	dap rdy 3
	jmp rdy

/READ SEQUENCE
rrs,	720001	/restart read seq
	dzm eot
	stf 3
	stf 4
	law i ts-10
	dac t1
	lac b1 ts-10
	dac b1
	lac b1 ts-7
	dac b1 1
	lac b1 ts-6
	dac b1 2
	lac b1 ts-5
	dac b1 3
	lac b1 ts-4
	dac b1 4
	lac b1 ts-3
	dac b1 5
	lac b1 ts-2
	dac b1 6
	lac b1 ts-1
	dac b1 7
	law b1 7
	dap sto
	law i 2000
	dac .t5
	isp t5
	jmp .-1	/wait for reader to get set
	jmp rdy 6
rd,	rrb
	dio rbf
ntr,	idx sto
	lac rbf
	szs i 40
	jmp nm	/not master
h7,	szs i 60	/ignore hole 7 lines
	jmp nm
	and (100
	sza i	/hole 7 punched
	jmp nm
drd,	law i 2000
	dac t5
	720001
	cks
	ril 1s
	spi
	jmp nm-2
	isp t5
	jmp drd 3
	stf 6
	jmp nm-2
	dio rbf
	jmp ntr 1
nm,	szs i 30
	jmp npc	/no parity check
pck,	lac rbf
	sza i
	jmp npc	/no parity check on blank lines
	parck
	jsp per	/parity error
npc,	szs i 40
	jmp sto-1	/no checkblock
	lac css
	add rbf
	dac css
	idx crc
	lac rbf
sto,	dac ...	/store line in table
	isp t1
	jmp nrd	/next read
	clf 3	/table full, stop read
	jmp rdy
nrd,	szf 2
	jmp . 4
	730001	/read 2 char before starting punch
	stf 2
	jmp rd 1
	720001
	dzm eot
	jmp rdy
/END SEQUENCE
end,	stf 6
	law 7777
	and get
	dac t4
	law 7777
	and sto	/address of last table entry
	dap dlt
	sub (1
	dap dlt 1
	sub (1
	dap dlt 2
	sub t4
	cma
	dac t4
	lac css
dlt,	sub ...
	sub ...
	sub ...
	dac css
	lac crc
	sub (3
	dac crc
	jmp get-1

/PUNCH CHECK SUM
pcs,	szs i 40
	jmp ncb	/no checkblock if not master
	feed 20
	lac crc
	add (20
	cma
	dac crc
	lio (300
	repeat 3,	rcr 6s	ril 6s	ppa
	lac css
	repeat 3,	rcr 6s	ril 6s	ppa
ncb,	feed 600
	lac (707070
	lio (070707
	clf 7
	jmp mst

/VERIFY ROUTINE
ver,	730002
	swap
	sza i
	jmp ver	/skip feed tape
	dac .csv	/save ck sum
	730002
	dio cr.v	/save char count
	dzm t1
	szs i 40
	jmp vr1	/not a master
	lac .css
	sas csv
	jmp ev1	/master check sum bad
	lac crc
	sas crv
	jmp ev2	/master char count bad
vr1,	730001
	jmp vrd-1
	idx eot	/end of tape
	sad (1750
	jmp ev3	/bad tape not enough char
	cks
	ril 1s
	spi i
	jmp vr1 2
	rrb
	dio rbf
vrd,	720001
	dzm eot	/clear end of tape counter
	szs i 30
	jmp dcp	/dont check parity
	lac rbf
	sza i
	jmp dcp	/no parity check on blank lines
	parck
	jmp ev4	/bad parity
dcp,	lac t1
	add rbf
	dac t1
	isp crv
	jmp vr1 5
	lac csv
	sub t1
	sza
	jmp ev5	/bad tape ck sum error
	jmp ev6	/OK if end of tape
v1,	text )Bad tape.  Check sum on master incorrectly punched.)
ev1,	typet v1,ev1
	lio (77
	tyo
	lio css
	lac csv
	jmp mst
v2,	text )Bad tape. Character count on master incorrectly punched.)
ev2,	typet v2,ev2
	lio (77
	tyo
	lio crc
	lac crv
	jmp mst
v3,	text )Bad tape. Not enough characters.)
ev3,	typet v3,ev3
	lio (77
	tyo
	jmp mst
v4,	text )Bad tape. Parity error.)
ev4,	typet v4,ev4
	lio (77
	tyo
	lac rbf
	jmp mst
v5,	text )Bad tape. Check sum error or too many characters.)
ev5,	typet v5,ev5
	lio (77
	tyo
	lio csv
	lac t1
	jmp mst
v6,	text )Tape OK.)
ev6,	typet v6,ev6
	lio (77
	tyo
	jmp mst

 /PARITY ERROR ROUTINE
per,	dap rpe
	lio (777234	/cr lc blk
	type3
	jmp em1
m1,	text )Parity error.  Type in one character to replace the one in red.)
em1,	typet m1,em1
	lio (77
	tyo
	szf 2	/only 1 character has been read
	jmp . 3
	lac rbf
	jmp fet
	law 7777
	and sto	/address of current table entry
	dac .t5
	sub (25
	sub (b1
	spa
	cla	/bad char within first 10 lines of table
	add (b1
	dap ty2
ty2,	lio ...
	tyo
	idx ty2
	and (7777
	sas t5
	jmp ty2
	lac rbf
	and (77
	sad (77
	jmp cr
	sad (36
	jmp tab
	sad (72
	jmp (lc
	sad (74
	jmp uc
	sad (75
	jmp bs
	sza i
	jmp fs
fet,	lio (35
	tyo
	rar 6s
	ior (3477	/blk,cr
	swap
	type3
sf1,	clf 1
	szf i 1
	jmp .-1
	tyi
	swap
	sad (75
	jmp npc
	swap
	pargn
	dio rbf
	jmp npc
inv,	lio (723557	/lc, red, (
	type3
mn,	lio ...
	type3
	lio (553477	/), blk, cr
	type3
	jmp sf1
cr,	law mnt
	dap mn
	jmp inv
tab,	law mnt 1
	dap mn
	jmp inv
lc,	law mnt 2
	dap mn
	jmp inv
uc,	law mnt 3
	dap mn
	jmp inv
bs,	law mnt 4
	dap mn
	jmp inv
fs,	law mnt 5
	dap mn
	jmp inv
mnt,	635451	/c-r
	236162	/tab
	435463	/l-c
	245463	/u-c
	625422	/b-s
	665422	/f-s
rpe,	jmp ...
          
                                                                 /TITLE PUNCH ROUTINE
tpt,	0	0	/space
	004277	400000	/1
	625151	514600	/2
	224145	453200	/3
	141211	771000	/4
	274545	453100	/5
	364545	453000	/6
	010171	050300	/7
	324545	453200	/8
	065151	513600	/9
lis,	szf i 1
	jmp .-1
	tyi
	clf 1
	swap
	sad (77
rtp,	jmp ...	/end and out
	sad (36	/tab ignore
	jmp lis
	jmp ls2
	hlt
	364141	413600	/zero
	000077	000000	/stroke
	224545	453000	/s
	010177	010100	/t
	374040	403700	/u
	073060	300700	/v
	376014	603700	/w
	412214	224100	/x
	010274	020100	/y
	615141	454300	/z
ls4,	add (tpt
	jmp ls3
	005030	000000	/comma
ls2,	sad (75	/bk sp ignore
	jmp lis
	sad (72	/lc ignore
	jmp lis
	sad (74	/uc ignore
	jmp lis
	ral 1s
	jmp ls4
	006666	000000	/colon
	204040	403700	/j
	771014	224100	/k
	774040	404000	/l
	770214	027700	/m
	770214	207700	/n
	364141	413600	/o
	771111	110600	/p
	364151	215600	/q
	771111	314600	/r
ls3,	jda ttl
	idx ttl
	law lis
	jmp ttl 1
	101010	101000	/-
	000041	221400	/)
	101010	101000	/-
	001422	410000	/(
tpr,	dap rtp	/entry point
	jmp pu1
	761111	117600	/a
	774545	453200	/b
	364141	412200	/c
	774141	413600	/d
	774545	414100	/e
	770505	010100	/f
	364151	513000	/g
	771010	107700	/h
	004177	410000	/i
	...
	...
	006060	000000	/full stop
ttl,	...	/letter punch
	dap ttr
	lac i ttl
	repeat 3,	lio (1	rcl 6s	ppa
ttr,	jmp ...
pu1,	clf 1
	feed 20
	jmp lis
constants
variables
start mst
          
                                                                                                                                                                                             w9>>76<<kj1