TAPE CHECK _ S.G.

|reg 0 = random number code word
|reg 1 = number of words per record   (octal max = 17777)
|reg 2 = number of eor gaps to be written in case of skip
|reg 3 = number of times each reading error is to be re-read
|reg 4 = number of times a record is to be checked before giving up

|tac
	|if bit 0 = 1, suppress all print
	|if bit 1 = 1, begin to write next record
	|if bit 2 = 1, print totals summary
	|if bit 3 = 1, print detailed summary
	|if bit 4 = 1, print record number of give up
	|if bit 5 = 1, list a parity error with read errors
	|if bit 6 = 1, on skipping record, write eor gaps as determined
		|by reg 2

	pfl=opr 6200	|program flags to lr

|ENTRY CODES
	|rww = read-write error on write
	|rwr = read write error on read
	|rer = reading error
	|erc = end of record error on read
	|par = parity error
	|pae = parity error and read error
	|gvp = too many read errors in record as determined by reg 4
	|rew = tape rewind

20|	tra beg		|random number initialize entry
	tra bgr		|write entry
	tra rei		|read initialize entry
	tra ree		|read error entry
	tra ntp		|rewind entry

30|
define	txtpnt A,B
	tsx tpt	lax B-1	A-B+1	term

define	move A,B
	llr A	slr B	term

define	load A,B
	move (B,A	term

define	tpos A
	trn .+2	tra A	term

define	regpnt A
	lda (A	tsx rgp	term

define	carret
	tsx crt	term

define	1tab
	tsx tab	term

tpt,	lax		|text printing sub
	sto tp1
	llx 1
	aux (2
	sxa tpx
	lxr
tp1,	xx
	xlr
	slr TM2
	tsx rgp
	ldx TM2
	tix tp1
tpx,	tra .

crt,	lda (char r
	tra .+2		|print carriage return
tab,	lda (char r		|print tab
rgp,	llr (111111	|print contents of ac as flex
	alp
	cyr
	sto TM1
	u=-opr
	lac u lro
	tze .+2
	pno
	add TM1
	tze .+2
	tra rgp
	trx

|OCTAL PRINT SUBROUTINE 
	zz=.

define	octpnt
	tsx zz	term

zz,	sxa zz+31
	sto TT
	llr (trn zz+22
	slr zz+17
zz+4,	llr tt
	lal
	cyl
	cyl
	sto tt
	llr (7
	ana
	add (add zz+33
	sto .+2
	llr zz+23
	hlt
zz+17,	hlt
	slr zz+17
zz+21,	pno
	lda zz+32
	cyr
	sto zz+32
	trn zz+4
	cyl
	trn zz+3
	cal
zz+31,	tra .
zz+32,	171717
zz+33,	flex  0t-add-.
	flex 11 -add-.
	flex 22 -add-.
	flex 33 -add-.
	flex 44 -add-.
	flex 55 -add-.
	flex 66 -add-.
	flex 77 -add-.

define	write A
	1tab	lda A	octpnt	term

define	list A,B
	regpnt A	write B	term

define	mode A
	tsx mdc	tra A	term

beg,	rew 1		|initialize
	cla
	ldx (lsv-fst-1
	stx fst
	tix .-1
	txtpnt rti,rtx
	lda 0
	sto RNB
	octpnt
	txtpnt rtx,rty
	move jtb,chb
	tsx chk
	com
	sto SMC
	move rer+2,chb
ntp,	rew 1		|end of tape entry
	list flex rew,RCT
	carret
bgr,	mode .+2
	cpf
	wtb 1
	ado RCT
	ldx 1
	sxa WCT
	move T1,SNB
wrl,	lda T1
	llr RNB
	cyr u cry
	alr u cpy
	sto T1
	rpf
	repeat 7,cyl
	trn eoe
	tix wrl
eoe,	lda WCT
	xcd
	sto T4
	rpf
	ldx (5
	cyl
	tix .-1
	trn rww
rei,	stz T7		|begin read pass
	stz EFR
	load LSA,200000
	bsr 1
	tsx chk
ree,	move SNB,T1	|reading error entry
	cal u xro
	rtb 1
	ldx T4
	cpf

rel,	lda T1		|read loop
	cpy
	slr T3
	llr RNB
	cyr u cry
	sto T1
	com
	add T3
	tze rle
	xac
	add lsa
	tpos rer		|read error
rle,	tix rel
	ldx (14
	tix .
	rpf+1
	xac-cla+opr
	tze erc
ftz,	xcc
	ldx (6
jty,	cyl
	trn jta
	sto T5
	sxa T6
	trx jtb
jta,	tix jty
	tra bgr
jtb,	tra ntp		|error dispatch table
	tra rwr
	tra pc

	clr
erc,	sto T5		|end of record flag not up
	sxa T6
	ado ERK
	tsx cme
	flex erc

pc,	ado PAR		|parity flag set
	tsx cme
	flex par

rwr,	ado RWK		|read >>61<<-write flag set on read
	tsx cme
	flex rwr

cme,	sxa cmf		|common error routine
	mode cmh
cmf,	lda .
	tsx rgp
	write RCT
	carret
cmh,	lda T5
	ldx T6
	tze ftz
	trn rsl
	tra jta

rer,	lda (-20000	|read error processor
	rpf+sxa
	tze erc-1	|end of record flag set
	lda T7
	tze .+6
	lda T8
	xcd
	tze .+3
	trn byp
	tra lbf
	ado T7
	com
	add 3
	trn lbf
	tra lbh
833=572>>76<<byp,	ado EFR
	com
	add 4
	tze .+2
	trn gvp
	bsr 1
	tra rsk
lbf,	stz T7
	xcc
	sto LSA
	ado EFR
	com
	add 4
	tze .+2
	trn gvp
lbh,	xac
	sto T8
	ado WDS
	cax u com
	bsr 1
	opr 6001		|program flags to xr
	opr 7100		|xr to program flags
	tsx chk
	llr T1
	lda T3
	lpd u com
	ldx (-21
lbg,	alr
	trn .+5
	ado BIT
	lax lst-1
	add (1
	stx lst-1
	lal
	tix lbg
	mode rsj
	rpf+1
	xac-cla+opr
	tze .-2
	ldx (17777
	opr
	tix .-1
	list flex rer,RCT
	1tab
	lda T8
	add WCT
	com
	trn .-1
	octpnt
	write T1
	write T3
	carret

rsj,	pfl
	lda (-10000
	cry
	trn rsk
	ado PAE
	lda (-10000
	opr 1000
	tze .+2
	tra rsk
	mode rsk
	list flex pae,RCT
	carret
rsk,	tac u com
	cyl
	trn ree
	rtb 1
rsm,	lda (-4000
	opr 1000
	tze .+2
	tra rsl-1
	ldx 2
	wtb 1
	lda (-2000
	rpf+sxa
	tze ntp
	tix .-4
	tsx chk
rsl,	lda (-2000
	rpf+sxa		|program flags or with ac
	tze ntp
	tra bgr

gvp,	rpf+1
	xac-cla+opr
	tze .-2
	ado LOS
	lda (-20000
	opr 1000
	tze .+3
	mode rsm
	list flex gvp,RCT
	carret
	tra rsm

mdc,	tac
	repeat 2, cyl
	trn spt		|print summary
	stz TM3
mdd,	tac
	trn .+2
	trx 1
	trx

spt,	llr TM3		|summary print routine
	sto TM3
	lcc
	tpos mdd
	sxa T2
	txtpnt sum,sux
	lda RCT
	octpnt
	write WDS
	1tab
	write BIT
	1tab
	write LOS
	carret
	ldx T2
	lda TM3
	cyl
	tpos mdd
	txtpnt sux,suy
	write ERK
	write PAR
	write PAE
	1tab
	write EWK
	txtpnt suy,suz
	stz TEM

rap,	lda TEM
	octpnt
	1tab
	ldx TEM
	lax fst
	octpnt
	carret
	ado TEM
	add (-21
	trn rap
	ldx T2
	tra mdd

rww,	list flex rww,RCT	|read-write error on write
	carret
	xx
	tra rsl

chk,	sxa chb		|sumcheck routine
	cla
	ldx (fst-1-20
	adx 20		|add all registers
	tix .-1
	com
	add tp1		|subtract off variable registers
	add tpx
	add zz+16
	add zz+17
	add zz+31
	add cmf
	add chb
	add SMC		|add sumcheck
chb,	tra .		|changed to tze after first time thru

	txtpnt dsc,dsx
	xx
	tra .-1

dsc,	text +Help.>>61<<1  Help.>>61<<1  I don1t sum check.
+	dsx,

sum,	text .SUMMARY

RECORDS	WRONG WORDS	WRONG BITS	GIVE UPS
.	sux,
text
+FLAG:	EOR	PARITY	PARITY-READ	READ-WRITE (ON READ)
+	suy,	text +
BIT	NO. OF ERRORS
+	suz,

rti,	text .
CODEWORD		.	rtx,	text .
CODE	RECORD	WORD	CORRECT	READ
.	rty,

	alp=anl+20
	xx=hlt

	constants
fst,	fst+22|	lst,
	variables
lsv,

start beg
v