.TITLE	MTU
	.IDENT	/20SEP6/
;
; GENERAL MAG TAPE UTILITY TASK
;
	.SBTTL GENERAL INFORMATION
;
;
;	TABLE OF CONTENTS
;
;
;	1. GENERAL INFORMATION
;	2. COMMAND LANGUAGE
;	   2.1 COMMAND STRING AND SWITCHES
;	   2.2 COMMAND AND SWITCH PROCESSING
;	3. MACRO DEFINITIONS
;	4. INITIALIZATION
;	5. DATA BASE
;	6. MAIN PROGRAM
;	   6.1 PREPARE FOR TRANSFER
;	   6.2 TAPE TRANSFER
;	7. SUBROUTINES
;
;
;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
;
;	1. GENERAL INFORMATION
;PROGRAM:	MTU, A MAGTAPE UTILITY PROGRAM
;
;PURPOSE:	TRANSLATE, COPY, VERIFY, AND LIST MAGTAPES OF 
;		VARIOUS FORMATS
;
;SYSTEM/MACHINE:	PDP11/45 * RSX11-D
;
;AUTHOR:	MARSHALL LONG
;
;DATE:		JULY 12,1976
;
;
;REVISED:	JULY 20,1976
;		7-SEP-76 (MK01): TAPE BUFFER ALLOCATED BY	;MK01
;		EXTTSK OR /INC					;MK01
;		10-SEP-76 (MK02): OUTPUT TRANSLATION CORRECTED	;MK02
;		AND OPTIMIZED.					;MK02
;		13-SEP-76 (MK03): INTERCHANGE BLOCK STARTING AT	;MK03
;		'TSTATT' WITH BLOCK STARTING AT 'TSTVAL'.	;MK03
;		THIS ALLOWS SECOND EOF TO BE WRITTEN ON OUTPUT	;MK03
;		WHEN INPUT ENCOUNTERS DOUBLE EOF.		;MK03
;		14-SEP-76 (MK04): ADD CODE TO POSITION TAPES	;MK04
;		BETWEEN FILE MARKS OF AN EOV AFTER COPY		;MK04
;		14-SEP-76 (MK05): ADD FILE COUNT TO DUMP	;MK05
;		INFORMATION					;MK05
;		14-SEP-76 (MK06): LEAD ZERO SUPPRESSION AND	;MK06
;		FLOATING MINUS SIGN FOR DECIMAL WORD DUMP	;MK06
;		15-SEP-76 (MK07): EOV FLAG RESET AT START OF	;MK07
;		COPY TO ALLOW COPYING PAST A DOUBLE EOF		;MK07
;		16-SEP-6 (MK08): LISTING DEFAULT FILENAME BLOCK	;MK08
;		CHANGED						;MK08
;		20-SEP-76 (MK09): USE SEPARATE LUNS FOR CMD LINE;MK09
;		INPUT AND TERMINAL MESSAGES; ADD ERROR DETECTION;MK09
;		FOR OPERATIONS ON LIST FILE			;MK09

	.SBTTL COMMAND LANGUAGE
;
;	2. COMMAND LANGUAGE
;
;	   2.1 COMMAND STRING AND SWITCHES
;	THE COMMAND STRING HAS THE FOLLOWING FORMAT:
;
;	MTU>OUTTAPE/SW1,LIST/SW2=INTAPE/SW3
;
;	("MTU>" IS THE PROMPTING STRING AND IS NOT TYPED BY THE USER)
;
;	SW1 AND SW3 SPECIFY THE TAPE FORMAT OR GIVE OPERATIONS TO
;	BE PERFORMED ON THE TAPE. VALUES OF THE SWITCHES ARE:
;
;SWITCH			FUNCTION			   USE
; /KS		TAPE IS IN KS90 FORMAT			SW1 & SW3
; /BE		TAPE IS IN BERKELEY FORMAT		SW1 & SW3
; /IM		TAPE IS IN IMAGE FORMAT (DEFAULT)	SW1 & SW3
; /20		TAPE IS 200 BPI				SW1 & SW3
; /55		TAPE IS 556 BPI				SW1 & SW3
;		(DEFAULT IF /KS OR /BE SPECIFIED)
; /80		TAPE IS 800 BPI				SW1 & SW3
; /CD		TAPE IS IN CORE DUMP MODE		SW1 & SW3
;		(DEFAULT IF /IM SPECIFIED OR IMPLIED)
; /EP		TAPE IS EVEN PARITY			SW1 & SW3
; /-EP		TAPE IS ODD PARITY (DEFAULT)		SW1 & SW3
; /RW		REWIND TAPE BEFORE COPY			SW1 & SW3
; /SF:N		SKIP N FILES BEFORE COPY		SW1 & SW3
; /SR:N		SKIP N RECORDS BEFORE COPY		SW1 & SW3
;		(N NEGATIVE MEANS BACKWARDS FOR /SF & /SR)
; /WF:N		WRITE N FILE MARKS ON OUTPUT TAPE	SW1 ONLY
;		AFTER COPY (DEFAULT=1)
; /ST		PRINT CURRENT TAPE FORMAT DEFAULTS	SW1 ONLY
; /RE:N		READ N RECORDS OR UNTIL THE NEXT T.M.	SW3 ONLY
; /FI:N		READ N FILES OR UNTIL DOUBLE T.M.	SW3 ONLY
; /VE		COMPARE INPUT & OUTPUT TAPES AND	SW1 & SW3
;		NOTE ANY DISCREPANCIES
;
;
;	SW2 CONTROLS THE FORMAT IN WHICH THE INPUT TAPE IS TO BE
;	DUMPED. POSSIBLE VALUES ARE:
;
; /LG		DUMP LOGICAL LENGTH (DEFAULT--IMPLIED WITH ALL SWITCHES)
; /OW		DUMP OCTAL WORDS
; /OB		DUMP OCTAL BYTES
; /DW		DUMP DECIMAL WORDS (SIGNED)
; /DB		DUMP DECIMAL BYTES (MAGNITUDE)
; /AS		DUMP ASCII BYTES
; /RA		DUMP RAD50 WORDS
;
;	   2.2 COMMAND AND SWITCH PROCESSING
;
;	COMMANDS ARE FETCHED AND PARSED BY ROUTINES PROVIDED BY
;	RSX 11-D. SWITCHES ARE PROCESSED IN THE ORDER THAT THEY
;	APPEAR IN 2.1 WHEN MORE THAN ONE PER FIELD IS PRESENT.
;
;	IF ONLY THE OUTTAPE IS GIVEN, I.E.
;		MTU>OUTTAPE/SW1
;	THE EFFECT IS EITHER TO PERFORM THE INDICATED OPERATION
;	OR SET UP THE SPECIFIED TAPE FORMAT AS A DEFAULT FOR
;	THAT TAPE. IF BOTH OUTTAPE AND INTAPE ARE GIVEN, FORMAT
;	SWITCHES CHANGE THE FORMAT ONLY FOR THE DURATION OF THE
;	COPY; THE FORMAT THEN REVERTS TO THE PREVIOUS DEFAULTS.
;
;
;	WHEN THE VERIFY (/VE) SWITCH IS USED, ALL OTHER
;	SWITCHES WORK AS FOR COPYING EXCEPT THAT /WF:N
;	CHECKS FOR THE PRESENCE OF N CONSECUTIVE FILE MARKS.
;
;
;	ANY TAPES TO BE USED SHOULD BE MOUNTED AS FOLLOWS:
;
;		MOU MTN:/CHA=[FOR,ATCH,DCF]
;
;	IF A SHORT RECORD (I.E. ONE LESS THAN 14. BYTES LONG)
;	IS DETECTED, IT IS AUTOMATICALLY EXTENDED TO
;	14. BYTES BY ADDING THE NECESSARY NUMBER OF ZEROES.
;
;
;	IF AN ERROR IS DETECTED, THE PROGRAM ATTEMPTS TO GIVE
;	AS MUCH INFORMATION AS POSSIBLE ABOUT THE NATURE OF
;	THE ERROR. "FATAL" ERRORS ARE REPORTED AS SUCH. FOLLOWING
;	A FATAL ERROR, ALL PENDING I/O IS ABANDONED. IF THE
;	ERROR IS NOT FATAL, HOWEVER, THE PROGRAM WILL CONTINUE.
;	(A PARITY ERROR IS AN EXAMPLE OF A NON-FATAL ERROR.)
;

	.SBTTL MACRO CALLS AND DEFINITIONS
;
;	3. MACRO CALLS AND DEFINITIONS
;
	.MCALL GCMLB$,GCML$,CSI$,CSI$1,CSI$2,CSI$SW,CSI$ND,CSI$SV
	.MCALL	EXIT$S,DIR$,FSRSZ$,QIO$,WTSE$S,GTSK$S,GLUN$S
	.MCALL	FDBDF$,FDOP$A,QIO$S,FINIT$,OPEN$W,PUT$,CLOSE$
	.MCALL	FDAT$A,FDRC$A
	.NLIST	BEX
;
;	MACRO DEFINITIONS
;
	.MACRO	STAB	BIT,OFSET,LAB	; COMPARE STATUS TO BITS
	CMPB	BIT,OFSET(R0)
	BNE	LAB			; BRANCH TO LABEL IF NOT EQUAL
	.ENDM
;
;
;	TYPE MESSAGES ON THE TERMINAL
;
	.MACRO TYPE	ADR,LEN,CCTL
	MOV	#QWVB+Q.IOPL,R5	
	MOV	ADR,(R5)+		; SETUP BUFFER ADDRESS
	MOV	LEN,(R5)+		; SETUP LENGTH
	MOV	CCTL,(R5)		; AND CONTROL
	CALL	QGO			; GO PRINT ON TI:
	.ENDM
;
;
;	REPORT TAPE ERRORS
;
	.MACRO	ERRPRT	VAL,RET,?LAB
	CMPB	#IS.SUC,IOST		; IS ERROR PRESENT?
	BEQ	LAB			; NO ---> CONTINUE
	.IF	NB	VAL
	MOV	VAL,FILE		; CAN KEEP TRACK OF FIELD OF ERROR
	.ENDC
	CALL	TAPERR			; GO TO ERROR REPORT ROUTINE
	.IF	NB	RET
	JMP	DONE			; QUIT IF ERROR IN SPECIAL PLACE
	.ENDC
LAB:
	.ENDM
;

	.SBTTL INITIALIZATION
;
;	4. INITIALIZATION
;
INIT:	FINIT$			;INITIALIZE FCS			;MK01
	GTSK$S	#BUFST		;GET TASK EXTENSION		;MK01
	MOV	BUFST+G.TSTS,R0					;MK01
	SUB	#BUFST+14,R0	;TOTAL BUFF AVAILABLE (LESS PAD);MK01
	BIC	#17,R0		;MAKE SURE EVERYTHING WILL BE	;MK01
				;ON A WORD BOUNDARY		;MK01
	MOV	R0,R1		;RESERVE 1/4 FOR OUTPUT TRANSL	;MK01
	ASR	R1						;MK01
	ASR	R1						;MK01
	SUB	R1,R0						;MK01
	MOV	R0,BUFLEN	;MAX RECORD SIZE (COPY)		;MK01
	ASR	R0						;MK01
	MOV	R0,VERLEN	;MAX RECORD SIZE (VERIFY)	;MK01
	ADD	#BUFST+10,R1	;FIND INPUT BUFF START		;MK01
	MOV	R1,INBUF	;SET INPUT BUFF START		;MK01
	ADD	R0,R1						;MK01
	MOV	R1,VERBUF	;SET VERIFY BUFF START		;MK01
	JSR	SP,GO		;OVERLAY THIS CODE WITH STACK	;MK01

	.SBTTL DATA BASE
;
;	5. DATA BASE
;
	FSRSZ$	2		; ROOM FOR FDB'S
GCMBLK:	GCMLB$	2,MTU,,5	; GET COMMAND LINE INITIALIZATION
	CSI$			; INITIALIZE CSI BUFFER
	.EVEN
CSIBLK:	.BLKB	C.SIZE		; SPACE FOR CSI INFO
IOSWCH:	CSI$SW	KS,MKS		; DEFINE SWITCH NAMES AND ATTRIBUTES
	CSI$SW	BE,MBE		; THESE ARE FOR SWITCHES 1 OR 3
	CSI$SW	IM,MIM
	CSI$SW	20,M20
	CSI$SW	55,M55
	CSI$SW	80,M80
	CSI$SW	CD,MCD
	CSI$SW	EP,MEP,,,NEG
	CSI$SW	RW,MRW
	CSI$SW	SF,MSF,,,,SFVTB
	CSI$SW	SR,MSR,,,,SRVTB
	CSI$SW	WF,MWF,,,,WFVTB
	CSI$SW	ST,MST
	CSI$SW	RE,MRE,,,,REVTB
	CSI$SW	FI,MFI,,,,FIVTB
	CSI$SW	VE,MVE
	CSI$ND
SFVTB:	CSI$SV	DECIMAL,SFVAL,2
	CSI$ND
SRVTB:	CSI$SV	DECIMAL,SRVAL,2
	CSI$ND
WFVTB:	CSI$SV	DECIMAL,WFVAL,2
	CSI$ND
REVTB:	CSI$SV	DECIMAL,REVAL,2
	CSI$ND
FIVTB:	CSI$SV	DECIMAL,FIVAL,2
	CSI$ND
SFVAL:	0			; STORE SWITCH VALUES HERE
SRVAL:	0
WFVAL:	0
REVAL:	0
FIVAL:	0
OUTSCH:	CSI$SW	OW,MOW
	CSI$SW	OB,MOB
	CSI$SW	DW,MDW
	CSI$SW	DB,MDB
	CSI$SW	AS,MAS
	CSI$SW	RA,MRA
	CSI$SW	LG,MLG
	CSI$ND
;
; 	FDB'S FOR THE TAPE RELATED FILES
;
OTBK1:	FDBDF$
	FDOP$A	1		; LUN=1
OTBK2:	FDBDF$
	FDAT$A	R.VAR,FD.CR
	FDRC$A	,ASCBUF,80.
	FDOP$A	2,,OUTNAM	; LUN=2
INBK1:	FDBDF$
	FDOP$A	3		; LUN=3
;
;	DEFINE DEFAULT FILENAME
;
OUTNAM:	NMBLK$	MTULIST,LST,,SY,0
;
;	ALLOCATION AND DEFINITION OF VARIABLES USED WITHIN
;	THE PROGRAM OR IT'S SUBROUTINES
;
STATUS:	0
STASAV:	0,0,0		; HOLDING AREA FOR MAGTAPE STATUS
STSV2:	0,0,0		; (SAVE ADDRESS AND 2 STATUS WORDS)
TPSAD:	0		; POINTER TO MAGTAPE STATUS WORDS
STATAD:	504,4		; MAGTAPE STATUS TABLE
	504,4		; 2 ENTRIES FOR EACH POSSIBLE MAGTAPE UNIT
	504,4		; DEFAULT STATUS IS /IM/CD (AND /-EP)
	504,4
	504,4
	504,4
	504,4
	504,4
ADRES:	0			; ADDR OF ADDR TABLE (SWITCH PROCESSING)
NSWT:	0			; # OF ALLOWED SWITCHES (FIELDS 1&3)
FILE::	0			; FIELD SPECIFIER FOR ERROR REPORTS
FILNUM:	0			; FIELD NUMBER
ATTFLG:	.BYTE	0		; ATTACHED TO DEVICE FLAG
COPFLG:	.BYTE	0		; COPY OPERATION FLAG
IOST::	0,0			; I/O STATUS WORDS
VERFLG:	.BYTE	0		; VERIFY SPECIFIED FLAG
DUNFLG:	.BYTE	0		; READ/WRITE DONE FLAG
FILCNT::	1		; MAGTAPE FILE NUMBER
RECCNT::	1		; MAGTAPE RECORD NUMBER
BYTSRD:	0			; BYTE COUNT
NWRDS:	0			; WORD COUNT
OUTADR:	0			; ADDRESS OF OUTPUT BUFFER
LASTAD:	0			; LAST ADDRESS IN OUTPUT BUFFER
DDRES:	0			; RELATIVE ADDR OF RECORD (FOR LISTING)
PLINE:	0			; SWITCH COUNTER FOR LISTING FIELD
TP:	0			; TEMPORARY
MISMAT:	0			; WORD MISMATCH COUNT (VERIFY)
CONVAD:	0,0,0,0,0,0,0		; LISTING FIELD CONVERSION ROUTINE ADDR
FREAD::	0			; USED IN COMPILING ERROR MESSAGES
LSTFLG:	.BYTE	0		; LISTING WANTED FLAG
PODFLG:	.BYTE	0		; DONE FLAG FOR LISTING FIELD
EOVFLG:	.BYTE	0		; END OF VOLUME FLAG
LWFFLG:	.BYTE	0		; LATENT WRITE EOF FLAG
	.EVEN
LUNBUF:	.WORD	0,0,0,0,0,0	;TERMINAL LUN BUFFER		;MK09
;
;	TAPE BUFFER PARAMETERS
;
OUTBUF:	BUFST			;OUTPUT BUFFER ADDR IF OUTPUT	;MK01
				;TRANSL IS USED			;MK01
INBUF:	0			;INPUT BUFFER ADDR		;MK01
VERBUF:	0			;VERIFY BUFFER ADDR		;MK01
BUFLEN:	0			;INPUT BUFF LENGTH (BYTES)	;MK01
VERLEN:	0			;VERIFY BUFF LENGTH (BYTES)	;MK01
;
;
;	ADDRESSES OF SWITCH PROCESSING ROUTINES FOR FIELDS 1 & 3
PRAD1:	PRKS,PRBE,PRIM,PR20,PR55,PR80,PRCD,PREP
	PRRW,PRSF,PRSR,PRWF,PRST,PRRE,PRFI,PRVE
;
;	ADDRESSES OF SWITCH PROCESS ING ROUTINES FOR FIELD 2
PRAD2:	PROW,PROB,PRDW,PRDB,PRAS,PRRA,PRLG
;
STSW:	.ASCII	/KSBEIM205580CDEP/	; ASCII SWITCH NAMES
SL:	.ASCII	@ MTN:/SW@		; USED IN PROCESSING "/ST"
;
;	SETUP FOR QIO CALLS
;
QWVB::	QIO$	IO.WVB,4,1,0,IOST,0,<0,0,0>			;MK09
QATT:	QIO$	IO.ATT,1,2,0,IOST,0
QSPB:	QIO$	IO.SPB,1,3,0,IOST,0,<0>
QDET:	QIO$	IO.DET,1,4,0,IOST,0
QRWD:	QIO$	IO.RWD,1,5,0,IOST,0
QSPF:	QIO$	IO.SPF,1,6,0,IOST,0,<0>
QSTC:	QIO$	IO.STC,1,7,0,IOST,0,<0>
QRLB:	QIO$	IO.RLB,3,10,0,IOST,0,<0,0>			;MK01
QWLB:	QIO$	IO.WLB,1,11,0,IOST,0,<0,0>
QEOF:	QIO$	IO.EOF,1,13,0,IOST,0
;
;	ASCII MESSAGES AND BUFFERS
;
ASCBUF::	.BLKB	84.
RECMES:	.ASCII	/FILE NNNN, RECORD NNNNN: NNNNN. BYTES/
ERVBF:	.ASCII	/INSUFFICIENT BUFFER FOR VERIFY/
ERNFM:	.ASCII	/EXPECTED FILE MARK(S) NOT FOUND/
ERVDL:	.ASCII	/RECORD LENGTH MISMATCH/
ERVFY:	.ASCII	/VERIFY ERROR-FILE NNNNN, RECORD NNNNN/<12><15>
	.ASCII	/	MISMATCH ON NNNNN WORD(S)/
ERILD:	.ASCII	/DEVICE NOT IN SYSTEM/
ERSTX:	.ASCII	/SYNTAX ERROR/
ERNOI:	.ASCII	/INPUT SPECS?/
ERSWT:	.ASCII	/SWITCH ERROR/
ERIOR:	.ASCII	@COMMAND LINE I/O ERROR@
EROPR:	.ASCII	/OPEN ERROR ON INDIRECT FILE/
ERBIF:	.ASCII	/INDIRECT COMMAND SYNTAX ERROR/
ERMDE:	.ASCII	/INDIRECT FILE DEPTH EXCEEDED/
ERMES:	.ASCII	/COMMAND ERROR/
	.EVEN							;MK09
OPNERM:	.ASCII	/  OPEN/					;MK09
PUTERM:	.ASCII	/OUTPUT/					;MK09
LSTERM:	.ASCII	/XXXXXX ERROR ON LIST FILE - ERR CODE = /	;MK09
LSTERC:	.ASCII	/-XX. /						;MK09
	.EVEN
;
;
;	NUMBER OF SWITCHES DEFINED
NSW1=16.				; FIELDS ONE AND THREE
NSW2=7					; FIELD TWO
;
;	DEFINE SWITCH MASKS
;
;	FOR FIELDS ONE AND THREE (TAPEIN AND TAPEOUT)
MKS=1
MBE=2
MIM=4
M20=10
M55=20
M80=40
MCD=100
MEP=200
MRW=400
MSF=1000
MSR=2000
MWF=4000
MST=10000
MRE=20000
MFI=40000
MVE=100000
;
;	FOR FIELD TWO (LISTING)
;
MOW=1
MOB=2
MDW=4
MDB=10
MAS=20
MRA=40
MLG=100
;
;	DEFINE LARGEST MAGTAPE UNIT NUMBER IN SYSTEM
;
LMTU=7

	.SBTTL MAIN PROGRAM--PREPARE FOR TRANSFER
;
;	6. MAIN PROGRAM
;
;	  6.1 PREPARE FOR TRANSFER
;
;		IN PREPARATION FOR THE TAPE TRANSFER, THE
;		FOLLOWING OCCURS:
;	1) THE COMMAND LINE IS FETCHED AND ANY ERRORS IN DOING
;	   SO ARE REPORTED.
;	2) THE SYNTAX OF THE COMMAND LINE IS CHECKED.
;	3) THE FIELDS IN THE COMMAND LINE (I.E. OUTTAPE,LIST,INTAPE)
;	   ARE PARSED SEQUENTIALLY.
;	4) AFTER A FIELD IS PARSED, THE SWITCHES ARE PROCESSED
;	   AND NECESSARY FLAGS SET, OPERATIONS PERFORMED, DEVICES
;	   ATTACHED, ETC.
;
;	NOTE THAT EACH FIELD IS PROCESSED COMPLETELY BEFORE THE
;	NEXT ONE IS EXAMINED FOR VALIDITY. THEREFORE, IT IS
;	POSSIBLE THAT SWITCH OPERATIONS (E.G. REWIND) WILL BE
;	PERFORMED ON FIELD ONE AND SUBSEQUENTLY A SWITCH ERROR
;	DETECTED IN FIELD THREE AND THE PARTIALLY COMPLETED
;	OPERATION WILL BE ABANDONED.
;
;
GO:	GLUN$S	#4,#LUNBUF					;MK09
	GCML$	#GCMBLK			; GET COMMAND LINE
	BCC	SYNTAX			; ERROR CHECK
	STAB	#GE.EOF,G.ERR,EIOR
	EXIT$S				; EXIT ON ^Z
EIOR:	STAB	#GE.IOR,G.ERR,EOPR	; CHECK FOR ERRORS & REPORT
	TYPE	#ERIOR,#22.,#40
	BR	GO
EOPR:	STAB	#GE.OPR,G.ERR,EBIF
	TYPE	#EROPR,#27.,#40
	BR	GO
EBIF:	STAB	#GE.BIF,G.ERR,EMDE
	TYPE	#ERBIF,#29.,#40
	BR	GO
EMDE:	STAB	#GE.MDE,G.ERR,EWAT
	TYPE	#ERMDE,#28.,#40
	BR	GO
EWAT:	TYPE	#ERMES,#13.,#40
	BR	GO
SYNTAX:	CSI$1	#CSIBLK,GCMBLK+G.CMLD+2,GCMBLK+G.CMLD
	BCC	PARSE			; CHECK SYNTAX O.K.
	TYPE	#ERSTX,#12.,#40		; REPORT SYNTAX ERROR
	TYPE	CSIBLK+C.FILD+2,CSIBLK+C.FILD,#40
	BR	GO
PARSE:	MOVB	C.STAT(R0),STATUS	; SAVE STATUS
	CSI$2	#CSIBLK,OUTPUT,#IOSWCH	; PARSE FIELD ONE
	BCC	CKLIN
SWEAR:	TYPE	#ERSWT,#12.,#40
	JMP	DONE
CKLIN:	BITB	#CS.DVF,CSIBLK+C.STAT
	BEQ	PRS2			; NO DEVICE
	BIT	#MRE!MFI,CSIBLK+C.MKW1
	BNE	SWEAR
	CLRB	COPFLG			; COPY FLAG
	MOV	#1,FILNUM
	BITB	#CS.EQU,STATUS
	BEQ	PROCES
	INCB	COPFLG			; THIS IS COPY OPERATION
	BR	DEVAT1			; GO ATTACH TO DEVICE
PROCES:	BIT	#MRW!MSF!MSR!MWF,CSIBLK+C.MKW1
	BEQ	NOIO
DEVAT1:	MOV	#OTBK1,R0
	MOV	#OTBK1+F.FNB,R1
	MOV	#CSIBLK+C.DSDS,R2
	CLR	R3
	CALL	PRSDV
	MOV	FILNUM,QATT+Q.IOLU	; INSERT LUN
	DIR$	#QATT
	WTSE$S	#2
	ERRPRT	#1,RET	
	INCB	ATTFLG			; HAVE ATTACHED TO DEVICE
NOIO:	JSR	R4,SWTPRS
	PRAD1-2
	2*NSW1
	CALL	SETCHR			; SET CHAR. FOR FILE 1
	TSTB	COPFLG
	BNE	PRS2			; PROCESS REST OF CMND
	TSTB	VERFLG			; SPECIAL VERIFY CONSIDERATION
	BEQ	PROUT			; NOT VERIFY --> DONE
	TSTB	LWFFLG			; SHOULD BE VERIFY AND /WF
	BEQ	PROUT			; IF NO --> DONE
	JMP	IODUN			; GO VERIFY # OF TAPE MARKS
PROUT:	BITB	#CS.MOR,C.STAT+CSIBLK	; SECOND FIELD PRESENT?
	BNE	PRS2E			; IF SO ---> ERROR
	JMP	DONE
PRS2:	BITB	#CS.MOR,C.STAT+CSIBLK	; SECOND FIELD PRESENT?
	BEQ	PRS3
	BITB	#CS.EQU,STATUS
	BNE	PARS2
PRS2E:	TYPE	#ERNOI,#12.,#40		; REPORT ERROR
	JMP	DONE			; DONE
PARS2:	CSI$2	#CSIBLK,OUTPUT,#OUTSCH
	BCC	PROS2
	JMP	SWEAR
PROS2:	MOV	#2,FILNUM
	OPEN$W	#OTBK2,,#CSIBLK+C.DSDS	; OPEN THE FILE
	CALL	OPNCHK
	CLR	PLINE
	MOV	#CONVAD,R5
	JSR	R4,SWTPRS
	PRAD2-2
	2*NSW2
	INCB	LSTFLG
PRS3:	CSI$2	#CSIBLK,INPUT,#IOSWCH
	BCC	PROS3
	JMP	SWEAR
PROS3:	BITB	#CS.DVF,C.STAT+CSIBLK
	BNE	.+6
	JMP	DONE
	BIT	#MWF!MST,CSIBLK+C.MKW1
	BEQ	.+6
	JMP	SWEAR
	INCB	COPFLG			; SET COPY IF NOT ALREADY
	MOV	#3,FILNUM
	MOV	#INBK1,R0		; GET LUN FOR FILE 3
	MOV	#INBK1+F.FNB,R1
	MOV	#CSIBLK+C.DSDS,R2
	CLR	R3
	CALL	PRSDV
	MOV	FILNUM,QATT+Q.IOLU	; PREPARE TO ATTACH
	DIR$	#QATT			; ATTACH
	WTSE$S	#2
	ERRPRT	#3,RET
	MOV	#STASAV,R5		; SAVE PREVIOUS STATUS
	MOV	(R5)+,STSV2
	MOV	(R5)+,STSV2+2
	MOV	(R5),STSV2+4		; STATUS SAVED
	JSR	R4,SWTPRS		; PROCESS SWITCHES
	PRAD1-2		; TEMP
	2*NSW1
	CALL	SETCHR			;SET CHARACTERISTICS HERE

	.SBTTL MAIN PROGRAM--TAPE TRANSFER
;
;	  6.2 TAPE TRANSFER
;
;		AT THIS POINT, ALL THE PREPARATIONS FOR READING,
;		WRITING, OR LISTING A TAPE ARE COMPLETE. THE COMMAND
;		HAS BEEN PARSED AND ALL SWITCHES PROCESSED-- THEIR
;		ACTIONS EITHER COMPLETED OR APPROPRIATE FLAGS SET. THE
;		DEVICE CHARACTERISTICS HAVE BEEN SET, LUN'S ASSIGNED,
;		AND DEVICES ATTACHED. IF A LISTING FILE IS NEEDED, IT
;		HAS BEEN OPENED.
;
;
;		THE TAPE TRANSFER CODE IS SUMMARIZED BY THE FOLLOWING:
;
;	1) A RECORD IS READ FROM THE INPUT TAPE.
;	2) IF NECESSARY, TRANSLATION IS DONE TO PUT THE INFORMATION IN
;	   A PACKED WORD FORMAT.
;	3) IF REQUESTED, THE RECORD IS LISTED ACCORDING TO SPECIFIED
;	   FORMATS.
;	4) IF VERIFY IS REQUESTED, THE OUTPUT TAPE IS READ, TRANSLATED
;	   TO PACKED WORD FORMAT, AND A WORD-BY-WORD COMPARISON MADE.
;	   ERRORS ARE REPORTED.
;	5) IF A COPY OPERATION IS SPECIFIED, THE INFORMATION IS TRANSLATED
;	   TO THE PROPER FORMAT AND WRITTEN TO THE OUTPUT TAPE.
;
;		THIS PROCESS CONTINUES, RECORD BY RECORD UNTIL THE
;		SPECIFIED AMOUNT OF INFORMATION HAS BEEN PROCESSED.
;		UPON COMPLETION, FILE MARKS ARE WRITTEN OR VERIFIED
;		AS REQUESTED, PREVIOUS TAPE STATUS IS RETURNED, AND
;		THE APPROPRIATE FLAGS RESET. CONTROL THEN IS TRANSFERED
;		TO THE BEGINNING OF THE PROGRAM.
;
;
;DO A READ
;
	MOV	#1,FILCNT
	CLR	RECCNT
	CLRB	EOVFLG						;MK07
READ:	MOV	INBUF,QRLB+Q.IOPL	; SET UP PARAMETERS	;MK01
	MOV	BUFLEN,QRLB+Q.IOPL+2				;MK01
	MOV	#3,QRLB+Q.IOLU
	DIR$	#QRLB			; READ
	WTSE$S	#10
	MOV	IOST+2,R0		; SAVE # OF BYTES
	INC	R0			;ROUND TO EVEN		;MK01
	BIC	#1,R0						;MK01
	MOV	R0,BYTSRD
	ASR	R0			; BYTES TO WORDS
	MOV	R0,NWRDS
	CMPB	IOST,#IE.EOF		; TEST FOR EOF
	BNE	.+6
	JMP	TSTATT			; BRANCH ON EOF FOUND	;MK03
	INC	RECCNT			; UP COUNTER
	CLRB	EOVFLG			; HAVE NON EOF RECORD
	CLR	FREAD			; TREAT AS ERROR REPORT FLAG
	ERRPRT
CONVRT:	MOV	@STASAV,R5		; R5 HAS STATUS
	BIT	#4,R5			; IS INPUT IN "IM"?
	BNE	HAVWRD			; YES
	MOV	INBUF,R0		; SETUP FOR BE OR KS	;MK01
	CALL	KSBECV			; CONVERT KS & BE
HAVWRD:	MOV	NWRDS,BYTSRD
	ASL	BYTSRD			; CORRECT BYTE COUNT
	; READY FOR PRINTOUT IF REQUESTED
	TSTB	LSTFLG			; LIST WANTED?
	BEQ	TRNOUT			; NO
	TST	FREAD			; PRINT ON LISTING DEVICE?
	BEQ	PDFI			; NO
	CALL	LSTERR			; REPORT ERROR ON LIST DEVICE
PDFI:	MOV	#RECMES+4,R0		; PRINT DEFAULT INFO	;MK05
	MOV	FILCNT,R1					;MK05
	CALL	CBDMG
	MOV	#RECMES+22,R0					;MK05
	MOV	RECCNT,R1					;MK05
	CALL	CBDMG						;MK05
	MOV	#RECMES+31,R0					;MK05
	MOV	BYTSRD,R1
	CALL	CBDMG
	PUT$	#OTBK2,#RECMES,#37.				;MK05
	CALL	PUTCHK						;MK09
	TST	PLINE			; TEST FOR BYTE PRINT
	BEQ	TRNOUT
	CLR	DDRES
	MOV	INBUF,R2					;MK01
	CLRB	PODFLG
	MOV	BYTSRD,LASTAD
	ADD	INBUF,LASTAD		; COMPUTE LAST ADDR IN BUFFER;MK01
POLO2:	MOV	#CONVAD,R5		; CONVERT ROUTINE ADDRESSES
	MOV	PLINE,TP		; SAVE # OF LINES
	MOV	DDRES,R1		; PRINT RELATIVE ADDR
	MOV	#ASCBUF,R0
	CALL	$CBOMG
POLO3:	MOV	#20040,(R0)+		; 2 SPACES
	MOV	#8.,R4			; NUMBERS /LINE
POLO:	MOV	(R2)+,R1
	CMP	R2,LASTAD
	BLE	POCO
	INCB	PODFLG			; DONE SOON
	BR	POCOO
POCO:	JSR	PC,@(R5)
	MOVB	#40,(R0)+		; SPACE BETWEEN FIELDS
POCOO:	DEC	R4			; WORD COUNT
	BNE	POLO
	SUB	#ASCBUF,R0		; GET BYTE COUNT
	CMP	R0,#8.			; DON'T PRINT JUST AN ADDRESS
	BLE	POCOD
	MOV	R0,OTBK2+F.NRBD
	PUT$	#OTBK2,#ASCBUF		; PUT THIS ONE AWAY
	CALL	PUTCHK						;MK09
POCOD:	DEC	TP			; ONE LESS LINE @ THIS ADDR
	BEQ	POTA
	TST	(R5)+			; NEXT ROUTINE ADDR
	SUB	#20,R2			; TO GET BACK 
	MOV	#ASCBUF,R0
	MOV	#20040,(R0)+
	MOV	#20040,(R0)+
	MOV	#20040,(R0)+
	BR	POLO3			; DO VARIOUS OUTPUT TYPES
POTA:	ADD	#20,DDRES
	TSTB	PODFLG			; ALL DONE?
	BEQ	POLO2

; OUTPUT OR VERIFY RECORD
;
TRNOUT:	TSTB	ATTFLG			; WRITE TO TAPE?
	BNE	.+6
	JMP	UPDATE
	TSTB	VERFLG			; VERIFY?
	BNE	.+6
	JMP	NOVFY
;
; OUTPUT IS TO BE VERIFIED AGAINST INPUT
	CMP	NWRDS,VERLEN		; IS THERE ROOM?	;MK01
	BLT	VERLOK
	TYPE	#ERVBF,#30.,#40		; NOPE
	JMP	DONE			; GIVE UP
VERLOK:	MOV	VERBUF,QRLB+Q.IOPL				;MK01
	MOV	VERLEN,QRLB+Q.IOPL+2				;MK01
	MOV	#1,QRLB+Q.IOLU
	DIR$	#QRLB
	WTSE$S	#10			; WAIT FOR READ DONE
	MOV	NWRDS,TP		; SAVE WORD COUNT
	MOV	IOST+2,R0		; SAVE BYTE COUNT
	INC	R0			;ROUND TO EVEN		;MK01
	BIC	#1,R0						;MK01
	MOV	R0,BYTSRD
	ASR	R0
	MOV	R0,NWRDS
	ERRPRT	#1
	MOV	@STSV2,R5
	BIT	#4,R5			; IN "IM"?
	BNE	VERDCV
	MOV	VERBUF,R0		; STARTING ADDRESS	;MK01
	CALL	KSBECV
VERDCV:	CMP	NWRDS,TP		; ARE LENGTHS SAME?
	BEQ	VERLCK
	TYPE	#ERVDL,#22.,#40
	JMP	DONE			; QUIT
VERLCK:	CLR	MISMAT
	MOV	INBUF,R0					;MK01
	MOV	VERBUF,R1					;MK01
VERLOP:	CMP	(R0)+,(R1)+
	BEQ	VERWCK			; BRANCH IF O.K.
	INC	MISMAT
VERWCK:	DEC	TP
	BNE	VERLOP
	TST	MISMAT
	BEQ	VERSUC
	MOV	#ERVFY+18.,R0		; FILL IN THE MESSAGE
	MOV	FILCNT,R1		; INSERT FILE COUNT
	CALL	CBDMG
	MOV	#ERVFY+32.,R0		; NOW RECORD COUNT
	MOV	RECCNT,R1
	CALL	CBDMG
	MOV	#ERVFY+52.,R0		; NOW MISMATCH COUNT
	MOV	MISMAT,R1
	CALL	CBDMG
	TYPE	#ERVFY,#65.,#40		; TYPE THE MESSAGE
VERSUC:	JMP	UPDATE
;
; OUTPUT IS TO BE COPIED FROM INPUT
NOVFY:	MOV	INBUF,OUTADR					;MK01
	BIT	#4,@STSV2		; IN "IM"?
	BNE	HAVOUT			; YES -- BRANCH
	MOV	INBUF,R0		; INPUT BUFFER ADDRESS	;MK01
	MOV	OUTBUF,R1		; OUTPUT BUFFER		;MK01
	MOV	R1,OUTADR
	MOV	NWRDS,R4	;INIT WORD COUNTER		;MK02
	MOV	(R0)+,R2	;GET FIRST WORD			;MK02
	SEC			;SET WORD MARKER		;MK02
	BIT	#2,@STSV2	;"BE" MODE FOR OUTPUT?		;MK02
	BNE	BEOUT		;YES				;MK02
;
; DO TRANSLATION FOR KS MODE
KSOUT:	MOVB	#40,R3		;SET CHAR MARKER		;MK02
1$:	ROR	R2		;SHIFT OUT OF WORD		;MK02
	BEQ	2$		;WORD DONE			;MK02
	RORB	R3		;SHIFT INTO CHAR		;MK02
	BCC	1$		;DO ANOTHER BIT			;MK02
	ASRB	R3		;ALIGN CHAR			;MK02
	ASRB	R3						;MK02
	MOVB	R3,(R1)+	;SAVE CHAR			;MK02
	BR	KSOUT		;DO ANOTHER CHAR		;MK02
2$:	MOV	(R0)+,R2	;GET NEXT WORD			;MK02
	DEC	R4		;DONE?				;MK02
	BNE	1$		;NO				;MK02
	CMPB	R3,#40		;INCOMPLETE CHAR?		;MK02
	BEQ	HAVOU		;NO				;MK02
	CLC							;MK02
3$:	RORB	R3		;FILL WITH 0 BITS		;MK02
	BCC	3$						;MK02
	ASRB	R3		;ALIGN CHAR			;MK02
	ASRB	R3						;MK02
	BR	SLAST						;MK02
;
; DO TRANSLATION FOR BE MODE
BEOUT:	MOVB	#4,R3		;SET CHAR MARKER		;MK02
1$:	ROL	R2		;SHIFT OUT OF WORD		;MK02
	BEQ	2$		;WORD DONE			;MK02
	ROLB	R3		;SHIFT INTO CHAR		;MK02
	BCC	1$		;DO ANOTHER BIT			;MK02
	MOVB	R3,(R1)+	;SAVE CHAR			;MK02
	CLC							;MK02
	BR	BEOUT		;DO ANOTHER CHAR		;MK02
2$:	MOV	(R0)+,R2	;GET NEXT WORD			;MK02
	DEC	R4		;DONE?				;MK02
	BNE	1$		;NO				;MK02
	CMPB	R3,#4		;INCOMPLETE CHAR?		;MK02
	BEQ	HAVOU		;NO				;MK02
3$:	ASLB	R3		;FILL WITH 0 BITS		;MK02
	BCC	3$						;MK02
SLAST:	MOVB	R3,(R1)+	;STORE LAST CHAR		;MK02
HAVOU:	BIT	#1,R1		;ODD NO OF BYTES?		;MK02
	BEQ	1$		;NO				;MK02
	CLRB	(R1)+		;PAD TO EVEN NO			;MK02
1$:	SUB	OUTBUF,R1					;MK01
	MOV	R1,BYTSRD		; PROPER BYTE COUNT
;
; TRANSLATION (IF ANY) ON OUTPUT IS DONE
HAVOUT:	CMP	BYTSRD,#14.		; CHECK FOR SHORT RECORD
	BGE	HAVNUF
	MOV	OUTADR,R0		; FILL IN ZEROES
	MOV	R0,R1			; GET STOP LOCATION
	ADD	#14.,R1
	ADD	BYTSRD,R0
HAVPAD:	CLRB	(R0)+			; PUT THEM IN
	CMP	R0,R1			; MUST BE 14 AT LEAST
	BLE	HAVPAD
	MOV	#14.,BYTSRD		; MAKE LENGTH THE MINIMUM
HAVNUF:	MOV	BYTSRD,QWLB+Q.IOPL+2
	MOV	OUTADR,QWLB+Q.IOPL
	DIR$	#QWLB
	WTSE$S	#11
	ERRPRT	#1
	BR	UPDATE
;
; DO PROCESSING FOR EOF ON INPUT TAPE
TSTATT:	TSTB	ATTFLG			; WRITE EOF TO OUTPUT TAPE
	BEQ	TSTVAL			; FOR A COPY OPERATION	;MK03
	TSTB	VERFLG			; DON'T DO IT IF DOING VERIFY
	BEQ	DIRWF
	MOV	VERBUF,QRLB+Q.IOPL				;MK01
	MOV	VERLEN,QRLB+Q.IOPL+2				;MK01
	MOV	#1,QRLB+Q.IOLU
	DIR$	#QRLB
	WTSE$S	#10			; WAIT FOR READ DONE
	CMPB	IOST,#IE.EOF		; TEST FOR EOF
	BEQ	TSTVAL		;YES - CONTINUE			;MK04
	JMP	IOVER		;REPORT MISSING EOF ERROR	;MK04
DIRWF:	DIR$	#QEOF			; WRITE EOF
	WTSE$S	#13
	ERRPRT	#1
TSTVAL:	INCB	EOVFLG			; BEEN HERE TWICE IN A ROW?
	CMPB	EOVFLG,#2		; IF SO WE ARE AT EOV
	BLT	SWTCHV						;MK03
; BACK UP TAPES OVER SECOND FILE MARK OF DOUBLE EOF
	MOV	#-1,QSPF+Q.IOPL					;MK04
	MOV	#3,QSPF+Q.IOLU					;MK04
	DIR$	#QSPF		;BACK UP INPUT TAPE		;MK04
	WTSE$S	#6						;MK04
	TSTB	ATTFLG		;IS THERE AN OUTPUT?		;MK04
	BEQ	1$		;NO				;MK04
	MOV	#1,QSPF+Q.IOLU					;MK04
	DIR$	#QSPF		;BACK UP OUTPUT TAPE		;MK04
	WTSE$S	#6						;MK04
1$:	MOVB	#IE.EOV,IOST		; FAKE AN EOV
	DEC	FILCNT			; DON'T COUNT DOUBLE TM
	MOV	FILCNT,IOST+2		; FURNISH COUNT
	CALL	TAPERR			; LET TAPE ERROR ROUTINE REPORT
	CALL	LSTERR			; PUT ON LIST DEVICE
	BR	IODUN			; STOP HERE
SWTCHV:	BIT	#MFI,CSIBLK+C.MKW1	; TEST FOR /FI SWITCH
	BNE	FILCTR			; BRANCH IF MATCH
	BIT	#MRE,CSIBLK+C.MKW1
	BEQ	FILBMP
	MOV	RECCNT,IOST+2		; REPORT # RECORDS READ
	MOV	#IE.EOF,IOST		; PUT IN EOF ERROR
	CALL	TAPERR
	CALL	LSTERR			; PUT ON LIST DEVICE
	BR	IODUN
FILCTR:	CMP	FILCNT,FIVAL
	BEQ	IODUN
FILBMP:	INC	FILCNT
	CLR	RECCNT
;
; CHECK RECORD COUNT
UPDATE:	BIT	#MRE,CSIBLK+C.MKW1
	BNE	.+6
	JMP	READ
	CMP	RECCNT,REVAL
	BEQ	IODUN
	JMP	READ

;PROCESSING FOR END OF COPY/VERIFY OPERATION
;
IODUN:	TSTB	LWFFLG			; TEST FOR LATENT WRITE EOF
	BEQ	IOEND
	CLRB	LWFFLG			; DO IT
	TSTB	VERFLG			; WF HAS SPECIAL MEANING FOR /VE
	BEQ	WFEND
	MOV	#1,QRLB+Q.IOLU		; READ RECORDS TO COUNT EOF'S
	MOV	INBUF,QRLB+Q.IOPL				;MK01
IOSR:	DIR$	#QRLB			; READ ONE RECORD
	WTSE$S	#10
	CMPB	#IE.EOF,IOST		; CHECK FOR EOF
	BNE	IOVER			; NOT FOUND IS ERROR
	DEC	WFVAL			; LOOK FOR NUMBER SPECIFIED
	BGT	IOSR
	BR	IOEND			; DONE IF ALL FOUND
IOVER:	TYPE	#ERNFM,#31.,#40
	BR	IOEND			; REPORT ERROR AND QUIT
WFEND:	DIR$	#QEOF			; WRITE EOF
	WTSE$S	#13
	ERRPRT	#1
	DEC	WFVAL			; WRITE # SPECIFIED
	BGT	WFEND
IOEND:	TSTB	COPFLG			; IF THIS ISN'T COPY --> DONE
	BEQ	DONE			; HAPPENS WITH MT0:/WF:5/VE
; RETURN STATUS
	MOV	STASAV,R5
	MOV	STASAV+2,(R5)+
	MOV	STASAV+4,(R5)		; STATUS OF FILE 3 BACK
	MOV	#3,QSTC+Q.IOLU
	CALL	SETCRS			; CHAR BACK
;
	TSTB	ATTFLG			; IF #1 ATTACHED, RETURN STATUS
	BEQ	DONE
	MOV	STSV2,R5
	MOV	STSV2+2,(R5)+
	MOV	STSV2+4,(R5)		; STATUS OF FILE 1 BACK
	MOV	#1,QSTC+Q.IOLU
	CALL	SETCRS			; CHAR BACK
DONE::	MOV	#3,QDET+Q.IOLU		; DETACH DEVICES
	DIR$	#QDET			; WHETHER THEY NEED IT OR NOT
	WTSE$S	#4
	MOV	#1,QDET+Q.IOLU
	DIR$	#QDET
	WTSE$S	#4
	CLRB	VERFLG			; DONE WITH VERIFY
	CLRB	ATTFLG
	MOV	#1,FILCNT
	MOV	#1,RECCNT		; RESET FILE & RECORD COUNTS
	TSTB	LSTFLG
	BEQ	END
	CLRB	LSTFLG
	CLOSE$	#OTBK2
END:	JMP	GO

	.SBTTL SUBROUTINES
;
;
;	7.0 SUBROUTINES
;
;
;	WRITE MESSAGES ON THE TERMINAL AS SETUP BY "TYPE" MACRO
;
QGO::	TST	-(R5)
	BLE	QRT
	DIR$	#QWVB
	WTSE$S	#1
QRT:	RETURN
;
;
;	SUBROUTINE TO SET CHARACTERISTICS
;	LUN IS TAKEN FROM FILNUM
;	CHARACTERISTICS WORD IS TAKEN FROM 2@TPSAD
;	UNLESS OPTIONAL ENTRY IS MADE AT "SETCRS"
;	IN THAT CASE, R5 HAS ADDRESS OF CHAR. WORD
;	AND LUN MUST BE SET BEFORE CALL
;
SETCHR:	MOV	FILNUM,QSTC+Q.IOLU
	MOV	TPSAD,R5
	TST	(R5)+
SETCRS:	MOV	(R5),QSTC+Q.IOPL	; OPTIONAL ENTRY
	DIR$	#QSTC
	WTSE$S	#7
	RETURN
;
;
;
;	THIS SUBROUTINE IS RESPONSIBLE FOR ALL SWITCH PROCESSING.
;	IT DETERMINES WHICH SWITCHES ARE PRESENT AND, AS
;	THEY ARE DETECTED, CALLS THE APPROPRIATE SWITCH PROCESS-
;	ING ROUTINE.
;
;	R3&R2 MUST NOT BE CHANGED IN SWITCH PROCESS ROUTINES
;
SWTPRS:	MOV	(R4)+,ADRES
	MOV	(R4)+,NSWT
	MOV	CSIBLK+C.MKW1,R3
	CLR	R2
	CMP	FILNUM,#2
	BEQ	SWTNXT			; GET STATUS FIELDS 1&3 ONLY
GETSTT:	MOV	CSIBLK+C.DEVD+2,R0
	MOVB	2(R0),R5		; R5 HAS ASCII INFO 
	MOV	#STATAD,TPSAD
	BIC	#177700,R5		; LOW BYTE ONLY
	SUB	#60,R5			; MAKE UNIT # AN OFFSET
	CMP	C.DEVD+CSIBLK,#3	; LEGAL DEVICE SPECS MUST HAVE
	BNE	GETILD			; 3 ASCII LETTERS
	CMP	R5,#LMTU		; CHECK FOR ILLEGAL DEVICE
	BLE	GETSTV			; 0-7  LEGAL (MAY NOT BE PRESENT)
GETILD:	TYPE	#ERILD,#20.,#40		; REPORT ERROR
	TST	(SP)+			; PRESERVE STACK
	JMP	DONE			; ABNORMAL ABORT
GETSTV:	ASL	R5
	ASL	R5
	ADD	R5,TPSAD		; NOW HAVE STATUS ADDR
	MOV	TPSAD,R5		; SAVE OLD ADDRESS AND STATUS
	MOV	R5,STASAV
	MOV	(R5),STASAV+2
	MOV	2(R5),STASAV+4
SWTNXT:	MOV	ADRES,R1
SWTCHK:	CMP	R2,NSWT
	BNE	SWTCNT
	RTS	R4
SWTCNT:	TST	(R2)+
	ASR	R3
	BCC	SWTCHK
	ADD	R2,R1
	JMP	@(R1)
;
;	SWITCH PROCESSING ROUTINES -- FIELDS 1 & 3
;
PRKS:	BIS	#MKS!M55,(R5)		; /KS
	BIC	#MBE!MIM!M20!M80!MCD,(R5)
	BR	SET55
PRBE:	BIS	#MBE!M55,(R5)		; /BE
	BIC	#MKS!MIM!M20!M80!MCD,(R5)
	BR	SET55
PRIM:	BIS	#MIM!MCD,(R5)		; /IM
	BIC	#MKS!MBE!M20!M55!M80,(R5)
	BR	SETCD
PR20:	BIS	#M20,(R5)		; /20
	BIC	#M55!MCD!M80,(R5)
	BIS	#2,2(R5)
	BIC	#5,2(R5)
	BR	SWTNXT
PR55:	BIS	#M55,(R5)		; /55
	BIC	#M20!MCD!M80,(R5)
SET55:	BIS	#1,2(R5)		; SET STATUS WORD
	BIC	#6,2(R5)
	BR	SWTNXT
PR80:	BIS	#M80,(R5)		; /80
	BIC	#M20!MCD!M55,(R5)
	BIC	#7,2(R5)
	BR	SWTNXT
PRCD:	BIS	#MCD,(R5)		; /CD
	BIC	#M20!M55!M80,(R5)
SETCD:	BIS	#4,2(R5)
	BIC	#3,2(R5)
	BR	SWTNXT
PREP:	MOV	#MRW,R1			; /EP & /-EP
	MOV	#MEP,R0
	BIS	#10,2(R5)		; ASSUME EP
	BIT	#MEP,CSIBLK+C.MKW2
	BNE	PREPC
	ASL	R0
	ASR	R1
	BIC	#10,2(R5)
PREPC:	BIS	R0,(R5)
	BIC	R1,(R5)
	BR	SWTNXT
PRRW:	CALL	SETCHR			; /RW
	MOV	FILNUM,QRWD+Q.IOLU
	DIR$	#QRWD
	WTSE$S	#5
	ERRPRT
	JMP	SWTNXT
PRSF:	CALL	SETCHR			; /SF
	MOV	FILNUM,QSPF+Q.IOLU
	MOV	SFVAL,QSPF+Q.IOPL
	DIR$	#QSPF
	WTSE$S	#6
	ERRPRT
	JMP	SWTNXT
PRSR:	CALL	SETCHR			; /SR
	MOV	FILNUM,QSPB+Q.IOLU
	MOV	SRVAL,QSPB+Q.IOPL
	DIR$	#QSPB
	WTSE$S	#3
	DEC	IOST+2			; DON'T COUNT FILE MARK
	ERRPRT
	JMP	SWTNXT
					; /WF
PRWF:	BIT	#MVE,CSIBLK+C.MKW1	; DON'T WRITE IF VERIFY
	BNE	PRWFV
	TSTB	COPFLG			; DO EOF'S AT END OF COPY
	BEQ	PRWFC			; DO IT NOW IF NOT COPY
PRWFV:	INCB	LWFFLG			; LET THEM KNOW LATER
	BR	PRRE
PRWFC:	CALL	SETCHR			; GET CHARACTERISTICS
	DIR$	#QEOF
	WTSE$S	#13
	ERRPRT
	DEC	WFVAL
	BGT	PRWFC+4
PRRE:	JMP	SWTNXT			; /RE
PRFI=PRRE				; /FI
PRVE:	INCB	VERFLG			; /VE
	JMP	SWTNXT
PRST:	MOV	CSIBLK+C.DEVD+2,R5	; /ST
	MOVB	2(R5),SL+3
	TYPE	#SL,#5,#44		; PRINT DEVICE
	MOV	@TPSAD,R1		; R1 HAS STATUS
	MOV	#STSW-2,R0
PRCMP:	TST	(R0)+
	CMP	R0,#SL
	BLT	PRSTC
	JMP	SWTNXT
PRSTC:	ASR	R1			; SEE IF BITS SET
	BCC	PRCMP
	MOV	(R0),SL+6
	TYPE	#SL+5,#3,#0		; IF SET -- PRINT SWITCH
	BR	PRCMP
;
;
;
;	SWITCH PROCESS ROUTINES FOR THE LISTING FIELD
;
PROW:	MOV	#CBOW,(R5)+	;/OW				;MK06
	BR	PRXX						;MK06
PROB:	MOV	#CBOB,(R5)+	;/OB				;MK06
	BR	PRXX						;MK06
PRDW:	MOV	#CBDW,(R5)+	;/DW				;MK06
	BR	PRXX						;MK06
PRDB:	MOV	#CBDB,(R5)+	;/DB				;MK06
	BR	PRXX						;MK06
PRAS:	MOV	#CBAS,(R5)+	;/AS				;MK06
	BR	PRXX						;MK06
PRRA:	MOV	#CBRA,(R5)+	;/RA				;MK06
PRXX:	INC	PLINE		;BUMP LINE COUNT		;MK06
PRLG:	JMP	SWTNXT		;/LG (DEFAULT - IGNORED)	;MK06

;	CONVERT A WORD TO 7 BYTES OF ASCII
;	THESE ROUTINES ARE FOR THE LISTING FILE
CBOW:	MOVB	#40,(R0)+
	CALL	$CBOMG
	RETURN
CBOB:	MOV	R0,-(SP)
	MOV	R1,-(SP)		; SAVE ADDR AND NUMBER
	MOV	#MINIBF+1,R0
	SWAB	R1			; DO HIGH BYTE FIRST
	BIC	#177400,R1		; ONE BYTE ONLY
	CALL	$CBOMG
	MOV	#MINIBF-3,R0		; NOW LOW BYTE
	MOV	(SP)+,R1
	BIC	#177400,R1
	CALL	$CBOMG
	MOVB	#40,(R0)+
	MOV	(SP)+,R0		; OLD ADDR
	CALL	MOVE7
	RETURN
MOVE7:	MOV	#MINIBF,R3
MOV7S:	MOVB	(R3)+,(R0)+
	CMP	R3,#MININD
	BLT	MOV7S
	RETURN
;
CBDW:	TST	R1
	BLT	CBDWP
	MOVB	#40,(R0)+
CBDWP:	CALL	$CBDSG
; FLOAT THE SIGN PAST LEAD ZEROS				;MK06
	DEC	R0		;ALWAYS LEAVE ONES DIGIT	;MK06
	MOV	R0,-(SP)	;SAVE END ADDRESS		;MK06
	SUB	#4,R0		;GO BACK 4 DIGITS		;MK06
1$:	CMPB	(R0),#60	;ZERO?				;MK06
	BNE	2$		;NO - DONE			;MK06
	MOVB	-1(R0),(R0)+	;DRAG SIGN ALONG		;MK06
	MOVB	#40,-2(R0)	;BLANK OLD SIGN POSITON		;MK06
	CMP	R0,(SP)		;LAST DIGIT DONE?		;MK06
	BLO	1$		;NO				;MK06
2$:	MOV	(SP)+,R0	;RESTORE END ADDRESS		;MK06
	INC	R0						;MK06
	MOVB	#56,(R0)+
	RETURN
;
	.BLKB	3
MINIBF:	.BLKB	7
MININD=.
;
CBDB:	MOV	R0,-(SP)		; SAVE R0 & R1
	MOV	R1,-(SP)
	MOV	#MINIBF+1,R0		; HIGH BYTE FIRST
	SWAB	R1
	BIC	#177400,R1		; SINGLE BYTE
	CALL	CBDMG
	MOVB	#56,(R0)		; DECIMAL POINT
	MOV	(SP)+,R1
	MOV	#MINIBF-3,R0		; DO OTHER BYTE
	BIC	#177400,R1		; ONE BYTE
	CALL	CBDMG
	MOVB	#56,(R0)		; OTHER DECIMAL PT
	MOV	(SP)+,R0		; ORIGINAL PLACE IN BUFFER
	MOVB	MINIBF-1,-(R0)		; SPECIAL CASE--NO SPACE
	INC	R0			; DON'T OVERPRINT
	CALL	MOVE7			; GET THE REST
	RETURN
;
CBAS:	BIC	#100200,R1		; 7-BIT ASCII
	MOV	R1,-(SP)		; ASCII  PRINT ROUTINE
	MOV	#2,R3			; TWO BYTES
CBASS:	BIC	#177600,R1		; 7-BITS
	MOVB	#40,(R0)+		; PROPER SPACING
	CMPB	R1,#40			; TEST FOR CONTROL CHAR.
	BGE	CBASC
	MOVB	#136,(R0)+		; "^" BEFORE CONTRL CHAR.
	ADD	#100,R1			; REGULAR UPPERCASE
	BR	CBASR
CBASC:	CMPB	R1,#140			; LOWER CASE?
	BGE	CBASL			; BRANCH IF SO.
	MOVB	#40,(R0)+		; SPACE IF REGULAR UPPERCASE
	BR	CBASR
CBASL:	MOVB	#45,(R0)+		; PRECEED LOWERCASE W/ "%"
	SUB	#40,R1			; REGULAR UPPERCASE
CBASR:	MOVB	R1,(R0)+		; GET CHARACTER
	DEC	R3			; DONE?
	BEQ	CBASD			; IF YES, BRANCH
	MOVB	#40,(R0)+		; ANOTHER SPACE
	MOV	(SP)+,R1		; GET OTHER BYTE
	SWAB	R1
	BR	CBASS
CBASD:	RETURN
;
CBRA:	MOV	R2,-(SP)		; SAVE R2
	MOV	#40,R3			; SPACES
	MOVB	R3,(R0)+
	MOVB	R3,(R0)+
	CALL	$C5TA
	MOVB	R3,(R0)+
	MOVB	R3,(R0)+
	MOV	(SP)+,R2		; RETURN R2
	RETURN

;	CONVERT BINARY WORD TO DECIMAL ASCII WITH LEADING SPACES
;	(MODIFY RESULT OF $CBDMG)
;
CBDMG::	JSR	R2,(PC)		;SAVE R2 AND SET NON-ZERO	;MK05
	CALL	$CBDMG			; GET ASCII WITH LEADING 0'S
	DEC	R0			; SAVE ONE ZERO!
	MOV	R0,-(SP)		; SAVE LAST ADDRESS	;MK05
	SUB	#4,R0
CBSUB:	CMPB	(R0),#60		; A ZERO?
	BNE	CBFDUN			; IF NOT THEN EXIT
	MOVB	#40,(R0)+		; IF SO, REPLACE
	CMP	R0,(SP)						;MK05
	BLO	CBSUB			; REPLACE UP TO FOUR
CBFDUN:	MOV	(SP)+,R0		; RESTORE R0		;MK05
	MOV	(SP)+,R2		; RESTORE R2		;MK05
	INC	R0
	RETURN
;
;
;	PARSE DEVICE SPECS
;	IF CARRY IS SET AFTER SYSTEM ROUTINE FINISHES, REPORT
;	"DEVICE NOT IN SYSTEM"; OTHERWISE RETURN.
;
PRSDV:	CALL	.PRSDV			; MOST OF WORK DONE BY SYSTEM
	BCC	.+6			; RETURN IF NO ERROR
	JMP	GETILD			; REPORT ERROR AND ABORT
	RETURN				; NO ERROR ---> RETURN
;
;	TRANSLATION SUBROUTINE
;	PACKS INFORMATION READ IN BERKELEY OR KS FORMAT INTO
;	PACKED WORD FORMAT -- IN THE SAME BUFFER.
;
KSBECV:	MOV	R0,-(SP)		;SAVE BUFFER START	;MK01
	MOV	BYTSRD,R1		; # OF BYTES
	ADD	R0,R1
	MOV	#-1,(R1)		; MARK BUFFER END
	MOV	R0,R1
	BIT	#2,R5			; IS INPUT IN "BE"?
	BNE	BE2W			; YES
	CLR	R2			; KS TO WORD FORMAT
KS1:	MOV	#100000,R3		; SET WORD MARKER
KS2:	ASRB	R2
	BEQ	KS3
	ROR	R3
	BCC	KS2
	MOV	R3,(R1)+		; STORE WORD
	BR	KS1
KS3:	MOVB	(R0)+,R2		; GET BYTE
	BISB	#100,R2			; SET MARKER
	BPL	KS2			; LOOP TILL END OF DATA
	BR	HAVWR
BE2W:	MOV	#200,R2			; SET TO GET FIRST BYTE
BE1:	MOV	#1,R3			; SET WORD MARKER
BE2:	ASLB	R2			; SHIFT BIT TO C
	BEQ	BE3			; TIME TO GET NEXT BYTE
	ROL	R3			; SHIFT C TO BIT
	BCC	BE2
	MOV	R3,(R1)+		; STORE WORD
	BR	BE1
BE3:	MOVB	(R0)+,R2		; GET BYTE
	ROLB	R2			; ALIGN AND SET BYTE MARKER
	ASLB	R2
	BCC	BE2
HAVWR:	SUB	(SP)+,R1		; BYTES IN BUFFER	;MK01
	ASR	R1			; # OF WORDS
	MOV	R1,NWRDS
	RETURN
;
;	PRINT ERROR MESSAGE ON LISTING DEVICE IF IT ISN'T "TI"
;
LSTERR:	CMP	OTBK2+F.FNB+N.DVNM,LUNBUF			;MK09
	BNE	1$						;MK09
	CMPB	OTBK2+F.FNB+N.UNIT,LUNBUF+2			;MK09
	BEQ	LSTERO			; IF ON TI JUST RETURN
1$:	PUT$	#OTBK2,#ASCBUF,FREAD	; WRITE IT
LSTERO:	RETURN
;
;	CHECK OPEN OR PUT ON LIST FILE
;
OPNCHK:	MOV	#OPNERM,R0					;MK09
	BR	OPPUCK						;MK09
PUTCHK:	MOV	#PUTERM,R0					;MK09
OPPUCK:	BCS	1$		;WAS THERE AN ERROR?		;MK09
	RETURN			;NO				;MK09
1$:	TST	(SP)+		;YES - FORGET RETURN		;MK09
	MOV	#LSTERM,R1	;FILL OUT MESSAGE		;MK09
	MOV	(R0)+,(R1)+					;MK09
	MOV	(R0)+,(R1)+					;MK09
	MOV	(R0)+,(R1)+					;MK09
	MOV	#LSTERC,R0					;MK09
	MOVB	OTBK2+F.ERR,R1					;MK09
	CLR	R2						;MK09
	CALL	$CBDSG		;CONVERT ERR CODE		;MK09
	MOVB	#'.,(R0)+	;INSERT PERIOD			;MK09
	SUB	#LSTERM,R0	;GET MESSAGE LENGTH		;MK09
	TYPE	#LSTERM,R0,#40	;TYPE THE MESSAGE		;MK09
	JMP	DONE		;QUIT				;MK09
;
;	TAPE BUFFER (ALLOCATED BY EXTTSK OR /INC)		;MK01
;
	.PSECT	...BUF,RW		;THIS MUST BE LAST PSECT LINKED
BUFST:	.BLKW	16.+6.						;MK01
	.END	INIT						;MK01