/7	OS/8 MCPIP				MAGTAPE AND CASSETTE PIP
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/

/	S.R.

/	REVISED FEB. 11, 1974
/	SECOND REVISION: 7-AUG-75


/1.	INSTALLED PATCH SEQ #1 , SEPT. 1974 DSN
/	(NOW TRANSFERS LAST 2 BYTES CORRECTLY IN IMAGE MODE)
/2.	BUMPED VERSION NUMBER TO V5
/3.	FIXED /L BUG IF DEVICE NOT MAGTAPE OR CASSETTE

/
/       12-DEC-2018 LHN - installed DSN date patch 21.21.1 M
/

	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


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

/CORE ALLOCATION

/00000-01777	COMMAND DECODER
/02000-02377	OUTPUT HANDLER
/02400-02777	INPUT HANDLER
/03000-03777	CASSETTE OUTPUT BUFFER
/04000-04777	CASSETTE INPUT BUFFER
/05000-05577	STAND ALONE CASSETTE HANDLER
/05600-07577	LOOKUP, ENTER, CLOSE
/07600-07777	OS/8

/10000-11777	USR
/12000-14577	PIPC
/14600-17577	OS/8 INPUT/OUTPUT BUFFER
/17600-17777	OS/8
/USR HAS THE FOLLOWING FREE LOCATIONS:
/0-6
/10-17 (BUT GET DESTROYED)
/20-37

	TEMP=20
	TEMP1=21
	TEMP2=22
	TEMP3=23

/	STARTING ADDRESS = 12000
/	JOB STATUS WORD = 6003

	INHAND=2400
	OUTHAND=2000
	COBUF=3000
	CIBUF=4000

	PIPVERSION=6
	PATCHLEV=77&"B
 
	SPCODE=6
	CLCODE=0
	REWCOD=1
	FICODE=3
	EOCODE=5
	RECCOD=2
/V3 CHANGES:

/1.	SHRUNK 0S/8 BUFFER TO 3000 WORDS
/2.	ADDED VERSION NUMBER (/V)
/3.	MADE INDEPENDENT OF MAGIC LOCATIONS IN CASSETTE HANDLER
/4.	ADDED MAGTAPE SUPPORT OF CASSETTE FILE STRUCTURE
/5.	ALTMODE MEANS RETURN TO KBM
/6.	^C DOESN'T CLOSE CASSETTES UNLESS WE ALREADY WROTE ON IT
/7.	FIXED BUG THAT CSA2 THRU CSA7 DIDN'T WORK
/8.	CR ALONE TO CD GIVES NO ERROR MESSAGE
/9.	ADDED ^O AND ^C SUPPORT TO MESSAGE PRINTOUT
/10.	GIVE ERRORS ON ILLEGAL * OR ? IN NAME
/11.	USES TTY: AS DEFAULT OUTPUT DEVICE ON /L

/PROPOSED:
/8.	ALLOW *.* FOR CASSETTE INPUT
/9.	SUPPORT OF UNLABELED MAGTAPE STANDARD
/10.	/7 OR /9 SPECIFIES CHANNEL

/FIXES SINCE FIELD TEST :

/1.	^C ALWAYS BRINGS YOU BACK TO KBM
/2.	FIXED BUG RE CHECK FOR FILE FULL
/3.	MADE COMPATIBLE WITH NEW TM8E HANDLER
/4.	TIME-OUT ON CASSETTE READ
/5.	BE NICE-GUY IF OS/8 LOOKUP FAILURE
/THIS ROUTINE LEAVES WITH INTERRUPTS OFF AND DEVICE SELECTED
/AND READY.
/THE NEW UNIT NUMBER (0-7) IS IN THE AC.
/THE UNIT  NUMBER IS IN BITS 8-11 OF THE AC.
/RETURN 1 IS MADE IF THE UNIT IS NOT READY.
/CINUSE IS SET TO 1.
/THE HANDLER MUST NOT ALREADY BE IN USE.
/THE DATA FIELD IS INTERROGATED
/AND A RETURN CIF CDF IS BUILT
/AND STORED IN LOCATION RETCIF

	*5000

FIXDVC,	0
	DCA DVC
	RDF
	TAD (CIF CDF
	CDF 0
	DCA TMP
	TAD I FIXDVC
	DCA ERRET
	ISZ FIXDVC
	TAD TMP
	DCA I ERRET
	TAD DVC
	SNA
	JMP CHECKR
	RAR		/MOVE UNIT TO LINK; DEVICE TO AC
	AND (3		/MASK OFF DEVICE CODE
	DCA DVC		/SAVE DEVICE CODE
	SZL
	TAD (100
	DCA I (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
	ISZ IOTPTR	/POINT TO NEXT ONE
	JMP IOTLOOP

TMP,	0
DVC,	0		/DEVICE CODE
IOTPTR,	0
CHECKR,	JMS I (CLEAR
	TAD (200
	JMS I (LOADA	/SELECT DRIVE
	JMS I (CHECKB
	AND (7735	/IGNORE EOT/BOT FLAG
			/AND WLO
	TAD (-1
	SZA CLA
	JMP I ERRET	/NOT READY
	ISZ I (CINUSE
	JMP I FIXDVC

ERRET,	0		/ERROR RETURN LOCATION
FIDDLE,	0
	CIF 10
	JMS I (FID2	/NEED ROOM
	TAD (CIBUF+11
	DCA 10
	TAD FAST
	SZA CLA
	JMP DIREOL
	TAD (40
	DCA I 10
	TAD I (CIBUF+20
	DCA I 10
	TAD I (CIBUF+20
	AND (177
	SZA
	TAD (-40
	SZA CLA
	TAD ("/-40
	TAD (40
	DCA SLSH
	TAD I (CIBUF+21
	DCA I 10
	TAD SLSH
	DCA I 10
	INCR 10
	INCR 10
	TAD SLSH
	DCA I 10
	TAD I (CIBUF+22
	DCA I 10
	TAD I (CIBUF+23
	DCA I 10
DIREOL,	TAD (15
	DCA I 10
	TAD (12
	DCA I 10
	TAD (32
	DCA I 10
FIDLV,	EXIT FIDDLE

/0 1 2 3 4 5 6 7 10 11 12 13 14 15 16 17 20 21 22 23 24 25
/F I L E N A M E S                  D  D  M  M  Y  Y
/F I L E N A . M E S       M  M  /  D  D  /  Y  Y CR LF ^Z

FAST,	0		/0 MEANS F NOT SPECIFIED
SLSH,	"/

IOTBL,	IOT0
	IOT1
	IOT4
	IOT5
	IOT6
	IOT6C
	IOT7
	0
	PAGE
UTIL,	0
	DCA TEMPU
	DCA REWSW	/ZERO REWIND SWITCH
	TAD I UTIL
	TAD (-10
	SNA
	ISZ REWSW
	ISZ UTIL
	TAD (210
	DCA TEMPFN
	TAD TEMPU
	JMS I (FIXDVC	/FIX DEVICE CODE
	UTEND		/UNIT NOT READY
	TAD (UT
	DCA CRET	/SET RETURN ADDRESS
	STA
	DCA I (RW	/NOTE FACT THAT OP AINT READ
	TAD TEMPFN
	JMS I (LOADA
	JMS GO		/INITIATE UTIL
	JMP CRET+1
	ISZ UTIL
UTEND,	HLT
	JMP I 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 REWSW
	SNA CLA		/CL OK IF DID REWIND
NOTOK,	STA
OK,	JMS CLEAR
	TAD CINUSE
	SMA CLA
	JMP UTEND-1
	TAD BSTATE	/ERROR
	JMP UTEND

TEMPU,	0
TEMPFN,	0
REWSW,	0		/1 MEANS OPERATION IS REWIND
CHECKB,	0
IOT7,	KRSB		/READ STATUS B INTO AC 4-11
	DCA BSTATE	/SAVE STATUS B
	TAD BSTATE
	JMP I CHECKB

CLEAR,	0
	DCA CINUSE	/LEAVE STATUS CONDITION IN AC; -1 MEANS  ERROR
IOT0,	KCLR		/CLEAR STATUS A AND B
	JMP I CLEAR

GO,	0
IOT6,	KGOA		/ASSERT CONTENTS OF STATUS A
	CLA
	JMP I GO

CHK,	0
	JMS I (CHECKB
	AND (374
IOT1,	KSDR
	SKP		/DATA FLAG NOT UP -
	JMP I CHK
	TAD (-20
	SNA CLA		/IS IT END OF FILE?
	JMP I (ERRR	/YES, ERROR - BUT DON'T RETRY
	TAD BSTATE
	JMP I CHK

CINUSE,	0		/1 MEANS HANDLER IN USE
BSTATE,	0		/STATUS OF REGISTER B ON ERROR
DTEM,	0

DOPTION,JMS I (CONVRT
	7601
	DCA DTEM
	TAD I (OUNIT
	JMS I (LOOKUP
	JMP I (XER4
	JMP MBNF	/NOT FOUND
	INCR DTEM
	JMS I (DELET
	JMP I (XER77	/OUTPUT ERROR
MBNF,	TAD DTEM
	SNA CLA		/ANYTHING DELETED?
	JMP I (XER24	/NO
	JMS UTIL
	REWIND
	CLA
	CIF CDF 10	/YES
	JMP I (DECODE
CRET,	0
	CDF 0
	TAD (-200	/COUNT OF HOW LONG TO WAIT
	DCA I (OUTER
IOL,	JMS I (CTRLC
	JMS I (TIMEOUT
IOT5,	KSAF
	JMP IOL
	EXIT CRET
	PAGE
HANDLER,0
	DCA TUN
	TAD I HANDLER	/GET FUNCTION CONTROL WORD
	AND L70		/ISOLATE FIELD OF BUFFER
	TAD LCDF
	DCA WCDF
	TAD I HANDLER	/RETRIEVE FUNCTION CONTROL WORD
	RAL		/READ/WRITE BIT TO LINK
	CLA RAL
	DCA RW		/RW=1 IF WRITE
	ISZ HANDLER	/POINT TO BUFFER ADDRESS
	TAD I HANDLER	/GET BUFFER ADDRESS
	DCA BUFFER	/SAVE IT
	ISZ HANDLER	/POINT TO ERROR RETURN
	TAD TUN
	JMS I (FIXDVC
	LV		/NOT READY
	TAD WCDF
	DCA BFIELD
	TAD WCDF
	DCA BFLD
	STA CLL RTL	/TAD (-3
	DCA ERKNT
	JMS	SETUP	/SET UP READ OR WRITE
	JMP I (CRET+1
	ISZ HANDLER	/POINT TO GOOD RETURN
LV,	HLT
	JMP I HANDLER
RW,	0		/1 IF WRITE (-1 IF UTIL)
ERKNT,	-3
SETUP,	0
	TAD RW
	TAD (WRITEX
	DCA I (CRET	/SET RETURN ADDRESS
	TAD BUFFER
	DCA BPTR
	TAD BSIZE
	CMA		/WANT TO READ ONE MORE
	TAD RW
	DCA BKNT
	TAD RW
	DCA OUTSW
	TAD RW
	CLL RTL
	RTL		/WRITE FN CODE=20
	TAD (200	/SELECT AND INTERRUPT ENABLE
	JMS I (LOADA
WCDF,	HLT
	TAD RW
	SZA CLA
	TAD I BPTR
LCDF,	CDF 0
	JMS I (GO
	JMP I	SETUP

READX,	JMS I (CHK
	AND L374
	SZA
	JMP ERRX
IOT6C,	KGOA		/GET CHAR JUST READ
	DCA BYTE
	ISZ BKNT
	SKP
	JMP RWCRC
BMODE,	TAD BYTE
TUN,
BFLD,	HLT
	DCA I BPTR
	ISZ BPTR
L374,	374
	JMP I (CRET+1	/CRET ALREADY SET UP

BSIZE,	200
OUTSW,	0		/1 MEANS WE BEGAN TO WRITE
RWCRC,	TAD (260	/ENABLE, ENABLE INTER, READ CRC
	JMS I (LOADA
	JMS I (GO
	JMS I (CRET
	JMS I (CHK
CRCMN,	JMS I (GO
	JMS I (CRET
	JMS I (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	/RETRY
ERRR,	STA		/ERROR WHILE READING CRC
	JMS I (CLEAR
	TAD I (CINUSE
	SMA CLA
	JMP LV-1
	TAD I (BSTATE
	JMP LV
WRITEX,	JMP READX
	JMS I (CHK
	SZA
	JMP ERRX
	ISZ BKNT
	SKP
	JMP WCRC
BFIELD,	HLT
	ISZ BPTR
L70,	70
	TAD I BPTR
	JMS I (GO
	JMP I (CRET+1


WCRC,	TAD (260
	JMS I (LOADA
	JMP CRCMN
BKNT,	0		/NUMBER OF CHARS EXPECTED
BPTR,	0		/NEXT LOCATION IN BUFFER TO STORE INTO
BYTE,	0		/TEMPORARILY HOLDS BYTE FOUND
BUFFER,	0
	PAGE
/ LOOKUP, ETC.

	F1=10
	READ=0
	WRITE=4000

	REWIND=10
	BACKFIL=30
	WRGAP=40
	BACKBLOCK=50
	SKPFIL=70

	HSIZE=40
	OBUFFER=4600	/LOCATION OF OS/8 I/O BUFFER
	BINBUF=OBUFFER
	OBUFLEN=3000
	HOBUFLEN=OBUFLEN%2
	MAXBLK=OBUFLEN%400

FILNUM,	0
/	ENTER

/	TAD UNIT
/	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
	JMS I (LOOKUP
	JMP ERET	/ERROR WHILE READING
	JMP NTF
	JMS I (DELET
	JMP ERET	/ERROR WHILE DELETING
NTF,	JMS BACK
	JMP ERET	/ERROR BACKING UP
	JMS I QH1	/WRITE NEW HEADER
	WRITE
	SINCH
	JMP ERET	/CASSETTE NOT READY
	TAD I (RECSIZ
	DCA I (BSIZE
	INCR ENTER
ERET,	EXIT ENTER

RDOR,	0
	AND (374	/CASSETTE ONLY
	TAD (-200
	SZA CLA		/WAS ERROR JUST CRC?
	EXIT BACK	/NO
	EXIT RDOR	/YES, OK CONTINUE
BACK,	0
BK4,	JMS I QU1
BK2,	BACKFIL		/GO BACK TO FILE GAP
	EXIT BACK
BK3,	JMS I QU1
	BACKBLOCK	/BACK TO LAST RECORD
	JMP BKERR
	TAD I (RECSIZ
	DCA I (BSIZE
	JMS I QH1	/READ LAST RECORD OF PREV FILE
	READ+F1		/DON'T STORE IN BUFFER
	BINBUF
	JMS RDOR	/^*******
			/ERROR READING LAST BLOCK
NEWGAP,	JMS I QU1
	WRGAP		/WRITE A NEW GAP
	EXIT BACK
BK9,	TAD (HSIZE
	DCA I (BSIZE
	INCR BACK
	EXIT BACK

BKERR,	AND (3775	/CASSETTES ONLY
	TAD (-41
	SZA CLA		/WAS ERROR CLEAR LEADER?
	EXIT BACK
	JMP NEWGAP

BK1,	JMP BK9

/FOR MAGTAPES:

/BK2_BACKBLOCK
/BK3_BK1
CLOSE,	0
	JMS I QU1
	WRGAP
	JMP CLRET	/ERROR WHILE WRITING GAP
	TAD (HSIZE
	DCA I (BSIZE
	JMS I QH1
	WRITE		/WRITE SENTINEL
	ZER
	JMP CLRET
	JMS I QU1
	REWIND
	JMP CLRET
	INCR CLOSE	/SKIP ERROR RETURN
CLRET,	EXIT CLOSE
CRED,	0
	TAD I (INRECSZ
	DCA I (BSIZE
	TAD I (IUNIT
	JMS I QH1
	READ
	CIBUF
	JMP INER
	TAD (CIBUF
	DCA I (CIPTR
	TAD I (INRECSZ
	CIA
	DCA I (CIKNT
/	CLA IAC
/	DCA DATAFLG
	EXIT CRED
INER,	AND EOFBIT
	SZA CLA		/REAL ERROR?
	JMP I (XER4	/YES
/	TAD DATAFLG
/	SNA CLA		/READ ANY DATA?
/	JMP INTO	/NO REWIND
/	DCA DATAFLG	/YES, COULD CLOSE OUTPUT AND OPEN NEXT INPUT
INTO,	CLA
	TAD I (IUNIT
	JMS I QU1
	REWIND
	CLA
	TAD I (BIPTR
	CIF CDF 10	/NO, MERELY END-OF-FILE
	TAD (-OBUFFER+377
	CLL RTL
	RTL
	RAL
	AND (17
	DCA I (INTEN	/NUMBER OF BLOCKS GOT
	JMP I (XFIN

LOADA,	0
	TAD ABUNIT
IOT4,	KLSA
	CLA
	JMP I LOADA

EOFBIT,	254		/CHANGED TO 3673 FOR MAGTAPE
/DATAFLG,0		/1 MEANS READ DATA
QU1,	UTIL
QH1,	HANDLER
ABUNIT,	0
	PAGE

/	LOOKUP

/	TAD UNIT
/	JMS I (LOOKUP
/	I/O ERROR RETURN
/	<NOT FOUND RETURN>
/	<FOUND RETURN>
/	ALWAYS LOOKS FOR THING SPECIFIED IN SINCH

LOOKUP,	0
	DCA P1
	CDF 10
	TAD I (7644
	CDF 0
	AND (10		/IS /U SPECIFIED?
	SZA CLA
	JMP GOODRT	/YES, DO NOTHING
	TAD P1
	JMS I QU2
	REWIND
	JMP ERRIT
	TAD (HSIZE	/SET LENGTH OF RECORD HEADER
	DCA I (BSIZE
	DCA I (FILNUM
FL1,	JMP FL2		/ZERO THIS LOCATION FOR MAGTAPES
FLOOP,	JMS I QU2
	SKPFIL
	JMP ERRIT
FL2,	INCR I (FILNUM
	JMS I QH2
	READ
	INCH
	JMP ERRIT
	TAD (INCH
	DCA P1
	TAD I P1
	SNA CLA		/SENTINEL FILE?
	JMP NFNDRET	/YES, NOT FOUND
	TAD (SINCH	/NO, IS THIS THE ONE WANTED?
	DCA P2
	TAD (-10
	DCA SCNT
SLOOP,	TAD I P1
	CIA
	TAD I P2
	AND (177	/ONLY LAST 7 BITS NEED MATCH
	SZA CLA
	JMP FLOOP	/FILE KEY NOT ONE DESIRED
	INCR P1
	INCR P2
	ISZ SCNT
	JMP SLOOP
GOODRT,	INCR LOOKUP	/SKIP NOT FOUND RETURN
NFNDRET,INCR LOOKUP	/SKIP ERROR RETURN
ERRIT,	CLA
	TAD I (RECSIZ
	DCA I (BSIZE	/BE NICE TO USER
LRET,	EXIT LOOKUP	/BYE-BYE

ERRT,	AND EOTBIT	/REAL ERROR?
	SZA CLA
	JMP ERRIT	/YES
	JMP NFNDRET	/NO, MERELY END-OF CASSETTE

/END OF CASSETTD IS SIGNALLED BY

/A	SENTINEL FILE
/B	DOUBLE FILE GAP
/C	EOT

EOTBIT,	314		/CHANGE TO 3663 FOR MAGTAPE
P1,	0
P2,	0
SCNT,	0
DELET,	0
	JMS I (BACK
	EXIT DELET
	JMS I QH2	/WRITE EMPTY HEADER
	WRITE+10
	EMPTINCH
	EXIT DELET	/ERROR WHILE DELETING
	CLL STA RAL	/-2
	TAD LOOKUP
	DCA LOOKUP
	JMP FLOOP	/JUMP INTO LOOKUP TO CONTINUE
ZER,	0

QH2,	HANDLER
QU2,	UTIL
FL3,	JMP FL2
ERRCOV,	JMS I (CLEAR
	JMS I (CTRLC
	TAD	(250
	JMS I	(LOADA
	JMS I	(GO	/BACKSPACE BLOCK
	JMS I	(CRET	/WAIT
	JMS I	(CHECKB
	AND	(374	/KILL WRITE-LOCK BIT
	SZA CLA
	JMP I	(ERRR
	JMS I	(SETUP	/RE-SET UP OPERATION
	JMP I	(CRET+1	/GO AWAY
TIMEOUT,0
	ISZ INNER
	JMP I TIMEOUT
	ISZ OUTER
	JMP I TIMEOUT
	TAD I (RW	/ I/O HAS TAKEN A LOT OF TIME
	SZA CLA		/IS IT A READ OP?
	JMP I TIMEOUT	/NO, RETURN
	JMP I (ERRR	/YES, ERROR

INNER,	0
OUTER,	-200

//			DSN PATCH 21.21.1 M
DSN13,	0		//
	TAD I DSN14	//
	RTR		//
	RTR		//
	AND DSN15	//
	JMP I DSN13	//
DSN14,	7777		//
DSN15,	0030		//
	
	PAGE
/SEND CONTENTS OF OS/8 BUFFER TO CASSETTE
/VIA CASSETTE OUTPUT BUFFER

CWRITE,	0
	TAD (OBUFFER
	DCA BUPTR	/PT TO BEGIN OF BUFFER
	CDF 10
	TAD I (INTEN	/GET NO. OF BLOCKS READ
	SNA
	JMP CWLV
	CDF 0
	CLL RTR
	RTR
	RAR		/CONVERT TO WORDS
	IAC
	AND (7776	/ROUND UP TO EVEN NO.
	CLL RAR		/DIVIDE BY TWO
	CIA		/USE AS COUNT OF DOUBLE-WORDS
	DCA BUKNT	/2000 TWO-WORD ENTRIES
CWLOOP,	CDF 10
	TAD I BUPTR
	JMS CWR		/SENT TO CASSETTE OUTPUT BUFFER
	CDF 10
	TAD I BUPTR
	AND (7400
	DCA TEMP1
	INCR BUPTR	/PT TO 2ND HALF
	TAD I BUPTR
	JMS CWR
	CDF 10
	TAD I BUPTR
	AND (7400
	CLL RTR
	RTR
	TAD TEMP1
	RTR
	RTR
	JMS CWR
	INCR BUPTR	/PT TO NEXT DOUBLE-WORD
	ISZ BUKNT	/AT END OF BUFFER?
	JMP CWLOOP	/NO
CWLV,	CIF CDF 10
	EXIT CWRITE	/YES, RETURN
BUPTR,	0		/PTS INTO OBUUFER
BUKNT,	0
/INSERT CHAR IN CASSETTE OUTPUT BUFFER
/AND OUTPUT BUFFER IF BUFFER FULL

CWR,	0
	AND (377
	CDF 0
	DCA CWTMP
	TAD LDRFLG
	SZA CLA
	JMS I (LDRTST
	CDF 10
	TAD I (7643
	RTL		/PUT /B OPTION IN LINK
	CDF 0
	SNL CLA
	JMP GOK
	TAD CWTMP
	TAD M200
	SNA CLA
	JMP I (PREFIN
GOK,	TAD CWTMP2
	JMS CWR2
	TAD CWTMP1
	DCA CWTMP2
	TAD CWTMP
	DCA CWTMP1
CWREX,	EXIT CWR

CWR2,	0
	SPA
	JMP CWRIGN	/IGNORE -1
	CDF 0
	DCA I COPTR	/INSERT CHAR IN COBUF
	INCR COPTR
	ISZ COKNT	/COBUF FULL?
	EXIT CWR2	/NO, SO RETURN
	JMS CWRI
M200,
CWRIGN,	7600		/CLA
	EXIT CWR2
CWRI,	0
	TAD COKNT
	TAD RECSIZ
	SNA CLA
	EXIT CWRI	/DO NOTHING IF BUFFER EMPTY
	TAD RECSIZ
	DCA I (BSIZE
	TAD I (OUNIT
	JMS I QH3	/YES, WRITE OUT BUFFER
	WRITE		/WRITE FROM FIELD 0
PCOBUF,	COBUF		/LOCATION COBUF
	JMP XER7	/OUTPUT ERROR
	TAD PCOBUF
	DCA COPTR	/BUFFER IS NOW EMPTY
	TAD RECSIZ
	CIA
	DCA COKNT
	EXIT CWRI

RECSIZ,	0		/RECORD SIZE ON OUTPUT
COPTR,	COBUF		/PTS TO NEXT FREE LOCATION IN COBUF
COKNT,	-1000		/NUMBER OF EMPTY SLOTS LEFT IN COBUF

XER7,	CIF CDF 10
	AND (40
	SZA CLA		/CLEAR LEADER?
	JMP I (ER5	/YES, DEVICE FULL
	JMP I (ER7	/OUTPUT ERROR
XER4,	CIF CDF 10
	JMP I (ER4
XER8,	CIF CDF 10
	JMP I (ER8

LDRFLG,	0		/NON-ZERO IF IGNORING LEADER
CWTMP1,	-1
CWTMP2,	-1
CWTMP,	0
QH3,	HANDLER
	PAGE
PREFIN,	TAD (200
	JMS I (CWR2	/WRITE OUT TRAILER
	JMP CFIN2	/BUT NO CHECKSUM
CFIN,	TAD I (CWTMP2	/V3C
	JMS I (CWR2
	TAD I (CWTMP1	/V3C
	JMS I (CWR2
CFIN2,	JMS I (CWRI
	TAD I (OUNIT
XCLOSE,	JMS I (CLOSE
	JMP I (XER8
XLV,	CIF CDF 10
	JMP I (DECODE
CTRTEM,
CREAD,	0
	TAD (OBUFFER
	DCA BIPTR
	TAD (-OBUFLEN
	DCA BIKNT
ZRLUP,	CDF 10
	DCA I BIPTR	/ZERO BUFFER
	CLA IAC
	AND I (7643
	SZA CLA
	TAD (DCRE-CRE	/GOT L OPTION
	TAD (CRE
	CDF 0
	DCA XCRE	/PT TO INPUT SUBR
	INCR BIPTR
	ISZ BIKNT
	JMP ZRLUP
	TAD (OBUFFER
	DCA BIPTR
	TAD (-HOBUFLEN
	DCA BIKNT	/# OF DOUBLE-WORDS
CRLOOP,	JMS I XCRE
	CDF 10
	DCA I BIPTR
	JMS I XCRE
	DCA TEMP2
	JMS I XCRE
	DCA TEMP3
	CDF 10
	TAD TEMP3
	RTL
	RTL
	AND (7400
	TAD I BIPTR
	DCA I BIPTR
	INCR BIPTR
	TAD TEMP3
	RTR
	RTR
	RAR
	AND (7400
	TAD TEMP2
	DCA I BIPTR
	INCR BIPTR
	ISZ BIKNT
	JMP CRLOOP	/REITERATE
	CIF CDF 10
	TAD (MAXBLK
	DCA I (INTEN	/READ 10 BLOCKS
	EXIT CREAD	/ALL DONE
BIPTR,	0		/PTS INTO OBUFFER
BIKNT,	0
XCRE,	CRE

CTRLC,	0
	KSF
	EXIT CTRLC
	TAD (7600
	KRS
	TAD (-7603
	SZA CLA
	EXIT CTRLC
	JMS I (CLEAR
	TAD I (OUNIT
	SPA CLA
	JMP I (7600
	TAD I (OUNIT
	DCA CTRTEM
	STA
	DCA I (OUNIT
	TAD CTRTEM
	JMS I (CLOSE
	JMP I (XER8
	JMP I (7600
LOPTION,TAD I (IUNIT
	JMS I QU3
	REWIND
	JMP I (INER
	CLA IAC
	DCA I (CIBUF
LM1,	JMP LM2		/ZERO FOR MAGTAPE
	JMS I QU3
	SKPFIL
	JMP I (INER
LM2,	CIF CDF 10
	JMP I (CHLOOP
LM3,	JMP LM2
QU3,	UTIL
	PAGE
CIKNT,	-1		/ONE'S COMPLEMENT OF # OF BYTES LEFT IN CIBUF
CIPTR,	CIBUF		/PTS TO NEXT BYTE IN CIBUF TO BE READ

CRE,	0
	CDF 0
	TAD FTFLG	/FIRST TIME THROUGH?
	SZA CLA
	JMP FT		/YES
	TAD TLRFLG
	SNA CLA
	JMP EPI		/TRAILER
	ISZ CIKNT
	SKP
	JMS I (CRED
	TAD I CIPTR
	JMS CHKSUM
	JMS CHKTLR
	TAD I CIPTR
	INCR CIPTR
/	AND (377
	EXIT CRE


/READ DIRECTORY
DCRE,	0
	CDF 0
	ISZ CIKNT
	SKP
	JMS DCRED
	TAD I CIPTR
	TAD (-32
	SNA
	JMP DCRE+1	/ALLOW '32' TO SHORTEN BUFFER
	TAD (32
	SNA
	TAD (232
	INCR CIPTR
	EXIT DCRE
FT,	DCA FTFLG
	TAD (200	/SEND LEADER
	EXIT CRE

CHKSUM,	0
	DCA CHTEM
	TAD CHTEM
	AND (200
	SNA CLA
	TAD CHTEM
	TAD CHECKSUM
	DCA CHECKSUM
	EXIT CHKSUM
CHTEM,	0
CHECKSUM,0
FTFLG,	1		/1 IF FIRST TIME HERE
CHKPTR,	CHKTBL
TLRFLG,	0

CHKTBL,	0		/CHECKSUM LEFT PART
	0		/CHECKSUM RIGHT PART
	200		/TRAILER
	32		/CTRL/Z
	-1		/TABLE END

CHKTLR,	0
	CDF 10
	TAD I (7643
	CDF 0
	RTL		/B SWITCH TO LINK
	SNL CLA
	EXIT CHKTLR
	TAD I CIPTR
	TAD (-200
	SZA CLA
	EXIT CHKTLR
	DCA TLRFLG
	TAD (CHKTBL
	DCA CHKPTR
	TAD CHECKSUM
	RTR
	RTR
	RTR
	AND (77
	DCA CHKTBL
	TAD CHECKSUM
	AND (77
	DCA CHKTBL+1
EPI,	TAD I CHKPTR
	SPA
	JMP I (INTO
	INCR CHKPTR
	EXIT CRE
DCRED,	0
	TAD (40
	DCA I (BSIZE
	TAD I PCIBUF
	SNA CLA
	JMP I (INTO
	TAD I (IUNIT
	JMS I QH4
	READ
PCIBUF,	CIBUF
	JMP I (INER
	TAD PCIBUF
	DCA CIPTR
	TAD I CIPTR
	SZA CLA
	TAD (-23
	TAD (-2
	DCA CIKNT
	JMS I (FIDDLE
	TAD I CIPTR
	SNA CLA
	EXIT DCRED
	JMS I QU4
	SKPFIL
	JMP I (INER
	EXIT DCRED

QH4,	HANDLER
QU4,	UTIL
/THIS WAS VERY UNOPTIMAL ADDING IN MAGTAPE SUPPORT
/AFTER THE PROGRAM WAS ALL DONE AND BURIED.
/IT COULD HAVE BEEN DONE IN A MUCH BETTER METHOD
/IF IT WAS DESIGNED IN BEFORE THE PROGRAM WAS WRITTEN.
	PAGE
/FIRST ARG: PTS TO OS/8 FILENAME IN FIELD 1

CONVRT,	0
	STA
	TAD I CONVRT
	DCA ONPTR
	INCR CONVRT
	TAD (SINCH
	DCA CNPTR
	TAD (-4
	DCA CKNT
CONLUP,	CDF 10
	INCR ONPTR
	TAD I ONPTR
	CDF 0
	RTR
	RTR
	RTR
	JMS CNV
	DCA I CNPTR
	INCR CNPTR
	CDF 10
	TAD I ONPTR
	CDF 0
	JMS CNV
	DCA I CNPTR
	INCR CNPTR
	ISZ CKNT
	JMP CONLUP
	TAD (40
	DCA I CNPTR
	CDF 10
	TAD I (7643
	CDF 0
	RTL
	SNL CLA
	EXIT CONVRT	/ NOT /B
	CDF 10
	TAD I (7643
	RAL
	CLA
	TAD I ONPTR
	CDF 0
	SZA CLA
	EXIT CONVRT	/EXTENSION SPECIFIED
	SZL
	EXIT CONVRT	/   /A
	CLL STA RAL
	TAD CNPTR
	DCA CNPTR
	TAD ("B		/SET EXTENSION TO .BIN
	DCA I CNPTR
	INCR CNPTR
	TAD ("I
	DCA I CNPTR
	INCR CNPTR
	TAD ("N
	DCA I CNPTR
	EXIT CONVRT
CNV,	0
	AND (77
	SZA		/CHANGE 0 TO BLANK
	TAD (40
	AND (77
	TAD (40
	EXIT CNV

ONPTR,	0
CNPTR,	0
CKNT,	0

LOOK4ME,JMS CONVRT
	7606
	TAD IUNIT
	JMS I (LOOKUP
	JMP I (XER4
	JMP XER24
	TAD I (INCH+12	/GET H.O. INPUT RECORD SIZE
	CLL RTR
	RTR
	RAR
	TAD I (INCH+13
	DCA INRECSZ
	TAD INRECSZ
	SNA
	JMP XER40	/RECORD SIZE 0
	CLL
	TAD (-1001
	SZL CLA
	JMP XER10
	CIF CDF 10
	JMP I (CHLOOP

XER24,	CIF CDF 10
	JMP I (ER24
XER25,	CIF CDF 10
	JMP I (ER3
OUNIT,	0
IUNIT,	0
/IN CASE OF CASSETTES, CONTAINS UNIT (AS CHAR)
/IN CASE OF MAGTAPE, CONTAINS HANDLER ENTRY ADDRESS
/OUNIT IS -1 DURING A ^C CLOSE
/-1 MEANS DON'T CLOSE ON ERROR
INRECSZ,200	/RECORD SIZE ON INPUT
XER40,	CIF CDF 10
	JMP I (ER40
XER10,	CIF CDF 10
	JMP I (ER10
F1CTRLC,0
	JMS I (CTRLC
	CIF CDF 10
	EXIT F1CTRLC
	PAGE
SINCH,	ZBLOCK 16
	40;40;40;40;40;40
	ZBLOCK 14
INCH,	ZBLOCK 40

LDRTST,	0
	TAD I (CWTMP
	TAD (-200
	SNA CLA		/LEADER?
	JMP I (CWREX	/YES, EXIT CWR
	DCA I (LDRFLG	/NO
	EXIT LDRTST
ENTERO,	TAD (COBUF
	DCA I (COPTR
	JMS I (CONVRT
	7601
	JMS I (MAKDAT
	TAD I (RECSIZ
	CLL RTL
	RTL
	RAL
	AND (17
	DCA I (SINCH+12
	TAD I (RECSIZ
	AND (377
	DCA I (SINCH+13
	CDF 10
	TAD I (FILTYP
	CDF 0
	DCA I (SINCH+11
	DCA I (SINCH+14
	DCA I (SINCH+15
	CDF 10
	TAD I (VRSNO
	CDF 0
	DCA I (SINCH+24
	TAD I (OUNIT
	JMS I (ENTER
	JMP I (XER25
	CIF CDF 10
	DCA I (OSWITCH
	JMP I (CONT1
	PAGE
ZOPTION,TAD I (OUNIT
	JMS I QU5
	REWIND
	JMP XER77	/OUTPUT ERROR
	CDF 10
	TAD I (7601
	CDF 0
	SNA CLA
	JMP NOFILE
	JMS I (CONVRT
	7601
	JMS I (LOOKUP
	JMP I (XER4
	JMP I (XER24
	JMS I QU5
	SKPFIL
	JMP I (XER24
	TAD (40
	DCA I (BSIZE
	JMS I QH5
	READ
	INCH
	JMP XER77
CLO3,	JMS I (BACK
	JMP XER77
	JMS I QH5
	WRITE
	ZER
	JMP XER77
NOFILE,	JMP I (XCLOSE
MAKDAT,	0
	CDF 10
	TAD I (DATE
	CDF 0
	SNA
	JMP SETOBL
	DCA SKNT
	TAD (SINCH+16
	DCA SPTR
	TAD SKNT
	RTR
	RAR
	AND (37
	JMS TWO		/INSERT DAY
	TAD SKNT
	RTL
	RTL
	RAL
	AND (17
	JMS TWO		/INSERT MONTH
	TAD SKNT
	AND (7
/
/	TAD (106
	JMP DSN11	//DSN PATCH 21.21.1 M STARTS HERE
DSN10,
/
	JMS TWO		/INSERT YEAR
	EXIT MAKDAT

SETOBL,	TAD (-6		/SET DATE TO BLANKS
	DCA SKNT
	TAD (SINCH+16
	DCA SPTR
SELOOP,	TAD (40
	DCA I SPTR
	INCR SPTR
	ISZ SKNT
	JMP SELOOP
	EXIT MAKDAT

SPTR,	0
SKNT,	0
TEM2,	0
TENS,	0
TWO,	0
	DCA TEM2
	TAD (60
	DCA TENS
	TAD TEM2
TWOLUP,	TAD (-12
	SPA
	JMP NEG
	INCR TENS
	JMP TWOLUP
NEG,	TAD (72
	DCA TEM2
	TAD TENS
	DCA I SPTR
	INCR SPTR
	TAD TEM2
	DCA I SPTR
	INCR SPTR
	EXIT TWO

XER77,	CIF CDF 10
	JMP I (ER7	/OUTPUT ERROR

QU5,	UTIL
QH5,	HANDLER
MHANDLER,0		/AC CONTAINS HANDLER ENTRY ADDRESS
	CIF 10
	JMP I (MHAN	/KLUDGEY LINK TO FIELD 1

MUTIL,	0		/AC CONTAINS ETC.
	CIF 10
	JMP I (MUT

//			DSN PATCH 21.21.1 M
DSN11,	DCA SKNT	//
	JMS I DSN12	//
	TAD SKNT	//
	TAD (160	//
	JMP DSN10	//
DSN12,	DSN13		//

	PAGE
	FIELD 1

	XR=10

	*2000

START,	JMP DEC2	/NORMAL STARTING ADDRESS
CHAIN,	JMP NODEC	/CHAIN STARTING ADDRESS
DECODE,	STL CLA RAR
	AND I (7642
	SZA CLA
	JMP KBM		/RETURN TO KBM ON $
/	WOULD BE NICE HERE TO TELL CD/BATCH NOT TO SPOOL
DEC2,	CALL (200
	5		/COMMAND DECODE
	5200		/USING SPECIAL MODE
NODEC,	TAD (OUTHAND+1
	DCA ENTR	/RESET PTR TO HANDLER LOCATION
	STA
	DCA I (OSWITCH
	JMS I (CHKSW	/CHECK FOR SWITCH OPTIONS
	CDF 0
	DCA I (OUTSW
	STA
	DCA I (OUNIT
	CDF 10
	TAD I (7666
	DCA I (DATE
FET,	TAD I (7600	/GET DEVICE NUMBER OF OUTPUT FILE
	SNA		/WAS ONE SPECIFIED?
	JMP NOF		/NO - NO OUTPUT FILE
	CALL (200
	1		/FETCH HANDLER
ENTR,	OUTHAND+1	/INTO PAGES 2400 AND 2600
			/REPLACED BY HANDLER STARTING ADDRESS
	JMP I (ER6		/OUTPUT DEVICE DOESN'T EXIST
	TAD I (7644
	AND (1000
	SZA CLA
	JMP I (FOXOUT	/O SPECIFIED
	STL CLA RTR
	AND I (7645
	TAD I (7601
	SNA CLA
	JMP NOCAS	/NO OUTPUT NAME
	TAD (7600
	JMS I (CHKNAM
	JMP I (STARER	/*.*
	TAD I (7600
	JMS I (TCAS	/CASSETTE?
	JMP I (FIXOUT	/YES
	JMP I (FXMOUT	/MAGTAPE
NOCAS,	TAD (7601	/NO
	DCA OBLK	/GET PTR TO OUTPUT FILE NAME
	TAD ENTR
	DCA I (OENTRY	/STORE AWAY OUTPUT HANDLER ENTRY PT
	TAD (OWRITE
	DCA PWRITE
	TAD (FINIO
	DCA I (XFINIO
	TAD I (7643
	RTL
	SNL CLA
	JMP NOB
	TAD I (7604	/GET EXT
	SZA CLA
	JMP NOB
	TAD (216	/SET TO .BN
	DCA I (7604
NOB,	TAD I (7600	/GET DEVICE NUMBER AGAIN
	CALL (200
	3		/OPEN OUTPUT FILE
OBLK,	7601		/PTS TO OUTPUT FILE NAME
			/REPLACED BY STARTING BLOCK NUMBER
LEN,	0		/REPLACED BY NEGATIVE OF LENGTH OF OUT AREA
	JMP I (ER3	/FILE OPEN ERROR
	DCA I (REALEN	/ZERO REAL LENGTH
	TAD OBLK
	DCA I (OBLOCK	/SET STARTING BLOCK NUMBER
CONT1,	JMS I (GETIN
/	INITIALIZE INPUT STUFF
CHLOOP,	CIF CDF 0
	JMS I (F1CTRLC
	CALL PREAD
	CIF CDF 0
	JMS I (F1CTRLC
	CALL PWRITE
	JMP CHLOOP
PREAD,	OREAD
PWRITE,	OWRITE
NOF,	STL CLA RTR
	AND I (7645
	SNA CLA
	JMP I (ER1
	JMP I (FOXOUT	/Z IMPLIES O

KBM,	CIF CDF 0
	JMP I (7605
	PAGE
UDIG,	0

GETSWDIG,0
	DCA UDIG
	TAD I (7645
	AND (1774
	SNA
	EXIT GETSWDIG	/NO UNIT
	INCR GETSWDIG
	RTL
	RAL
LUDIG,	SZL
	JMP GOTUD
	INCR UDIG
	RAL
	JMP LUDIG
G7600,
GOTUD,	7600
	TAD UDIG
	TAD (60
	EXIT GETSWDIG
FOXOUT,	JMS GETSWDIG
	JMP I (ER1	/NO OUTPUT UNIT
	JMP GOTOU
FIXOUT,	TAD I (ENTR
	JMS I (GETDVC
GOTOU,	CDF 0
	DCA I (OUNIT
	CDF 10
	JMS I (SETCAS
YAHAOU,	TAD I (7643
	AND (400
	SZA CLA
	JMP DOPT
	STL CLA RTR
	AND I (7645
	SZA CLA
	JMP ZOPT
	TAD I G7600
	RTR
	RTR
	AND (377	/ISOLATE FILE TYPE
	DCA FILTYP	/SAVE IT
	JMS I (GETLEN
	TAD (CW
	DCA I (PWRITE
	TAD (CFINIO
	DCA I (XFINIO
	TAD I (7643
	RTL		/B TO LINK
	SZL CLA
	CLA IAC
	CIF CDF 0
	DCA I (LDRFLG
	STA
	DCA I (CWTMP1
	STA
	DCA I (CWTMP2
	DCA I (CHECKSUM
	JMP I (ENTERO
/	RETURN TO CONT1

FXMOUT,	TAD I (ENTR
	CDF 0
	DCA I (OUNIT
	CDF 10
	JMS I (SETMAG
	TAD I (ENTR	/GET LOCATION OF MAGTAPE HANDLER
	JMS SETDEN
	JMP YAHAOU
SETDEN,	0
	AND G7600
	DCA MTA
	TAD I (7644
	AND (10
	SZA CLA		/IS /U SPECIFIED?
	IAC		/YES, USE DENSITY 3
	TAD (2		/NO, USE DENSITY 2
	DCA DEN
	CDF 0
	TAD PARITY
	CLL RAR		/LINK ON IF PARITY SPECIFIED
	SZL
	TAD PAR
	SNL
	TAD I MTA	/GET RELATIVE LOC 0
	AND (400	/ISOLATE PARITY
	TAD DEN		/FORCE CORE DUMP MODE
	DCA I MTA	/STORE BACK DENSITY AND PARITY
	CDF 10
	JMP I SETDEN
FILTYP,	0
BINTYP,	0		/SET BINARY TYPE - DON'T TOUCH LINK
	IAC
	IAC
	DCA FILTYP
	EXIT BINTYP

DOPT,	CIF CDF 0
	JMP I (DOPTION

ZOPT,	CIF CDF 0
	JMP I (ZOPTION

MTA,	0		/FIRST LOC OF MAGTAPE HANDLER
PARITY,	0		/0 MENAS NOT SPECIFIED, 1 MEANS SPECIFIED PARITY
PAR,	0		/0 OR 400 SPECIFYING PARITY
DEN,	2		/DENSITY
	PAGE
FID2,	0
	TAD I (CIBUF
	AND (177		/DF=0
	TAD (-52
	SNA CLA
	JMS EMPTY
	TAD I (CIBUF+10
	DCA I (CIBUF+11
	TAD I (CIBUF+7
	DCA I (CIBUF+10
	TAD I (CIBUF+6
	DCA I (CIBUF+7
	TAD (".
	DCA I (CIBUF+6
	CIF 0
	JMP I FID2

EMPTY,	0
	TAD I (FAST
	SNA CLA
	JMP I EMPTY
	STA
	DCA I (CIKNT
	TAD (32
	DCA I (CIBUF
	CIF 0
	JMP I (FIDLV
GETLEN,	0
	CLL STA RAR	/3777
	AND I (7642	/GET H.O. OPTION
	DCA VRSNO
	TAD I (7646	/GET = OPTION (L.O. 12 BITS)
	CLL
	TAD (-1001
	SZL CLA		/LESS THAN 1001?
	JMP I (ER10	/NO, ERROR
	TAD I (7646	/YES
	SNA
	TAD (200	/200 IS DEFAULT RECORD SIZE
	CDF 0
	DCA I (RECSIZ
	TAD I (RECSIZ
	CIA
	DCA I (COKNT
	CDF 10
	EXIT GETLEN

FINIO,	JMS I (OWRITE
	TAD I (7600	/GET OUTPUT DEVICE NUMBER
	CALL (200
	4		/CLOSE
	7601		/PTR TO FILE NAME
REALEN,	0		/LENGTH OF NEW OUTPUT FILE
	JMP ER8		/CLOSE ERROR
	JMP I (DECODE
ER8,	JMS I (PRINT
	TEXT	/?CLOSE ERROR/
ER5,	JMS I (PRINT
	TEXT	/?OUTPUT DEVICE FULL/
ER30,	JMS I (PRINT
	TEXT	/?OUT=IN/
VRSNO,	0

ER6,	JMS I (PRINT
	TEXT	/?FETCH ERROR/
ER24,	STA
	DCA I (SPSWTCH	/RETURN FROM PRINT
	JMS I (PRINT
	TEXT	/?FILE NOT FOUND/
	ISZ I (FUDSW	/FIXUP CASSETTE
	JMP I (CLO
	PAGE
OREAD,	0
	TAD (MAXBLK
	DCA INTEN	/TRY TO READ 10 BLOCKS
	TAD (MAXBLK^200+10
	DCA READSZ
	TAD I (7605
	AND (17
	TAD (7757
	DCA TEMP	/GET DCB ADDR
	TAD I TEMP	/GET DCB
	AND (1000
	SZA CLA
	JMP ER4		/INPUT DEVICE IS WRITE-ONLY
	TAD I TEMP
	SMA CLA
	JMP YES		/NOT FILE-STRUCTURED
	TAD I (INLEN
	TAD (MAXBLK
	SMA SZA CLA	/CAN I READ IN 10 BLOCKS?
	JMS SHORT	/NO
YES,	CIF 0		/YES
	JMS I IENTRY	/CALL INPUT HANDLER
READSZ,	2010		/READ 20 PAGES INTO FIELD 1
	OBUFFER		/LOCATION 4000
IBLOCK,	0		/INPUT BLOCK NUMBER
	JMP QER4	/INPUT ERROR
	TAD IBLOCK
	TAD INTEN
	DCA IBLOCK	/UPDATE BLOCK NUMBER
	TAD I (INLEN
	TAD INTEN
	DCA I (INLEN	/UPDATE LENGTH LEFT
	TAD INTEN
	TAD (-MAXBLK
	SZA CLA
	JMP XFIN
	EXIT OREAD	/RETURN
INTEN,	10		/NUMBER OF BLOCKS JUST READ
XFINIO,	FINIO

SHORT,	0
	TAD I (INLEN	/HOW MANY BLOCKS LEFT?
	CIA		/MAKE POSITIVE
	DCA INTEN	/THAT'S AS MUCH AS WE CAN READ
	TAD INTEN
	SNA
XFIN,	JMP I XFINIO	/NO MORE
	CLL RTR
	RTR
	RTR		/CONVERT TO PAGES IN BITS 1-5
	TAD (10		/ADD IN FIELD 1 BIT
	DCA READSZ
	EXIT SHORT	/RETURN
IENTRY,	0		/PTS TO INPUT HANDLER ENTRY POINT
QER4,	SMA CLA
	JMP SFIN	/NON-FATAL END-OF FILE
ER4,	JMS I (PRINT
	TEXT	/?INPUT ERROR/
ER26,	JMS I (PRINT
	TEXT /?TOO MANY FILES/
SFIN,	TAD (7600
	DCA TPTR
SLUP,	STA
	TAD TPTR
	DCA TPTR
	TAD I TPTR
	SNA CLA
	JMP SLUP
	TAD TPTR
	TAD (-OBUFFER+1
	SNA
	JMP ALLZ
	TAD (377	/CHANGED FROM PIPC'S 376
	CLL RTL
	RTL
	RAL
	AND (17
	DCA INTEN
	JMP XFIN
ALLZ,	CLA IAC
	JMP .-3
TPTR,	0
ER3,	JMS I (PRINT
	TEXT	/?ENTER ERROR/
	PAGE
GETIN,	0		/OPEN INPUT FILE
	DCA DATE
	TAD I (7605	/ANY MORE FILES SPECIFIED?
	SNA CLA
	JMP NOIN	/NO
	TAD I (7612
	SZA CLA
	JMP I (ER26	/2ND INPUT FILE IS BAD
	TAD (7605
	JMS I (CHKNAM
	JMP I (STARER	/*.*
	TAD (7606
	DCA IN		/SET PTR TO FILE NAME
	TAD (INHAND+1
	DCA IN3
	TAD I (7605	/GET DEVICE NUMBER
	CALL (200
	1		/FETCH NEW DEVICE HANDLER
IN3,	INHAND+1	/INTO PAGES 3200 AND 3400
			/REPLACED BY ENTRY PT TO INPUT HANDLER
	JMP I (ER6	/FETCH ERROR
	TAD I (7643
	AND (10
	SZA CLA
	JMP I (FOXIN	/I SPECIFIED
	CLA IAC		/V3C
	AND I (7643	/LOOK AT /L OPTION
	TAD I (7606
	SNA CLA
	JMP NOCAS2
/IF NO NAME IS GIVEN AND /L IS NOT SPECIFIED, THEN USE
/MAGTAPE OR CASSETTE HANDLER AS IS, I.E. AS
/A NON-FILE-STRUCTURED OS/8 DRIVER.
	TAD I (7605
	JMS I (TCAS	/CASSETTE?
	JMP I (FIXIN	/YES
	JMP I (FIXMIN	/MAGTAPE
NOCAS2,	CLA IAC
	AND I (7643
	SZA CLA
	JMP ER11	/V3C  /L SPECIFIED WHEN DEVICE WAS NOT MAGTAPE OR CASSETTE
	TAD (OREAD
	DCA I (PREAD
	TAD IN3		/GET NEW HANDLER ENTRY PT
	DCA I (IENTRY	/STORE AWAY
	TAD I (7605	/GET DEVICE NUMBER AGAIN
	CALL (200
	2		/PERFORM A LOOKUP
IN,	0		/PTR TO FILE NAME
			/REPLACED BY INPUT BLOCK NUMBER
IN2,	0		/REPLACED BY NEGATIVE OF INPUT FILE LENGTH
	JMP LKERR	/LOOKUP ERROR
	TAD IN		/GET NEW INPUT BLOCK
	DCA I (IBLOCK	/STORE AWAY
	TAD IN2		/GET NEW INPUT FILE LENGTH
	DCA INLEN
	TAD I (1404	/GET # OF ADDITIONAL WORDS
	SNA
	JMP NONE
	TAD 17
	DCA POINTER
	TAD I POINTER	/GET FILE CREATION DATE
	SNA
	JMP NONE
SETDAT,	DCA DATE
	EXIT GETIN
NONE,	TAD I (7666	/USE TODAY'S DATE
	JMP SETDAT
LKERR,	CLA
	TAD I (7611
	SZA CLA
	JMP I (ER24	/FILE NOT FOUND
	TAD I (7643	/TRY .BN
	RTL
	SNL CLA
	JMP I (ER24	/ NOT /B
	TAD (216
	DCA I (7611
	JMP GETIN+1

INLEN,	0
DATE,	0		/OS8 DATE OF INPUT FILE
POINTER,0

NOIN,	CLA IAC
	AND I (7643
	SNA CLA
	JMP I (ER21
	JMP I (FOXIN	/ /L SPECIFIED
ER11,	JMS I (PRINT	/V3C
	TEXT	/?L OPTION OUT OF CONTEXT/
	PAGE
/ENTER WITH INTEN BLOCKS TO WRITE
OWRITE,	0
	TAD I (INTEN	/HOW MUCH IS THERE TO WRITE?
	SNA
	EXIT OWRITE	/NOTHING
	DCA OUTEN	/SAVE NUMBER OF BLOCKS TO WRITE
	TAD I (7600
	AND (17
	TAD (7757
	DCA TEMP
	STL CLA RTR
	AND I TEMP
	SZA CLA
	JMP I (ER7	/OUTPUT DEVICE IS READ-ONLY
	TAD OUTEN
	CLL RTR
	RTR
	RTR		/CONVERT TO PAGES
	TAD (4010	/FIELD 1 (WRITE DIRECTLY FROM INPUT BUFFER)
	DCA WRSIZ
	TAD I (LEN
	SNA CLA
	JMP NFS		/NON-FILE STRUCTURED
	TAD I (REALEN
	TAD OUTEN
	STL
	TAD I (LEN
	SNL SZA CLA
	JMP I (ER5
NFS,	CIF 0
	JMS I OENTRY	/CALL OUTPUT HANDLER
WRSIZ,	6010		/WRITE 20 PAGES FROM FIELD 1
	OBUFFER		/LOCATION 4000
OBLOCK,	0		/OUTPUT BLOCK NUMBER
	JMP I (ER7	/OUTPUT ERROR
	TAD OBLOCK
	TAD OUTEN
	DCA OBLOCK	/UPDATE OUTPUT BLOCK NUMBER
	TAD I (REALEN
	TAD OUTEN
	DCA I (REALEN	/UPDATE LENGTH WROTE
	EXIT OWRITE

OENTRY,	0
OUTEN,	0
FOXIN,	JMS I (GETSWDIG
	JMP I (ER21
	JMP GOTIU
FIXIN,	TAD I (IN3	/GET INPUT HANDLER ADDRESS
	JMS I (GETDVC
GOTIU,	CDF 0
	DCA I (IUNIT
	CDF 10
	JMS I (SETCAS
YAHAIN,	CDF 0
	TAD I (OUNIT
	CIA
	TAD I (IUNIT
	SNA CLA
	JMP I (ER30
	STA
	DCA I (CIKNT
	DCA I (CHECKSUM
	CLA IAC
	DCA I (TLRFLG
	CDF 10
	TAD (CR
	DCA I (PREAD
	TAD I (7643
	RTL
	CLA RAL
	CDF 0
	DCA I (FTFLG
	CDF 10
	JMS I (GETLEN
	TAD I (7643
	AND (100	/ F OPTION?
	CDF 0
	DCA I (FAST
	CDF 10
	CLA IAC
	AND I (7643
	CIF CDF 0
	SZA CLA
	JMP I (LOPTION
	JMP I (LOOK4ME
/RETURN TO CHLOOP
FIXMIN,	TAD I (IN3
	CDF 0
	DCA I (IUNIT
	CDF 10
	JMS I (SETMAG
	TAD I (IN3
	JMS I (SETDEN
	JMP YAHAIN
	PAGE
PRINT,	0
	CLA
	CDF 10
	DCA CTOFLG	/ALLOW ECHOING
	JMS CRLF
PRLUP,	TAD I PRINT
	RTR
	RTR
	RTR
	JMS PRIN
	TAD I PRINT
	JMS PRIN
	INCR PRINT
	JMP PRLUP

PRIN,	0
	AND (77
	SNA
	JMP PRFIN
	TAD (240
	AND (77
	TAD (240
	DCA TM
	KSF
	JMP NOBOTH
	TAD (200
	KRS
	TAD (-203
	SNA
	JMP KBM2
	TAD (203-217
	SZA CLA
	JMP NOBOTH
	TAD ("^
	JMS TYPE
	TAD ("O
	JMS TYPE
	JMS CRLF
	ISZ CTOFLG
NOBOTH,	TAD TM
	JMS TYPE
	EXIT PRIN
PRFIN,	JMS CRLF
	DCA FUDSW
	TAD I (SPSWTCH
	SNA CLA
	JMP CLO
	DCA I (SPSWTCH	/SWITCH NON-ZERO MEANS RETURN
	INCR PRINT	/POINT TO RETURN
	JMP I PRINT
/DO A CLOSE IF OUTPUT CASSETTE OPEN
CLO,	CDF 0
	TAD I (OUNIT
	CDF 10
	SPA CLA
	JMP I (DECODE
	TAD OSWITCH
	SZA CLA
	JMP I (DECODE
	CDF 0
	TAD I (OUTSW
	CDF 10
	SNA CLA		/DID WE WRITE ON OUTPUT CASSETTE?
	JMP I (DECODE	/NO
	CIF CDF 0
	TAD I (OUNIT
	DCA TEMP
	STA
	DCA I (OUNIT
	TAD FUDSW
	SZA CLA
	JMP I (CLO3
	TAD TEMP
	JMP I (XCLOSE
OSWITCH,-1		/0 MEANS OUTPUT CASSETTE OPEN

KBM2,	CIF CDF 0
	JMP I L7600	/RETURN TO OS/8

FUDSW,	0		/1 MEANS GOT OS/8 LOOKUP FAILURE
TYPE,	0
	DCA TM
	TAD CTOFLG
	SZA CLA
	EXIT TYPE	/NOT ECHOING
	TAD TM
	TLS
	TSF
	JMP .-1
L7600,	7600
	EXIT TYPE

CRLF,	0
	TAD (215
	JMS TYPE
	TAD (212
	JMS TYPE
	EXIT CRLF

CTOFLG,	0		/1 MEANS DON'T ECHO
TM,	0

ER7,	JMS PRINT
	TEXT	/?OUTPUT ERROR/

CFINIO,	CIF CDF 0
	JMS I (CWRITE
	CIF CDF 0
	JMP I (CFIN	/FINISH OUTPUT AND WRITE SENTINEL
/RETURN TO DECODE
	PAGE
ER10,	JMS I (PRINT
	TEXT	/?RECORD SIZE TOO BIG/
/ENTRY POINT REL 1: UNIT 1
/ENTRY POINT REL 7: UNIT 0

GETDVC,	0
	IAC
	DCA TEMP
	STL CLA RTL	/2
	AND TEMP
	RAR
	DCA UNIT	/DETERMINE IF UNIT 0 OR 1
	TAD TEMP
	AND (7600
	DCA TEMP
	CDF 0
LOOKIO,	ISZ TEMP
	TAD I TEMP	/SEARCH HANDLER FOR ANY IOT
	AND (7700
	TAD (-6700
	SZA CLA
	JMP LOOKIO
	TAD I TEMP	/GET CASSETETE IOT
	CDF 10
	AND (30		/V3 BUG FIX FROM V2
	CLL RTR
	TAD UNIT
	TAD (60
	EXIT GETDVC	/LEAVE IT IN AC

UNIT,	0
CHKNAM,	0		/DON'T ALLOW *'S OR ?'S
	DCA XR		/IN OUTPUT OR INPUT NAME
	TAD I XR
	TAD (-5200
	SNA
	JMP STARNM	/ENTIRE NAME IS *
	TAD (5200
	JMS CHKSTR
	TAD I XR
	JMS CHKSTR
	TAD I XR
	JMS CHKSTR
	TAD I XR
	JMS CHKSTR
	ISZ CHKNAM
	JMP I CHKNAM	/NAME GOOD, RETURN 2

CHKSTR,	0
	DCA TEM
	TAD TEM
	CLL RTR
	RTR
	RTR
	JMS CHC
	TAD TEM
	JMS CHC
	JMP I CHKSTR
CHC,	0
	AND (77
	TAD (-52
	SNA
	JMP STARER	/* IN NAME
	TAD (52-77
	SZA CLA
	JMP I CHC	/OKAY
STARER,	JMS I (PRINT
	TEXT	/?ILLEGAL * OR ?/

STARNM,	ISZ XR
	ISZ XR
	TAD I XR
	TAD (-5200
	SZA CLA
	JMP STARER	/NOT *.*
	JMP I CHKNAM	/TAKE SPECIAL RETURN ON *.*

TEM,	0
CHKSW,	0		/CHECK SWITCHES
	TAD I (7644
	AND (4		/CHECK FOR /V
	SZA CLA
	JMS I (VERSN	/PRINT MCPIP VERSION #
	TAD I (7644
	AND (400	/CHECK FOR /P
			/NOTE /P = 400 SAME AS ODD PARITY CODE
	SZA
	JMP ODDPAR
	TAD I (7643
	AND (200	/CHECK FOR /E
	SZA CLA
	JMP EVPAR
GOTP,	NOP
	JMP I CHKSW

ODDPAR,			/400 IN AC
EVPAR,	DCA I (PAR
	CLA IAC
	DCA I (PARITY
	JMP GOTP
	PAGE
SPSWTCH,0		/NON-ZERO MEANS RETURN FROM PRINT

/RET 1: CASSETTE
/RET 2: MAGTAPE
/RET 3: NEITHER

TCAS,	0
	AND (17		/ISOLATE
	TAD (7757	/ADD IN BASE OF DCB TABLE
	DCA TEMP	/TO GET DCB ADDRESS
	TAD I TEMP	/GET DCB
	AND (770	/ISOLATE UNIT TYPE
	TAD (-270	/CASSETTE HANDLER TYPE IS 27
	SNA
	JMP ITSCAS
	TAD (270-200
	SZA CLA
	INCR TCAS	/NOTHING SPECIAL
	INCR TCAS	/MAGTAPE
ITSCAS,	EXIT TCAS
VERSN,	0
	STA
	DCA SPSWTCH	/RETURN FROM PRINT
	JMS I (PRINT
	TEXT	\OS/8 MCPIP V\
	*.-1
	PIPVERSION+60^100+PATCHLEV
	0
	JMP I VERSN

ER1,	TAD I (7605
	SNA CLA
	JMP I (DECODE	/NO OUT AND NO IN
	CLA IAC
	AND I (7643	/WAS /L SPECIFIED?
	SZA CLA
	JMP SETTY	/YES
	JMS I (PRINT
	TEXT	/?NO OUTPUT FILE/
ER40,	JMS I (PRINT
	TEXT	/?CANNOT HANDLE VARIABLE-LENGTH RECORDS/
SETTY,	TAD (3100
	DCA Y
	JMS I (200
	12		/INQUIRE
TT,	2424
Y,	3100		/DEVICE TTY
	0
	JMP ER99
	TAD Y		/GET DEVICE NO. OF TTY:
	DCA I (7600
	JMP I (FET

ER99,	JMS I (PRINT
	TEXT	/?TTY DOES NOT EXIST/
ER21,	JMS I (PRINT
	TEXT	/?NO INPUT FILE/
CW,	0
	CIF CDF 0
	JMS I (CWRITE
	EXIT CW

CR,	0
	CIF CDF 0
	JMS I (CREAD
	EXIT CR
	PAGE
SETCAS,	0
	TAD (UTIL
	JMS SETU
	TAD (HANDLER
	JMS SETH
	CDF 0
	TAD (BACKFIL
	DCA I (BK2
	TAD I (BK4
	DCA I (BK3
	TAD (254
	DCA I (EOFBIT
	TAD I (FL3
	DCA I (FL1
	TAD (314
	DCA I (EOTBIT
	TAD I (LM3
	DCA I (LM1
	CDF 10
	JMP I SETCAS

SETMAG,	0
	TAD (MUTIL
	JMS SETU
	TAD (MHANDLER
	JMS SETH
	CDF 0
	TAD (BACKBLOCK
	DCA I (BK2
	TAD I (BK1
	DCA I (BK3
	TAD (3673
	DCA I (EOFBIT
	DCA I (FL1
	TAD (3663
	DCA I (EOTBIT
	DCA I (LM1
	CDF 10
	JMP I SETMAG
SETU,	0
	DCA SETH
	CDF 0
	TAD SETH
	DCA I (QU1
	TAD SETH
	DCA I (QU2
	TAD SETH
	DCA I (QU3
	TAD SETH
	DCA I (QU4
	TAD SETH
	DCA I (QU5
	CDF 10
	JMP I SETU
SETH,	0
	DCA SETU
	CDF 0
	TAD SETU
	DCA  I (QH1
	TAD SETU
	DCA I (QH2
	TAD SETU
	DCA I (QH3
	TAD SETU
	DCA I (QH4
	TAD SETU
	DCA I (QH5
	CDF 10
	JMP I SETH
	PAGE
MH,	0

MHAN,	SZA
	DCA MENTRY
	TAD I (MHANDLER
	DCA MH		/PICK UP ARGS VIA MH
	TAD I MH	/GET FN WORD
	TAD (SPCODE	/ADD SPECIAL CODE
	DCA MARG1
	ISZ MH
	TAD I MH	/GET CORE LOC
	DCA MARG2
	ISZ MH		/PT TO ERROR RETURN
	TAD I (BSIZE	/GET BLOCKSIZE
	CIA
	DCA MARG3	/STORE NEG
	CDF 10
	CIF 0
	JMS I MENTRY	/CALL MAGTAPE HANDLER
MARG1,	HLT
MARG2,	HLT
MARG3,	HLT
	SKP		/TAKE ERROR RETURN
	ISZ MH		/NORMAL RETURN
	CIF CDF 0
	JMP I MH	/GO BACK TO FIELD 0

MENTRY,	0
MU,	0

MUT,	SZA
	DCA MENTRY	/DF=0
	TAD I (MUTIL	/PICK UP ARGS
	DCA MU		/VIA 'MU'
	TAD I MU	/GET UTILITY FUNCTION
	ISZ MU
	CDF 10
	TAD (-REWIND
	SNA
	JMP REWT
	TAD (REWIND-BACKFIL
	SNA
	JMP BAKFT
	TAD (BACKFIL-WRGAP
	SNA
	JMP WRGT
	TAD (WRGAP-BACKBLOCK
	SNA
	JMP BAKBT
	TAD (BACKBLOCK-SKPFIL
	SZA CLA
	HLT		/IMPOSSIBLE
SKPFT,	STL CLA RAR	/4000=WRITE
BAKFT,	TAD (WRITE+FICODE-REWCOD
REWT,	TAD (REWCOD-EOCODE
WRGT,	TAD (EOCODE-RECCOD-WRITE
BAKBT,	TAD (RECCOD+WRITE
	DCA MRG1
	CIF 0
	JMS I MENTRY
MRG1,	HLT
MCA,	HLT		/IRRELEVANT
MWC,	-1
	SKP		/ERROR RETURN
	ISZ MU
	CIF CDF 0
	JMP I MU	/RETURN
EMPTINCH,52;105;115;120;124;131;40;40;40;14
	0;0;0;0;40;40;40;40;40;40
	ZBLOCK 14
	PAGE
	*2000
	$
