/1.3	CASSETTE MONITOR SYSTEM		CAPS-8 MONITOR

/	DEC-8E-OMONA-A

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

/	STANLEY RABINOWITZ

/	RELEASED VERSION 1.3	- APRIL 9, 1973

	FIXMRI CALL=4400
	FIXMRI INCR=2000
	FIXMRI EXIT=5400

	VERSION=1
	SUBVERSION=3

	LSF=6661
	LCF=6662
	LSE=6663
	LIE=6665
	LLS=6666
	LIF=6667

	KCLR=6700	/CLEAR ALL
			/CLEAR STATUS A AND B REGISTERS.
	KSDR=6701	/SKIP ON DATA FLAG
	KSEN=6702	/SKIP ON ERROR
	KSBF=6703	/SKIP ON READY FLAG
	KLSA=6704	/LOAD STATUS A FROM AC 4-11
			/CLEAR AC, THEN
			/LOAD 8 BIT COMPLEMENT OF STATUS A
			/BACK INTO AC
	KSAF=6705	/SKIP ON ANY FLAG OR ERROR
	KGOA=6706	/ASSERT THE CONTENTS OF STATUS A,
			/TRANSFER DATA IF READ OR WRITE
	KRSB=6707	/READ STATUS B INTO AC 4-11


	TTYDVC=040
	KBDDVC=030
	VT05=0
	OS8=0

	F0=0
	F1=10
	READ=0
	WRITE=4000

	REWIND=10
	BACKFIL=30
	WRGAP=40
	BACKBLOCK=50
	SKPFIL=70

	CAF=6007	/ 8/E ONLY
	BSW=7002	/BYTE SWAP (8/E)
	MQL=7421
	MQA=7501
	CAM=7621
	SWP=7521
	SKON=6000
	KKCC=6002+KBDDVC
	KKSF=6001+KBDDVC
	KKRB=6006+KBDDVC
	TTSF=6001+TTYDVC
	TTCF=6002+TTYDVC
	TTLS=6006+TTYDVC
	TTFL=6000+TTYDVC	/SET TELEPRINTER FLAG
	PCE=6020	/CLEAR INTERRUPT ENABLE ON H.S. RDR/PUN
	RCF=6014
	RCC=6016

	X0=10
	X1=11
	X2=12
	X3=13

/	FORMAT OF HEADER RECORD

/	BYTES	FUNCTION	COMMENTS

/	0-5	FILENAME	(BYTE 0 IS 0 MEANS SENTINEL FILE)
/	6-10	FILENAME EXTENSION
/	11	FILE TYPE	1 MEANS ASCII
/				- MEANS BINARY
/				13 MEANS BAD FILE
/	12,13	RECORD SIZE	ALWAYS 30 OR 200
/	14,15	SHOULD BE ZERO
/	16-23	CREATION DATE (IN ASCII)     	SPACES IF NONE
/	24	VERSION NUMBER	0 MEANS NONE
/	25-37	UNUSED

	HSIZE=30	/TEMP
	HSIZE=40	/SIZE OF HEADER

/	STATUS A

/AC BIT	FUNCTION

/11	ENABLE INTERRUPTS
/6-8	FUNCTION REGISTER
/5	DRIVE 0=A, 1=B
/4	SELECT ENABLE

/	FUNCTION REGISTER

/000	READ
/001	REWIND
/2	WRITE
/3	BACKSPACE TO FILE GAP
/4	WRITE GAP
/5	BACKSPACE BLOCK GAP
/6	READ/WRITE CRC CHARACTER
/7	SPACE FORWARD FILE GAP

/	STATUS REGISTER B

/AC BIT	FUNCTION

/11	READY FLAG
/10	WRITE LOCK OUT
/9	REWIND
/8	DRIVE EMPTY
/7	END OF FILE FLAG
/6	EOT/BOT
/5	TIMING ERROR
/4	CRC/BLOCK ERROR

	*1

	JMP I .+1
	INTRPT

/	SPECIAL (TEST) MONITOR SYSTEM

	*200

	CDF 10
	DCA I (CINUSE
	KKCC
	TTCF
	CDF 0
	DCA I (TTCHCT
	DCA I (LPCHCT
	TAD (MONRES
	DCA CTRLCJ
	ION
START,	JMP ABSLD

MVLUP,	TAD I SPTR
	CDF 10
	DCA I RPTR	/SET NAME TO "BBBBBB.BIN"
	CDF 0
	INCR RPTR
	INCR SPTR
	ISZ RKNT
	JMP MVLUP
	TAD (SINCH
	DCA RPTR
GNL,	CALL (KBDCHR
	TAD (-15
	SNA
	JMP NGL
	TAD (15
	CDF 10
	DCA I RPTR
	TAD I RPTR
	CDF 0
	CALL (TTOCHR
	INCR RPTR
	JMP GNL
NGL,	CALL (CRLF1

	CIF 10
	TAD (260
	CALL (ENTER
	HLT
	DCA I (KBDFLG
	TAD ("^
	CALL (TTOCHR
	CALL (KBDCHR
	CLA
	DCA TSUM
	CLA IAC
	DCA LDRFLG
	PCE		/CLEAR INTERRUPT ENABLE FOR RDR PUNCH
	RCF		/INITIATE I/O
	TAD (RBUFR
	DCA RPTR
	TAD (-202
	DCA RKNT
RLOOP,	RSF
	JMP .-1
	RCC		/FETCH CHAR READ AND READ NEXT CHAR
	DCA I RPTR
	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
	TAD (RBUFR
	DCA RPTR
	TAD (-200
	DCA RKNT
	TAD I (RBUFR+200
	DCA I RPTR
	INCR RPTR
	TAD I (RBUFR+201
	DCA I RPTR
	INCR RPTR
	JMP RLOOP

TSUM,	0
LDRFLG,	1		/0 MEANS AM PROCESSING DATA


RKNT,	0
RPTR,	0
SPTR,	0
	PAGE

LDR,	0
	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
	TAD I RPT
	TAD CS
	CIA
	TAD I (TSUM
	SZA
	HLT		/CHECKSUM ERROR
	JMS SEND
	CIF 10
	CALL (CLOSE
	HLT
	JMP I (START

RPT,	0
RP,	0
CS,	0

CRLF1,	0
	TAD (215
	JMS TTOCHR
	TAD (212
	JMS TTOCHR
	IFNZRO VT05 <
	JMS TTOCHR
	JMS TTOCHR
	JMS TTOCHR
	>
	EXIT CRLF1

SEND,	0
	CIF 10
	CALL (HANDLER
	WRITE+F0
	RBUFR
	HLT
	CIF 10
	CALL (WAIT
	HLT
	EXIT SEND

SIN,	40;40;40;40;40;40;102;111;116	/BIN


/HAVE TO DOUBLE BUFFER

ABSLD,	CALL (CRLF1
	TAD ("*
	CALL (TTOCHR
	TAD (SIN
	DCA SPTR
	TAD (SINCH
	DCA RPTR
	TAD (-11
	DCA RKNT
	JMP I (MVLUP
	PAGE
RBUFR,	0
	PAGE
	0;0

	*7400
LPOCHR,0		/ENTRY POINT FOR LPT OUT ROUTINE
	JMP LPJAM
TTOCHR,	0		/ENTRY POINT FOR TTY OUTPUT ROUTINE
	JMP TTJAM

LPPUTP,	LPBUFR+1	/NEXT LOCATION FREE IN BUFFER
LPGETP,	LPBUFR		/PREVIOUS LOCATION WHICH WAS
			/OUTPUT IN BUFFER (ALWAYS POS)

LPCHCT,	0

ECHO,	0		/-1 MEANS CTRL/O IS ON (NO ECHO)
TTSIZ,	TTSIZE
TTPUTP,	TTBUFR+1
TTGETP,	TTBUFR
TTCHCT,	0
LPSIZ,	LPSIZE-1
MONRES,	CIF CDF 10	/RESTART MONITOR
	JMP I (MON
/ABOVE LOCATIONS MAY NOT CHANGE


LPIO,	TAD LPCHCT	/CHAR COUNT=0?
	SMA CLA		/IGNORE PRINTER FIDDLING BY OPERATOR
	JMP LPTLCF
	ISZ LPCHCT
	JMP LPMORE
LPTLCF,	LCF
	JMP I (DISMIS
LPMORE,	INCR LPGETP
	TAD I LPGETP
	SPA
	DCA LPGETP
	CLA
	TAD I LPGETP	/GET NEXT CHAR FROM BUFFER
	LLS		/AND PRINT IT
	NOP
	CLA
	JMP I (DISMIS


/LPOCHR,0		/OUTPUT CHAR ON LP08
LPJAM,	MQL
	RDF
	TAD KCIFCDF
	DCA LPRET
	CDF 0
	MQA
	AND (777	/PROTECTION
	DCA I LPPUTP
LPFULP,	CLA IAC		/FOR BENEFIT OF LS8E
	LIE		/ENABLE LP08 INTERUPT
	TAD LPCHCT	/AC STILL = 1
	TAD LPSIZ
	SNA CLA		/IS LPT BUFFER FULL?
	JMP LPFULP	/YES - WAIT
	IOF		/NO; KILL INTERUPTS FOR DELICATE MANEUVERS [STUFF]
	CLL STA
	TAD LPCHCT
	DCA LPCHCT	/BUMP COUNT
	TAD I LPPUTP
	SNL		/LINK OFF MEANS PRINTER QUIET
	LLS		/START LPT
	ION		/NO NEED TO TIPTOE ANY LONGER
	SZL CLA		/DID WE OUTPUT CHAR?
	INCR LPPUTP	/NO
	TAD I LPPUTP	/LOOK AT NEXT WORD
	SPA
	DCA LPPUTP	/NEW POINTER
	CLA
LPRET,	HLT
	EXIT LPOCHR	/RETURN

/TTOCHR,	0		/OUTPUT CHAR ON TTY
TTJAM,	MQL
	RDF
	TAD KCIFCDF
	DCA TTRET
KCIFCDF,CIF CDF 0
	MQA
	AND (777	/PROTECTION
	DCA I TTPUTP
TTFULP,	TAD TTCHCT
	TAD TTSIZ
	SNA CLA		/IS TTY BUFFER STILL FULL?
	JMP TTFULP	/YES, WAIT
	IOF		/NO, KILL INTERUPTS
	CLL STA
	TAD TTCHCT
	DCA TTCHCT	/BUMP COUNT
	TAD I TTPUTP
	SNL
	JMS TTTLS	/START TTY
	ION
	SZL CLA		/DID WE OUTPUT?
	INCR TTPUTP	/NO
	TAD I TTPUTP
	SPA
	DCA TTPUTP
	CLA
TTRET,	HLT
	EXIT TTOCHR

TTYIO,	TAD TTCHCT
	SMA CLA
	JMP TTYCF	/1.3
	ISZ TTCHCT
	JMP TTMORE
TTYCF,	TTCF
	JMP I (DISMIS
TTMORE,	INCR TTGETP
	TAD I TTGETP
	SPA
	DCA TTGETP
	CLA
	TAD I TTGETP
	JMS TTTLS
	CLA
	JMP I (DISMIS

/	THIS ROUTINE MUST PRESERVE THE LINK
TTTLS,	0		/TURN ON ECHO IF BIT 3 IS ON
	MQL		/THEN OUTPUT CHAR IF ECHO IS ON
	MQA		/ELSE TURN TTY FLAG ON
	AND (400
	SZA CLA
	DCA ECHO	/SPECIAL CHAR FORCED ECHO ON
	TAD ECHO	/IS ECHO ON?
	SZA CLA
	JMP SIMTLS	/NO
	MQA
	TTLS		/YES, ECHO CHAR
	EXIT TTTLS
SIMTLS,	TTFL		/SET TELEPRINTER FLAG
	EXIT TTTLS

	PAGE

	JMP MONSTART
KBDFLG,	0		/NON-ZERO MEANS READ A CHARACTER
KBDIN,	0
BREAK,	1		/ZEROED IF BREAK HIT
CTRLCJ,	0	/IF NON-ZERO, JUMP THERE IN FIELD 0 ON ^C

MONSTART,CLA
	CDF 10		/SAVE USER THE BOTHER
	KCLR		/???
	DCA CINUSE	/TEMP
	CDF 0
	TAD DISMIS
	CIF 10
	CALL PLOOKUP
	CDF 10
	DMON
PLOOKUP,LOOKUP		/MONITOR I/O ERROR
	JMP .-1
	CIF 10
	STA
	JMS BIN

M3,	-3
PCASINO,CASINO

	IFNZRO .-7626 <INTERFACE ERROR>

KBDCHR,	0
	RDF
	TAD KCIDF
	DCA KRET
	CDF 0
	TAD KBDFLG
	SNA CLA
	JMP .-2
	DCA KBDFLG
	TAD KBDIN
KRET,	HLT
	EXIT KBDCHR

GOTBRK,	DCA BREAK
DISMIS,	CLA CLL		/MUST END IN 00
KCIDF,	CIF CDF 0
	TAD SAVEMQ
	MQL		/RESTORE MQ
	TAD SAVELNK	/RESTORE LINK
	RAL
	TAD SAVEAC	/RESTORE AC
	RMF		/RESTORE DATA AND INSTRUCTION FIELD
	ION
	JMP I 0		/RESUME PROCESSING

INTRPT,	DCA SAVEAC	/SAVE AC
	RAR		/GET LINK INTO AC 0
	DCA SAVELNK	/SAVE LINK
	MQA
	DCA SAVEMQ	/SAVE MQ
	CIF CDF 10
	JMS I PCASINO
	LSE
	SKP
	LIF
	LSF		/LPT?
	SKP
	JMP I (LPIO
	TTSF
	SKP
	JMP TTYIO

KBDIO,	KKSF
	JMP DISMIS
	KKRB
	AND L177
	DCA KBDIN	/SAVE CHARACTER
	TAD KBDIN
	SNA
	JMP	GOTBRK
	TAD M3
	SNA
	JMP CTRLC	/^C TYPED
	TAD (3-17
	SZA CLA
	JMP NOTSPEC
	TAD ECHO
	CMA		/COMPLEMENT ECHO SWITCH ON CTRL/O
	DCA ECHO
	JMP DISMIS
NOTSPEC,INCR KBDFLG	/NOTE THAT WE GOT INPUT
	JMP DISMIS

CTRLC,	ION
	CIF 10
	CALL (WAIT	/WAIT FOR CASSETTES TO QUIET DOWN
	CLA		/*** IIGNORE ERRORS!
	TAD CTRLCJ
	SNA CLA		/JUMP ANY PLACE SPECIAL?
	JMP 7600	/NO, GO TO 7600 THEN
	JMP I CTRLCJ	/YES, GO TO USER'S CTRL/C LOCATION
	LPSIZE=2
	TTSIZE=30
	IFZERO .-7732&4000	<CATASTROPHE>
	*7731

LPBUFR,	ZBLOCK LPSIZE
	LPBUFR
TTBUFR,	ZBLOCK TTSIZE
	TTBUFR
SAVELNK,0
SAVEAC,	0
SAVEMQ,	0
L177,	177
	PAGE

	FIELD 1

	LNKNT=100
	LNPTR=101
	HCHAR=102
	SETPTR=103
	SETKNT=104
	NMKNT=105
	U=106
	PRKNT=107
	STPTR=110
	OPTKNT=111
	WORD=112
	TEMDIG=113
	QKNT=115
	REMTEM=116
	DOTFLG=121	/1 IF FOUND DOT
	SAVPTR=122
	FTEMP=123

	*4200

FILTBL,	0
	*.+36
LNBFR,	0
	*.+112
/GETS DIGIT FROM LNPTR, LEAVES AS CHAR IN AC
/ADVANCES SCAN, AND TAKES RETURN 2
/IF NOT DIGIT, RETURN 1 WITH AC=0

GETDIG,	0
	TAD I LNPTR
	TAD (-72
	CLL
	TAD (12
	SNL CLA
	EXIT GETDIG	/NOT A DIGIT
	TAD I LNPTR
	INCR LNPTR
	INCR GETDIG
	EXIT GETDIG

WLO,	JMS ERROR
	TEXT	/UNLOCK UNIT ?/
	PAGE

/ASSUMES UNIT NUMBER IN 'U'
/ENTERED WITH ERROR IN AC
OUTERR,	AND (376
	TAD (-2
	SNA CLA		/WAS IT WRITE LOCK OUT?
	JMP WLO		/YES
	JMS ERROR
	TEXT	/OUTPUT ERROR ON UNIT ?/
INERR,	CLA
	JMS ERROR
	TEXT	/INPUT ERROR ON UNIT ?/
NRERR,	CLA
	JMS ERROR
	TEXT	/UNIT ? IS NOT READY/

ERROR,	0
	TAD K400
	JMS CRLF
ERLUP,	TAD I ERROR
	BSW
	JMS EPRIN
	TAD I ERROR
	JMS EPRIN
	INCR ERROR
	JMP ERLUP

EPRIN,	0
	AND (77
	SNA
	JMP MON		/RESTART MONITOR AFTER ERROR
	TAD (-77
	SNA
	JMP PUTU
	TAD (77+40
	AND (77
	TAD K40
ECIF,	JMS TOCHR
	EXIT EPRIN
PUTU,	TAD U
	JMP ECIF

VNO,	0
	JMS PRINT
K40,	40
	40
	126		/V
	0
	DCA QKNT
	TAD INCH+24	/GET VERSION NUMBER FROM INCH
VLUP,	INCR QKNT
	TAD (-12
	SMA
	JMP VLUP
	TAD (12+60
	DCA REMTEM
	STA
	TAD QKNT
	TAD (-12
	SPA SNA
	TAD K12
	SNA
	JMP ONEDIG
	TAD K60
	JMS XTO
ONEDIG,	TAD REMTEM	/GET UNITS DIGIT
	JMS XTO
	EXIT VNO	/RETURN
K12,	12
K60,	60
K400,	400
DEFBIN,	0		/SET EXTENSION TO .BIN
	TAD FILPTR
	TAD (6
	DCA X2		/POINT TO BEFORE EXTENSION
	TAD (102
	DCA I X2
	TAD (111
	DCA I X2
	TAD (116
	DCA I X2
	EXIT DEFBIN
	PAGE

OPTION,	0
	DCA OPT1
	DCA OPT2
	DCA OPT3
	TAD I LNPTR
	SNA
	EXIT OPTION	/END OF LINE
	TAD (-57
	SZA CLA		/LOOK FOR SLASH
	JMP BADC	/NOT THERE - BAD
	INCR LNPTR
OPTLUP,	TAD I LNPTR
	SNA CLA
	EXIT OPTION	/END-OF-LINE
	JMS GETLET	/CHECK FOR A-Z
	JMP NOTAZ	/NOT A-Z
	TAD (-101
GOTOPT,	CMA
	DCA OPTKNT
	TAD (OPT1-1
	DCA WORD
NXTWD,	INCR WORD
	TAD I WORD
	MQL
	STL
BITLUP,	RAR
	SZL
	JMP NXTWD
	ISZ OPTKNT
	JMP BITLUP
	MQA		/OR IN BIT
	DCA I WORD
	JMP OPTLUP

NOTAZ,	JMS GETDIG
	JMP BADC
	TAD (-60+32	/ADD IN DIGIT BASE
	JMP GOTOPT

GETSLS,	0
	TAD I LNPTR
	TAD (-57
	SZA CLA
	JMP BADC
	TAD I LNPTR
	INCR LNPTR
	DCA I X0	/SET SLASH
	EXIT GETSLS

ZERO,	JMS COMN
	JMS GETNAM
	STA
	DCA TEMDIG
	JMS OPTION
	TAD U
	CALL QUTIL
L10,	REWIND
	JMP OUTERR
	TAD TEMDIG
M70,	SPA CLA
	JMP HZERO
	CALL (LOOKUP
	CDF 10
	FILTBL+1
	JMP INERR
	JMP NFERR
	CALL QUTIL
	SKPFIL
	JMP INERR
/	TAD (40
/	DCA I (BSIZE	/PREVENT ROCKING ON CRC ERROR
	CALL (HANDLER
	READ+F1
	BINBUF
	JMP INERR
	CALL (WAIT
QUTIL,	CLA
	JMS BACK
	JMP INERR
	JMS PATCH1
HZERO,	CALL (CLOSE
	JMP OUTERR
	JMP MON
GETUNIT,0
	TAD I LNPTR
	TAD M70
	CLL
	TAD L10
	SNL
	JMP DEF
	INCR LNPTR
	SKP
DEF,	CLA
	TAD (60
	DCA U
	EXIT GETUNIT
DATE,	JMS SPACE
	TAD (DATWD-1
	DCA X0
	JMS GETNUM	/GET MONTH
	JMS GETSLS	/CHECK FOR SLASH
	JMS GETNUM	/GET DAY
	JMS GETSLS	/CHECK FOR SLASH
	JMS GETNUM	/GET YEAR
	JMS OPTION
	JMP MON
	PAGE

CRLF,	0		/MAY BE ENTERED WITH 400 IN AC
	TAD (215
	JMS TOCHR
	TAD (212
	JMS TOCHR
	IFNZRO VT05 <
	JMS TOCHR
	JMS TOCHR
	JMS TOCHR
	>
	EXIT CRLF

KILL,	JMS COMN
/3.1	JMS SETBIN
	JMS GETNAM
	JMP BADC	/NO FILENAME
	JMS OPTION
	DCA SETBIN
	TAD U
	CALL (LOOKUP
	CDF 10
	FILTBL+1
	JMP INERR
	JMP MBNF
	INCR SETBIN
	CALL (DELET	/FOUND
	JMP OUTERR

WIND,	JMS SPACE
	JMS GETUNIT
	TAD U
	CALL (UTIL
	REWIND
	JMP NRERR
	JMP ENDIR
MBNF,	TAD SETBIN
	SNA CLA		/WAS ANYTHING DELETED?
	JMP NFERR	/NO
	JMP ENDIR	/YES, OK

SETBIN,	0		/SET NAMES TO BLANKS
	TAD (-12
	DCA SETKNT
MOVLUP,	TAD (40
	DCA I SETPTR
	INCR SETPTR
	ISZ SETKNT
	JMP MOVLUP
	TAD SETPTR
	TAD (-12
	DCA SETPTR
	EXIT SETBIN

GETLET,	0
	TAD I LNPTR
	TAD (-133
	CLL
	TAD (133-101
	SNL CLA
	EXIT GETLET	/NOT A LETTER
	INCR GETLET
	TAD I LNPTR
	INCR LNPTR
	EXIT GETLET
DIR,	JMS SPACE
	JMS GETUNIT
	JMS OPTION
	TAD U
	CALL (UTIL
	REWIND
	JMP NRERR
	JMP PRNTDIR
VRSN,	TAD (TTOCHR
	DCA XTOCHR
	JMS PRINT
	126
	60+VERSION
	56
	60+SUBVERSION
	0
	JMP MON

/GETS 1 OR 2-DIGIT NUMBER FROM LNPTR
/STORES VIA X0

GETNUM,	0
	JMS GETDIG
	JMP BADC
	DCA TEMDIG
	JMS GETDIG
	JMP NODIG
	MQL
	TAD TEMDIG
	DCA I X0	/SET DIGIT 1
	MQA
LDIG,	DCA I X0	/SET DIGIT 2
	EXIT GETNUM

NODIG,	TAD (60
	DCA I X0
	TAD TEMDIG
	JMP LDIG

COMN,	0
	TAD (FILTBL
	DCA SETPTR
	JMS SPACE
	JMS SETBIN	/3.1
	EXIT COMN

PATCH1,	0
	CALL (HANDLER
	WRITE+F1
	ZER
	JMP OUTERR
	EXIT PATCH1
	PAGE

	*5200

STRT,	JMS RECOVER	/TURN ON ECHO AND RESTORE BUFFERS
MON,	CDF 10
	ION
	TAD (400
	JMS CRLF
	TAD (".
	JMS TOCHR
	TAD (-111
	DCA LNKNT	/SET UP FOR 64 CHARS
	IFZERO VT05 <
	DCA ROFLAG
	>
	TAD (LNBFR
	DCA LNPTR
INPLUP,	CIF 0
	CALL (KBDCHR
	DCA HCHAR
	TAD HCHAR
	TAD (-177		/RUB OUT
	SNA CLA		/IS IT A RUBOUT?
	JMP RO		/YES
	IFZERO VT05 <
	TAD ROFLAG
	SZA
	JMS PRSLSH
	>
	TAD HCHAR	/NO
	TAD (-15
	SNA		/IS IT A CR?
	JMP CR		/YES
	TAD (15-25
	SNA CLA		/IS IT ^U?
	JMP MON		/YES
	ISZ LNKNT	/NO, IT'S A CHAR
	SKP
	JMP EOL		/AT END OF LINE
	TAD HCHAR
	DCA I LNPTR	/INSERT IN LINE BUFFER
	TAD I LNPTR
	JMS TOCHR
	INCR LNPTR
	JMP INPLUP

RO,	IFZERO VT05 <
	TAD ROFLAG
	SNA CLA
	JMS PRSLSH
	>
	STA
	TAD LNPTR
	TAD (-LNBFR
	SPA
	JMP WALL	/AT BEGIN
	TAD (LNBFR
	DCA LNPTR
	STA
	TAD LNKNT
	DCA LNKNT
	IFZERO VT05 <
	TAD I LNPTR
	JMS TOCHR
	>
	IFNZRO VT05 <
	TAD (210
	JMS TOCHR
	TAD (240
	JMS TOCHR
	TAD (210
	JMS TOCHR
	>
	JMP INPLUP

EOL,	STA		/DON'T ACCEPT CHARACTER
	DCA LNKNT
	JMP INPLUP

TOCHR,	0
	CIF 0
	CALL (TTOCHR
	EXIT TOCHR

	IFZERO VT05 <
PRSLSH,	0
	CIA
	CLL RAL		/CHANGE [ TO ] IF AC=-1
	TAD ("[
	JMS TOCHR
	TAD ROFLAG
	CMA
	DCA ROFLAG
	EXIT PRSLSH
ROFLAG,	0
	>

WALL,	STA
	IFZERO VT05 <JMS PRSLSH>
	IFNZRO VT05 <CLA>
	JMP MON
RECOVER,0
	JMS SUPWAIT
	CDF 0
/	DCA I (TTCHCT
	TAD (TTBUFR
	DCA I (TTGETP
	TAD (TTBUFR+1
	DCA I (TTPUTP
	DCA I (ECHO
	TAD (TTSIZE
	DCA I (TTSIZ
/	DCA I (LPCHCT
	TAD (LPBUFR
	DCA I (LPGETP
	TAD (LPBUFR+1
	DCA I (LPPUTP
	TAD (LPSIZE-1
	DCA I (LPSIZ
	TAD (MONRES
	DCA CTRLCJ
	CLA IAC
	DCA BREAK
	CDF 10
	DCA CINUSE
	EXIT RECOVER
	PAGE

		/BRANCH HERE IF SYSTEM  HAD BOMBED
	CDF 0
	CAF
	TAD (INTRPT
	DCA I (2
	TAD (JMP I Z 2
	DCA I (1
	DCA TTCHCT
	DCA LPCHCT
	CDF 10
	DCA CINUSE
	TAD SUPCLA
	CALL (FIXDVC
	.+1	/WHO CARES IF NOT READY?
	HLT
	DCA CINUSE
	JMP STRT

SUPWAIT,0
	CDF 0
	TAD TTCHCT
	SZA CLA
	JMP .-2
	TAD LPCHCT
	SZA CLA
	JMP .-2
	CDF 10
	CALL (WAIT
SUPCLA,	CLA
	CAF
	EXIT SUPWAIT

CR,	DCA I LNPTR
	JMS CRLF
	TAD (LNBFR
	DCA LNPTR
	TAD I LNPTR	/GET FIRST CHAR
	SNA
	JMP MON		/NULL LINE IS OK
	TAD (-122
	SNA		/IS IT R FOR RUN OR REWIND?
	JMP R		/YES
	TAD (122-104	/NO
	SNA		/IS IT D FOR DELETE, DIRECTORY, OR DATE
	JMP D		/YES
	TAD (104-126	/NO
	SNA	 	/IS IT V FOR VERSION?
	JMP VRSN
	TAD (126-132
	SNA
	JMP ZERO
	TAD (132-114
	SNA CLA		/IS IT L?
	JMP LOAD	/YES
BADC,	CLA
	JMS ERROR
	TEXT	/BAD COMMAND/
R,	INCR LNPTR	/POINT TO SECOND CHARACTER
	TAD I LNPTR	/GET IT
	TAD (-40
	SNA		/IS IT SPACE?
	JMP RUN		/YES
	TAD (40-125	/NO
	SNA		/IS IT "U"?
	JMP RUN		/YES
	TAD (125-105	/NO
	SNA CLA		/IS IT "E"?
	JMP WIND	/YES
	JMP BADC	/NO, BAD COMMAND

D,	INCR LNPTR	/POINT TO SECOND CHAR
	TAD I LNPTR	/GRAB IT
	TAD (-111
	SNA		/IS IT "I"?
	JMP DIR		/YES
	TAD (111-105	/NO
	SNA		/IS IT "E"?
	JMP KILL	/YES... KILL
	TAD (105-101	/NO
	SNA CLA		/IS IT "A"?
	JMP DATE	/YES
	JMP BADC	/NO, BAD COMMAND
NFERR,	CALL (UTIL
	REWIND
	CLA
	JMS ERROR
	TEXT	/FILE NOT FOUND/
	PAGE

/FILTBL CONAISTS OF ENTRIES
/UNIT, FILENAME
/...
/UNIT IS CHARACTER, LAST ONE IS NEGATIVE

LOAD,	CLA IAC
RUN,	DCA LOADFLG
	JMS COMN
RULUP,	TAD SETPTR
	DCA FILPTR	/SAVE
	JMS SETBIN
	JMS GETNAM	/GET UNIT AND FILE NAME
	JMP BADC	/NO FILE NAME
	TAD DOTFLG
	SZA CLA		/DID GUY TYPE AN EXTENSION?
	JMP NODEF	/YES
	JMS DEFBIN
/	SET EXTENSION TO .BIN
NODEF,	TAD I LNPTR
	TAD (-54
	SZA CLA		/IS IT ,?
	STL CLA RAR	/NO, MARK UNIT AS BEING LAST ONE
	TAD I FILPTR
	DCA I FILPTR
	TAD I FILPTR
	SPA CLA		/MORE FILES?
	JMP GOLOAD	/NO
	TAD FILPTR	/YES
	TAD (12
	DCA SETPTR
	INCR LNPTR	/SKIP OVER COMMA
	JMP RULUP

GOLOAD,	JMS OPTION
	JMS CRLF
	TAD (FILTBL
GOLUP,	DCA FILPTR
	TAD I FILPTR
	DCA FTEMP
	INCR FILPTR
	TAD FTEMP
	CALL (LOOKUP
	CDF 10
FILPTR,	FILTBL
	JMP INERR
	JMP NFERR
	TAD FTEMP	/MORE TO LOAD IF AC IS POSITIVE
	JMS BIN		/BINARY LOAD
	TAD FILPTR
	TAD (11
	JMP GOLUP

SPACE,	0
GETL,	JMS GETLET	/SPAN OVER LETTERS
	JMP GOTSP1
	CLA
	JMP GETL
GOTSP,	INCR LNPTR
GOTSP1,	TAD I LNPTR
	TAD (-40
	SNA CLA
	JMP GOTSP	/SPAN OVER SPACES
	EXIT SPACE

/TAKES RETURN 1 ON UNIT BUT NO FILENAME
GETNAM,	0
	DCA DOTFLG
	JMS GETUNIT
	TAD U
	DCA I SETPTR	/INSERT UNIT IN TABLE
	INCR SETPTR
	TAD SETPTR
	DCA SAVPTR
	TAD I LNPTR
	TAD (-72
	SNA CLA		/IS IT :?
	INCR LNPTR	/YES, PASS BY IT
	TAD JMPBAD
	DCA NOTLOD	/DON'T ALLOW NULL NAME
	TAD (-7
PREGET,	DCA NMKNT	/DON'T ALLOW MORE THAN 6 CHARS NAMES
MOVL,	JMS GETLET
	JMP NOTLET
SETNAM,	DCA I SETPTR
	DCA NOTLOD
	INCR SETPTR
	ISZ NMKNT
	JMP MOVL
	JMP BADC

NOTLET,	JMS GETDIG
	JMP NOTLOD
	JMP SETNAM	/IT'S A DIGIT
NOTLOD,	EXIT GETNAM	/REPLACE BY 0
	TAD I LNPTR
	TAD (-57
	SNA
	JMP GETLV	/IT'S A SLASH
/	TAD (57-56
	IAC
	SZA CLA
	JMP GETLV	/IT'S NOTHING
	TAD DOTFLG
	SZA CLA
	JMP GETLV	/TWO DOTS
	INCR DOTFLG	/NOTE FACT THAT GOT EXTENSION
	INCR LNPTR	/PASS DOT
	TAD SAVPTR
	TAD (6
	DCA SETPTR
	TAD (-4		/DON'T ALLOW MORE THAN 3 CHAR EXTENSIONS
	JMP PREGET

GETLV,	INCR GETNAM
JMPBAD,	EXIT GETNAM
	PAGE

XTOCHR,	TTOCHR		/OUTPUT DEVICE FOR 'PRINT'
PRINT,	0
	TAD I PRINT	/GET ARGUMENT
	SNA		/ARE WE AT END OF ARGUMENT LIST?
	JMP PREND	/YES
	SMA		/IS IT A COUNT?
	JMP PRCHAR	/NO, IT'S A CHARACTER TO PRINT
	DCA PRKNT	/YES, SAVE COUNT
	INCR PRINT	/POINT TO POINTER TO STRING TO BE PRINTED
	TAD I PRINT	/GET SAID POINTER
	DCA STPTR	/SAVE IT
PRLUP,	TAD I STPTR	/GET CHAR IN STRING
	CIF 0
	JMS I XTOCHR	/PRINT IT
	INCR STPTR	/POINT TO NEXT CHAR
	ISZ PRKNT	/DONE?
	JMP PRLUP	/NO, KEEP PRINTING
	JMP PRLV	/YES
PRCHAR,	JMS XTO		/PRINT CHAR
PRLV,	INCR PRINT	/POINT TO NEXT ARGUMENT
	JMP PRINT+1	/KEEP GOING

PREND,	INCR PRINT	/POINT TO RETURN
	EXIT PRINT	/AND SWOOP THERE WITHOUT HASTE

XTO,	0
	CIF 0
	JMS I XTOCHR
	EXIT XTO

PRNTDIR,TAD OPT1
	RAR		/MOVE 'L' BIT TO LINK
	SZL CLA
	TAD M2		/CHANGE TTOCHR TO LPOCHR
	TAD (TTOCHR		/NO
	DCA XTOCHR		/SET PRINT DEVICE
	TAD (HSIZE
	DCA I (BSIZE	/SET LENGTH OF HEADER
	TAD DATWD+1
	TAD (-40
	SNA CLA
	JMP DL2		/NO DATE TODAY
	JMS PRINT
	14	/FORM FEED
	15
	12
	-10;DATWD
	0
	JMP DL2		/HANDLE FIRST FILE SPECIALLY
DLOOP,	CALL (UTIL
	SKPFIL		/SKIP TO NEXT FILE
	JMP NRERR
DL2,	CALL (WAIT
	JMP INERR
	JMS PRINT
	15
	12
	0
	CALL (HANDLER
	READ+F1
	INCH		/READ HEADER INTO INCH
	JMP NRERR
	CALL (WAIT
	JMP INERR
	TAD I (INCH
	SNA CLA		/SENTINEL?
	JMP ENDIR	/YES
	JMS PRINT	/NO
	-6;INCH
	56
	-3;INCH+6
	0
	CLA IAC BSW	/100
	AND OPT1
	SZA CLA		/IS F OPTION SPECIFIED?
	JMP DLOOP	/YES
	TAD (57
	DCA SLASH
	TAD INCH+17
	TAD (-40
	SZA CLA
	JMP DTOK	/DATE IS OKAY
	TAD L40		/NO DATE
	DCA SLASH
DTOK,	JMS PRINT	/NO
L40,	40
	40
M2,	-2;INCH+20
	-1;SLASH
	-2;INCH+16
SLASH,	40
	-2;INCH+22
	0
	TAD INCH+24
	SZA CLA		/IS VERSION 0?
	JMS VNO
	JMP DLOOP
ENDIR,	CALL (UTIL
	REWIND
	CLA
	CALL (WAIT
	CLA
	JMP MON
	PAGE

WAIT,	TB
	RDF
	TAD (CIF CDF
	DCA WAITEND
CWAIT,	TAD CINUSE
	SNA
	JMP WLV		/ZERO MEANS READY
	SMA CLA
	JMP CWAIT	/1 MEANS IN USE
	DCA CINUSE	/-1 MEANS HAD ERROR
	STL RAR		/4000
	TAD BSTATE	/LEAVE WITH STATUS B REGISTER IN AC
	SKP		/TAKE ERROR RETURN
WLV,	INCR WAIT
WAITEND,CDF 10
	EXIT WAIT

/	FIXDVC

/THIS ROUTINE LEAVES WITH INTERRUPTS OFF AND DEVICE SELECTED
/AND READY.
/THE NEW UNIT NUMBER (0-17) IS IN THE AC.
/THE UNIT  NUMBER IS IN BITS 8-11 OF THE AC.
/THE UNIT 0 MUST ALSO HAVE ONE OF THE BITS 0-7 ON.
/IF THE AC IS ZERO (0), THIS MEANS USE THE OLD UNIT.
/THE INITIAL UNIT IS ZERO.
/RETURN 1 IS MADE IF THE UNIT IS NOT READY.
/CINUSE IS SET TO 1.
/IF CASSETTES WERE ALREADY IN USE, THIS ROUTINE DOES A WAIT.
/THE DATA FIELD IS INTERROGATED
/AND A RETURN CIF CDF IS BUILD
/AND STORED IN LOCATION RETCIF

FIXDVC,	0
	DCA DVC
	RDF
	TAD (CIF CDF
	DCA TMP
	CDF 10
	TAD I FIXDVC
	DCA ERRET
	INCR FIXDVC
	CALL (WAIT
	JMP PRERR	/ERROR ON PREVIOUS OPERATION
	IOF
	TAD TMP
	DCA I ERRET
	TAD DVC
	SNA		/0 MEANS USE OLD UNIT
	JMP CHECKR	/0 MEANS USE OLD UNIT
	RAR		/MOVE UNIT TO LINK; DEVICE TO AC
	AND (7		/MASK OFF DEVICE CODE
	DCA DVC		/SAVE DEVICE CODE
	SZL
	TAD (100
	DCA ABUNIT	/SET UNIT IN BIT 5
	TAD DVC
	CLL RTL
	RAL		/UGLY
	DCA DVC		/MOVE TO BITS 6-8
	TAD (IOTBL
	DCA IOTPTR
IOTLOOP,TAD I IOTPTR
	SNA		/END OF TABLE?
	JMP CHECKR	/YES
	DCA TMP
	TAD I TMP
	AND (7707	/MASK OUT OLD DVC
	TAD DVC		/INSERT NEW ONE
	DCA I TMP	/REPLACE
	INCR IOTPTR	/POINT TO NEXT ONE
	JMP IOTLOOP

TMP,	0
DVC,	0		/DEVICE CODE
IOTPTR,	0
ERRET,	0		/ERROR RETURN LOCATION
CINUSE,	0		/0 MEANS READY
			/1 MEANS IN USE
			/-1 MEANS HAD ERROR
BSTATE,	0		/STATUS OF REGISTER B

PRERR,	MQL		/SAVE ERROR BITS
	TAD TMP
	DCA I ERRET
	STL CLA RAR	/4000
	MQA		/RETRIEVE ERROR
	JMP I ERRET	/TAKE ERROR RETURN

CHECKR,	JMS CLEAR
	TAD (200
	JMS LOADA	/SELECT DRIVE
	JMS CHECKB
	AND (7735	/IGNORE EOT/BOT FLAG
			/AND WLO
	TAD (-1
	SZA CLA
	JMP ERRETT	/NOT READY
	INCR CINUSE	/??
	EXIT FIXDVC
	HLT

ERRCOV,	KCLR
	TAD (251
	JMS LOADA
	JMS GO		/BACKSPACE BLOCK
	JMS CRET	/WAIT
	JMS CHECKB
	AND (334	/KILL WRITE-LOCK BIT AND BOT
	SZA CLA
	JMP I (ERRR
	JMS SETUP	/RE-SET UP OPERATION
	JMP CRET+1	/GO AWAY

CHECKB,	0
IOT7,	KRSB		/READ STATUS B INTO AC 4-11
	DCA BSTATE	/SAVE STATUS B
	TAD BSTATE
	EXIT CHECKB

CLEAR,	0
	DCA CINUSE	/LEAVE STATUS CONDITION IN AC; -1 MEANS  ERROR
IOT0,	KCLR		/CLEAR STATUS A AND B
	EXIT CLEAR
GO,	0
IOT6,	KGOA		/ASSERT CONTENTS OF STATUS A
	CLA
	EXIT GO

LOADA,	0
	TAD ABUNIT
IOT4,	KLSA		/LOAD STATUS REGISTER A
	CLA
	EXIT LOADA
ABUNIT,	0
ERRETT,	JMS CLEAR
	JMP I ERRET
	PAGE

CLOSE,	0
	JMP CLFIX
BACK,	0
	JMP BAKFIX

/	ENTER

/	TAD UNIT
/	CDF FROMFLD
/	CIF 10
/	JMS I (ENTER
/	<ERROR RETURN>
/	<NORMAL RETURN>

/	ENTER FILENAME AS SPECIFIED IN SINCH
/	USER MUST SET SINCH BUT ONLY FIRST 25 (OCTAL) LOCATIONS.

ENTER,	0
	MQL
	RDF
	TAD (CDF CIF
	DCA ERET
	CDF 10
	MQA
	JMS I (LOOKUP
	CDF 10
	SINCH
	JMP ERET	/ERROR WHILE READING
	JMP NTF
	JMS DELET
	JMP ERET	/ERROR WHILE DELETING
NTF,	JMS BACK
	JMP ERET	/ERROR BACKING UP
	TAD (SINCH+16
	DCA ODPTR
	TAD (DATWD+3
	JMS PUTD
	TAD (DATWD
	JMS PUTD
	TAD (DATWD+6
	JMS PUTD
/	DCA SINCH+12	/ZERO HIGH-ORDER RECORD SIZE
	TAD (200
	DCA SINCH+13	/
/	DCA SINCH+15	/ZERO CONTINUATION BYTE
	CALL (HANDLER	/WRITE NEW HEADER
	WRITE+F1
	SINCH
	JMP ERET	/CASSETTE NOT READY
	CALL (WAIT
	JMP ERET	/ERROR WHILE WRITING
	TAD (200
	DCA I (BSIZE
	INCR ENTER
ERET,	HLT
	EXIT ENTER

RDOR,	0
	AND (374
	TAD MM200
	SZA CLA 		/WAS ERROR JUST CRC?
	EXIT BACK	/NO
	EXIT RDOR	/YES, OK CONTINUE

BAKFIX,	CALL (UTIL
	BACKFIL		/GO BACK TO FILE GAP
	EXIT BACK
	CALL (WAIT
	EXIT BACK
	CALL (UTIL
	BACKBLOCK	/BACK TO LAST RECORD
	EXIT BACK
	CALL (WAIT
	JMP BKERR
	TAD (200
	DCA BSIZE
	CALL (HANDLER	/READ LAST RECORD OF PREV FILE
	READ+F1		/DON'T STORE IN BUFFER
MM200,	BINBUF
	EXIT BACK
			/ERROR READING LAST BLOCK
	CALL (WAIT
	JMS RDOR
NEWGAP,	CALL (UTIL
R40,	WRGAP		/WRITE A NEW GAP
	EXIT BACK
	TAD R40
	DCA BSIZE
	INCR BACK
	EXIT BACK

BKERR,	AND (374
	TAD (-40
	SZA CLA		/WAS ERROR CLEAR LEADER?
	EXIT BACK
	JMP NEWGAP

ODPTR,	0
DPTR,	0

PUTD,	0
	DCA DPTR
	TAD I DPTR
	DCA I ODPTR
	INCR ODPTR
	INCR DPTR
	TAD I DPTR
	DCA I ODPTR
	INCR ODPTR
	EXIT PUTD

CLFIX,	MQL
	RDF
	TAD (CDF CIF
	DCA CLRET
	CDF 10
	MQA
	CALL (UTIL
	WRGAP
	JMP CLRET	/ERROR WHILE WRITING GAP
	TAD R40
	DCA I (BSIZE
	CALL (HANDLER
	WRITE+F1		/WRITE SENTINEL
	ZER
	JMP CLRET
	CALL (WAIT
	JMP CLRET
	CALL (UTIL
	REWIND
	JMP CLRET
	INCR CLOSE	/SKIP ERROR RETURN
CLRET,	HLT
	EXIT CLOSE

	PAGE

HANDLER,0
	MQL
	TAD I HANDLER	/GET FUNCTION CONTROL WORD
	AND L70		/ISOLATE FIELD OF BUFFER
	TAD (CDF
	DCA WCDF
	TAD I HANDLER	/RETRIEVE FUNCTION CONTROL WORD
	RAL		/READ/WRITE BIT TO LINK
	CLA RAL
	DCA RWO		/RW=1 IF WRITE
	INCR HANDLER	/POINT TO BUFFER ADDRESS
	TAD I HANDLER	/GET BUFFER ADDRESS
	DCA BUFFER	/SAVE IT
	INCR HANDLER	/POINT TO ERROR RETURN
	MQA
	JMS FIXDVC
	LV
	TAD WCDF
	DCA BFIELD
	TAD WCDF
	DCA BFLD
	TAD RWO
	DCA RW
	INCR HANDLER	/POINT TO GOOD RETURN
	STA CLL RTL	/TAD (-3
	DCA ERKNT
	JMS SETUP	/SET UP READ OR WRITE
LV,	HLT
	ION
	EXIT HANDLER
RW,	0		/1 IF WRITE
ERKNT,	-3

RWO,
SETUP,	0
	TAD RW
	TAD (WRITEX
	DCA CRET	/SET RETURN ADDRESS
	TAD BUFFER
	DCA BPTR
	TAD I (BSIZE
	CMA		/WANT TO READ ONE MORE
	TAD RW
	DCA BKNT
	TAD RW
	CLL RTL
	RTL		/WRITE FN CODE=20
	TAD (201	/SELECT AND INTERRUPT ENABLE
	JMS LOADA
WCDF,	HLT
	TAD RW
	SZA CLA
	TAD I BPTR
	JMS GO
	JMP I	SETUP	/BE CAREFUL ABOUT DATA FIELDS

/HANDLER IS ALL SCREWED UP IF YOU MAKE TWO SUCCESSIVE
/CALLS TO IT WITH NO WAIT IN BETWEEN AND THE FIRST
/CALL GETS AN ERROR.
/NAMELY LOCATIONS  RWO  BUFFER  AND WCDF
/ARE IMPROPERLY SET UP.
/UNFORTUNATELY, THERE'S NO ROOM ON THIS PAGE...
/OR ANY OTHER PAGE FOR THAT MATTER.

READX,	JMS CHK
	AND (374
	SZA
	JMP ERRX
IOT6C,	KGOA		/GET CHAR JUST READ
	ISZ BKNT
	SKP
	JMP RWCRC
BFLD,	HLT
	DCA I BPTR
	INCR BPTR
L261,	261
	JMP CRET+1	/CRET ALREADY SET UP

RWCRC,	CLA
	TAD L261	/ENABLE, ENABLE INTER, READ CRC
	JMS LOADA
	JMS GO
	JMS CRET
	JMS CHK
CRCMN,	JMS GO
	JMS CRET
	JMS CHECKB
	AND (7775	/IGNORE WLO
	TAD (-1
ERRX,	SNA CLA		/ERRORS?
	JMP ERRR+1	/NO - CLEAN BILL OF HEALTH
	ISZ ERKNT	/TRY 3 TIMES
	JMP I (ERRCOV
ERRR,	STA		/ERROR WHILE READING CRC
	JMS CLEAR
	JMP CRET+1

WRITEX,	JMP READX
	JMS CHK
	SZA
	JMP ERRR	/ERROR WHILE WRITING
	ISZ BKNT
	SKP
	JMP WCRC
BFIELD,	HLT
	INCR BPTR
L70,	70
	TAD I BPTR
	JMS GO
	JMP CRET+1


WCRC,	TAD L261
	JMS LOADA
	JMP CRCMN
			/0 MEANS BYTE MODE (CHAR MODE)
BKNT,	0		/NUMBER OF CHARS EXPECTED
BPTR,	0		/NEXT LOCATION IN BUFFER TO STORE INTO
BUFFER,	0
DMON,	115;117;116;124;117;122;102;111;116	/ MONTOR.BIN
	PAGE

BSIZE,	200
FILNUM,	0		/FILE NUMBER OF FILE FOUND

/	LOOKUP

/	TAD UNIT
/	CDF FROMFLD
/	CIF 10
/	JMS I (LOOKUP
/	CDF FILENAMEFLD
/	PTR TO FILENAME
/	I/O ERROR RETURN
/	<NOT FOUND RETURN>
/	<FOUND RETURN>

LOOKUP,	0
	MQL		/SAVE UNIT NUMBER
	RDF
	TAD (CIF CDF
	DCA LRET
	TAD I LOOKUP	/GET CDF TO FILENAME
	DCA FLCDF
	INCR LOOKUP
	TAD I LOOKUP	/GET PTR TO FILE
	DCA PNAME	/SAVE IT
	INCR LOOKUP	/POINT TO ERROR RETURN
	CDF 10
	MQA
	CALL (UTIL
	REWIND
	JMP ERRIT
	CALL (WAIT
	JMP ERRIT
	TAD (HSIZE	/SET LENGTH OF RECORD HEADER
	DCA I (BSIZE
	DCA FILNUM
	JMP FL2
FLOOP,	CALL (UTIL
	SKPFIL
	JMP ERRIT
	CALL (WAIT
	JMP ERRIT
FL2,	INCR FILNUM
	CALL (HANDLER
	READ+F1
	INCH
	JMP ERRIT
	TAD (INCH
	DCA P1
	CALL (WAIT
	JMP ERRIT	/TAKE ERROR RETURN
	TAD I P1
	SNA CLA		/SENTINEL FILE?
	JMP NFNDRET	/YES, NOT FOUND
	TAD PNAME	/NO, IS THIS THE ONE WANTED?
	DCA P2
	TAD M11
	DCA SCNT

SLOOP,	TAD I P1
	CIA
FLCDF,	HLT
	TAD I P2
	AND Q177	/ONLY LAST 7 BITS NEED MATCH
	CDF 10
	SZA CLA
	JMP FLOOP	/FILE KEY NOT ONE DESIRED
	INCR P1
	INCR P2
	ISZ SCNT
	JMP SLOOP
	INCR LOOKUP	/SKIP NOT FOUND RETURN
NFNDRET,INCR LOOKUP	/SKIP ERROR RETURN
ERRIT,	CLA
	TAD Q200
	DCA I (BSIZE	/BE NICE TO USER
LRET,	HLT		/RETURN TO USER'S FIELD
	EXIT LOOKUP	/BYE-BYE

PNAME,	0		/POINTER TO USER'S NAME

/END OF CASSETTE IS SIGNALLED BY SENTINEL ONLY.


P1,	0
P2,	0
SCNT,	0
DELET,	0
	JMS BACK
	EXIT DELET
	CALL (HANDLER	/WRITE EMPTY HEADER
	WRITE+F1
	EMPTINCH
	EXIT DELET	/ERROR WHILE DELETING
	CLL STA RAL	/-2
	TAD LOOKUP
	DCA LOOKUP
	JMP FLOOP	/JUMP INTO LOOKUP TO CONTINUE
IOTBL,	IOT0
	IOT1
/	IOT2
/	IOT3
	IOT4
	IOT5
	IOT6
/	IOT6B
	IOT6C
	IOT7
	ERRCOV
	NIOT1
	NIOT2
	NIOT3
	NIOT4
	NIOT5
	NIOT6
	NIOT7
	NIOT8
	NIOT9
ZER,	0
EMPTINCH,52;105;115;120;124;131;40;40;40;14
M11,	-11
Q177,	177
Q200,	200
	0;40;40;40;40;40;40;0
	PAGE

UTIL,	0
	MQL
	DCA REWSW	/ZERO REWIND SWITCH
	TAD I UTIL
	TAD (-10
	SNA
	INCR REWSW
	INCR UTIL
	TAD (211
	DCA TEMPFN
	MQA
	JMS FIXDVC
	UTEND
	TAD REWSW
	DCA RWSW
	INCR UTIL
	TAD (UT
	DCA CRET	/SET RETURN ADDRESS
	TAD TEMPFN
	JMS LOADA
	JMS GO		/INITIATE UTIL
UTEND,	HLT
	ION
	EXIT UTIL
UT,	JMS CHECKB	/LOOK AT STATUS B
	AND (50		/CHECK FOR CL, EMPTY, OR WLO
			/GIVE NO ERROR ON WLO ************
			/BAD FOR WRGAP
	SNA
	JMP OK		/NO ERRORS
	TAD (-40
	SZA CLA
	JMP NOTOK	/ERROR NOT CL
	TAD RWSW
	SNA CLA		/CL OK IF DID REWIND
NOTOK,	STA
OK,	JMS CLEAR
	JMP CRET+1
TEMPFN,	0
REWSW,	0		/1 MEANS OPERATION IS REWIND
RWSW,	0


CHK,	0
	JMS CHECKB
	AND (376
IOT1,	KSDR
	SKP		/DATA FLAG NOT UP - SIMULATE BIGGIE ERROR
	EXIT CHK
	AND (374
	TAD (-20
	SNA CLA		/IS IT END OF FILE?
	JMP ERRR	/YES, DON'T RETRY
	TAD BSTATE
	EXIT CHK
/IS THIS ALLOWED TO MOVE?
CASINO,	0
IOT5,	KSAF
UNDEF,	JMP PDIS	/******************** UNDEFINED INTERRUPT
	JMP I CRET
CRET,	UNDEF
	CIF 0		/MUST BE AT CRET+1
	JMP I .+1
	DISMIS
PDIS,	CIF CDF 0
	JMP I CASINO

/SET UNIT AND DEVICE CODE (+200)
/POSITION TAPE
/CHANGE DEVICE CODES

NIHANDL,0
	IOF
	CLL STA RTL	/-3
	DCA ERKNTT
ERETRY,	CLA
	TAD UNIT
	TAD (200
NIOT1,	KLSA		/READ SELECT
	JMS CWAITY
	CLA
	TAD ABINBUF
	DCA WDCNT
	TAD ABINBUF
	DCA BFPTR
REED,	JMS CWAITY
	DCA I BFPTR
	INCR BFPTR
LL260,	260
	ISZ WDCNT
	JMP REED
	TAD UNIT
	TAD LL260
NIOT2,	KLSA
	JMS CWAITY
	JMS CWAITY
ABINBUF,7600		/CLA
NIOT9,	KCLR		/?
	ION
	EXIT NIHANDL

CWAITY,	0
NIOT3,	KGOA
NIOT4,	KSAF
	JMP .-1
NIOT5,	KSEN		/ERROR?
	EXIT CWAITY	/NO
	ISZ ERKNTT
	SKP CLA
	JMP INERR		/ERROR
	TAD UNIT
	TAD (250
NIOT6,	KLSA
NIOT7,	KGOA
NIOT8,	KSBF
	JMP .-1
	JMP ERETRY

WDCNT,	0
UNIT,	0
BFPTR,	0
ERKNTT,	0
	PAGE

/012345678901
/ABCDEFGHIJKL

/012345678901
/MNOPQRSTUVWX

/012345678901
/YZ0123456789

OPT1,	0
OPT2,	0
OPT3,	0
SINCH,	ZBLOCK 25
VRSNO,	VERSION		/MONITOR VERSION NUMBER
PROGSTRT,TAD BINTEM
	SMA CLA
	EXIT BIN
	TAD LSTORG
	SNA CLA		/WANT TO SELF-START?
	HLT		/NO, SO HALT AFTER LOADING
	TAD LOADFLG
	SZA CLA
	HLT
	STL CLA RTL	/2
	TAD FLD		/GET DATA FIELD
	DCA .+1		/CHANGE TO CIF CDF
	HLT
	IOF
	JMP I ORG	/GO TO START OF USER'S PROGRAM
PSTRT,	5400

LOADFLG,0		/NON-ZERO MEANS HALT AFTER LOADING

BIN,	0		/NEGATIVE NUMBER MEANS START AFTER LOADING
	DCA BINTEM
	STA
	DCA GRKNT
CDF0,	CDF 0
	DCA I (CTRLCJ
	CDF 10
	TAD PSTA
	DCA BINLDR	/7600 KLUDGE
ITSFLD,	TAD CDF0
	DCA FLD
ITSORG,	DCA ORG		/ASSUMES ORIGIN ALWAYS APPEARS
			/AFTER FIELD SETTING
BINLDR,	JMP I PSTRT
	DCA ORGSW
	JMS GETBYT
	BSW
	CLL RTR
	SZL
	JMP SPEC	/BIT 4=1
	SPA		/BIT 4=0 (TWO WORD COMMAND)
	ISZ ORGSW	/IS ORIGIN
N7000,	NOP
	RAL
	CLL RAL
	DCA TEM
	JMS GETBYT
	TAD TEM		/COMBINE
	INCR LSTORG
	NOP
	ISZ ORGSW
	JMP ITSORG	/ORIGIN
FLD,	CDF 10
	DCA I ORG
	DCA LSTORG
	ISZ ORG
PSTA,	STA
	JMP BINLDR
SPEC,	SMA
	JMP PROGSTRT
	RTL
	AND N7000
	BSW
	JMP ITSFLD

ORG,	.
TEM,	0
ORGSW,	0
LSTORG,	0		/SET TO 1 ON ORIGIN, BUT 0 IF DATA
DATWD,	40;40;40;40;40;40;40;40	/THE DATE

GETBYT,	0	/DF IS RANDOM ON ENTRY
	CDF 10
	ISZ GRKNT
	JMP TB
	TAD (-200
	DCA GRKNT
	TAD PBINBUF
	DCA GRPTR
/	CALL (HANDLER
/	READ+F1
PBINBUF,BINBUF
/	HLT		/*********
/	JMS WAIT
/	HLT
	TAD ABUNIT
	DCA UNIT
	JMS NIHANDL
TB,	TAD I GRPTR
	INCR GRPTR
	NOP
	EXIT GETBYT

GRKNT,	0
GRPTR,	0

/	00	DATA
/	01	ORIGIN
/	11	FIELD
/	10	LEADER/TRAILER

BINTEM,	0

	PAGE

INCH,
BINBUF,	0
	PAGE

	IFNZRO OS8 <
	FIELD 6

	*20

MOVE,	0
	TAD I MOVE
	DCA MVKNT
	INCR MOVE
	TAD I MOVE
	DCA FFLD
	INCR MOVE
	STA
	TAD I MOVE
	DCA 10
	INCR MOVE
	TAD I MOVE
	DCA TFLD
	INCR MOVE
	STA
	TAD I MOVE
	DCA 11
	INCR MOVE
FFLD,	HLT
	TAD I 10
TFLD,	HLT
	DCA I 11
	ISZ MVKNT
	JMP FFLD
	CDF 60
	EXIT MOVE
MVKNT,	0

	*200

	CDF 60
	JMS MOVE
	-200
	CDF 0
	7600
	CDF 30
	7600
	JMS MOVE
	-200
	CDF 10
	7600
	CDF 30
	7400
	JMS MOVE
	-400
	CDF 20
	7400
	CDF 0
	7400
	JMS MOVE
	-2
	CDF 20
	1
	CDF 0
	1
	CIF CDF 10
	JMP I .+1
	MON

	*400
	CDF 60
	JMS MOVE
	-200
	CDF 30
	7600
	CDF 0
	7600
	JMS MOVE
	-200
	CDF 30
	7400
	CDF 10
	7600
	CIF CDF 0
	JMP I .+1
	7605
	>

	FIELD 1
	*5400
	$