/6   CAPS-8 PAPER TAPE UTILITY

/	DEC-8E-OUTLA-A

/	COPYRIGHT 1973
/	DIGITAL EQUIPMENT CORPORATION
/	MAYNARD, MASS. 01754

/	S.R. - WAMW

/THIS PROGRAM ALLOWS THE CAPS-8 USER TO READ PAPER TAPES
/BOTH FROM THE LOW AND HIGH SPEED READERS AND TURN THEM
/INTO FILES ON CASSETTES.  BOTH ASCII AND BINARY FORMATS
/ARE ACCEPTED.

	VERSION=1

	FIXMRI CALL=4400
	FIXMRI EXIT=5400
	FIXMRI INCR=ISZ

	REWIND=10
	WRGAP=40
	SKPFIL=70

	TTOCHR=7402
	KBDCHR=7626
	HANDLER=6600
	UTIL=7200
	WAIT=6200
	CLOSE=6400
	BACK=6402
	BSIZE=7000

	LOOKUP=7002
	MON=5201
	CRLF=5000
	MONRES=7415
	CTRLCJ=7604
	OPT1=7400
	OPT2=OPT1+1
	OPT3=OPT2+1
	XTOCHR=6000
	PRINT=6001
	CLEAR=6336
	HSIZE=40
	U=106
	GETNAM=5667
	SETPTR=103
	FILTBL=4200
	LNBFR=4237
	LNPTR=101
	LNKNT=100
	X0=10
	X1=11
	INCH=7600
	MODE=132
	SINCH=7403
	ENTER=6404
	SETBIN=5037
	FKNT=13
	DATWD=7531
	CBUF=140	/CURRENT BUFFER
	OBUF=141	/OLD BUFFER
	RKNT=142
	RTEM=144
	RPTR=145	/POINTER INTO CURRENT BUFFER

	KBDFLG=7601

	PCE=6020	/CLEAR INTERRUPT ENABLE FOR RDR/PUNCH
	RCF=6014	/CLEAR FLAG AND BUFFER AND FETCH CHAR
	RCC=6016	/READ READER BUFFER,CLEAR FLAG & BUFFER
			/AND FETCH CHARACTER
	BSW=7002
	KIE=6035	/AC11 TO KBD/RDR INTERRUPT ENABLE FF
	RPE=6010	/SET INTERRUPT ENABLE FOR RDR/PUNCH

	FIELD 1

	*200

START,	CDF 10
	CLA
	TAD (MONRES
	CDF 0
	DCA CTRLCJ	/ALLOW RESTART ON ^C
	CDF 10
	CALL (WAIT
	JMP NRERRD
	TAD (TTOCHR
	DCA XTOCHR	/ERR MSG TO TTY
MOD,	TAD (400
	JMS CRLF
	TAD ("M
	JMS TCHAR
	TAD ("O
	JMS TCHAR
	TAD ("D
	JMS TCHAR
	TAD ("E
	JMS TCHAR
	TAD ("-
	JMS TCHAR
R1,	CIF 0
	JMS KBDCHR
	TAD (-102	/IS IT B?
	SNA
	JMP MODEB
	IAC		/IS IT A?
	SZA CLA
	JMP R1		/NOT A OR B
	CLA IAC
MODEB,	DCA MODE	/MODE A=1, B=0
	TAD MODE
	CIA
	TAD ("B
	JMS TCHAR	/ECHO CHAR IF GOOD
	CLA IAC
	AND OPT1
	SZA CLA		/WAS /L SPECIFIED?
	JMP LOW		/YES
	TAD (PCE	/NO, HIGH SPEED READER ASSUMED
	DCA IOT0
	TAD (RCF
	DCA IOT4
	TAD (RSF
	DCA IOT1
	TAD (RCC
	DCA IOT6
	JMP OUT
LOW,	TAD (KIE
	DCA IOT0
	TAD (KCC
	DCA IOT4
	TAD (KSF
	DCA IOT1
	TAD (KRB
	DCA IOT6
	JMP OUT

TCHAR,	0
	CIF 0
	JMS TTOCHR
	JMP I TCHAR
	PAGE

OUT,	TAD (400
	JMS CRLF
	TAD ("O
	JMS TCHAR
	TAD ("U
	JMS TCHAR
	TAD ("T
	JMS TCHAR
	TAD ("-
	JMS TCHAR
	TAD (FILTBL
	DCA SETPTR
	JMS SETBIN
	TAD (FILTBL
	DCA SETPTR
	TAD (LNBFR
	DCA LNPTR
	TAD (-20
	DCA LNKNT
RDLP,	CIF 0
	CALL (KBDCHR
	DCA I LNPTR
	TAD I LNPTR
	TAD (-15
	SNA
	JMP CR
	TAD (15-25
	SNA
	JMP OUT
	TAD (25-177
	SNA CLA
	JMP OUT
	TAD I LNPTR
	JMS TCHAR	/ECHO CHARACTER
	ISZ LNPTR
	ISZ LNKNT
	JMP RDLP
	JMP OUT

CR,	DCA I LNPTR
	JMS CRLF
	TAD LNPTR
	TAD (-LNBFR
	SNA CLA
	JMP MOD
	TAD (LNBFR
	DCA LNPTR
	TAD (-11
	DCA FKNT
	TAD (FILTBL
	DCA X0
FBLP,	TAD (40
	DCA I X0
	ISZ FKNT
	JMP FBLP
	JMS GETNAM
	JMP OUT
	JMP GO
	PAGE

/GO,	TAD U
/	CALL (UTIL
/	REWIND
/	JMP NRERRD
/	CALL (WAIT
/	JMP NRERRD
/MOVE NAME TO SINCH
GO,	TAD (FILTBL
	DCA X0
	TAD (SINCH-1
	DCA X1
	TAD (-11
	DCA FKNT
	TAD I X0
	DCA I X1
	ISZ FKNT
	JMP .-3
	TAD MODE
	SZA CLA
	JMP NOB
	TAD I (SINCH+6	/BINARY
	TAD (-40
	SZA CLA
	JMP NOB
	TAD (102	/DEFAULT EXTENSION IS .BIN
	DCA I (SINCH+6
	TAD (111
	DCA I (SINCH+7
	TAD (116
	DCA I (SINCH+10
NOB,	TAD MODE
	SNA		/A=1
	STL CLA RTL	/B=2
/A 1 --> 1
/B 0 --> 2
	DCA I X1	/SET FILE TYPE
	DCA I X1
	TAD (200
	DCA I X1	/RECORD SIZE=00200
	DCA I X1
	DCA I X1

/SET DATA
	TAD (DATWD-1
	DCA X0
	TAD (-6
	DCA FKNT
	TAD I X0
	DCA I X1
	ISZ FKNT
	JMP .-3
	DCA I X1	/0 VERSION #
	TAD U
	CALL (ENTER
	JMP EERROR
	JMP COPY
	PAGE

NRERRD,	CLA
	TAD U
	DCA NUT
	JMS SET
	JMS PRINT
	"U;"N;"I;"T
	40
NUT,	60
	40
	"N;"O;"T;40;"R;"E;"A;"D;"Y
	0
	JMP START

OUTERR,	AND (40
	SZA CLA
	JMP DEVFUL
	JMS SET
	TAD U
	SPA
	JMP NORE	/ERROR ON TRYING TO CLOSE AFTER ERROR
	DCA UNT
	JMS PRINT
	"O;"U;"T;"P;"U;"T;40;"E;"R;"R;"R;"O;"R
	40
	"O;"N;40;"U;"N;"I;"T;40
UNT,	60
	0
SENTNL,	TAD U
	DCA TEMP
	STA
	DCA U
	TAD TEMP
	CALL (CLOSE
	JMP OUTERR
NORE,	CLA
	JMP START
TEMP,	0

EERROR,	CLA
	TAD U
	DCA TUN
	JMS SET
	JMS PRINT
	"E;"N;"T;"E;"R;40;"E;"R;"R;"O;"R
	40;"O;"N;40;"U;"N;"I;"T;40
TUN,	60
	0
	JMP START

SET,	0
	CLA IAC
	KIE
	TAD (377
	JMS CRLF
	JMP I SET
	PAGE

DEVFUL,	JMS SET
	TAD U
	DCA UNTY
	JMS PRINT
	"U;"N;"I;"T;40
UNTY,	0
	40;"F;"U;"L;"L
	0
	JMP START

CLERROR,CLA
	JMS SET
	TAD U
	DCA UTN
	JMS PRINT
	"C;"L;"O;"S;"E;40;"E;"R;"R;"R;"O;"R
	40;"O;"N;40;"U;"N;"I;"T;40
UTN,	60
	0
	JMP START

TERROR,	CLA
	JMS SET
	JMS PRINT
	"I;"N;"P;"U;"T;40;"E;"R;"R;"O;"R
	0
	JMP SENTNL

CKERR,	CLA
	JMS SET
	JMS PRINT
	"C;"H;"E;"C;"K;"S;"U;"M;40;"E;"R;"R;"O;"R
	0
	JMP SENTNL
	PAGE

COPY,	CDF 0
	DCA I (KBDFLG
	CDF 10
	TAD ("^
	JMS TCHAR
	CIF 0
	CALL (KBDCHR	/WAIT FOR CHAR
	CLA		/ANY CHAR
	DCA TSUM
	CLA IAC
	DCA LDRFLG
IOT0,	PCE		/CLEAR INTERRUPT ENABLE FOR RDR PUNCH
IOT4,	RCF		/INITIATE I/O
	TAD (RBUFR
	DCA CBUF
	TAD (RBUFR2
	DCA OBUF
	JMS ZERO
	TAD CBUF
	DCA RPTR
	TAD (-202
	DCA RKNT
	TAD CBUF
	DCA SBUF
RLOOP,	TAD (-30	/RESET OUTER TIMER
	DCA TIMER2
IOT1,	RSF
	SKP
	JMP OK
	ISZ TIMER1
	JMP IOT1
	ISZ TIMER2
	JMP IOT1
	TAD MODE
	SNA CLA
	JMP TERROR	/BINARY CAN'T TIME OUT
	TAD (32		/INSERT ^Z AT END OF ASCII BUFFER
	DCA I RPTR
	JMP FINISH

ZERO,	0
	TAD CBUF
	DCA RPTR
	TAD (-202
	DCA RKNT
	DCA I RPTR	/PRE-ZERO BUFFER
	INCR RPTR
	ISZ RKNT
	JMP .-3
	EXIT ZERO

OK,IOT6,RCC		/FETCH CHAR READ AND READ NEXT CHAR
	DCA I RPTR
	TAD MODE
	SNA CLA
	JMP BM
	TAD I RPTR
	AND (177
	SNA CLA
	JMP RLOOP	/IGNORE NULL IN ASCII MODE
BM,	TAD I RPTR
	AND (200
	SNA CLA
	TAD I RPTR
	TAD TSUM
	DCA TSUM
	TAD I RPTR
	TAD (-200
	SNA CLA
	JMS I (LDR		/ON LEADER
	DCA LDRFLG
	INCR RPTR
	ISZ RKNT
	JMP RLOOP
	JMS I (SEND
	JMP RLOOP
TSUM,	0
LDRFLG,	1		/0 MEANS AM PROCESSING DATA


TIMER1,	0
TIMER2,	-30
	PAGE

LDR,	0
	TAD MODE
	SZA CLA
	EXIT LDR
	TAD I (LDRFLG
	SZA CLA
	JMP I (RLOOP	/STILL ON BOT (POS)
	CLL STA RAL	/-2
	TAD I (RPTR
	DCA RPT
	TAD RPT
	DCA RP
	TAD I RPT
	BSW
	DCA CS
	TAD I RPT
	INCR RPT
	TAD I RPT
	CIA
	TAD I (TSUM
	DCA I (TSUM
	TAD (200	/LEADER
	DCA I RP
	ISZ RP
	TAD I RPT
	TAD CS
	CIA
	TAD I (TSUM
	SZA
	JMP CKERR	/CHECKSUM ERROR
	DCA I RP
FINISH,	TAD RPTR
	CIA
	TAD (201
	TAD CBUF
	SNA CLA
	STA
	DCA XFLAG
	JMS SEND
	ISZ XFLAG
	SKP
	JMS SEND
	CLA IAC
	KIE
	CLA
/	RPE
	NOP
	CALL (WAIT
	JMP OUTERR
	CALL (CLOSE
	JMP CLERROR
	JMP START

RPT,	0
RP,	0
CS,	0
XFLAG,	0		/-1 MEANS OUTPUT 2 BUFFERS WHEN DONE

SEND,	0
	CALL (WAIT
	JMP OUTERR
	CALL (HANDLER
	4010		/WRITE IN FIELD 1
SBUF,	RBUFR
	JMP OUTERR
	TAD OBUF
	DCA RTEM
	TAD CBUF
	DCA OBUF
	TAD RTEM
	DCA CBUF
	JMS ZERO
	TAD CBUF
	DCA RPTR
	TAD CBUF
	DCA SBUF
	TAD OBUF
	TAD (200
	DCA RTEM
	TAD I RTEM
	DCA I RPTR
	INCR RPTR
	ISZ RTEM
	TAD I RTEM
	DCA I RPTR
	INCR RPTR
	TAD (-200
	DCA RKNT
	EXIT SEND

	PAGE

RBUFR,	0
	*.+203
	PAGE
RBUFR2,	0
	*.+203
	*200