.TITLE *** TDV FUNCTION TO TRANSFER & COPY FILES
/ 
/ 
/                   FIRST PRINTING, JUNE 1976
/ 
/ 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 RESPON-
/ SIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS
/ DOCUMENT.
/ 
/ THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FUR-
/ NISHED 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 PRO-
/ VIDED IN WRITING BY DIGITAL.
/ 
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/ FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIP-
/ MENT THAT IS NOT SUPPLIED BY DIGITAL.
/ 
/ COPYRIGHT (C) 1976, BY DIGITAL EQUIPMENT CORPORATION
/ 
/ 
        .EJECT
/
/ EDIT #1	MJH		JUNE 4, 1976		TAKEN FROM FIN.28
/ EDIT #2+3	MJH		JUNE 7, 1976		BASIC BUGS
/
/	THIS TASK CAN COPY OR MOVE FILES FROM ONE DEVICE TO
/	ANOTHER VIA LUNS.  THE FORMAT OF THE COMMAND STRING IS
/		TDV>COPY LUN:FILNAM EXT, LUN:FILNAM EXT
/	WHERE 1ST NAMED FILE IS THE SOURCE AND 2ND IS THE DESTINATION
/	AND BOTH LUNS AND EXTENSIONS ARE OPTIONAL.
	.EJECT
	.DEC
ILUN=19				/FILE(S) INPUT LUN (NORMALLY ASSIGNED TO DECTAPE).
OLUN=17				/FILE(S) OUTPUT LUN (NORMALLY ASSIGNED TO DISK).
TDVTTY=13			/TDV TTY ERROR LUN.
	.OCT
/
X10=10				/AUTOINCREMENT REGISTER 10.
IDX=ISZ				/USED WHEN THE SKIP IS NOT INTENDED.
CBFSIZ=40			/SIZE OF THE COMMAND LINE BUFFER FOR UP
				/TO 80 CHARACTERS.
BUFSIZ=104			/SIZE OF THE FILE DATA BUFFER -- ENOUGH
				/FOR A 132 COLUMN LINE PRINTER PLUS
				/WHATEVER THE ASSEMBLER TACKS ON. THIS IS
				/ALSO SUFFICIENT TO HANDLE BINARY RECORDS
				/CREATED BY THE ASSEMBLER, COMPILER AND
				/TASK BUILDER.
/
	.EJECT
TRA	CAL	XFER		/TRANSFER THE COMMAND LINE READ BY 'TDV...'.
	CAL	WAITFR
	LAW	-16		/IS THE BUFFER TOO SMALL, I.E., IS THE
	SAD	EV		/COMMAND LINE TOO LONG?
	JMP	ERR1		/YES.
/
/ INITIALIZE THE FETCH-A-CHARACTER SUBROUTINE. THIS MUST BE DONE HERE,
/ RATHER THAN BEING ASSEMBLED IN, IN CASE THE TASK IS FIXED IN CORE AND
/ IS THUS NOT REINITIALIZED.
/
	LAC	(FACLB+2)
	DAC	FACLBX
	LAC	(FACCB+5)
	DAC	FACCBX
	DZM	TRACK9		/INITIALIZE THE 9-TRACK MAGTAPE FLAG
				/FOR 7-TRACK.
/
/ FLUSH COMMAND INPUT THROUGH THE FIRST BREAK CHARACTER.
/
FLUSH	JMS	FAC		/FETCH A CHARACTER FROM COMMAND LINE.
	SAD	(40)		/SPACE?
	JMP	NEXFIL
	SAD	(15)		/CARRIAGE RETURN?
	SKP
	SAD	(175)		/ALTMODE?
	JMP	ERR2		/SYNTAX ERROR.
	DAC	TRACK9		/SAVE THE CHARACTER. WILL BE USED TO
				/INDICATE 9-TRACK MAGTAPE OPERATION OR NOT.
	JMP	FLUSH
/
/
/
NEXFIL	JMS	LUNFIL		/GET LUN AND FILE NAME
	INLUN			/PLACE TO STORE LUN
	SKP			/IF BREAK CHAR IS A SPACE, LOOK FOR
	JMS	FAC		/A NON-SPACE
	SAD	(40
	JMP	.-2
	SAD	(15		/CHECK LINE TERM
	SKP
	SAD	(175
	JMP	ERR2		/ERROR -- ILLEGAL TERM
	SAD	(54		/IF BREAK CHAR IS COMMA OK.
	SKP
	JMP	ERR2		/NO GOOD -- ERROR
	LAC	NAME1		/STORE FILE NAME IN CPB
	DAC	SEEK+3
	LAC	NAME2
	DAC	SEEK+4
	LAC	NAME3
	DAC	SEEK+5
	LAC	INLUN
	DAC	I.HINF+2
	DAC	SEEK+2
	DAC	READ+2
	DAC	CLOSIN+2
	DAC	ATCHIN+2
	DAC	DTCHIN+2
	DAC	I.FMT+2
/
	JMS	LUNFIL		/GET LUN AND FILE NAME
	OUTLUN			/PLACE TO PUT OUTPUT LUN
	SAD	(15		/CHECK LINE TERM
	SKP
	SAD	(175
	SKP
	JMP	ERR2		/ERROR -- BAD LINE TERM
	LAC	NAME1		/STORE FILE NAME
	DAC	DELETE+3
	DAC	ENTER+3
	LAC	NAME2
	DAC	DELETE+4
	DAC	ENTER+4
	LAC	NAME3
	DAC	DELETE+5
	DAC	ENTER+5
	LAC	OUTLUN		/STORE OUTPUT LUN IN CPBS
	DAC	O.HINF+2
	DAC	ENTER+2
	DAC	DELETE+2
	DAC	EJECT+2
	DAC	WRITE+2
	DAC	CLOSOT+2
	DAC	ATCHOU+2
	DAC	DTCHOU+2
	DAC	O.FMT+2
	DAC	WREOF+2
	.EJECT
/
/ IF THE FILE NAME EXTENSION IS 'BIN' OR 'TSK', THE DATA MODE IS 0 (IOPS BINARY).
/ OTHERWISE, IT IS 2 (IOPS ASCII).
/
	LAC	SEEK+5
	SAD	(021116)	/(.SIXBT "BIN")
	SKP
	SAD	(242313)	/(.SIXBT "TSK")
	CLA!SKP			/BINARY.
	LAC	(2)		/ASCII.
	DAC	READ+3		/SET THE DATA MODE.
	DAC	WRITE+3
/
	.EJECT
/ DETERMINE THE CHARACTERISTICS OF THE INPUT AND OUTPUT DEVICES. THIS
/ IS DONE EACH TIME A FILE IS TRANSFERRED RATHER THAN ONLY ONCE AT THE
/ BEGINNING, IN CASE THE INPUT OR OUTPUT LUN IS REASSIGNED AT THE WRONG
/ TIME.
/
	CAL	I.HINF		/GET INPUT DEVICE INFORMATION.
	JMS	WAIT		/RETURN THE EV IN THE AC.
	DAC	INDEV		/SAVE HINF VALUE.
	SPA!RAL
	JMP	ERR3		/HINF ERROR.
	SMA
	JMP	ERR4		/NOT AN INPUT DEVICE.
/
/ CHECK UP ON THE OUTPUT DEVICE.
/
	CAL	O.HINF		/GET OUTPUT DEVICE INFORMATION.
	JMS	WAIT		/RETURN THE EV IN THE AC.
	DAC	OUTDEV		/SAVE HINF VALUE.
	SPA!RTL
	JMP	ERR3		/HINF ERROR.
	SMA
	JMP	ERR5		/NOT AN OUTPUT DEVICE.
/
/ DOES THE INPUT DEVICE HAVE A DIRECTORY?
/
	LAC	INDEV
	ALS	3
	SMA
	JMP	AT.IN		/NOT A DIRECTORIED DEVICE.
/
/ INPUT DEVICE HAS A DIRECTORY -- OPEN THE FILE.
/
	CAL	SEEK
	JMS	WAIT		/RETURN THE EV IN THE AC.
	SAD	(-13)
	JMP	ERR7		/FILE NOT FOUND.
	SAD	(-54)
	JMP	ERR19A		/FILE STILL OPEN.
	SPA
	JMP	ERR8		/ERROR DURING 'SEEK'.
	JMP	DO.OUT
/
	.EJECT
/ INPUT DEVICE HAS NO DIRECTORY -- TRY TO ATTACH IT.
/
AT.IN	CAL	ATCHIN		/ATTACH.
	JMS	WAIT		/RETURN THE EV IN THE AC.
	SAD	(-6)
	JMP	I.MTAP		/ATTACH IGNORED.
	SPA
	JMP	ERR9B		/'ATTACH' ERROR.
/
/ IF THE INPUT DEVICE IS MAGTAPE, ISSUE A FORMAT REQUEST.
/
I.MTAP	LAC	INDEV
	AND	(077)
	SAD	(5)		/MAGTAPE?
	SKP			/YES.
	JMP	DO.OUT		/NO.
	JMS	FORMAT		/ISSUE A FORMAT REQUEST
	I.FMT			/TO THE INPUT LUN.
/
/ DOES THE OUTPUT DEVICE HAVE A DIRECTORY?
/
DO.OUT	LAC	OUTDEV
	ALS	3
	SMA
	JMP	AT.OUT		/NOT A DIRECTORIED DEVICE.
/
/ OUTPUT DEVICE HAS A DIRECTORY -- OPEN THE FILE.
/
	CAL	ENTER
	JMS	WAIT		/RETURN THE EV IN THE AC.
	SAD	(-54)
	JMP	ERR19B		/FILE STILL OPEN.
	SPA
	JMP	ERR10		/ERROR DURING 'ENTER'.
	JMP	LOOP
/
/ OUTPUT DEVICE HAS NO DIRECTORY -- TRY TO ATTACH IT.
/
AT.OUT	CAL	ATCHOU		/ATTACH.
	JMS	WAIT		/RETURN THE EV IN THE AC.
	SAD	(-6)
	JMP	O.MTAP		/ATTACH IGNORED.
	SPA
	JMP	ERR9A		/"ATTACH" ERROR.
/
	.EJECT
/ IF THE OUTPUT DEVICE IS MAGTAPE, ISSUE A FORMAT REQUEST.
/
O.MTAP	LAC	OUTDEV
	AND	(077)
	SAD	(5)		/MAGTAPE?
	SKP			/YES.
	JMP	O.LPT		/NO.
	JMS	FORMAT		/ISSUE A FORMAT REQUEST
	O.FMT			/TO THE OUTPUT LUN.
/
/ IF THE OUTPUT DEVICE IS A LINE PRINTER OR A TTY, EJECT A PAGE BEFORE PRINTING.
/
O.LPT	LAC	OUTDEV
	AND	(077)
	SAD	(11)		/LINE PRINTER?
	SKP
	SAD	(1)		/TTY?
	CAL	EJECT		/YES -- EJECT PAGE.
/
	.EJECT
/ READ THE RECORD.
/
LOOP	LAC	INLUN		/SETUP LUN FOR EOT CHECKING
	DAC	LUN
	CAL	READ
	JMS	WAIT		/RETURN THE EV IN THE AC.
	SPA
	JMP	ERR11		/'READ' ERROR.
	JMS	CHKEOT		/CHECK FOR END-OF-TAPE. IF SO, DISMOUNT.
	INDEV			/ARG. 1 = WORD CONTAINING INPUT HINF.
	LAC	BUF+0
	AND	(60)
	SAD	(20)
	JMP	ERR12		/INPUT PARITY ERROR.
	SAD	(40)
	JMP	ERR13		/INPUT CHECKSUM ERROR.
	SAD	(60)
	JMP	ERR14		/BUFFER OVERFLOW ERROR.
	JMP	CHKEOF
/
/ THE FOLLOWING ERRORS, WHICH INDICATE ALTERED DATA, ARE NOT FATAL. AN
/ ERROR MESSAGE IS PRINTED INDICATING THE CAUSE OF THE ERROR. THE ERRON-
/ EOUS LINE OR RECORD IS STILL TRANSFERRED TO THE OUTPUT DEVICE SINCE
/ IT MAY BE POSSIBLE FOR THE USER TO CORRECT THE ERROR.
/
ERR12	LAC	(MES12)	/INPUT PARITY ERROR
	SKP
ERR13	LAC	(MES13)		/INPUT CHECKSUM ERROR.
	SKP
ERR14	LAC	(MES14)		/BUFFER OVERFLOW ERROR.
	JMS	TYPERR
/
/ CHECK FOR END-OF-FILE.
/
CHKEOF	LAC	BUF+0
	AND	(17)
	SAD	(5)
	JMP	EOF		/END-OF-FILE -- CLOSE FILES.
/
/ IF IOPS ASCII INPUT FROM TTY, CHECK FOR 'CTRL D-CARRIAGE RETURN' OR
/ 'CTRL D-ALTMODE' AT THE BEGINNING OF THE BUFFER. THIS IS THE RSX
/ STANDARD EOF INDICATION FROM TTY.
/
	LAC	INDEV		/IS THE INPUT DEVICE A TTY?
	AND	(77)
	SAD	(1)
	SKP
	JMP	DOWRIT		/NO.
/
	.EJECT
/ NOTE -- READ FROM TTY WAS SUCCESSFUL; THEREFORE, THE DATA MODE MUST
/ BE IOPS ASCII.
/
	777760			/EXAMINE THE 1ST TWO BUFFER CHARACTERS.
	AND	BUF+2
	SAD	(020320)	/CTRL D-CARRIAGE RETURN?
	SKP
	SAD	(023720)	/CTRL D-ALTMODE?
	JMP	EOF		/YES -- END-OF-FILE.
/
/ WRITE THE RECORD.
/
DOWRIT=.
	LAC	OUTDEV		/GET THE HINF CODE FOR THE OUTPUT DEVICE
	AND	(077		/MASK OFF THE OPERATIONS BITS TO GET CODE
	SAD	(1		/IS OUTPUT DEVICE A TTY?
	SKP
	JMP	DOWRT1		/NO -- PROCEED AS USUAL
	LAC	BUF+2		/YES -- GET THE 1ST WORD OF INPUT BUFFER
	AND	(774000		/EXAMINE THE 1ST CHARACTER
	SAD	(050000		/IS IT A LINE FEED?
	SKP
	JMP	DOWRT1		/NO -- PROCEED AS USUAL
	XOR	BUF+2		/YES -- CONVERT LF TO NULL
	DAC	BUF+2		/SAVE THE NULL IN THE BUFFER
DOWRT1=.
	LAC	OUTLUN
	DAC	LUN
CALWRI	CAL	WRITE	/NOW WRITE THE LINE
	JMS	WAIT		/RETURN THE EV IN THE AC.
	SPA
	JMP	ERR15		/'WRITE' ERROR.
	JMS	CHKEOT		/CHECK FOR END-OF-TAPE. IF SO, DISMOUNT.
	OUTDEV			/ARG. 1 = WORD CONTAINING OUTPUT HINF.
	JMP	LOOP	/NOW READ NEXT LINE
/
/ READ OR WRITE ERROR. PRINT AN ERROR MESSAGE AND THEN CLOSE OR DETACH
/ THE INPUT AND OUTPUT, AS APPROPRIATE.
/
ERR11	LAC	(MES11)		/'READ' ERROR.
	SKP
ERR15	LAC	(MES15)		/'WRITE' ERROR.
	JMS	TYPERR
/
/ END-OF-FILE. CLOSE THE OUTPUT.
/
EOF	CAL	CLOSOT
	JMS	WAIT		/RETURN THE EV IN THE AC.
	SAD	(-6)		/IGNORED FUNCTION?
	JMP	.+3		/YES.
	SPA
	JMP	ERR18		/ERROR DURING OUTPUT CLOSE.
	LAC	OUTDEV		/DOES THE OUTPUT DEVICE HAVE A DIRECTORY?
	ALS	3
	SPA
	JMP	INCLOS		/YES.
/
	.EJECT
/ IF THE OUTPUT DEVICE IS MAGTAPE, WRITE AN END-OF-FILE.
/
	LAC	OUTDEV
	AND	(077)
	SAD	(5)		/MAGTAPE?
	SKP			/YES.
	JMP	O.DTCH		/NO.
	LAC	OUTLUN		/SETUP LUN FOR CHECKING EOT
	DAC	LUN
	CAL	WREOF		/WRITE AN END-OF-FILE MARK.
	JMS	WAIT		/WAITFOR COMPLETION AND RETURN THE EV
				/VALUE IN THE AC.
	SPA			/ERROR?
	JMP	ERR22		/YES.
	JMS	CHKEOT		/CHECK FOR END-OF-TAPE. IF SO, DISMOUNT.
	OUTDEV			/ARG. 1 = WORD CONTAINING OUTPUT HINF.
	JMP	O.DTCH
ERR22	LAC	(MES22)		/ERROR DURING WRITE EOF.
	JMS	TYPERR
/
/ DETACH THE OUTPUT DEVICE.
/
O.DTCH	CAL	DTCHOU		/DETACH.
	JMS	WAIT		/RETURN THE EV IN THE AC.
	SPA
	SAD	(-6)
	JMP	INCLOS		/DETACH COMPLETED OR IGNORED.
	JMP	ERR17A		/DETACH ERROR.
/
	.EJECT
/ ERROR WHILE OPENING OR CLOSING THE OUTPUT FILE OR WHILE ATTACHING OR
/ DETACHING THE OUTPUT DEVICE. PRINT AN ERROR MESSAGE AND THEN CLOSE OR
/ DETACH THE INPUT.
/
ERR9A	LAC	(MES9)		/'ATTACH' ERROR.
	SKP
ERR10	LAC	(MES10)		/'ENTER' ERROR.
	SKP
ERR17A	LAC	(MES17)		/'DETACH' ERROR.
	JMP	ERR19B+1
ERR18	CAL	DELETE		/ERROR DURING OUTPUT 'CLOSE'; DELETE THE FILE
	LAC	(MES18)
	SKP
ERR19B	LAC	(MES19)		/FILE STILL OPEN.
	JMS	TYPERR
/
/ CLOSE THE INPUT.
/
INCLOS	CAL	CLOSIN
	JMS	WAIT		/RETURN THE EV IN THE AC.
	SAD	(-6)		/IGNORED FUNCTION?
	JMP	.+3		/YES.
	SPA
	JMP	ERR16		/ERROR DURING INPUT 'CLOSE'.
	LAC	INDEV		/DOES THE INPUT DEVICE HAVE A DIRECTORY?
	ALS	3
	SPA
	JMP	VAL		/YES.
/
/ DETACH THE INPUT DEVICE.
/
DETACH	CAL	DTCHIN		/DETACH.
	JMS	WAIT		/RETURN THE EV IN THE AC.
	SAD	(-6)
	JMP	VAL		/DETACH IGNORED.
	SPA
	JMP	ERR17B		/'DETACH' ERROR.
/
/ EXIT
/
VAL=.
EXIT	CAL	(10		/SPLIT
/
	.EJECT
/ ERRORS -- PRINT THE ERROR MESSAGE AND THEN REQUEST 'TDV...' EVEN IF
/ THE LINE TERMINATOR IS AN ALTMODE.
/
ERR1	LAC	(MES1)		/COMMAND LINE TOO LONG.
	SKP
ERR2	LAC	(MES2)		/SYNTAX ERROR.
	SKP
ERR3	LAC	(MES3)		/HINF ERROR.
	SKP
ERR4	LAC	(MES4)		/NOT AN INPUT DEVICE.
	SKP
ERR5	LAC	(MES5)		/NOT AN OUTPUT DEVICE.
	SKP
ERR7	LAC	(MES7)		/FILE NOT FOUND.
	SKP
ERR8	LAC	(MES8)		/'SEEK' ERROR.
	SKP
ERR9B	LAC	(MES9)		/'ATTACH' ERROR.
	SKP
ERR16	LAC	(MES16)		/ERROR DURING INPUT 'CLOSE'.
	SKP
ERR17B	LAC	(MES17)		/'DETACH' ERROR.
	SKP
ERR19A	LAC	(MES19)		/FILE STILL OPEN.
	JMS	TYPERR		/TYPE THE MESSAGE.
	JMP	EXIT
/
	.EJECT
/
MES1	005002; 0; .ASCII 'COPY-LINE TOO LONG'<15>
MES2	005002; 0; .ASCII 'COPY-SYNTAX ERR'<15>
MES3	004002; 0; .ASCII 'COPY-HINF ERR'<15>
MES4	005002; 0; .ASCII 'COPY-NOT INPUT DEV'<15>
MES5	005002; 0; .ASCII 'COPY-NOT OUTPUT DEV'<15>
MES7	005002; 0; .ASCII 'COPY-FILE NOT FOUND'<15>
MES8	004002; 0; .ASCII 'COPY-SEEK ERR'<15>
MES9	005002; 0; .ASCII 'COPY-ATTACH ERR'<15>
MES10	004002; 0; .ASCII 'COPY-ENTER ERR'<15>
MES11	004002; 0; .ASCII 'COPY-READ ERR'<15>
MES12	005002; 0; .ASCII 'COPY-PARITY ERR'<15>
MES13	005002; 0; .ASCII 'COPY-CHECKSUM ERR'<15>
MES14	005002; 0; .ASCII 'COPY-BUF OVERFLOW'<15>
MES15	004002; 0; .ASCII 'COPY-WRITE ERR'<15>
MES16	006002; 0; .ASCII 'COPY-CLOSE INPUT ERR'<15>
MES17	005002; 0; .ASCII 'COPY-DETACH ERR'<16>
MES18	006002; 0; .ASCII 'COPY-CLOSE OUTPUT ERR'<15>
MES19	006002; 0; .ASCII 'COPY-FILE STILL OPEN'<15>
MES20	005002; 0; .ASCII 'COPY-DISMOUNT MT#'<15>
MES21	007002; 0; .ASCII 'COPY-THEN, "RESUME COP..."'<15>
MES22	005002; 0; .ASCII 'COPY-WRITE EOF ERR'<15>
/
	.EJECT
/
/ SUBROUTINE GDNUM -- GET AN DECIMAL NUMBER
/
/		AC HAS 1ST CHAR. ON ENTRY OR 0
/
/		RETURN AT JMS+2 IF OK WITH TERM IN MQ AND NUMBER IN AC
/		RETURN AT JMS+1 IF ERROR WITH THE CHAR IN MQ
/
/		AC AND MQ ARE MODIFIED
/
GDNUM	0
	DAC	GDNV.1		/SAVE THE CHAR
	LAW	-5		/SET DIGIT COUNTER
	DAC	GDNV.5
	DZM	GDNV.3		/ZERO PREVIOUS RESULTS
	DZM	GDNV.6		/CLEAR THE "SPACES ARE NOT BREAKS" FLAG
	LAC	GDNV.1		/PICK UP THE CHAR AGAIN
	SNA
GDN1	JMS	FAC		/GET A CHARACTER
	SAD	(40
	JMP	GDN2
	IDX	GDNV.6		/SET THE "SPACES ARE NOT BREAKS" FLAG
	DAC	GDNV.4		/SAVE IT TEMPORARILY
	AAC	-60		/IS IT A DIGIT?
	SPA
	JMP	GDN6		/NO -- EITHER A BREAK OR AN ERROR
	DAC	GDNV.2		/MAYBE -- SAVE THE POTENTIAL DIGIT
	AAC	-12		/CHECK THE UPPER BOUND -- IS IT A DIGIT?
	SMA
	JMP	GDN6		/NO -- EITHER A BREAK OR AN ERROR
	LAC	GDNV.3		/YES -- PICK UP THE REAL NUMBER
				/THAT HAS ALREADY BEEN CONSTRUCTED
	CLL
	MUL			/MULTIPLY BY 10 DECIMAL
	12
	LACQ			/GET RESULT
	TAD	GDNV.2		/ADD THE DIGIT JUST READ
	DAC	GDNV.3		/SAVE THE RESULTING DECIMAL NUMBER
	ISZ	GDNV.5		/HAVE 5 DIGITS BEEN READ?
	JMP	GDN1		/NO -- READ SOME MORE
	JMS	FAC		/YES -- READ A BREAK CHARACTER
GDN3	LMQ			/SAVE THE TERMINATOR
GDN4	LAC	GDNV.3
	IDX	GDNUM		/PREPARE TO RETURN AT JMS+2
	JMP*	GDNUM
GDN6	LAC	GDNV.4		/PUT OFFENDING CHAR IN MQ
GDN5	LMQ
	LAW	-5		/CHARACTER IS EITHER A BREAK OR ERROR
	SAD	GDNV.5		/IF THIS WAS THE 1ST CHARACTER READ
				/ITS AN ERROR. OTHERWIZE ITS A BREAK.
	JMP*	GDNUM		/ERROR -- RETURN AT JMS+1
	JMP	GDN4
GDN2	LAC	GDNV.6		/ARE SPACES BREAKS?
	SNA
	JMP	GDN1		/NO -- IGNORE THE SPACE
	LAC	(40		/YES -- PREPARE TO EXIT
	JMP	GDN5
GDNV.1	0			/TEMP. STORAGE FOR AC
GDNV.2	0			/STORAGE FOR THIS DIGIT
GDNV.3	0			/STORAGE FOR THE NUMBER
GDNV.4	0			/STORAGE FOR THE ASCII CHAR.
GDNV.5	0			/DIGIT COUNTER
GDNV.6	0			/"SPACES ARE NOT BREAKS" FLAG
	.EJECT
/
/ SUBROUTINE GETFIL -- READ A FILE NAME FROM LINE BUFFER
/
/	ALL REGISTERS ARE LOST
/
/	ON ENTRY AC HAS 0 OR 1ST CHARACTER OF NAME
/	ON EXIT CHAR HAS BREAK CHARACTER, AND NAME1-NAME3 
/		CONTAIN FILE NAME AND EXTENSION
/
GETFIL	0
	DAC	BUF		/SAVE POSSIBLE 1ST CHAR OF NAME
	SZA!CLL			/LEAVE LINK ZERO IF NO 1ST CHAR
	STL			/BUT SET LINK IF 1ST CHAR GIVEN
/
/ UNPACK THE FILE NAME.
/
	LAC	(BUF-1)		/INITIALIZE THE NAME BUFFER.
	SZL			/IF 1ST CHAR IN BUFFER SKIP AROUND
	IAC
	DAC*	(X10)
	LAW	-7		/UNPACK FILE NAME (UP TO 6 CHARACTERS).
	SZL			/IF 1ST CHAR IN BUFFER SKIP AROUND
	IAC
	JMS	UNPACK		/RETURN IF NO ERROR OCCURRED.
/
/ CONVERT FILE NAME TO .SIXBT AND STORE IT IN THE SEEK, DELETE, AND ENTER CPB'S.
/
	.DEC
	LAC	BUF+2
	LRS	6
	LAC	BUF+1
	LRS	6
	LAC	BUF+0
	LLS	12
	SNA
	JMP	ERR2		/SYNTAX ERROR -- NULL FILE NAME.
	DAC	NAME1
	LAC	BUF+5
	LRS	6
	LAC	BUF+4
	LRS	6
	LAC	BUF+3
	LLS	12
	DAC	NAME2
	.OCT
/
	.EJECT
/ THE FILE NAME EXTENSION IS OPTIONAL; THE DEFAULT EXTENSION IS 'SRC'.
/ VALIDATE THE DELIMITER.
/
	LAC	CHAR
	SAD	(15)		/CARRIAGE RETURN?
	SKP
	SAD	(175)		/ALTMODE?
	SKP
	SAD	(54)		/COMMA?
	JMP	USESRC		/ASSUME DEFAULT 'SRC' EXTENSION.
	SAD	(40)		/SPACE?
	JMP	FILEXT	/READ IN FILE EXTENSION
	JMP	ERR2		/NO -- ILLEGAL DELIMITER.
/
/ UNPACK THE FILE NAME EXTENSION.
/
FILEXT	LAW	-4		/UNPACK EXTENSION (UP TO 3 CHARACTERS).
	JMS	UNPACK		/RETURN IF NO ERROR OCCURRED.
/
/ CONVERT THE FILE NAME EXTENSION TO .SIXBT AND STORE IT IN THE
/ SEEK, DELETE, AND ENTER CPB'S.
/
	.DEC
	LAC	BUF+8
	LRS	6
	LAC	BUF+7
	LRS	6
	LAC	BUF+6
	LLS	12
	.OCT
	SNA
	JMP	ERR2		/SYNTAX ERROR -- NULL EXTENSION.
	SKP
/
/ USE THE DEFAULT EXTENSION 'SRC'.
/
USESRC	LAC	(232203)	/.SIXBT 'SRC'.
	DAC	NAME3
	JMP*	GETFIL		/RETURN
	.EJECT
/ SUBROUTINE TYPERR -- TYPEOUT AND WAITFOR COMPLETION OF ERROR MESSAGE.
/
/ CALLING SEQUENCE:
/
/	MESSAGE ADDRESS IN AC
/	JMS	TYPERR
/	(UNCONDITIONAL RETURN)
/
/ ALTERED REGISTERS:
/
/	EFFECTIVELY ALL (DUE TO THE CAL)
/
TYPERR	0
	DAC	TYPE+4		/STORE MESSAGE ADDRESS.
	LAC	EV		/SAVE EV VALUE SO THAT SOMEONE MAY EXAMINE
	DAC	ERRCOD		/IT BY USING THE "OPEN" MCR FUNCTION.
	CAL	TYPE		/TYPE THE MESSAGE.
	CAL	WAITFR
	JMP*	TYPERR
/
TYPE	2700			/'WRITE' CPB.
	EV
	TDVTTY			/TDV TTY ERROR LUN.
	2			/IOPS ASCII.
	XX			/MESSAGE ADDRESS.
/
	.EJECT
/ SUBROUTINE FORMAT -- ISSUE FORMAT REQUEST TO MAGTAPE TO ESTABLISH ONE
/ OF THE FOLLOWING CONDITIONS:
/
/	9-TRACK ASCII:		9-TRACK; 800 BPI; ODD PARITY
/	9-TRACK BINARY:		9-TRACK; 800 BPI; ODD PARITY; CORE DUMP MODE
/	7-TRACK ASCII:		7-TRACK; 800 BPI; EVEN PARITY
/	7-TRACK BINARY:		7-TRACK; 800 BPI; ODD PARITY
/
/ CALLING SEQUENCE:
/
/	JMS	FORMAT
/	ADDRESS OF THE FORMAT CPB
/	(RETURN HERE UNCONDITIONALLY)
/
/ ALTERED REGISTERS:
/
/	ALL, DUE TO THE CAL INSTRUCTION
/
FORMAT	0
	LAC*	FORMAT		/PICK UP ADDRESS OF FORMAT CPB.
	IDX	FORMAT
	DAC	DO.FMT		/ADDRESS LOOKS LIKE A CAL INSTRUCTION.
	AAC	3
	DAC	TEMP		/SAVE ADDRESS OF FORMAT TYPE IN CPB.
	LAC	(13)		/INITIALLY ASSUME 7-TRACK TAPE (FORMAT
	DAC*	TEMP		/13 = 7-TRACK; 800 BPI; DEFAULT PARITY).
	LAC	TRACK9		/EXAMINE THE COMMAND CHARACTER PRECEDING
	SAD	(071)		/THE FIRST SPACE. IS IT A 9?
	SKP			/YES -- 9-TRACK TAPE.
	JMP	DO.FMT		/NO.
	LAC	READ+3		/IOPS ASCII OR IOPS BINARY?
	SZA			/0=BINARY; 2=ASCII.
	CLA!IAC			/FORMAT 12 FOR ASCII = 9-TRACK; 800 BPI;
				/DEFAULT PARITY.
	AAC	11		/FORMAT 11 FOR BINARY = 9-TRACK; 800 BPI;
				/ODD PARITY; CORE DUMP MODE.
	DAC*	TEMP
DO.FMT	XX			/CAL INPUT OR OUTPUT FORMAT.
	JMS	WAIT		/WAITFOR COMPLETION; DOES NOT INVOLVE
				/IOTS TO THE MAGTAPE CONTROLLER.
	JMP*	FORMAT
/
	.EJECT
/ SUBROUTINE CHKEOT -- CHECK FOR AN END-OF-TAPE CONDITION (EV=+4). IF SO,
/ DISMOUNT THE MAGTAPE, PRINT INSTRUCTIONS TO THE OPERATOR, AND THEN
/ SUSPEND EXECUTION.
/
/ CALLING SEQUENCE:
/
/	EV VALUE IN THE AC
/	ILUN OR OLUN INS VARIABLE LUN
/	JMS	CHKEOT
/	INDEV OR OUTDEV
/	(UNCONDITIONAL RETURN)
/
/ ALTERED REGISTERS:
/
/	ALL, DUE TO THE CAL INSTRUCTION
/
CHKEOT	0
	SAD	(4)		/END-OF-TAPE?
	SKP			/YES.
	JMP	CHKOUT		/NO.
	LAC	LUN		/GET THE INPUT/OUTPUT LUN.
	DAC	DISMNT+2	/PREPARE THE DISMOUNT CPB.
	LAC*	CHKEOT		/ADDRESS OF INDEV/OUTDEV.
	DAC	TEMP
	LAC*	TEMP		/HINF VALUE.
	ALS	5		/SHIFT THE MAGTAPE UNIT NUMBER TO
	AND	(034000)	/CHARACTER POSITION 1, CONVERT TO ASCII,
	TAD	(300320)	/AND APPEND A CARRIAGE RETURN.
	DAC	MES20+10
	CAL	DISMNT		/REWIND, THEN SPACE FORWARD 1 RECORD.
	LAC	(MES20)		/DISMOUNT MTN.
	JMS	TYPERR
	LAC	(MES21)		/RESUME WHEN READY.
	JMS	TYPERR
	CAL	WFDSMT		/WAITFOR DISMOUNT TO COMPLETE.
	CAL	(6)		/SUSPEND EXECUTION.
	SKP
CHKOUT	IDX	CHKEOT
	JMP*	CHKEOT
/
	.EJECT
/
/ SUBROUTINE LUNFIL -- GET LUN AND FILE NAME
/
/	ALL REGISTERS ARE DESTROYED
/
/	ON EXIT NAME1-NAME3 HAS NAME AND AC HAS BREAK
/
LUNFIL	0
	LAC*	LUNFIL		/GET LOCATION WHERE LUN SHOULD BE PUT
	IDX	LUNFIL		/BUMP RETURN AROUND ARG.
	DAC	LUNTMP		/SAVE ADDR OF LOC TO PUT LUN
	CLA			/SPECIFY NO INIT CHAR
	JMS	GDNUM		/GET DECIMAL LUN
	JMP	LUNF1		/RETURN HERE ON POSSIBLE ERROR
	DAC*	LUNTMP		/STORE LUN
	LACQ			/GET BREAK CHAR
	SAD	(72		/COLON?
	JMP	LUNF2		/YES
	JMP	ERR2		/NO -- SYNTAX ERR
LUNF1	LACQ			/GET BREAK CHAR
	SAD	(15		/LINE TERM?
	SKP
	SAD	(175
	JMP	ERR2		/YES -- ERROR
	SKP			/NO
LUNF2	CLA			/SPECIFY NO CHAR
	JMS	GETFIL		/GET A FILE NAME
	LAC	CHAR		/GET BREAK CHAR
	JMP*	LUNFIL		/RETURN
/
LUNTMP	0			/ADDR OF PLACE TO PUT LUN
	.EJECT
/ SUBROUTINE UNPACK -- UNPACK 7-BIT ASCII CHARACTERS FROM THE COMMAND
/ INPUT LINE AND STORE THEM SEQUENTIALLY IN 'BUF' VIA X10 (ALREADY SET UP).
/ THE NEGATIVE COUNT OF (MAXIMUM NUMBER OF CHARACTERS + 1) IS IN THE AC.
/
/ CALLING SEQUENCE:
/
/	-COUNT IN THE AC
/	JMS	UNPACK
/	(RETURN IF NO ERROR OCCURRED)
/
/ ALTERED REGISTERS:
/
/	AC & MQ
/
UNPACK	0
	DAC	CNT		/SAVE COUNT.
LOOP1	JMS	FAC		/FETCH A CHARACTER.
	DAC	CHAR
	SAD	(54)		/COMMA?
	JMP	NOT6BT		/YES -- DELIMITER.
	AAC	-41
	SPA
	JMP	NOT6BT		/NOT .SIXBT. CHAR < 41.
	AAC	-76
	SMA
	JMP	NOT6BT		/NOT .SIXBT. CHAR > 136.
	ISZ	CNT
	SKP
	JMP	ERR2		/TOO MANY CHARACTERS.
	LAC	CHAR		/STORE CHARACTER.
	DAC*	X10
	JMP	LOOP1
/
/ FILL IN THE REMAINDER OF THE NAME WITH ZEROS.
/
	DZM*	X10
NOT6BT	ISZ	CNT	/NOTE, SPACE AND BACK ARROW COME HERE
	JMP	.-2
	JMP*	UNPACK
/
	.EJECT
/ SUBROUTINE FAC -- FETCH A CHARACTER FROM THE 5/7 ASCII LINE BUFFER 'FACLB'.
/ THE INDICIES 'FACLBX' AND 'FACCBX' MUST BE SET WHEN A NEW LINE IS READ.
/ CHARACTERS ARE NOT FETCHED BEYOND TERMINAL CHARACTERS.
/
/ CALLING SEQUENCE:
/
/	JMS	FAC
/	(UNCONDITIONAL RETURN WITH CHARACTER IN THE AC)
/
/ ALTERED REGISTERS:
/
/	AC & MQ
/
FAC	0
	LAC*	FACCBX		/FETCH THE NEXT UNPACKED CHARACTER FROM 'FACCB'.
	SMA			/WAS THE CHARACTER BUFFER (FACCB) EMPTY?
	JMP	FAC2		/NO -- TEST FOR A TERMINAL CHARACTER.
	LAC	(FACCB-1)	/YES -- REFILL 'FACCB' FROM THE INPUT LINE.
	DAC	FACCBX
	LAC*	FACLBX		/(FIRST HALF OF WORD PAIR).
	IDX	FACLBX
	LMQ
	CLA!CLL
	JMS	FACUPS		/(FIRST CHARACTER).
	JMS	FACUPS		/(SECOND CHARACTER).
	JMS	FACUPS		/(FIRST 4 BITS OF THIRD CHARACTER).
	LAC*	FACLBX		/(SECOND HALF OF WORD PAIR).
	IDX	FACLBX
	LRS	17		/(LAST 3 BITS OF THIRD CHARACTER).
	XOR*	FACCBX
	DAC*	FACCBX
	CLA
	JMS	FACUPS		/(FOURTH CHARACTER).
	JMS	FACUPS		/(FIFTH CHARACTER).
	LAC	(FACCB)		/RESET THE CHARACTER BUFFER INDEX.
	DAC	FACCBX
	LAC*	FACCBX		/FETCH THE FIRST CHARACTER FROM THE
				/CHARACTER BUFFER.
/
FAC2	SAD	(015)		/IF IT IS A TERMINAL CHARACTER, CARRIAGE
	JMP*	FAC		/RETURN OR ALTMODE, RETURN WITH THE CHARACTER
	SAD	(175)		/IN THE AC BUT DO NOT AUGMENT THE CHARACTER
	JMP*	FAC		/BUFFER INDEX. THUS, REPEATED CALLS TO FAC
				/WILL RETURN THE TERMINAL CHARACTER.
/
	IDX	FACCBX		/IT IS NOT A TERMINAL CHARACTER -- AUGMENT
	JMP*	FAC		/THE CHARACTER BUFFER INDEX AND RETURN WITH
				/THE CHARACTER IN THE AC.
/
	.EJECT
/ SUBROUTINE FACUPS -- UNPACKING SUBROUTINE USED BY 'FAC'.
/
/ CALLING SEQUENCE:
/
/	AC & LINK MUST BE CLEARED.
/	NEXT CHARACTER MUST BE IN
/	THE HIGH-ORDER END OF THE MQ.
/	'FACCBX' MUST  POINT TO THE
/	WORD PRECEDING THE ONE IN
/	WHICH THE CHARACTER IS TO
/	BE STORED.
/	JMS	FACUPS
/	(UNCONDITIONAL RETURN WITH
/	'FACCBX' POINTING TO THE
/	STORED CHARACTER AND WITH
/	THE AC & LINK LEFT CLEARED)
/
/ ALTERED REGISTERS:
/
/	AC & MQ
/
FACUPS	0
	LLS	7		/SHIFT THE CHARACTER INTO THE AC. THE LOW
	IDX	FACCBX		/ORDER BITS OF THE THIRD CHARACTER ARE ZERO
	DAC*	FACCBX		/BECAUSE THE LINK IS ZERO.
	CLA
	JMP*	FACUPS
/
FACLBX	XX			/LINE BUFFER INDEX.
FACCBX	XX			/CHARACTER BUFFER INDEX.
FACCB	.BLOCK	5		/CHARACTER BUFFER (5 IMAGE ALPHA CHARACTERS).
	-1			/END-OF-'FACCB' INDICATOR.
/
/ SUBROUTINE WAIT -- WAIT FOR THE EVENT VARIABLE TO BE SET, AND RETURN ITS
/ VALUE IN THE AC.
/
/ CALLING SEQUENCE:
/
/	JMS	WAIT
/	(UNCONDITIONAL RETURN)
/
/ ALTERED REGISTERS:
/
/	EFFECTIVELY ALL (DUE TO THE CAL)
/
WAIT	0
	CAL	WAITFR
	LAC	EV
	JMP*	WAIT
/
	.EJECT
/
I.HINF	3600			/INPUT HINF CPB.
	EV
	ILUN
/
O.HINF	3600			/OUTPUT HINF CPB.
	EV
	OLUN
/
SEEK	3200			/'OPEN SEQUENTIAL INPUT FILE' CPB.
	EV
	ILUN
	.SIXBT	'---'		/FILE NAME -- 1ST HALF.
	.SIXBT	'---'		/FILE NAME -- 2ND HALF.
	.SIXBT	'---'		/FILE NAME -- EXTENSION.
/
ENTER	3300			/'OPEN SEQUENTIAL OUTPUT FILE' CPB.
	EV
	OLUN
	.SIXBT	'---'		/FILE NAME -- 1ST HALF.
	.SIXBT	'---'		/FILE NAME -- 2ND HALF.
	.SIXBT	'---'		/FILE NAME -- EXTENSION.
/
DELETE	3500			/'DELETE' CPB
	0
	OLUN
	.SIXBT	'---'		/FILE NAME -- 1ST HALF.
	.SIXBT	'---'		/FILE NAME -- 2ND HALF.
	.SIXBT	'---'		/FILE NAME -- EXTENSION.
/
READ	2600			/'READ' CPB.
	EV
	ILUN
	XX			/DATA MODE 0 OR 2.
	BUF
	BUFSIZ			/BUFFER SIZE.
/
EJECT	2700			/'PAGE EJECT' CPB.
	0
	OLUN
	3			/IMAGE ALPHA MODE.
	FF
/
FF	002003			/FORM FEED LINE BUFFER.
	000000
	000014			/A FORM FEED.
	000000			/A NULL CHARACTER
/
WRITE	2700			/'WRITE' CPB.
	EV
	OLUN
	XX			/DATA MODE 0 OR 2.
	BUF
/
	.EJECT
CLOSIN	3400			/CLOSE (INPUT) CPB.
	EV
	ILUN
/
CLOSOT	3400			/CLOSE (OUTPUT) CPB.
	EV
	OLUN
/
ATCHIN	2400			/'ATTACH INPUT' CPB.
	EV
	ILUN
/
ATCHOU	2400			/'ATTACH OUTPUT' CPB.
	EV
	OLUN
/
DTCHIN	2500			/'DETACH INPUT' CPB.
	EV
	ILUN
/
DTCHOU	2500			/'DETACH OUTPUT' CPB.
	EV
	OLUN
/
XFER	37			/'TRANSFER TDV COMMAND LINE' CPB.
	EV
	FACLB			/BUFFER ADDRESS.
	CBFSIZ			/BUFFER SIZE.
/
WAITFR	20			/'WAITFOR' CPB.
	EV
/
I.FMT	5000			/'FORMAT INPUT' CPB.
	EV
	ILUN
	XX			/FORMAT CODE.
/
O.FMT	5000			/'FORMAT OUTPUT' CPB.
	EV
	OLUN
	XX			/FORMAT CODE.
/
WREOF	4400			/'WRITE END-OF-FILE' CPB.
	EV
	OLUN
/
DISMNT	5100			/'MOUNT/DISMOUNT' CPB.
	EV1
	XX			/ILUN OR OLUN.
	3			/SUBFUNCTION = DISMOUNT.
/
WFDSMT	20			/WAITFOR DISMOUNT TO COMPLETE.
	EV1
/
	.EJECT
INLUN	ILUN			/INPUT LUN
OUTLUN	OLUN			/OUTPUTLUN
LUN	0			/TEMP LUN
NAME1	0			/FILE NAME
NAME2	0
NAME3	0
TEMP	0			/TEMPORARY STORAGE
EV	0			/EVENT VARIABLE.
EV1	0			/EVENT VARIABLE.
CNT	0			/COUNTER.
CHAR	0			/INPUT CHARACTER.
INDEV	0			/HINF EV FOR INPUT DEVICE.
OUTDEV	0			/HINF EV FOR OUTPUT DEVICE.
ERRCOD	0			/EV VALUE SAVED BEFORE ERROR PRINTOUT IN
				/CASE SOMEONE WANTS TO EXAMINE IT USING
				/THE "OPEN" MCR FUNCTION.
TRACK9	0			/CHARACTER FROM THE COMMAND STRING WHICH
				/PRECEDES THE FIRST SPACE. IF "9", IT
				/SIGNIFIES 9-TRACK MAGTAPE OPERATION.
/
BUF	.BLOCK BUFSIZ		/FILE NAME BUFFER AND FILE DATA LINE BUFFER.
/
FACLB	.BLOCK	CBFSIZ		/COMMAND INPUT BUFFER, OR
				/FETCH-A-CHARACTER BUFFER.
	064032			/GUARD WORD -- GUARANTEES FINDING A
				/CARRIAGE RETURN AT END OF BUFFER.
/
	.END